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

Changeset 9939


Ignore:
Timestamp:
2018-07-13T09:28:50+02:00 (6 years ago)
Author:
gm
Message:

#1911 (ENHANCE-04): RK3 branche phased with MLF@9937 branche

Location:
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3
Files:
1 deleted
154 edited
2 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg

    r9773 r9939  
    3030   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time 
    3131   ! 
    32    rn_rdt      = 5760.     !  time step for the dynamics and tracer 
     32   rn_Dt       = 5760.     !  time step for the dynamics and tracer 
    3333/ 
    3434!----------------------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg

    r9773 r9939  
    3131   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time 
    3232   ! 
    33    rn_rdt      = 1440.     !  time step for the dynamics (and tracer if nn_acc=0) 
     33   rn_Dt       = 1440.     !  time step for the dynamics (and tracer if nn_acc=0) 
    3434/ 
    3535!----------------------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg

    r9773 r9939  
    3131   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time 
    3232   ! 
    33    rn_rdt      = 480.     !  time step for the dynamics (and tracer if nn_acc=0) 
     33   rn_Dt       = 480.     !  time step for the dynamics (and tracer if nn_acc=0) 
    3434/ 
    3535!----------------------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg

    r9771 r9939  
    3030   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time 
    3131   ! 
    32    rn_rdt      = 5760.     !  time step for the dynamics and tracer 
     32   rn_Dt       = 5760.     !  time step for the dynamics and tracer 
    3333/ 
    3434!----------------------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/AMM12/EXPREF/namelist_cfg

    r9742 r9939  
    3333&namdom        !   time and space domain 
    3434!----------------------------------------------------------------------- 
    35    rn_rdt      =   600.    !  time step for the dynamics (and tracer if nn_acc=0) 
     35   rn_Dt       =   600.    !  time step for the dynamics (and tracer if nn_acc=0) 
    3636/ 
    3737!----------------------------------------------------------------------- 
    … …  
    301301   ln_dynspg_ts = .true.   ! split-explicit free surface 
    302302   ln_bt_auto   = .false.  ! Number of sub-step defined from: 
    303    nn_baro      = 30       ! =F : the number of sub-step in rn_rdt seconds 
     303   nn_e         = 30       ! =F : the number of sub-step in rn_Dt seconds 
    304304/ 
    305305!----------------------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/C1D_PAPA/EXPREF/namelist_cfg

    r9799 r9939  
    4949&namdom        !   time and space domain 
    5050!----------------------------------------------------------------------- 
    51    rn_rdt      =  360.     !  time step for the dynamics and tracer 
     51   rn_Dt       =  360.     !  time step for the dynamics and tracer 
    5252/ 
    5353!----------------------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/GYRE_BFM/EXPREF/namelist_cfg

    r9560 r9939  
    4545   ln_linssh   = .true.    !  =T  linear free surface  ==>>  model level are fixed in time 
    4646   ! 
    47    rn_rdt      = 7200.     !  time step for the dynamics 
     47   rn_Dt       = 7200.     !  time step for the dynamics 
    4848/ 
    4949 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/GYRE_PISCES/EXPREF/namelist_cfg

    r9742 r9939  
    4545   ln_linssh   = .true.    !  =T  linear free surface  ==>>  model level are fixed in time 
    4646   ! 
    47    rn_rdt      = 7200.     !  time step for the dynamics 
     47   rn_Dt       = 7200.     !  time step for the dynamics 
    4848/ 
    4949!!====================================================================== 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/GYRE_PISCES/cpp_GYRE_PISCES.fcm

    r9139 r9939  
    1 bld::tool::fppkeys   key_top key_mpp_mpi key_iomput 
     1bld::tool::fppkeys   key_top     key_mpp_mpi key_iomput    key_nosignedzero 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r9838 r9939  
    2828&namdom        !   time and space domain 
    2929!----------------------------------------------------------------------- 
    30    rn_rdt      = 5760.     !  time step for the dynamics and tracer 
     30   rn_Dt      = 5760.     !  time step for the dynamics and tracer 
    3131/ 
    3232!----------------------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/ORCA2_OFF_PISCES/EXPREF/namelist_cfg

    r9751 r9939  
    3434   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time 
    3535   ! 
    36    rn_rdt      = 21600.     !  time step for the dynamics and tracer 
     36   rn_Dt       = 21600.     !  time step for the dynamics and tracer 
    3737/ 
    3838!----------------------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/ORCA2_OFF_TRC/EXPREF/namelist_cfg

    r9742 r9939  
    3434   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time 
    3535   ! 
    36    rn_rdt      = 21600.     !  time step for the dynamics and tracer 
     36   rn_Dt       = 21600.     !  time step for the dynamics and tracer 
    3737/ 
    3838!----------------------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/SHARED/namelist_ref

    r9838 r9939  
    4242   nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
    4343   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
    44       nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T 
    45       nn_rstctl   =    0      !  restart control ==> activated only if ln_rstart=T 
     44      ln_1st_euler = .false.  !  =T force a start with forward time step (ln_rstart=T) 
     45      nn_rstctl    =    0     !  restart control ==> activated only if ln_rstart=T 
    4646      !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist 
    4747      !                          !    = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart 
    … …  
    7070   rn_isfhmin  =    1.00   !  treshold [m] to discriminate grounding ice from floating ice 
    7171   ! 
    72    rn_rdt      = 5760.     !  time step for the dynamics and tracer 
     72   rn_Dt       = 5760.     !  time step for the dynamics and tracer 
    7373   rn_atfp     =    0.1    !  asselin time filter parameter 
    7474   ! 
    … …  
    562562!----------------------------------------------------------------------- 
    563563   ln_tide     = .false.      ! Activate tides 
    564       ln_tide_pot   = .true.                !  use tidal potential forcing 
    565          ln_scal_load  = .false.               ! Use scalar approximation for 
    566             rn_scal_load = 0.094               !     load potential 
    567          ln_read_load  = .false.               ! Or read load potential from file 
    568             cn_tide_load = 'tide_LOAD_grid_T.nc'  ! filename for load potential 
     564      ln_tide_pot   = .true.        !  use tidal potential forcing 
     565         ln_scal_load  = .false.       ! Use scalar approximation for 
     566            rn_load    = 0.094         !     load potential 
     567         ln_read_load  = .false.    ! read load potential from file 
     568            cn_tide_load = 'tide_LOAD_grid_T.nc'  ! load potential filename  
    569569            !       
    570570      ln_tide_ramp  = .false.               !  Use linear ramp for tides at startup 
    571          rdttideramp   =    0.                 !  ramp duration in days 
     571         rn_ramp    =    0.                 !  ramp duration in days 
    572572      clname(1)     = 'DUMMY'               !  name of constituent - all tidal components must be set in namelist_cfg 
    573573/ 
    … …  
    888888   ln_dynspg_exp  = .false.   ! explicit free surface 
    889889   ln_dynspg_ts   = .false.   ! split-explicit free surface 
    890       ln_bt_fw      = .true.     ! Forward integration of barotropic Eqs. 
     890      ln_bt_fw      = .true.     ! Forward integration of external mode Eqs. 
    891891      ln_bt_av      = .true.     ! Time filtering of barotropic variables 
    892892         nn_bt_flt     = 1          ! Time filter choice  = 0 None 
    … …  
    894894         !                          !                     = 2 Boxcar over 2*nn_baro  "    " 
    895895      ln_bt_auto    = .true.     ! Number of sub-step defined from: 
    896          rn_bt_cmax   =  0.8        ! =T : the Maximum Courant Number allowed 
    897          nn_baro      = 30          ! =F : the number of sub-step in rn_rdt seconds 
     896         rn_bt_cmax    = 0.8         ! =T : the Maximum Courant Number allowed 
     897         nn_e          = 30          ! =F : the number of sub-step in rn_Dt seconds 
    898898      rn_bt_alpha   = 0.         ! Temporal diffusion parameter (if ln_bt_av=F) 
    899899/ 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/SPITZ12/EXPREF/namelist_cfg

    r9793 r9939  
    2727&namdom        !   time and space domain 
    2828!----------------------------------------------------------------------- 
    29    rn_rdt      =  720.     !  time step for the dynamics and tracer 
     29   rn_Dt       =  720.     !  time step for the dynamics and tracer 
    3030   ! 
    3131/ 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/ice.F90

    r9604 r9939  
    188188   !                                     !!** some other parameters  
    189189   INTEGER , PUBLIC ::   kt_ice           !: iteration number 
    190    REAL(wp), PUBLIC ::   rdt_ice          !: ice time step 
    191    REAL(wp), PUBLIC ::   r1_rdtice        !: = 1. / rdt_ice 
     190   REAL(wp), PUBLIC ::   rDt_ice          !: ice time step 
     191   REAL(wp), PUBLIC ::   r1_Dt_ice        !: = 1. / rdt_ice 
    192192   REAL(wp), PUBLIC ::   r1_nlay_i        !: 1 / nlay_i 
    193193   REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s  

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icealb.F90

    r9604 r9939  
    148148               ! 
    149149               !                       !--- Snow-covered ice albedo (freezing, melting cases) 
    150                IF( pt_su(ji,jj,jl) < rt0_snow ) THEN 
     150               IF( pt_su(ji,jj,jl) < rt0 ) THEN 
    151151                  zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 ) 
    152152               ELSE 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icecor.F90

    r9604 r9939  
    8686      IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        ! 
    8787      !                             !----------------------------------------------------- 
    88          zzc = rhoic * r1_rdtice 
     88         zzc = rhoi * r1_Dt_ice 
    8989         DO jl = 1, jpl 
    9090            DO jj = 1, jpj  
    … …  
    137137               !                 ! heat content variation (W.m-2) 
    138138               diag_heat(ji,jj) = - (  SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) )    &  
    139                   &                  + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_rdtice 
     139                  &                  + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_Dt_ice 
    140140               !                 ! salt, volume 
    141                diag_sice(ji,jj) = SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoic * r1_rdtice 
    142                diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice 
    143                diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice 
     141               diag_sice(ji,jj) = SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_Dt_ice 
     142               diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_Dt_ice 
     143               diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_Dt_ice 
    144144            END DO 
    145145         END DO 
    146146         !                       ! concentration tendency (dynamics) 
    147          zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice  
     147         zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice  
    148148         afx_tot(:,:) = zafx(:,:) 
    149149         IF( iom_use('afxdyn') )   CALL iom_put( 'afxdyn' , zafx(:,:) ) 
    … …  
    158158               !                 ! heat content variation (W.m-2) 
    159159               diag_heat(ji,jj) = diag_heat(ji,jj) - (  SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) )    &  
    160                   &                                   + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_rdtice 
     160                  &                                   + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_Dt_ice 
    161161               !                 ! salt, volume 
    162                diag_sice(ji,jj) = diag_sice(ji,jj) + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoic * r1_rdtice 
    163                diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice 
    164                diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice 
     162               diag_sice(ji,jj) = diag_sice(ji,jj) + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_Dt_ice 
     163               diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_Dt_ice 
     164               diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_Dt_ice 
    165165            END DO 
    166166         END DO 
    167167         !                       ! concentration tendency (total + thermo) 
    168          zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
     168         zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice 
    169169         afx_tot(:,:) = afx_tot(:,:) + zafx(:,:) 
    170170         IF( iom_use('afxthd') )   CALL iom_put( 'afxthd' , zafx(:,:) ) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icectl.F90

    r9604 r9939  
    9393            &                  ) *  e1e2t(:,:) ) * zconv 
    9494 
    95          pdiag_v = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * zconv ) 
    96  
    97          pdiag_s = glob_sum( SUM( sv_i * rhoic             , dim=3 ) * e1e2t * zconv ) 
     95         pdiag_v = glob_sum( SUM( v_i  * rhoi + v_s * rhos, dim=3 ) * e1e2t * zconv ) 
     96 
     97         pdiag_s = glob_sum( SUM( sv_i * rhoi             , dim=3 ) * e1e2t * zconv ) 
    9898 
    9999         pdiag_t = glob_sum( (  SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )     & 
    … …  
    120120  
    121121         ! outputs 
    122          zv = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t ) * zconv  & 
    123             &     - pdiag_v ) * r1_rdtice - zfv ) * rday 
    124  
    125          zs = ( ( glob_sum( SUM( sv_i * rhoic             , dim=3 ) * e1e2t ) * zconv  & 
    126             &     - pdiag_s ) * r1_rdtice + zfs ) * rday 
     122         zv = ( ( glob_sum( SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) * zconv  & 
     123            &     - pdiag_v ) * r1_Dt_ice - zfv ) * rday 
     124 
     125         zs = ( ( glob_sum( SUM( sv_i * rhoi             , dim=3 ) * e1e2t ) * zconv  & 
     126            &     - pdiag_s ) * r1_Dt_ice + zfs ) * rday 
    127127 
    128128         zt = ( glob_sum( (  SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )   & 
    129129            &              + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv   & 
    130             &   - pdiag_t ) * r1_rdtice + zft 
     130            &   - pdiag_t ) * r1_Dt_ice + zft 
    131131 
    132132         ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 
    133          zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t  ) * zconv * rday  
    134          zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e1e2t  ) * zconv 
     133         zvtrp = glob_sum( ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t  ) * zconv * rday  
     134         zetrp = glob_sum( ( diag_trp_ei        + diag_trp_es        ) * e1e2t  ) * zconv 
    135135 
    136136         zvmin = glob_min( v_i ) 
    … …  
    580580               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj) 
    581581               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj)  
    582                WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice 
     582               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_Dt_ice 
    583583               WRITE(numout,*) 
    584584               WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icedia.F90

    r9604 r9939  
    9595      ! 2 - Trends due to forcing  ! 
    9696      ! ---------------------------! 
    97       z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9  ! freshwater flux ice/snow-ocean  
    98       z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) ) * 1.e-9                     ! freshwater flux ice/snow-atm 
    99       z_frc_sal    = r1_rau0 * glob_sum(   - sfx(:,:) * e1e2t(:,:) ) * 1.e-9                                          ! salt fluxes ice/snow-ocean 
     97      z_frc_volbot = r1_rho0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9  ! freshwater flux ice/snow-ocean  
     98      z_frc_voltop = r1_rho0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) ) * 1.e-9                     ! freshwater flux ice/snow-atm 
     99      z_frc_sal    = r1_rho0 * glob_sum(   - sfx(:,:) * e1e2t(:,:) ) * 1.e-9                                          ! salt fluxes ice/snow-ocean 
    100100      z_frc_tembot =           glob_sum( hfx_out(:,:) * e1e2t(:,:) ) * 1.e-20                                         ! heat on top of ocean (and below ice) 
    101101      z_frc_temtop =           glob_sum( hfx_in (:,:) * e1e2t(:,:) ) * 1.e-20                                         ! heat on top of ice-coean 
    … …  
    110110      ! 3 -  Content variations ! 
    111111      ! ----------------------- ! 
    112       zdiff_vol = r1_rau0 * glob_sum( ( rhoic*vt_i(:,:) + rhosn*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater trend (km3)  
    113       zdiff_sal = r1_rau0 * glob_sum( ( rhoic* SUM( sv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! salt content trend (km3*pss) 
    114       zdiff_tem =           glob_sum( ( et_i(:,:) + et_s(:,:)             - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20 ! heat content trend (1.e20 J) 
     112      zdiff_vol = r1_rho0 * glob_sum( ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater trend (km3)  
     113      zdiff_sal = r1_rho0 * glob_sum( ( rhoi* SUM( sv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! salt content trend (km3*pss) 
     114      zdiff_tem =           glob_sum( ( et_i(:,:) + et_s(:,:)           - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20 ! heat content trend (1.e20 J) 
    115115      !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check) 
    116116 
    … …  
    125125      ! 5 - Diagnostics writing ! 
    126126      ! ----------------------- ! 
    127 !!gm I don't understand the division by the ocean surface (i.e. glob_sum( e1e2t(:,:) ) * 1.e-20 * kt*rdt ) 
    128 !!   and its multiplication bu kt ! is it really what we want ? what is this quantity ? 
    129 !!   IF it is really what we want, compute it at kt=nit000, not 3 time by time-step ! 
    130 !!   kt*rdt  : you mean rdtice ? 
    131 !!gm 
    132127      ! 
    133128      IF( iom_use('ibgvolume')    )   CALL iom_put( 'ibgvolume' , zdiff_vol     )   ! ice/snow volume  drift            (km3 equivalent ocean water)          
    … …  
    135130      IF( iom_use('ibgheatco')    )   CALL iom_put( 'ibgheatco' , zdiff_tem     )   ! ice/snow heat content drift       (1.e20 J) 
    136131      IF( iom_use('ibgheatfx')    )   CALL iom_put( 'ibgheatfx' ,               &   ! ice/snow heat flux drift          (W/m2) 
    137          &                                                     zdiff_tem /glob_sum( e1e2t(:,:) * 1.e-20 * kt*rdt ) ) 
     132         &                                                     zdiff_tem /glob_sum( e1e2t(:,:) * 1.e-20 * kt*rn_Dt ) ) 
    138133 
    139134      IF( iom_use('ibgfrcvoltop') )   CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water)  
    … …  
    143138      IF( iom_use('ibgfrctembot') )   CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)    
    144139      IF( iom_use('ibgfrchfxtop') )   CALL iom_put( 'ibgfrchfxtop' ,            &   ! heat on top of ice/snw/ocean      (W/m2)  
    145          &                                                          frc_temtop / glob_sum( e1e2t(:,:) ) * 1.e-20 * kt*rdt  ) 
     140         &                                                          frc_temtop / glob_sum( e1e2t(:,:) ) * 1.e-20 * kt*rn_Dt  ) 
    146141      IF( iom_use('ibgfrchfxbot') )   CALL iom_put( 'ibgfrchfxbot' ,            &   ! heat on top of ocean(below ice)   (W/m2)  
    147          &                                                          frc_tembot / glob_sum( e1e2t(:,:) ) * 1.e-20 * kt*rdt  ) 
     142         &                                                          frc_tembot / glob_sum( e1e2t(:,:) ) * 1.e-20 * kt*rn_Dt  ) 
    148143 
    149144      IF( iom_use('ibgvol_tot' )  )   CALL iom_put( 'ibgvol_tot'  , zbg_ivol     )   ! ice volume                       (km3) 
    … …  
    246241            frc_sal     = 0._wp                                                  
    247242            ! record initial ice volume, salt and temp 
    248             vol_loc_ini(:,:) = rhoic * vt_i(:,:) + rhosn * vt_s(:,:)  ! ice/snow volume (kg/m2) 
    249             tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:)                  ! ice/snow heat content (J) 
    250             sal_loc_ini(:,:) = rhoic * SUM( sv_i(:,:,:), dim=3 )      ! ice salt content (pss*kg/m2) 
     243            vol_loc_ini(:,:) = rhoi * vt_i(:,:) + rhos * vt_s(:,:)   ! ice/snow volume (kg/m2) 
     244            tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:)                 ! ice/snow heat content (J) 
     245            sal_loc_ini(:,:) = rhoi * SUM( sv_i(:,:,:), dim=3 )      ! ice salt content (pss*kg/m2) 
    251246         ENDIF 
    252247         ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icedyn_adv.F90

    r9604 r9939  
    9898      ! diagnostics 
    9999      !------------ 
    100       diag_trp_ei(:,:) = SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice 
    101       diag_trp_es(:,:) = SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice 
    102       diag_trp_sv(:,:) = SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice 
    103       diag_trp_vi(:,:) = SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice 
    104       diag_trp_vs(:,:) = SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice 
    105       IF( iom_use('icemtrp') )   CALL iom_put( "icemtrp" , diag_trp_vi * rhoic          )   ! ice mass transport 
    106       IF( iom_use('snwmtrp') )   CALL iom_put( "snwmtrp" , diag_trp_vs * rhosn          )   ! snw mass transport 
    107       IF( iom_use('salmtrp') )   CALL iom_put( "salmtrp" , diag_trp_sv * rhoic * 1.e-03 )   ! salt mass transport (kg/m2/s) 
     100      diag_trp_ei(:,:) = SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice 
     101      diag_trp_es(:,:) = SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice 
     102      diag_trp_sv(:,:) = SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_Dt_ice 
     103      diag_trp_vi(:,:) = SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_Dt_ice 
     104      diag_trp_vs(:,:) = SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_Dt_ice 
     105      IF( iom_use('icemtrp') )   CALL iom_put( "icemtrp" , diag_trp_vi * rhoi           )   ! ice mass transport 
     106      IF( iom_use('snwmtrp') )   CALL iom_put( "snwmtrp" , diag_trp_vs * rhos           )   ! snw mass transport 
     107      IF( iom_use('salmtrp') )   CALL iom_put( "salmtrp" , diag_trp_sv * rhoi * 1.e-03 )   ! salt mass transport (kg/m2/s) 
    108108      IF( iom_use('dihctrp') )   CALL iom_put( "dihctrp" , -diag_trp_ei                 )   ! advected ice heat content (W/m2) 
    109109      IF( iom_use('dshctrp') )   CALL iom_put( "dshctrp" , -diag_trp_es                 )   ! advected snw heat content (W/m2) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icedyn_rdgrft.F90

    r9604 r9939  
    189189            ! divergence given by the advection scheme 
    190190            !   (which may not be equal to divu as computed from the velocity field) 
    191             zdivu_adv(ji) = ( 1._wp - ato_i_1d(ji) - SUM( a_i_2d(ji,:) ) ) * r1_rdtice 
     191            zdivu_adv(ji) = ( 1._wp - ato_i_1d(ji) - SUM( a_i_2d(ji,:) ) ) * r1_Dt_ice 
    192192            ! 
    193193            IF( zdivu_adv(ji) < 0._wp )   closing_net(ji) = MAX( closing_net(ji), -zdivu_adv(ji) )   ! make sure the closing rate is large enough 
    … …  
    255255               ELSE 
    256256                  iterate_ridging  = 1 
    257                   zdivu_adv  (ji) = zfac * r1_rdtice 
     257                  zdivu_adv  (ji) = zfac * r1_Dt_ice 
    258258                  closing_net(ji) = MAX( 0._wp, -zdivu_adv(ji) ) 
    259259                  opning     (ji) = MAX( 0._wp,  zdivu_adv(ji) ) 
    … …  
    460460            zfac = apartf(ji,jl) * closing_gross(ji) * rdt_ice 
    461461            IF( zfac > pa_i(ji,jl) ) THEN 
    462                closing_gross(ji) = pa_i(ji,jl) / apartf(ji,jl) * r1_rdtice 
     462               closing_gross(ji) = pa_i(ji,jl) / apartf(ji,jl) * r1_Dt_ice 
    463463            ENDIF 
    464464         END DO 
    … …  
    472472         zfac = pato_i(ji) + ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rdt_ice 
    473473         IF( zfac < 0._wp ) THEN           ! would lead to negative ato_i 
    474             opning(ji) = apartf(ji,0) * closing_gross(ji) - pato_i(ji) * r1_rdtice  
     474            opning(ji) = apartf(ji,0) * closing_gross(ji) - pato_i(ji) * r1_Dt_ice  
    475475         ELSEIF( zfac > zasum(ji) ) THEN   ! would lead to ato_i > asum 
    476             opning(ji) = apartf(ji,0) * closing_gross(ji) + ( zasum(ji) - pato_i(ji) ) * r1_rdtice  
     476            opning(ji) = apartf(ji,0) * closing_gross(ji) + ( zasum(ji) - pato_i(ji) ) * r1_Dt_ice  
    477477         ENDIF 
    478478      END DO 
    … …  
    543543               ! volume and enthalpy (J/m2, >0) of seawater trapped into ridges 
    544544               vsw = v_i_2d(ji,jl1) * afrdg * rn_porordg 
    545                ersw(ji) = -rhoic * vsw * rcp * sst_1d(ji)   ! clem: if sst>0, then ersw <0 (is that possible?) 
     545               ersw(ji) = -rhoi * vsw * rcp * sst_1d(ji)   ! clem: if sst>0, then ersw <0 (is that possible?) 
    546546 
    547547               ! volume etc of ridging / rafting ice and new ridges (vi, vs, sm, oi, es, ei) 
    … …  
    570570 
    571571               ! Ice-ocean exchanges associated with ice porosity 
    572                wfx_dyn_1d(ji) = wfx_dyn_1d(ji) - vsw * rhoic * r1_rdtice   ! increase in ice volume due to seawater frozen in voids 
    573                sfx_dyn_1d(ji) = sfx_dyn_1d(ji) - vsw * sss_1d(ji) * rhoic * r1_rdtice 
    574                hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ersw(ji) * r1_rdtice          ! > 0 [W.m-2]  
     572               wfx_dyn_1d(ji) = wfx_dyn_1d(ji) - vsw              * rhoi * r1_Dt_ice   ! increase in ice volume due to seawater frozen in voids 
     573               sfx_dyn_1d(ji) = sfx_dyn_1d(ji) - vsw * sss_1d(ji) * rhoi * r1_Dt_ice 
     574               hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ersw(ji)                * r1_Dt_ice   ! > 0 [W.m-2]  
    575575 
    576576               ! Put the snow lost by ridging into the ocean 
    577577               !  Note that esrdg > 0; the ocean must cool to melt snow. If the ocean temp = Tf already, new ice must grow. 
    578                wfx_snw_dyn_1d(ji) = wfx_snw_dyn_1d(ji) + ( rhosn * vsrdg(ji) * ( 1._wp - rn_fsnwrdg )   &   ! fresh water source for ocean 
    579                   &                                      + rhosn * vsrft(ji) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice 
     578               wfx_snw_dyn_1d(ji) = wfx_snw_dyn_1d(ji) + ( rhos * vsrdg(ji) * ( 1._wp - rn_fsnwrdg )   &   ! fresh water source for ocean 
     579                  &                                      + rhos * vsrft(ji) * ( 1._wp - rn_fsnwrft ) ) * r1_Dt_ice 
    580580 
    581581               ! Put the melt pond water into the ocean 
    … …  
    583583               !       is no net mass flux between melt ponds and the ocean (see icethd_pnd.F90 for ex.) 
    584584               !IF ( ln_pnd_fwb ) THEN 
    585                !   wfx_pnd_1d(ji) = wfx_pnd_1d(ji) + ( rhofw * vprdg(ji) * ( 1._wp - rn_fpndrdg )   &        ! fresh water source for ocean 
    586                !      &                              + rhofw * vprft(ji) * ( 1._wp - rn_fpndrft ) ) * r1_rdtice 
     585               !   wfx_pnd_1d(ji) = wfx_pnd_1d(ji) + ( rhow * vprdg(ji) * ( 1._wp - rn_fpndrdg )   &        ! fresh water source for ocean 
     586               !      &                              + rhow * vprft(ji) * ( 1._wp - rn_fpndrft ) ) * r1_Dt_ice 
    587587               !ENDIF 
    588588 
    … …  
    590590               IF( nn_icesal /= 2 )  THEN 
    591591                  sirdg2(ji)     = sirdg2(ji)     - vsw * ( sss_1d(ji) - s_i_1d(ji) )        ! ridge salinity = s_i 
    592                   sfx_bri_1d(ji) = sfx_bri_1d(ji) + sss_1d(ji) * vsw * rhoic * r1_rdtice  &  ! put back sss_m into the ocean 
    593                      &                            - s_i_1d(ji) * vsw * rhoic * r1_rdtice     ! and get  s_i  from the ocean  
     592                  sfx_bri_1d(ji) = sfx_bri_1d(ji) + sss_1d(ji) * vsw * rhoi * r1_Dt_ice  &  ! put back sss_m into the ocean 
     593                     &                            - s_i_1d(ji) * vsw * rhoi * r1_Dt_ice     ! and get  s_i  from the ocean  
    594594               ENDIF 
    595595 
    … …  
    621621                  ! Put the snow lost by ridging into the ocean 
    622622                  hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ( - esrdg(ji,jk) * ( 1._wp - rn_fsnwrdg )   &                 ! heat sink for ocean (<0, W.m-2) 
    623                      &                                - esrft(ji,jk) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice 
     623                     &                                - esrft(ji,jk) * ( 1._wp - rn_fsnwrft ) ) * r1_Dt_ice 
    624624                  ! 
    625625                  ! Remove energy of new ridge to each category jl1 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icedyn_rhg_evp.F90

    r9660 r9939  
    114114      INTEGER ::   jter         ! local integers 
    115115      ! 
    116       REAL(wp) ::   zrhoco                                              ! rau0 * rn_cio 
     116      REAL(wp) ::   zrhoco                                              ! rho0 * rn_cio 
    117117      REAL(wp) ::   zdtevp, z1_dtevp                                    ! time step for subcycling 
    118118      REAL(wp) ::   ecc2, z1_ecc2                                       ! square of yield ellipse eccenticity 
    … …  
    221221      ! 1) define some variables and initialize arrays 
    222222      !------------------------------------------------------------------------------! 
    223       zrhoco = rau0 * rn_cio  
     223      zrhoco = rho0 * rn_cio  
    224224 
    225225      ! ecc2: square of yield ellipse eccenticrity 
    … …  
    271271         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
    272272         ! 
    273          zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 
     273         zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rho0 
    274274         ! 
    275275      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
    … …  
    285285 
    286286            ! Ice/snow mass at U-V points 
    287             zm1 = ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) ) 
    288             zm2 = ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) ) 
    289             zm3 = ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) ) 
     287            zm1 = ( rhos * vt_s(ji  ,jj  ) + rhoi * vt_i(ji  ,jj  ) ) 
     288            zm2 = ( rhos * vt_s(ji+1,jj  ) + rhoi * vt_i(ji+1,jj  ) ) 
     289            zm3 = ( rhos * vt_s(ji  ,jj+1) + rhoi * vt_i(ji  ,jj+1) ) 
    290290            zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
    291291            zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
    … …  
    799799               zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * rswitch 
    800800                
    801                zdiag_xmtrp_ice(ji,jj) = rhoic * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 
    802                zdiag_ymtrp_ice(ji,jj) = rhoic * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   '' 
    803                 
    804                zdiag_xmtrp_snw(ji,jj) = rhosn * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component 
    805                zdiag_ymtrp_snw(ji,jj) = rhosn * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   '' 
    806                 
    807                zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )         ! area transport,      X-component 
    808                zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )         !        ''            Y-   '' 
     801               zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) )  ! ice mass transport, X-component 
     802               zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) )  !        ''           Y-   '' 
     803                
     804               zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) )  ! snow mass transport, X-component 
     805               zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) )  !          ''          Y-   '' 
     806                
     807               zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )          ! area transport,      X-component 
     808               zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )          !        ''            Y-   '' 
    809809                
    810810            END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/iceistate.F90

    r9656 r9939  
    295295                  ! In case snow load is in excess that would lead to transformation from snow to ice 
    296296                  ! Then, transfer the snow excess into the ice (different from icethd_dh) 
    297                   zdh = MAX( 0._wp, ( rhosn * h_s(ji,jj,jl) + ( rhoic - rau0 ) * h_i(ji,jj,jl) ) * r1_rau0 )  
     297                  zdh = MAX( 0._wp, ( rhos * h_s(ji,jj,jl) + ( rhoi - rho0 ) * h_i(ji,jj,jl) ) * r1_rho0 )  
    298298                  ! recompute h_i, h_s avoiding out of bounds values 
    299299                  h_i(ji,jj,jl) = MIN( hi_max(jl), h_i(ji,jj,jl) + zdh ) 
    300                   h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoic * r1_rhosn ) 
     300                  h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoi * r1_rhos ) 
    301301                  ! 
    302302                  ! ice volume, salt content, age content 
    … …  
    321321                     t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 
    322322                     ! Snow energy of melting 
    323                      e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 
     323                     e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
    324324                     ! 
    325325                     ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 
    … …  
    340340                     ! 
    341341                     ! heat content per unit volume 
    342                      e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) )         & 
    343                         &             + lfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0) , -epsi20 )  )   & 
    344                         &             - rcp  * ( ztmelts - rt0 ) ) 
     342                     e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoi * (   rcpi    * ( ztmelts - t_i(ji,jj,jk,jl) )           & 
     343                        &             + rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0) , -epsi20 )  )   & 
     344                        &             - rcp   * ( ztmelts - rt0 ) ) 
    345345                     ! 
    346346                     ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
    … …  
    410410      ! 5) Snow-ice mass (case ice is fully embedded) 
    411411      !---------------------------------------------- 
    412       snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhosn * v_s(:,:,:) + rhoic * v_i(:,:,:), dim=3  )   ! snow+ice mass 
     412      snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3  )   ! snow+ice mass 
    413413      snwice_mass_b(:,:) = snwice_mass(:,:) 
    414414      ! 
    415415      IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area 
    416416         ! 
    417          sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
    418          sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     417         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rho0 
     418         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rho0 
    419419         ! 
    420420         IF( .NOT.ln_linssh ) THEN 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icestp.F90

    r9725 r9939  
    341341      IF( ln_bdy .AND. ln_icediachk )   CALL ctl_warn('par_init: online conservation check does not work with BDY') 
    342342      ! 
    343       rdt_ice   = REAL(nn_fsbc) * rdt          !--- sea-ice timestep and its inverse 
    344       r1_rdtice = 1._wp / rdt_ice 
     343      rdt_ice   = REAL(nn_fsbc) * rn_Dt        !--- sea-ice timestep and its inverse 
     344      r1_Dt_ice = 1._wp / rdt_ice 
    345345      IF(lwp) WRITE(numout,*) 
    346       IF(lwp) WRITE(numout,*) '      ice timestep rdt_ice = nn_fsbc*rdt = ', rdt_ice 
     346      IF(lwp) WRITE(numout,*) '      ice timestep rdt_ice = nn_fsbc*rn_Dt = ', rdt_ice, ' [s]' 
    347347      ! 
    348348      r1_nlay_i = 1._wp / REAL( nlay_i, wp )   !--- inverse of nlay_i and nlay_s 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd.F90

    r9750 r9939  
    120120         DO jj = 2, jpjm1 
    121121            DO ji = fs_2, fs_jpim1 
    122                zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  & 
     122               zfric(ji,jj) = r1_rho0 * SQRT( 0.5_wp *  & 
    123123                  &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    124124                  &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 
    … …  
    150150            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
    151151            ! includes supercooling potential energy (>0) or "above-freezing" energy (<0) 
    152             zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
     152            zqfr = tmask(ji,jj,1) * rho0_rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
    153153 
    154154            ! --- Above-freezing sensible heat content (J/m2 grid) 
    155             zqfr_neg = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * MIN( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ), 0._wp ) 
     155            zqfr_neg = tmask(ji,jj,1) * rho0_rcp * e3t_m(ji,jj) * MIN( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ), 0._wp ) 
    156156 
    157157            ! --- Sensible ocean-to-ice heat flux (W/m2) 
    158158            zfric_u      = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
    159             fhtur(ji,jj) = rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 
    160  
    161             fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     159            fhtur(ji,jj) = rswitch * rho0_rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 
     160 
     161            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr_neg * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ) 
    162162            ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
    163163            !                        the freezing point, so that we do not have SST < T_freeze 
    … …  
    169169            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting  
    170170            IF( zqld > 0._wp ) THEN 
    171                fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
     171               fhld (ji,jj) = rswitch * zqld * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
    172172               qlead(ji,jj) = 0._wp 
    173173            ELSE 
    … …  
    197197      !     Third  step in iceupdate.F90  :  heat from ice-ocean mass exchange (zf_mass) + solar 
    198198      hfx_out(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:)  &  ! Non solar heat flux received by the ocean                
    199          &           - qlead(:,:) * r1_rdtice                                &  ! heat flux taken from the ocean where there is open water ice formation 
     199         &           - qlead(:,:) * r1_Dt_ice                                &  ! heat flux taken from the ocean where there is open water ice formation 
    200200         &           - at_i (:,:) * fhtur(:,:)                               &  ! heat flux taken by turbulence 
    201201         &           - at_i (:,:) *  fhld(:,:)                                  ! heat flux taken during bottom growth/melt  
    … …  
    295295            ztmelts       = -tmut * sz_i_1d(ji,jk) 
    296296            ! Conversion q(S,T) -> T (second order equation) 
    297             zbbb          = ( rcp - cpic ) * ztmelts + e_i_1d(ji,jk) * r1_rhoic - lfus 
    298             zccc          = SQRT( MAX( zbbb * zbbb - 4._wp * cpic * lfus * ztmelts, 0._wp ) ) 
    299             t_i_1d(ji,jk) = rt0 - ( zbbb + zccc ) * 0.5_wp * r1_cpic 
     297            zbbb          = ( rcp - rcpi ) * ztmelts + e_i_1d(ji,jk) * r1_rhoi - rLfus 
     298            zccc          = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts, 0._wp ) ) 
     299            t_i_1d(ji,jk) = rt0 - ( zbbb + zccc ) * 0.5_wp * r1_cpi 
    300300             
    301301            ! mask temperature 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_da.F90

    r9604 r9939  
    137137             
    138138            ! Contribution to salt flux 
    139             sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoic *  h_i_1d(ji) * zda * s_i_1d(ji) * r1_rdtice 
     139            sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoi *  h_i_1d(ji) * zda * s_i_1d(ji) * r1_Dt_ice 
    140140             
    141141            ! Contribution to heat flux into the ocean [W.m-2], (<0)   
    142             hfx_thd_1d(ji) = hfx_thd_1d(ji) - zda * r1_rdtice * ( h_i_1d(ji) * r1_nlay_i * SUM( e_i_1d(ji,1:nlay_i) )  & 
     142            hfx_thd_1d(ji) = hfx_thd_1d(ji) - zda * r1_Dt_ice * ( h_i_1d(ji) * r1_nlay_i * SUM( e_i_1d(ji,1:nlay_i) )  & 
    143143                                                                + h_s_1d(ji) * r1_nlay_s * SUM( e_s_1d(ji,1:nlay_s) ) )  
    144144             
    145145            ! Contribution to mass flux 
    146             wfx_lam_1d(ji) =  wfx_lam_1d(ji) + zda * r1_rdtice * ( rhoic * h_i_1d(ji) + rhosn * h_s_1d(ji) ) 
     146            wfx_lam_1d(ji) =  wfx_lam_1d(ji) + zda * r1_Dt_ice * ( rhoi * h_i_1d(ji) + rhos * h_s_1d(ji) ) 
    147147             
    148148            ! new concentration 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_dh.F90

    r9767 r9939  
    7676      REAL(wp) ::   zgrr         ! bottom growth rate 
    7777      REAL(wp) ::   zt_i_new     ! bottom formation temperature 
    78       REAL(wp) ::   z1_rho       ! 1/(rhosn+rau0-rhoic) 
     78      REAL(wp) ::   z1_rho       ! 1/(rhos+rho0-rhoi) 
    7979 
    8080      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean 
    … …  
    181181         DO ji = 1, npti 
    182182            IF( t_s_1d(ji,jk) > rt0 ) THEN 
    183                hfx_res_1d    (ji) = hfx_res_1d    (ji) + e_s_1d(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_rdtice   ! heat flux to the ocean [W.m-2], < 0 
    184                wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhosn         * zh_s(ji,jk) * a_i_1d(ji) * r1_rdtice   ! mass flux 
     183               hfx_res_1d    (ji) = hfx_res_1d    (ji) + e_s_1d(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! heat flux to the ocean [W.m-2], < 0 
     184               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos          * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! mass flux 
    185185               ! updates 
    186186               dh_s_mlt(ji)    = dh_s_mlt(ji) - zh_s(ji,jk) 
    … …  
    202202            ! 
    203203            ! --- precipitation --- 
    204             zdh_s_pre (ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhosn / at_i_1d(ji)   ! thickness change 
     204            zdh_s_pre (ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhos / at_i_1d(ji)    ! thickness change 
    205205            zqprec    (ji) = - qprec_ice_1d(ji)                                             ! enthalpy of the precip (>0, J.m-3) 
    206206            ! 
    207             hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji)    * r1_rdtice   ! heat flux from snow precip (>0, W.m-2) 
    208             wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn         * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice   ! mass flux, <0 
     207            hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji)    * r1_Dt_ice   ! heat flux from snow precip (>0, W.m-2) 
     208            wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhos          * a_i_1d(ji) * zdh_s_pre(ji) * r1_Dt_ice   ! mass flux, <0 
    209209             
    210210            ! --- melt of falling snow --- 
    … …  
    212212            zdeltah       (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )   ! thickness change 
    213213            zdeltah       (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) )                ! bound melting  
    214             hfx_snw_1d    (ji)   = hfx_snw_1d    (ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji)    * r1_rdtice   ! heat used to melt snow (W.m-2, >0) 
    215             wfx_snw_sum_1d(ji)   = wfx_snw_sum_1d(ji) - rhosn         * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice   ! snow melting only = water into the ocean (then without snow precip), >0 
     214            hfx_snw_1d    (ji)   = hfx_snw_1d    (ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji)    * r1_Dt_ice   ! heat used to melt snow (W.m-2, >0) 
     215            wfx_snw_sum_1d(ji)   = wfx_snw_sum_1d(ji) - rhos          * a_i_1d(ji) * zdeltah(ji,1) * r1_Dt_ice   ! snow melting only = water into the ocean (then without snow precip), >0 
    216216             
    217217            ! updates available heat + precipitations after melting 
    … …  
    252252               zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk) 
    253253                
    254                hfx_snw_1d(ji)     = hfx_snw_1d(ji)     - zdeltah(ji,jk) * a_i_1d(ji) * e_s_1d (ji,jk) * r1_rdtice   ! heat used to melt snow(W.m-2, >0) 
    255                wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhosn          * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice   ! snow melting only = water into the ocean (then without snow precip) 
     254               hfx_snw_1d(ji)     = hfx_snw_1d(ji)     - zdeltah(ji,jk) * a_i_1d(ji) * e_s_1d (ji,jk) * r1_Dt_ice   ! heat used to melt snow(W.m-2, >0) 
     255               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos           * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice   ! snow melting only = water into the ocean (then without snow precip) 
    256256                
    257257               ! updates available heat + thickness 
    … …  
    273273         IF( evap_ice_1d(ji) > 0._wp ) THEN 
    274274            ! 
    275             zdh_s_sub (ji)   = MAX( - h_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) 
    276             zevap_rema(ji)   = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhosn   ! remaining evap in kg.m-2 (used for ice melting later on) 
     275            zdh_s_sub (ji)   = MAX( - h_s_1d(ji) , - evap_ice_1d(ji) * r1_rhos  * rdt_ice ) 
     276            zevap_rema(ji)   = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhos   ! remaining evap in kg.m-2 (used for ice melting later on) 
    277277            zdeltah   (ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 
    278278             
    279279            hfx_sub_1d    (ji) = hfx_sub_1d(ji) + &   ! Heat flux by sublimation [W.m-2], < 0 (sublimate snow that had fallen, then pre-existing snow) 
    280280               &                 ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * e_s_1d(ji,1) )  & 
    281                &                 * a_i_1d(ji) * r1_rdtice 
    282             wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice   ! Mass flux by sublimation 
     281               &                 * a_i_1d(ji) * r1_Dt_ice 
     282            wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos * a_i_1d(ji) * zdh_s_sub(ji) * r1_Dt_ice   ! Mass flux by sublimation 
    283283             
    284284            ! new snow thickness 
    … …  
    309309            e_s_1d(ji,jk) = rswitch / MAX( h_s_1d(ji), epsi20 ) *            & 
    310310              &             ( ( zdh_s_pre(ji)              ) * zqprec(ji) +  & 
    311               &               ( h_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) ) 
     311              &               ( h_s_1d(ji) - zdh_s_pre(ji) ) * rhos * ( rcpi * ( rt0 - t_s_1d(ji,jk) ) + rLfus ) ) 
    312312         END DO 
    313313      END DO 
    … …  
    326326            IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN   !-- Internal melting 
    327327 
    328                zEi            = - e_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0]        
     328               zEi            = - e_i_1d(ji,jk) * r1_rhoi             ! Specific enthalpy of layer k [J/kg, <0]        
    329329               zdE            = 0._wp                                 ! Specific enthalpy difference (J/kg, <0) 
    330330                                                                      ! set up at 0 since no energy is needed to melt water...(it is already melted) 
    331331               zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing      
    332332                                                                      ! this should normally not happen, but sometimes, heat diffusion leads to this 
    333                zfmdt          = - zdeltah(ji,jk) * rhoic              ! Mass flux x time step > 0 
     333               zfmdt          = - zdeltah(ji,jk) * rhoi               ! Mass flux x time step > 0 
    334334                          
    335335               dh_i_itm(ji)   = dh_i_itm(ji) + zdeltah(ji,jk)         ! Cumulate internal melting 
    336336                
    337                zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0] 
    338  
    339                hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice                           ! Heat flux to the ocean [W.m-2], <0 
     337               zfmdt          = - rhoi * zdeltah(ji,jk)               ! Recompute mass flux [kg/m2, >0] 
     338 
     339               hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0 
    340340               !                                                                                                  ice enthalpy zEi is "sent" to the ocean 
    341                sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice   ! Salt flux 
     341               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi  * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice   ! Salt flux 
    342342               !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok 
    343                wfx_res_1d(ji) = wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice                ! Mass flux 
     343               wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi  * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                ! Mass flux 
    344344 
    345345            ELSE                                        !-- Surface melting 
    346346                
    347                zEi            = - e_i_1d(ji,jk) * r1_rhoic            ! Specific enthalpy of layer k [J/kg, <0] 
     347               zEi            = - e_i_1d(ji,jk) * r1_rhoi             ! Specific enthalpy of layer k [J/kg, <0] 
    348348               zEw            =    rcp * ztmelts                      ! Specific enthalpy of resulting meltwater [J/kg, <0] 
    349349               zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0 
    … …  
    351351               zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0] 
    352352                
    353                zdeltah(ji,jk) = - zfmdt * r1_rhoic                    ! Melt of layer jk [m, <0] 
     353               zdeltah(ji,jk) = - zfmdt * r1_rhoi                     ! Melt of layer jk [m, <0] 
    354354                
    355355               zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0] 
    356356                
    357                zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 
     357               zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoi * zdE ) ! update available heat 
    358358                
    359359               dh_i_sum(ji)   = dh_i_sum(ji) + zdeltah(ji,jk)         ! Cumulate surface melt 
    360360                
    361                zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0] 
     361               zfmdt          = - rhoi * zdeltah(ji,jk)               ! Recompute mass flux [kg/m2, >0] 
    362362                
    363363               zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0] 
    364364                
    365                sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice   ! Salt flux >0 
     365               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice   ! Salt flux >0 
    366366               !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok) 
    367                hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice                           ! Heat flux [W.m-2], < 0 
    368                hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice                           ! Heat flux used in this process [W.m-2], > 0   
     367               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux [W.m-2], < 0 
     368               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat flux used in this process [W.m-2], > 0   
    369369               !  
    370                wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice                ! Mass flux 
     370               wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                ! Mass flux 
    371371                
    372372            END IF 
    … …  
    374374            ! Ice sublimation 
    375375            ! --------------- 
    376             zdum            = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoic ) 
     376            zdum            = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoi ) 
    377377            zdeltah (ji,jk) = zdeltah (ji,jk) + zdum 
    378378            dh_i_sub(ji)    = dh_i_sub(ji)    + zdum 
    379379             
    380             sfx_sub_1d(ji)     = sfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * s_i_1d(ji) * r1_rdtice ! Salt flux >0 
     380            sfx_sub_1d(ji)     = sfx_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * s_i_1d(ji) * r1_Dt_ice ! Salt flux >0 
    381381            !                                                                                          clem: flux is sent to the ocean for simplicity 
    382382            !                                                                                                but salt should remain in the ice except 
    383383            !                                                                                                if all ice is melted. => must be corrected 
    384             hfx_sub_1d(ji)     = hfx_sub_1d(ji) + zdum * e_i_1d(ji,jk) * a_i_1d(ji) * r1_rdtice      ! Heat flux [W.m-2], < 0 
    385  
    386             wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * r1_rdtice          ! Mass flux > 0 
     384            hfx_sub_1d(ji)     = hfx_sub_1d(ji) + zdum * e_i_1d(ji,jk) * a_i_1d(ji) * r1_Dt_ice      ! Heat flux [W.m-2], < 0 
     385 
     386            wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * r1_Dt_ice          ! Mass flux > 0 
    387387 
    388388            ! update remaining mass flux 
    389             zevap_rema(ji)  = zevap_rema(ji) + zdum * rhoic 
     389            zevap_rema(ji)  = zevap_rema(ji) + zdum * rhoi 
    390390             
    391391            ! record which layers have disappeared (for bottom melting)  
    … …  
    409409      ! remaining "potential" evap is sent to ocean 
    410410      DO ji = 1, npti 
    411          wfx_err_sub_1d(ji) = wfx_err_sub_1d(ji) - zevap_rema(ji) * a_i_1d(ji) * r1_rdtice  ! <=0 (net evap for the ocean in kg.m-2.s-1) 
     411         wfx_err_sub_1d(ji) = wfx_err_sub_1d(ji) - zevap_rema(ji) * a_i_1d(ji) * r1_Dt_ice  ! <=0 (net evap for the ocean in kg.m-2.s-1) 
    412412      END DO 
    413413 
    … …  
    437437               !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7  
    438438               !--- zswi2  if dh/dt > 3.6e-7 
    439                zgrr     = MIN( 1.0e-3, MAX ( dh_i_bog(ji) * r1_rdtice , epsi10 ) ) 
     439               zgrr     = MIN( 1.0e-3, MAX ( dh_i_bog(ji) * r1_Dt_ice , epsi10 ) ) 
    440440               zswi2    = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) ) 
    441441               zswi12   = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 
    … …  
    450450               zt_i_new      = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 
    451451                
    452                zEi           = cpic * ( zt_i_new - (ztmelts+rt0) ) &                                  ! Specific enthalpy of forming ice (J/kg, <0) 
    453                   &            - lfus * ( 1.0 - ztmelts / ( zt_i_new - rt0 ) ) + rcp * ztmelts 
     452               zEi           = rcpi * ( zt_i_new - (ztmelts+rt0) ) &                                  ! Specific enthalpy of forming ice (J/kg, <0) 
     453                  &          - rLfus * ( 1.0 - ztmelts / ( zt_i_new - rt0 ) ) + rcp * ztmelts 
    454454 
    455455               zEw           = rcp  * ( t_bo_1d(ji) - rt0 )                                           ! Specific enthalpy of seawater (J/kg, < 0) 
    … …  
    457457               zdE           = zEi - zEw                                                              ! Specific enthalpy difference (J/kg, <0) 
    458458 
    459                dh_i_bog(ji)  = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoic ) ) 
     459               dh_i_bog(ji)  = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) ) 
    460460                
    461461            END DO 
    462462            ! Contribution to Energy and Salt Fluxes                                     
    463             zfmdt          = - rhoic * dh_i_bog(ji)                                                   ! Mass flux x time step (kg/m2, < 0) 
    464              
    465             hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice                           ! Heat flux to the ocean [W.m-2], >0 
    466             hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice                           ! Heat flux used in this process [W.m-2], <0 
    467              
    468             sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bog(ji) * s_i_new(ji) * r1_rdtice    ! Salt flux, <0 
    469  
    470             wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bog(ji) * r1_rdtice                  ! Mass flux, <0 
     463            zfmdt          = - rhoi * dh_i_bog(ji)                                                   ! Mass flux x time step (kg/m2, < 0) 
     464             
     465            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], >0 
     466            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat flux used in this process [W.m-2], <0 
     467             
     468            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * s_i_new(ji) * r1_Dt_ice    ! Salt flux, <0 
     469 
     470            wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * r1_Dt_ice                  ! Mass flux, <0 
    471471 
    472472            ! update heat content (J.m-2) and layer thickness 
    473             eh_i_old(ji,nlay_i+1) = eh_i_old(ji,nlay_i+1) + dh_i_bog(ji) * (-zEi * rhoic) 
     473            eh_i_old(ji,nlay_i+1) = eh_i_old(ji,nlay_i+1) + dh_i_bog(ji) * (-zEi * rhoi) 
    474474            h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bog(ji) 
    475475 
    … …  
    489489               IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN   !-- Internal melting 
    490490 
    491                   zEi               = - e_i_1d(ji,jk) * r1_rhoic    ! Specific enthalpy of melting ice (J/kg, <0) 
     491                  zEi               = - e_i_1d(ji,jk) * r1_rhoi     ! Specific enthalpy of melting ice (J/kg, <0) 
    492492                  zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0) 
    493493                                                                    !    set up at 0 since no energy is needed to melt water...(it is already melted) 
    … …  
    497497                  dh_i_itm (ji)     = dh_i_itm(ji) + zdeltah(ji,jk) 
    498498 
    499                   zfmdt             = - zdeltah(ji,jk) * rhoic      ! Mass flux x time step > 0 
    500  
    501                   hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice                           ! Heat flux to the ocean [W.m-2], <0 
     499                  zfmdt             = - zdeltah(ji,jk) * rhoi       ! Mass flux x time step > 0 
     500 
     501                  hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0 
    502502                  !                                                                                                  ice enthalpy zEi is "sent" to the ocean 
    503                   sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice   ! Salt flux 
     503                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice   ! Salt flux 
    504504                  !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok 
    505                   wfx_res_1d(ji) = wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice                ! Mass flux 
     505                  wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                ! Mass flux 
    506506 
    507507                  ! update heat content (J.m-2) and layer thickness 
    … …  
    511511               ELSE                                        !-- Basal melting 
    512512 
    513                   zEi             = - e_i_1d(ji,jk) * r1_rhoic                                ! Specific enthalpy of melting ice (J/kg, <0) 
     513                  zEi             = - e_i_1d(ji,jk) * r1_rhoi                                 ! Specific enthalpy of melting ice (J/kg, <0) 
    514514                  zEw             = rcp * ztmelts                                             ! Specific enthalpy of meltwater (J/kg, <0) 
    515515                  zdE             = zEi - zEw                                                 ! Specific enthalpy difference   (J/kg, <0) 
    … …  
    517517                  zfmdt           = - zq_bo(ji) / zdE                                         ! Mass flux x time step (kg/m2, >0) 
    518518 
    519                   zdeltah(ji,jk)  = - zfmdt * r1_rhoic                                        ! Gross thickness change 
     519                  zdeltah(ji,jk)  = - zfmdt * r1_rhoi                                         ! Gross thickness change 
    520520 
    521521                  zdeltah(ji,jk)  = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) )       ! bound thickness change 
    522522                   
    523                   zq_bo(ji)       = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE )   ! update available heat. MAX is necessary for roundup errors 
    524  
    525                   dh_i_bom(ji)    = dh_i_bom(ji) + zdeltah(ji,jk)                            ! Update basal melt 
    526  
    527                   zfmdt           = - zdeltah(ji,jk) * rhoic                                  ! Mass flux x time step > 0 
     523                  zq_bo(ji)       = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoi * zdE )    ! update available heat. MAX is necessary for roundup errors 
     524 
     525                  dh_i_bom(ji)    = dh_i_bom(ji) + zdeltah(ji,jk)                             ! Update basal melt 
     526 
     527                  zfmdt           = - zdeltah(ji,jk) * rhoi                                   ! Mass flux x time step > 0 
    528528 
    529529                  zQm             = zfmdt * zEw                                               ! Heat exchanged with ocean 
    530530 
    531                   hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice                           ! Heat flux to the ocean [W.m-2], <0   
    532                   hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice                           ! Heat used in this process [W.m-2], >0   
    533  
    534                   sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoic *  a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice  ! Salt flux 
     531                  hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0   
     532                  hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat used in this process [W.m-2], >0   
     533 
     534                  sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoi *  a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice  ! Salt flux 
    535535                  !                                                                                                   using s_i_1d and not sz_i_1d(jk) is ok 
    536536                   
    537                   wfx_bom_1d(ji)  = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice                ! Mass flux 
     537                  wfx_bom_1d(ji)  = wfx_bom_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                ! Mass flux 
    538538 
    539539                  ! update heat content (J.m-2) and layer thickness 
    … …  
    565565         
    566566         zq_rema(ji)        = zq_rema(ji) + zdeltah(ji,1) * e_s_1d(ji,1)                               ! update available heat (J.m-2) 
    567          hfx_snw_1d(ji)     = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * e_s_1d(ji,1) * r1_rdtice   ! Heat used to melt snow, W.m-2 (>0) 
    568          wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice      ! Mass flux 
     567         hfx_snw_1d(ji)     = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * e_s_1d(ji,1) * r1_Dt_ice   ! Heat used to melt snow, W.m-2 (>0) 
     568         wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos * a_i_1d(ji) * zdeltah(ji,1) * r1_Dt_ice      ! Mass flux 
    569569         dh_s_mlt(ji)       = dh_s_mlt(ji) + zdeltah(ji,1) 
    570570         !     
    571571         ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 
    572          hfx_out_1d(ji) = hfx_out_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 
     572         hfx_out_1d(ji) = hfx_out_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_Dt_ice 
    573573 
    574574         IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 
    … …  
    580580      ! When snow load excesses Archimede's limit, snow-ice interface goes down under sea-level,  
    581581      ! flooding of seawater transforms snow into ice dh_snowice is positive for the ice 
    582       z1_rho = 1._wp / ( rhosn+rau0-rhoic ) 
     582      z1_rho = 1._wp / ( rhos + rho0 - rhoi ) 
    583583      DO ji = 1, npti 
    584584         ! 
    585          dh_snowice(ji) = MAX(  0._wp , ( rhosn * h_s_1d(ji) + (rhoic-rau0) * h_i_1d(ji) ) * z1_rho ) 
     585         dh_snowice(ji) = MAX(  0._wp , ( rhos * h_s_1d(ji) + (rhoi-rho0) * h_i_1d(ji) ) * z1_rho ) 
    586586 
    587587         h_i_1d(ji)    = h_i_1d(ji) + dh_snowice(ji) 
    … …  
    589589 
    590590         ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 
    591          zfmdt          = ( rhosn - rhoic ) * dh_snowice(ji)    ! <0 
     591         zfmdt          = ( rhos - rhoi ) * dh_snowice(ji)    ! <0 
    592592         zEw            = rcp * sst_1d(ji) 
    593593         zQm            = zfmdt * zEw  
    594594          
    595          hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice ! Heat flux 
    596  
    597          sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * a_i_1d(ji) * zfmdt * r1_rdtice ! Salt flux 
     595         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice ! Heat flux 
     596 
     597         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * a_i_1d(ji) * zfmdt * r1_Dt_ice ! Salt flux 
    598598 
    599599         ! Case constant salinity in time: virtual salt flux to keep salinity constant 
    600600         IF( nn_icesal /= 2 )  THEN 
    601             sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d (ji) * a_i_1d(ji) * zfmdt                  * r1_rdtice  & ! put back sss_m     into the ocean 
    602                &                            - s_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice    ! and get  rn_icesal from the ocean  
     601            sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d (ji) * a_i_1d(ji) * zfmdt                 * r1_Dt_ice  & ! put back sss_m     into the ocean 
     602               &                            - s_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_Dt_ice    ! and get  rn_icesal from the ocean  
    603603         ENDIF 
    604604 
    605605         ! Mass flux: All snow is thrown in the ocean, and seawater is taken to replace the volume 
    606          wfx_sni_1d(ji)     = wfx_sni_1d(ji)     - a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice 
    607          wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhosn * r1_rdtice 
     606         wfx_sni_1d(ji)     = wfx_sni_1d(ji)     - a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_Dt_ice 
     607         wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhos * r1_Dt_ice 
    608608 
    609609         ! update heat content (J.m-2) and layer thickness 
    … …  
    627627            e_s_1d(ji,jk) = rswitch * e_s_1d(ji,jk) 
    628628            ! recalculate t_s_1d from e_s_1d 
    629             t_s_1d(ji,jk) = rt0 + rswitch * ( - e_s_1d(ji,jk) * r1_rhosn * r1_cpic + lfus * r1_cpic ) 
     629            t_s_1d(ji,jk) = rt0 + rswitch * ( - e_s_1d(ji,jk) * r1_rhos * r1_cpi + rLfus * r1_cpi ) 
    630630         END DO 
    631631      END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_do.F90

    r9604 r9939  
    140140         ! Physical constants 
    141141         zhicrit = 0.04                                          ! frazil ice thickness 
    142          ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav 
     142         ztwogp  = 2. * rho0 / ( grav * 0.3 * ( rho0 - rhoi ) ) ! reduced grav 
    143143         zsqcd   = 1.0 / SQRT( 1.3 * zcai )                      ! 1/SQRT(airdensity*drag) 
    144144         zgamafr = 0.03 
    … …  
    264264         DO ji = 1, npti 
    265265            ztmelts       = - tmut * zs_newice(ji)                  ! Melting point (C) 
    266             ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - ( t_bo_1d(ji) - rt0 ) )                     & 
    267                &                       + lfus * ( 1.0 - ztmelts / MIN( t_bo_1d(ji) - rt0, -epsi10 ) )   & 
    268                &                       - rcp  *         ztmelts ) 
     266            ze_newice(ji) =   rhoi * (  rcpi * ( ztmelts - ( t_bo_1d(ji) - rt0 ) )                     & 
     267               &                      + rLfus * ( 1.0 - ztmelts / MIN( t_bo_1d(ji) - rt0, -epsi10 ) )   & 
     268               &                      - rcp   *         ztmelts ) 
    269269         END DO 
    270270 
    … …  
    275275         DO ji = 1, npti 
    276276 
    277             zEi           = - ze_newice(ji) * r1_rhoic             ! specific enthalpy of forming ice [J/kg] 
     277            zEi           = - ze_newice(ji) * r1_rhoi              ! specific enthalpy of forming ice [J/kg] 
    278278 
    279279            zEw           = rcp * ( t_bo_1d(ji) - rt0 )            ! specific enthalpy of seawater at t_bo_1d [J/kg] 
    … …  
    284284            zfmdt         = - qlead_1d(ji) / zdE                   ! Fm.dt [kg/m2] (<0)  
    285285                                                                   ! clem: we use qlead instead of zqld (icethd) because we suppose we are at the freezing point    
    286             zv_newice(ji) = - zfmdt * r1_rhoic 
     286            zv_newice(ji) = - zfmdt * r1_rhoi 
    287287 
    288288            zQm           = zfmdt * zEw                            ! heat to the ocean >0 associated with mass flux   
    289289 
    290290            ! Contribution to heat flux to the ocean [W.m-2], >0   
    291             hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice 
     291            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_Dt_ice 
    292292            ! Total heat flux used in this process [W.m-2]   
    293             hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_rdtice 
     293            hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_Dt_ice 
    294294            ! mass flux 
    295             wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoic * r1_rdtice 
     295            wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoi * r1_Dt_ice 
    296296            ! salt flux 
    297             sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice 
     297            sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoi * zs_newice(ji) * r1_Dt_ice 
    298298         END DO 
    299299          

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_ent.F90

    r9604 r9939  
    129129      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 
    130130      DO ji = 1, npti 
    131          hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  & 
     131         hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice *  & 
    132132            &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) )  
    133133      END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_pnd.F90

    r9750 r9939  
    133133      REAL(wp) ::   zdv_mlt          ! available meltwater for melt ponding 
    134134      REAL(wp) ::   z1_Tp            ! inverse reference temperature 
    135       REAL(wp) ::   z1_rhofw         ! inverse freshwater density 
    136135      REAL(wp) ::   z1_zpnd_aspect   ! inverse pond aspect ratio 
    137136      REAL(wp) ::   zfac, zdum 
    … …  
    139138      INTEGER  ::   ji   ! loop indices 
    140139      !!------------------------------------------------------------------- 
    141       z1_rhofw       = 1._wp / rhofw  
    142140      z1_zpnd_aspect = 1._wp / zpnd_aspect 
    143141      z1_Tp          = 1._wp / zTp  
    … …  
    157155            ! 
    158156            ! available meltwater for melt ponding [m, >0] and fraction 
    159             zdv_mlt = -( dh_i_sum(ji)*rhoic + dh_s_mlt(ji)*rhosn ) * z1_rhofw * a_i_1d(ji) 
     157            zdv_mlt = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * r1_rhow * a_i_1d(ji) 
    160158            zfr_mlt = zrmin + ( zrmax - zrmin ) * a_i_1d(ji)  ! from CICE doc 
    161159            !zfr_mlt = zrmin + zrmax * a_i_1d(ji)             ! from Holland paper  
    … …  
    168166            ! melt pond mass flux (<0) 
    169167            IF( ln_pnd_fwb .AND. zdv_mlt > 0._wp ) THEN 
    170                zfac = zfr_mlt * zdv_mlt * rhofw * r1_rdtice 
     168               zfac = zfr_mlt * zdv_mlt * rhow * r1_Dt_ice 
    171169               wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 
    172170               ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_sal.F90

    r9750 r9939  
    7777            !--------------------------------------------------------- 
    7878            IF( h_i_1d(ji) > 0._wp ) THEN 
    79                zs_sni   = sss_1d(ji) * ( rhoic - rhosn ) * r1_rhoic                 ! Salinity of snow ice 
     79               zs_sni   = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi                    ! Salinity of snow ice 
    8080               zs_i_si = ( zs_sni      - s_i_1d(ji) ) * dh_snowice(ji) / h_i_1d(ji) ! snow-ice     
    8181               zs_i_bg = ( s_i_new(ji) - s_i_1d(ji) ) * dh_i_bog  (ji) / h_i_1d(ji) ! bottom growth 
    … …  
    9898                
    9999               ! Salt flux 
    100                sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * h_i_1d(ji) * ( zs_i_fl + zs_i_gd ) * r1_rdtice 
     100               sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * ( zs_i_fl + zs_i_gd ) * r1_Dt_ice 
    101101            ENDIF 
    102102         END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_zdf_bl99.F90

    r9656 r9939  
    217217            ! 
    218218            DO ji = 1, npti 
    219                ztcond_i(ji,0)      = rcdic + zbeta * sz_i_1d(ji,1)      / MIN( -epsi10, t_i_1d(ji,1) - rt0 ) 
    220                ztcond_i(ji,nlay_i) = rcdic + zbeta * sz_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji)  - rt0 ) 
     219               ztcond_i(ji,0)      = rcnd_i + zbeta * sz_i_1d(ji,1)      / MIN( -epsi10, t_i_1d(ji,1) - rt0 ) 
     220               ztcond_i(ji,nlay_i) = rcnd_i + zbeta * sz_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji)  - rt0 ) 
    221221            END DO 
    222222            DO jk = 1, nlay_i-1 
    223223               DO ji = 1, npti 
    224                   ztcond_i(ji,jk) = rcdic + zbeta * 0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) /  & 
    225                      &                      MIN( -epsi10, 0.5_wp * (t_i_1d(ji,jk) + t_i_1d(ji,jk+1)) - rt0 ) 
     224!!gm faster coding 
     225                  ztcond_i(ji,jk) = rcnd_i + zbeta * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) )             & 
     226                     &                          / MIN( t_i_1d (ji,jk) + t_i_1d (ji,jk+1) - 2._wp * rt0 , -epsi10 ) 
     227!!gm old 
     228!                  ztcond_i(ji,jk) = rcnd_i + zbeta * 0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) )   & 
     229!                     &                             / MIN( 0.5_wp * (t_i_1d(ji,jk) + t_i_1d(ji,jk+1)) - rt0 , -epsi10 ) 
     230!!gm  
    226231               END DO 
    227232            END DO 
    … …  
    230235            ! 
    231236            DO ji = 1, npti 
    232                ztcond_i(ji,0)      = rcdic + 0.09_wp  *  sz_i_1d(ji,1)      / MIN( -epsi10, t_i_1d(ji,1) - rt0 )  & 
    233                   &                        - 0.011_wp * ( t_i_1d(ji,1) - rt0 ) 
    234                ztcond_i(ji,nlay_i) = rcdic + 0.09_wp  *  sz_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji)  - rt0 )  & 
    235                   &                        - 0.011_wp * ( t_bo_1d(ji) - rt0 ) 
     237               ztcond_i(ji,0)      = rcnd_i + 0.09_wp  *  sz_i_1d(ji,1)      / MIN( -epsi10, t_i_1d(ji,1) - rt0 )  & 
     238                  &                         - 0.011_wp * ( t_i_1d(ji,1) - rt0 ) 
     239               ztcond_i(ji,nlay_i) = rcnd_i + 0.09_wp  *  sz_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji)  - rt0 )  & 
     240                  &                         - 0.011_wp * ( t_bo_1d(ji) - rt0 ) 
    236241            END DO 
    237242            DO jk = 1, nlay_i-1 
    238243               DO ji = 1, npti 
    239                   ztcond_i(ji,jk) = rcdic + 0.09_wp  *   0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) /        & 
    240                      &                     MIN( -epsi10, 0.5_wp * ( t_i_1d (ji,jk) + t_i_1d (ji,jk+1) ) - rt0 )  & 
    241                      &                    - 0.011_wp * ( 0.5_wp * ( t_i_1d (ji,jk) + t_i_1d (ji,jk+1) ) - rt0 ) 
     244!!gm faster coding 
     245                  zfac   = t_i_1d (ji,jk) + t_i_1d (ji,jk+1) - 2._wp * rt0 
     246                  ztcond_i(ji,jk) = rcnd_i + 0.09_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) / MIN( -epsi10, zfac )  & 
     247                     &                     - 0.0055_wp * zfac            !NB:  0.0055 = 1/2 * 0.011 
     248!!gm old 
     249!                  ztcond_i(ji,jk) = rcnd_i + 0.09_wp  *   0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) /        & 
     250!                     &                      MIN( -epsi10, 0.5_wp * ( t_i_1d (ji,jk) + t_i_1d (ji,jk+1) ) - rt0 )  & 
     251!                     &                     - 0.011_wp * ( 0.5_wp * ( t_i_1d (ji,jk) + t_i_1d (ji,jk+1) ) - rt0 ) 
     252!!gm  
    242253               END DO 
    243254            END DO 
    … …  
    299310         DO jk = 1, nlay_i 
    300311            DO ji = 1, npti 
    301                zcpi = cpic + zgamma * sz_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztiold(ji,jk) - rt0 ), epsi10 ) 
    302                zeta_i(ji,jk) = rdt_ice * r1_rhoic * z1_h_i(ji) / MAX( epsi10, zcpi )  
     312               zcpi = rcpi + zgamma * sz_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztiold(ji,jk) - rt0 ), epsi10 ) 
     313               zeta_i(ji,jk) = rdt_ice * r1_rhoi * z1_h_i(ji) / MAX( epsi10, zcpi )  
    303314            END DO 
    304315         END DO 
    … …  
    306317         DO jk = 1, nlay_s 
    307318            DO ji = 1, npti 
    308                zeta_s(ji,jk) = rdt_ice * r1_rhosn * r1_cpic * z1_h_s(ji) 
     319               zeta_s(ji,jk) = rdt_ice * r1_rhos * r1_cpi * z1_h_s(ji) 
    309320            END DO 
    310321         END DO 
    … …  
    770781                
    771782               IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC 
    772                   zhfx_err = ( qns_ice_1d(ji) + qsr_ice_1d(ji)    - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice )*a_i_1d(ji) 
     783                  zhfx_err = ( qns_ice_1d(ji) + qsr_ice_1d(ji)    - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_Dt_ice )*a_i_1d(ji) 
    773784               ELSE                          ! case T_su = 0degC 
    774                   zhfx_err = ( fc_su(ji)      + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice )*a_i_1d(ji) 
     785                  zhfx_err = ( fc_su(ji)      + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_Dt_ice )*a_i_1d(ji) 
    775786               ENDIF 
    776787                
    777788            ELSEIF( k_jules == np_jules_ACTIVE ) THEN 
    778789             
    779                zhfx_err = ( fc_su(ji) + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice ) * a_i_1d(ji) 
     790               zhfx_err = ( fc_su(ji) + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_Dt_ice ) * a_i_1d(ji) 
    780791             
    781792            ENDIF 
    … …  
    785796            ! 
    786797            ! hfx_dif = Heat flux diagnostic of sensible heat used to warm/cool ice in W.m-2    
    787             hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_rdtice * a_i_1d(ji) 
     798            hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_Dt_ice * a_i_1d(ji) 
    788799            ! 
    789800         END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/iceupdate.F90

    r9784 r9939  
    172172            snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step 
    173173            !                                               ! new mass per unit area 
    174             snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj)  )  
     174            snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj)  )  
    175175            !                                               ! time evolution of snow+ice mass 
    176             snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice 
     176            snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_Dt_ice 
    177177             
    178178         END DO 
    … …  
    336336      ENDIF 
    337337 
    338       zrhoco = rau0 * rn_cio 
     338      zrhoco = rho0 * rn_cio 
    339339      ! 
    340340      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
    … …  
    432432            ELSE                                     ! start from rest 
    433433               IF(lwp) WRITE(numout,*) '   ==>>   previous run without snow-ice mass output then set it' 
    434                snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 
     434               snwice_mass  (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) ) 
    435435               snwice_mass_b(:,:) = snwice_mass(:,:) 
    436436            ENDIF 
    437437         ELSE                                   !* Start from rest 
    438438            IF(lwp) WRITE(numout,*) '   ==>>   start from rest: set the snow-ice mass' 
    439             snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 
     439            snwice_mass  (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) ) 
    440440            snwice_mass_b(:,:) = snwice_mass(:,:) 
    441441         ENDIF 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icevar.F90

    r9725 r9939  
    228228                     ztmelts          = - sz_i(ji,jj,jk,jl) * tmut                                 ! Ice layer melt temperature [C] 
    229229                     ! Conversion q(S,T) -> T (second order equation) 
    230                      zbbb             = ( rcp - cpic ) * ztmelts + ze_i * r1_rhoic - lfus 
    231                      zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * cpic * lfus * ztmelts , 0._wp) ) 
    232                      t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_cpic , ztmelts ) ) + rt0   ! [K] with bounds: -100 < t_i < ztmelts 
     230                     zbbb             = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus 
     231                     zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) ) 
     232                     t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_cpi , ztmelts ) ) + rt0   ! [K] with bounds: -100 < t_i < ztmelts 
    233233                     ! 
    234234                  ELSE                                !--- no ice 
    … …  
    247247         WHERE( v_s(:,:,:) > epsi20 )        !--- icy area 
    248248            t_s(:,:,jk,:) = rt0 + MAX( -100._wp ,  & 
    249                  &                MIN( r1_cpic * ( -r1_rhosn * ( e_s(:,:,jk,:) / v_s(:,:,:) * zlay_s ) + lfus ) , 0._wp ) ) 
     249                 &                MIN( r1_cpi * ( -r1_rhos * ( e_s(:,:,jk,:) / v_s(:,:,:) * zlay_s ) + rLfus ) , 0._wp ) ) 
    250250         ELSEWHERE                           !--- no ice 
    251251            t_s(:,:,jk,:) = rt0 
    … …  
    477477               DO ji = 1 , jpi 
    478478                  ! update exchanges with ocean 
    479                   hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
     479                  hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_Dt_ice ! W.m-2 <0 
    480480                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj) 
    481481                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 
    … …  
    488488               DO ji = 1 , jpi 
    489489                  ! update exchanges with ocean 
    490                   hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
     490                  hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_Dt_ice ! W.m-2 <0 
    491491                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj) 
    492492                  t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 
    … …  
    498498            DO ji = 1 , jpi 
    499499               ! update exchanges with ocean 
    500                sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoic * r1_rdtice 
    501                wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoic * r1_rdtice 
    502                wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhosn * r1_rdtice 
     500               sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_Dt_ice 
     501               wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_Dt_ice 
     502               wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_Dt_ice 
    503503               ! 
    504504               !----------------------------------------------------------------- 
    … …  
    669669               ! In case snow load is in excess that would lead to transformation from snow to ice 
    670670               ! Then, transfer the snow excess into the ice (different from icethd_dh) 
    671                zdh = MAX( 0._wp, ( rhosn * zh_s(ji,jl) + ( rhoic - rau0 ) * zh_i(ji,jl) ) * r1_rau0 )  
     671               zdh = MAX( 0._wp, ( rhos * zh_s(ji,jl) + ( rhoi - rho0 ) * zh_i(ji,jl) ) * r1_rho0 )  
    672672               ! recompute h_i, h_s avoiding out of bounds values 
    673673               zh_i(ji,jl) = MIN( hi_max(jl), zh_i(ji,jl) + zdh ) 
    674                zh_s(ji,jl) = MAX( 0._wp, zh_s(ji,jl) - zdh * rhoic * r1_rhosn ) 
     674               zh_s(ji,jl) = MAX( 0._wp, zh_s(ji,jl) - zdh * rhoi * r1_rhos ) 
    675675            ENDIF 
    676676         END DO 
    … …  
    854854            ztmelts      = - tmut  * sz_i_1d(ji,jk) 
    855855            t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts + rt0 ) ! Force t_i_1d to be lower than melting point 
    856                                                                 !   (sometimes zdf scheme produces abnormally high temperatures)    
    857             e_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - ( t_i_1d(ji,jk) - rt0 ) )           & 
    858                &                    + lfus * ( 1._wp - ztmelts / ( t_i_1d(ji,jk) - rt0 ) )   & 
    859                &                    - rcp  *   ztmelts ) 
     856            !                                                   !   (sometimes zdf scheme produces abnormally high temperatures)    
     857            e_i_1d(ji,jk) = rhoi * ( rcpi * ( ztmelts - ( t_i_1d(ji,jk) - rt0 ) )           & 
     858               &                   + rLfus * ( 1._wp - ztmelts / ( t_i_1d(ji,jk) - rt0 ) )   & 
     859               &                   - rcp   *   ztmelts ) 
    860860         END DO 
    861861      END DO 
    862862      DO jk = 1, nlay_s             ! Snow energy of melting 
    863863         DO ji = 1, npti 
    864             e_s_1d(ji,jk) = rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) 
     864            e_s_1d(ji,jk) = rhos * ( rcpi * ( rt0 - t_s_1d(ji,jk) ) + rLfus ) 
    865865         END DO 
    866866      END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icewri.F90

    r9604 r9939  
    8585      ! Standard outputs 
    8686      !----------------- 
    87       zrho1 = ( rau0 - rhoic ) * r1_rau0; zrho2 = rhosn * r1_rau0 
     87      zrho1 = ( rho0 - rhoi ) * r1_rho0   ;   zrho2 = rhos * r1_rho0 
    8888      ! masks 
    8989      IF( iom_use('icemask'  ) )   CALL iom_put( "icemask"  , zmsk00              )   ! ice mask 0% 
    … …  
    9292      ! 
    9393      ! general fields 
    94       IF( iom_use('icemass'  ) )   CALL iom_put( "icemass", rhoic * vt_i * zmsk00 )   ! Ice mass per cell area  
    95       IF( iom_use('snwmass'  ) )   CALL iom_put( "snwmass", rhosn * vt_s * zmsksn )   ! Snow mass per cell area 
     94      IF( iom_use('icemass'  ) )   CALL iom_put( "icemass", rhoi * vt_i * zmsk00 )   ! Ice mass per cell area  
     95      IF( iom_use('snwmass'  ) )   CALL iom_put( "snwmass", rhos * vt_s * zmsksn )   ! Snow mass per cell area 
    9696      IF( iom_use('icepres'  ) )   CALL iom_put( "icepres", zmsk00                )   ! Ice presence (1 or 0)  
    9797      IF( iom_use('iceconc'  ) )   CALL iom_put( "iceconc", at_i  * zmsk00        )   ! ice concentration 
    … …  
    104104      IF( iom_use('snwvolu'  ) )   CALL iom_put( "snwvolu", vt_s  * zmsksn        )   ! snow volume 
    105105      IF( iom_use('icefrb') ) THEN 
     106!!gm remove the WHERE by using : 
     107!!         z2d(:,:) = MAX( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) , 0._wp )                                          
     108!!gm end 
    106109         z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) )                                          
    107110         WHERE( z2d < 0._wp )   z2d = 0._wp 
    … …  
    115118      ! salt 
    116119      IF( iom_use('icesalt'  ) )   CALL iom_put( "icesalt", sm_i  * zmsk00        )   ! mean ice salinity 
    117       IF( iom_use('icesalm'  ) )   CALL iom_put( "icesalm", SUM( sv_i, DIM = 3 ) * rhoic * 1.0e-3 * zmsk00 )   ! Mass of salt in sea ice per cell area 
     120      IF( iom_use('icesalm'  ) )   CALL iom_put( "icesalm", SUM( sv_i, DIM = 3 ) * rhoi * 1.0e-3 * zmsk00 )   ! Mass of salt in sea ice per cell area 
    118121 
    119122      ! heat 
    … …  
    164167      ! trends 
    165168      IF( iom_use('dmithd') )   CALL iom_put( "dmithd", - wfx_bog - wfx_bom - wfx_sum - wfx_sni - wfx_opw - wfx_lam - wfx_res ) ! Sea-ice mass change from thermodynamics 
    166       IF( iom_use('dmidyn') )   CALL iom_put( "dmidyn", - wfx_dyn + rhoic * diag_trp_vi     )   ! Sea-ice mass change from dynamics(kg/m2/s) 
     169      IF( iom_use('dmidyn') )   CALL iom_put( "dmidyn", - wfx_dyn + rhoi * diag_trp_vi      )   ! Sea-ice mass change from dynamics(kg/m2/s) 
    167170      IF( iom_use('dmiopw') )   CALL iom_put( "dmiopw", - wfx_opw                           )   ! Sea-ice mass change through growth in open water 
    168171      IF( iom_use('dmibog') )   CALL iom_put( "dmibog", - wfx_bog                           )   ! Sea-ice mass change through basal growth 
    … …  
    174177      IF( iom_use('dmisub') )   CALL iom_put( "dmisub", - wfx_ice_sub                       )   ! Sea-ice mass change through sublimation 
    175178      IF( iom_use('dmsspr') )   CALL iom_put( "dmsspr", - wfx_spr                           )   ! Snow mass change through snow fall 
    176       IF( iom_use('dmsssi') )   CALL iom_put( "dmsssi",   wfx_sni*rhosn*r1_rhoic            )   ! Snow mass change through snow-to-ice conversion 
     179      IF( iom_use('dmsssi') )   CALL iom_put( "dmsssi",   wfx_sni*rhos*r1_rhoi              )   ! Snow mass change through snow-to-ice conversion 
    177180      IF( iom_use('dmsmel') )   CALL iom_put( "dmsmel", - wfx_snw_sum                       )   ! Snow mass change through melt 
    178       IF( iom_use('dmsdyn') )   CALL iom_put( "dmsdyn", - wfx_snw_dyn + rhosn * diag_trp_vs )   ! Snow mass change through dynamics(kg/m2/s) 
     181      IF( iom_use('dmsdyn') )   CALL iom_put( "dmsdyn", - wfx_snw_dyn + rhos * diag_trp_vs )   ! Snow mass change through dynamics(kg/m2/s) 
    179182 
    180183      ! Global ice diagnostics 
    … …  
    250253      CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up") 
    251254 
    252       CALL histdef( kid, "sithic", "Ice thickness"          , "m"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    253       CALL histdef( kid, "siconc", "Ice concentration"      , "%"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    254       CALL histdef( kid, "sitemp", "Ice temperature"        , "C"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    255       CALL histdef( kid, "sivelu", "i-Ice speed "           , "m/s"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    256       CALL histdef( kid, "sivelv", "j-Ice speed "           , "m/s"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    257       CALL histdef( kid, "sistru", "i-Wind stress over ice" , "Pa"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    258       CALL histdef( kid, "sistrv", "j-Wind stress over ice" , "Pa"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    259       CALL histdef( kid, "sisflx", "Solar flx over ocean"   , "W/m2"   , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    260       CALL histdef( kid, "sinflx", "NonSolar flx over ocean", "W/m2"   , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    261       CALL histdef( kid, "snwpre", "Snow precipitation"     , "kg/m2/s", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    262       CALL histdef( kid, "sisali", "Ice salinity"           , "PSU"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    263       CALL histdef( kid, "sivolu", "Ice volume"             , "m"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    264       CALL histdef( kid, "sidive", "Ice divergence"         , "10-8s-1", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    265       CALL histdef( kid, "si_amp", "Melt pond fraction"     , "%"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    266       CALL histdef( kid, "si_vmp", "Melt pond volume"       ,  "m"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    267       ! 
    268       CALL histdef( kid, "sithicat", "Ice thickness"        , "m"      , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
    269       CALL histdef( kid, "siconcat", "Ice concentration"    , "%"      , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
    270       CALL histdef( kid, "sisalcat", "Ice salinity"         , ""       , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
    271       CALL histdef( kid, "snthicat", "Snw thickness"        , "m"      , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 
     255      CALL histdef( kid, "sithic", "Ice thickness"          , "m"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
     256      CALL histdef( kid, "siconc", "Ice concentration"      , "%"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
     257      CALL histdef( kid, "sitemp", "Ice temperature"        , "C"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
     258      CALL histdef( kid, "sivelu", "i-Ice speed "           , "m/s"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
     259      CALL histdef( kid, "sivelv", "j-Ice speed "           , "m/s"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )  
     260      CALL histdef( kid, "sistru", "i-Wind stress over ice" , "Pa"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
     261      CALL histdef( kid, "sistrv", "j-Wind stress over ice" , "Pa"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )  
     262      CALL histdef( kid, "sisflx", "Solar flx over ocean"   , "W/m2"   , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )  
     263      CALL histdef( kid, "sinflx", "NonSolar flx over ocean", "W/m2"   , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
     264      CALL histdef( kid, "snwpre", "Snow precipitation"     , "kg/m2/s", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )  
     265      CALL histdef( kid, "sisali", "Ice salinity"           , "PSU"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )  
     266      CALL histdef( kid, "sivolu", "Ice volume"             , "m"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )  
     267      CALL histdef( kid, "sidive", "Ice divergence"         , "10-8s-1", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )  
     268      CALL histdef( kid, "si_amp", "Melt pond fraction"     , "%"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
     269      CALL histdef( kid, "si_vmp", "Melt pond volume"       ,  "m"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
     270      ! 
     271      CALL histdef( kid, "sithicat", "Ice thickness"        , "m" , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rn_Dt, rn_Dt ) 
     272      CALL histdef( kid, "siconcat", "Ice concentration"    , "%" , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rn_Dt, rn_Dt ) 
     273      CALL histdef( kid, "sisalcat", "Ice salinity"         , ""  , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rn_Dt, rn_Dt ) 
     274      CALL histdef( kid, "snthicat", "Snw thickness"        , "m" , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rn_Dt, rn_Dt ) 
    272275 
    273276      CALL histend( kid, snc4set )   ! end of the file definition 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/NST/agrif_oce_update.F90

    r9780 r9939  
    1212   !!            3.6  !  2014-09  (R. Benshila)  
    1313   !!---------------------------------------------------------------------- 
     14 
     15   !!---------------------------------------------------------------------- 
     16   !!   Agrif_Update_Tra   : T-S agrif update 
     17   !!   Agrif_Update_Dyn   : dynamics agrif update 
     18   !!   Agrif_Update_ssh   : sea surface height update 
     19   !!   Agrif_Update_Tke   :  
     20   !!   Agrif_Update_vvl   :  
     21   !!   dom_vvl_update_UVF :  
     22   !!   updateTS           :  
     23   !!   updateu            : 
     24   !!   correct_u_bdy      : 
     25   !!   updatev            : 
     26   !!   correct_v_bdy      : 
     27   !!   updateu2d          : 
     28   !!   updatev2d          : 
     29   !!   updateSSH          : 
     30   !!   updateub2b         : 
     31   !!   reflux_sshu        : 
     32   !!   updatevb2b         : 
     33   !!   reflux_sshv        : 
     34   !!   update_scales      : 
     35   !!   updateEN           : 
     36   !!   updateAVT          : 
     37   !!   updateAVM          : 
     38   !!   updatee3t          : 
     39   !!---------------------------------------------------------------------- 
     40 
    1441#if defined key_agrif  
    1542   !!---------------------------------------------------------------------- 
    1643   !!   'key_agrif'                                              AGRIF zoom 
    1744   !!---------------------------------------------------------------------- 
    18    USE par_oce 
    19    USE oce 
    20    USE dom_oce 
     45   USE par_oce        ! ocean parameter 
     46   USE oce            ! ocean variables 
     47   USE dom_oce        ! ocean domain 
    2148   USE zdf_oce        ! vertical physics: ocean variables  
    22    USE agrif_oce 
     49   USE agrif_oce      !  
    2350   ! 
    2451   USE in_out_manager ! I/O manager 
    … …  
    6794      ! 
    6895   END SUBROUTINE Agrif_Update_Tra 
     96 
    6997 
    7098   SUBROUTINE Agrif_Update_Dyn( ) 
    … …  
    125153   END SUBROUTINE Agrif_Update_Dyn 
    126154 
     155 
    127156   SUBROUTINE Agrif_Update_ssh( ) 
    128       !!--------------------------------------------- 
    129       !!   *** ROUTINE Agrif_Update_ssh *** 
    130       !!--------------------------------------------- 
     157      !!---------------------------------------------------------------------- 
     158      !!                   *** ROUTINE Agrif_Update_ssh *** 
     159      !!---------------------------------------------------------------------- 
    131160      !  
    132161      IF (Agrif_Root()) RETURN 
    … …  
    163192 
    164193   SUBROUTINE Agrif_Update_Tke( ) 
    165       !!--------------------------------------------- 
    166       !!   *** ROUTINE Agrif_Update_Tke *** 
    167       !!--------------------------------------------- 
    168       !! 
     194      !!---------------------------------------------------------------------- 
     195      !!                   *** ROUTINE Agrif_Update_Tke *** 
     196      !!---------------------------------------------------------------------- 
    169197      !  
    170198      IF (Agrif_Root()) RETURN 
    171199      !        
    172200#  if defined TWO_WAY 
    173  
     201      ! 
    174202      Agrif_UseSpecialValueInUpdate = .TRUE. 
    175203      Agrif_SpecialValueFineGrid = 0. 
    176  
     204      ! 
    177205      CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN  ) 
    178206      CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT ) 
    179207      CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM ) 
    180  
     208      ! 
    181209      Agrif_UseSpecialValueInUpdate = .FALSE. 
    182  
     210      ! 
    183211#  endif 
    184        
     212      ! 
    185213   END SUBROUTINE Agrif_Update_Tke 
    186214 
    187215 
    188216   SUBROUTINE Agrif_Update_vvl( ) 
    189       !!--------------------------------------------- 
    190       !!   *** ROUTINE Agrif_Update_vvl *** 
    191       !!--------------------------------------------- 
    192       ! 
    193       IF (Agrif_Root()) RETURN 
     217      !!---------------------------------------------------------------------- 
     218      !!                   *** ROUTINE Agrif_Update_vvl *** 
     219      !!---------------------------------------------------------------------- 
     220      ! 
     221      IF ( Agrif_Root() )  RETURN 
    194222      ! 
    195223#if defined TWO_WAY   
    … …  
    214242   END SUBROUTINE Agrif_Update_vvl 
    215243 
     244 
    216245   SUBROUTINE dom_vvl_update_UVF 
    217       !!--------------------------------------------- 
    218       !!       *** ROUTINE dom_vvl_update_UVF *** 
    219       !!--------------------------------------------- 
    220       !! 
    221       INTEGER :: jk 
    222       REAL(wp):: zcoef 
    223       !!--------------------------------------------- 
    224  
    225       IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Finalize e3 on grid Number', & 
    226                   & Agrif_Fixed(), 'Step', Agrif_Nb_Step() 
    227  
    228       ! Save "old" scale factor (prior update) for subsequent asselin correction 
    229       ! of prognostic variables 
     246      !!---------------------------------------------------------------------- 
     247      !!                   *** ROUTINE dom_vvl_update_UVF *** 
     248      !!---------------------------------------------------------------------- 
     249      INTEGER ::   jk      ! dummy loop index 
     250      REAL(wp)::   zcoef   ! local scalar 
     251      !!---------------------------------------------------------------------- 
     252      ! 
     253      IF (lwp.AND.lk_agrif_debug)   Write(*,*) 'Finalize e3 on grid Number', & 
     254         &                                      Agrif_Fixed(), 'Step', Agrif_Nb_Step() 
     255 
     256      ! Save "old" scale factor (prior update) for subsequent asselin correction of prognostic variables 
    230257      ! ----------------------- 
    231       ! 
    232258      e3u_a(:,:,:) = e3u_n(:,:,:) 
    233259      e3v_a(:,:,:) = e3v_n(:,:,:) 
    … …  
    239265      ! 1) NOW fields 
    240266      !-------------- 
    241        
    242          ! Vertical scale factor interpolations 
    243          ! ------------------------------------ 
    244       CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:) ,  'U' ) 
    245       CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:) ,  'V' ) 
    246       CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:) ,  'F' ) 
    247  
     267      !                       ! Vertical scale factor interpolations 
     268      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n (:,:,:) , 'U' ) 
     269      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n (:,:,:) , 'V' ) 
     270      CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n (:,:,:) , 'F' ) 
    248271      CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
    249272      CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
    250  
    251          ! Update total depths: 
    252          ! -------------------- 
     273      ! 
     274      !                       ! Update total depths 
    253275      hu_n(:,:) = 0._wp                        ! Ocean depth at U-points 
    254276      hv_n(:,:) = 0._wp                        ! Ocean depth at V-points 
    … …  
    264286      ! 2) BEFORE fields: 
    265287      !------------------ 
    266       IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 
    267          ! 
    268          ! Vertical scale factor interpolations 
    269          ! ------------------------------------ 
    270          CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:),  'U'  ) 
    271          CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:),  'V'  ) 
    272  
     288      IF (.NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN 
     289!!gm      IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 
     290         !                    ! Vertical scale factor interpolations 
     291         CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b (:,:,:), 'U'  ) 
     292         CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b (:,:,:), 'V'  ) 
    273293         CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 
    274294         CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 
    275  
    276          ! Update total depths: 
    277          ! -------------------- 
     295         ! 
     296         !                    ! Update total depths: 
    278297         hu_b(:,:) = 0._wp                     ! Ocean depth at U-points 
    279298         hv_b(:,:) = 0._wp                     ! Ocean depth at V-points 
    … …  
    289308   END SUBROUTINE dom_vvl_update_UVF 
    290309 
    291 #if defined key_vertical 
     310# if defined key_vertical 
    292311 
    293312   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    294313      !!---------------------------------------------------------------------- 
    295       !!           *** ROUTINE updateT *** 
    296       !!--------------------------------------------- 
     314      !!                   *** ROUTINE updateT *** 
     315      !!---------------------------------------------------------------------- 
    297316      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    298317      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    … …  
    306325      REAL(wp) :: zrho_xy, h_diff 
    307326      REAL(wp) :: tabin(k1:k2,n1:n2) 
    308       !!--------------------------------------------- 
     327      !!---------------------------------------------------------------------- 
    309328      ! 
    310329      IF (before) THEN 
    311330         AGRIF_SpecialValue = -999._wp 
    312331         zrho_xy = Agrif_rhox() * Agrif_rhoy()  
    313          DO jn = n1,n2-1 
    314             DO jk=k1,k2 
    315                DO jj=j1,j2 
    316                   DO ji=i1,i2 
     332         DO jn = n1, n2-1 
     333            DO jk = k1, k2 
     334               DO jj = j1, j2 
     335                  DO ji = i1, i2 
    317336                     tabres(ji,jj,jk,jn) = (tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) & 
    318337                                           * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp 
    … …  
    321340            END DO 
    322341         END DO 
    323          DO jk=k1,k2 
    324             DO jj=j1,j2 
    325                DO ji=i1,i2 
     342         DO jk = k1, k2 
     343            DO jj = j1, j2 
     344               DO ji = i1, i2 
    326345                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) & 
    327346                                           + (tmask(ji,jj,jk)-1)*999._wp 
    … …  
    332351         tabres_child(:,:,:,:) = 0. 
    333352         AGRIF_SpecialValue = 0._wp 
    334          DO jj=j1,j2 
    335             DO ji=i1,i2 
     353         DO jj = j1 , j2 
     354            DO ji = i1, i2 
    336355               N_in = 0 
    337                DO jk=k1,k2 !k2 = jpk of child grid 
    338                   IF (tabres(ji,jj,jk,n2) == 0  ) EXIT 
     356               DO jk = k1, k2 !k2 = jpk of child grid 
     357                  IF ( tabres(ji,jj,jk,n2) == 0  )  EXIT 
    339358                  N_in = N_in + 1 
    340359                  tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2) 
    341                   h_in(N_in) = tabres(ji,jj,jk,n2) 
    342                ENDDO 
     360                  h_in (N_in) = tabres(ji,jj,jk,n2) 
     361               END DO 
    343362               N_out = 0 
    344                DO jk=1,jpk ! jpk of parent grid 
    345                   IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF 
     363               DO jk = 1, jpk ! jpk of parent grid 
     364                  IF (tmask(ji,jj,jk) < -900)   EXIT ! TODO: Will not work with ISF 
    346365                  N_out = N_out + 1 
    347366                  h_out(N_out) = e3t_n(ji,jj,jk)  
    348                ENDDO 
     367               END DO 
    349368               IF (N_in > 0) THEN !Remove this? 
    350369                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    … …  
    355374                     STOP 
    356375                  ENDIF 
    357                   DO jn=n1,n2-1 
     376                  DO jn = n1, n2-1 
    358377                     CALL reconstructandremap(tabin(1:N_in,jn),h_in(1:N_in),tabres_child(ji,jj,1:N_out,jn),h_out(1:N_out),N_in,N_out) 
    359                   ENDDO 
     378                  END DO 
    360379               ENDIF 
    361             ENDDO 
    362          ENDDO 
    363  
    364          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    365             ! Add asselin part 
    366             DO jn = n1,n2-1 
    367                DO jk=1,jpk 
    368                   DO jj=j1,j2 
    369                      DO ji=i1,i2 
    370                         IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 
    371                            tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) &  
    372                                  & + atfp * ( tabres_child(ji,jj,jk,jn) & 
    373                                  &          - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     380            END DO 
     381         END DO 
     382 
     383         IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN       ! Add asselin part 
     384 
     385!!gm         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     386            DO jn = n1, n2-1 
     387               DO jk = 1, jpk 
     388                  DO jj = j1, j2 
     389                     DO ji = i1, i2 
     390                        IF( tabres_child(ji,jj,jk,jn) /= 0. ) THEN 
     391                           tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn)   &  
     392                              &             + rn_atfp * ( tabres_child(ji,jj,jk,jn) - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    374393                        ENDIF 
    375                      ENDDO 
    376                   ENDDO 
    377                ENDDO 
    378             ENDDO 
    379          ENDIF 
    380          DO jn = n1,n2-1 
    381             DO jk=1,jpk 
    382                DO jj=j1,j2 
    383                   DO ji=i1,i2 
    384                      IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN  
     394                     END DO 
     395                  END DO 
     396               END DO 
     397            END DO 
     398         ENDIF 
     399         DO jn = n1, n2-1 
     400            DO jk = 1, jpk 
     401               DO jj = j1, j2 
     402                  DO ji = i1, i2 
     403                     IF( tabres_child(ji,jj,jk,jn) /= 0. ) THEN  
    385404                        tsn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk) 
    386405                     END IF 
    … …  
    396415 
    397416   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    398       !!--------------------------------------------- 
    399       !!           *** ROUTINE updateT *** 
    400       !!--------------------------------------------- 
     417      !!---------------------------------------------------------------------- 
     418      !!                   *** ROUTINE ROUTINE updateT *** 
     419      !!---------------------------------------------------------------------- 
    401420      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    402421      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    403422      LOGICAL, INTENT(in) :: before 
    404       !! 
     423      ! 
    405424      INTEGER :: ji,jj,jk,jn 
    406425      REAL(wp) :: ztb, ztnu, ztno 
    407       !!--------------------------------------------- 
     426      !!---------------------------------------------------------------------- 
    408427      ! 
    409428      IF (before) THEN 
    … …  
    425444            tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & 
    426445                                         & * tmask(i1:i2,j1:j2,k1:k2) 
    427          ENDDO 
     446         END DO 
    428447!< jc tmp 
    429          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     448         IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN 
     449!!gm         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    430450            ! Add asselin part 
    431451            DO jn = 1,jpts 
    … …  
    437457                           ztnu = tabres(ji,jj,jk,jn) 
    438458                           ztno = tsn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) 
    439                            tsb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) )  &  
    440                                      &        * tmask(ji,jj,jk) / e3t_b(ji,jj,jk) 
     459                           tsb(ji,jj,jk,jn) = ( ztb + rn_rn_atfp * ( ztnu - ztno) ) / e3t_b(ji,jj,jk) * tmask(ji,jj,jk) 
    441460                        ENDIF 
    442461                     END DO 
    … …  
    457476         END DO 
    458477         ! 
    459          IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     478         IF ( l_1st_euler .AND. Agrif_Nb_Step() == 0 ) THEN 
     479!!gm         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    460480            tsb(i1:i2,j1:j2,k1:k2,1:jpts)  = tsn(i1:i2,j1:j2,k1:k2,1:jpts) 
    461481         ENDIF 
    … …  
    470490 
    471491   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    472       !!--------------------------------------------- 
    473       !!           *** ROUTINE updateu *** 
    474       !!--------------------------------------------- 
     492      !!---------------------------------------------------------------------- 
     493      !!                   *** ROUTINE updateu *** 
     494      !!---------------------------------------------------------------------- 
    475495      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
    476496      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    … …  
    487507      REAL(wp) :: tabin(k1:k2) 
    488508! VERTICAL REFINEMENT END 
    489       !!--------------------------------------------- 
     509      !!---------------------------------------------------------------------- 
    490510      !  
    491511      IF( before ) THEN 
    … …  
    515535                  tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 
    516536                  h_in(N_in) = tabres(ji,jj,jk,2)/e2u(ji,jj) 
    517                ENDDO 
     537               END DO 
    518538               N_out = 0 
    519539               DO jk=1,jpk 
    … …  
    521541                  N_out = N_out + 1 
    522542                  h_out(N_out) = e3u_n(ji,jj,jk) 
    523                ENDDO 
     543               END DO 
    524544               IF (N_in * N_out > 0) THEN 
    525545                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    … …  
    538558                           EXIT 
    539559                        ENDIF 
    540                      ENDDO 
     560                     END DO 
    541561                  ENDIF 
    542562                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out) 
    543563                  tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e2u(ji,jj)*h_out(N_out)) 
    544564               ENDIF 
    545             ENDDO 
    546          ENDDO 
    547  
    548          DO jk=1,jpk 
    549             DO jj=j1,j2 
    550                DO ji=i1,i2 
    551                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    552                      ub(ji,jj,jk) = ub(ji,jj,jk) &  
    553                            & + atfp * ( tabres_child(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 
     565            END DO 
     566         END DO 
     567 
     568         DO jk = 1, jpk 
     569            DO jj = j1, j2 
     570               DO ji = i1, i2 
     571                  IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler) ) THEN    ! Add asselin part 
     572!!gm                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN   ! Add asselin part 
     573                     ub(ji,jj,jk) = ub(ji,jj,jk) + rn_atfp * ( tabres_child(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 
    554574                  ENDIF 
    555                   ! 
    556575                  un(ji,jj,jk) = tabres_child(ji,jj,jk) * umask(ji,jj,jk) 
    557576               END DO 
    … …  
    565584 
    566585   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    567       !!--------------------------------------------- 
    568       !!           *** ROUTINE updateu *** 
    569       !!--------------------------------------------- 
     586      !!---------------------------------------------------------------------- 
     587      !!                   *** ROUTINE updateu *** 
     588      !!---------------------------------------------------------------------- 
    570589      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
    571590      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    … …  
    574593      INTEGER  :: ji, jj, jk 
    575594      REAL(wp) :: zrhoy, zub, zunu, zuno 
    576       !!--------------------------------------------- 
     595      !!---------------------------------------------------------------------- 
    577596      !  
    578597      IF( before ) THEN 
    … …  
    587606                  tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e2u(ji,jj)  
    588607                  ! 
    589                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     608                  IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN    ! Add asselin part 
     609!!gm                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN   ! Add asselin part 
    590610                     zub  = ub(ji,jj,jk) * e3u_b(ji,jj,jk)  ! fse3t_b prior update should be used 
    591611                     zuno = un(ji,jj,jk) * e3u_a(ji,jj,jk) 
    592612                     zunu = tabres(ji,jj,jk,1) 
    593                      ub(ji,jj,jk) = ( zub + atfp * ( zunu - zuno) ) &       
    594                                     & * umask(ji,jj,jk) / e3u_b(ji,jj,jk) 
     613                     ub(ji,jj,jk) = ( zub + rn_atfp * ( zunu - zuno) ) / e3u_b(ji,jj,jk) * umask(ji,jj,jk) 
    595614                  ENDIF 
    596615                  ! 
    597                   un(ji,jj,jk) = tabres(ji,jj,jk,1) * umask(ji,jj,jk) / e3u_n(ji,jj,jk) 
    598                END DO 
    599             END DO 
    600          END DO 
    601          ! 
    602          IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     616                  un(ji,jj,jk) = tabres(ji,jj,jk,1) / e3u_n(ji,jj,jk) * umask(ji,jj,jk) 
     617               END DO 
     618            END DO 
     619         END DO 
     620         ! 
     621         IF ( l_1st_euler .AND. Agrif_Nb_Step() == 0 ) THEN 
     622!!gm         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    603623            ub(i1:i2,j1:j2,k1:k2)  = un(i1:i2,j1:j2,k1:k2) 
    604624         ENDIF 
    … …  
    611631 
    612632   SUBROUTINE correct_u_bdy( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
    613       !!--------------------------------------------- 
    614       !!           *** ROUTINE correct_u_bdy *** 
    615       !!--------------------------------------------- 
     633      !!---------------------------------------------------------------------- 
     634      !!                   *** ROUTINE correct_u_bdy *** 
     635      !!---------------------------------------------------------------------- 
    616636      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
    617637      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    618638      LOGICAL                                     , INTENT(in   ) :: before 
    619       INTEGER                                     , INTENT(in)    :: nb, ndir 
     639      INTEGER                                     , INTENT(in   ) :: nb, ndir 
    620640      !! 
    621641      LOGICAL :: western_side, eastern_side  
    622       ! 
    623       INTEGER  :: jj, jk 
    624       REAL(wp) :: zcor 
    625       !!--------------------------------------------- 
     642      INTEGER ::   jj, jk 
     643      REAL(wp)::   zcor 
     644      !!---------------------------------------------------------------------- 
    626645      !  
    627646      IF( .NOT.before ) THEN 
    … …  
    657676 
    658677   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    659       !!--------------------------------------------- 
    660       !!           *** ROUTINE updatev *** 
    661       !!--------------------------------------------- 
     678      !!---------------------------------------------------------------------- 
     679      !!                   *** ROUTINE updatev *** 
     680      !!---------------------------------------------------------------------- 
    662681      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
    663682      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    … …  
    674693      REAL(wp) :: tabin(k1:k2) 
    675694! VERTICAL REFINEMENT END 
    676       !!---------------------------------------------       
     695      !!----------------------------------------------------------------------       
    677696      ! 
    678697      IF( before ) THEN 
    … …  
    700719                  tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 
    701720                  h_in(N_in) = tabres(ji,jj,jk,2)/e1v(ji,jj) 
    702                ENDDO 
     721               END DO 
    703722               N_out = 0 
    704723               DO jk=1,jpk 
    … …  
    706725                  N_out = N_out + 1 
    707726                  h_out(N_out) = e3v_n(ji,jj,jk) 
    708                ENDDO 
     727               END DO 
    709728               IF (N_in * N_out > 0) THEN 
    710729                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    … …  
    723742                           EXIT 
    724743                        ENDIF 
    725                      ENDDO 
     744                     END DO 
    726745                  ENDIF 
    727746                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out) 
    728747                  tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e1v(ji,jj)*h_out(N_out)) 
    729748               ENDIF 
    730             ENDDO 
    731          ENDDO 
     749            END DO 
     750         END DO 
    732751 
    733752         DO jk=1,jpk 
    … …  
    735754               DO ji=i1,i2 
    736755                  ! 
    737                   IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN ! Add asselin part 
    738                      vb(ji,jj,jk) = vb(ji,jj,jk) &  
    739                            & + atfp * ( tabres_child(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 
     756                  IF( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN ! Add asselin part 
     757!!gm                  IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN  ! Add asselin part 
     758                     vb(ji,jj,jk) = vb(ji,jj,jk) + rn_atfp * ( tabres_child(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 
    740759                  ENDIF 
    741760                  ! 
    … …  
    751770 
    752771   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before) 
    753       !!--------------------------------------------- 
    754       !!           *** ROUTINE updatev *** 
    755       !!--------------------------------------------- 
     772      !!---------------------------------------------------------------------- 
     773      !!                   *** ROUTINE updatev *** 
     774      !!---------------------------------------------------------------------- 
    756775      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
    757776      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    … …  
    760779      INTEGER  :: ji, jj, jk 
    761780      REAL(wp) :: zrhox, zvb, zvnu, zvno 
    762       !!---------------------------------------------       
     781      !!----------------------------------------------------------------------       
    763782      ! 
    764783      IF (before) THEN 
    … …  
    777796                  tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e1v(ji,jj) 
    778797                  ! 
    779                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     798                  IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN    ! Add asselin part 
     799!!gm                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN   ! Add asselin part 
    780800                     zvb  = vb(ji,jj,jk) * e3v_b(ji,jj,jk) ! fse3t_b prior update should be used 
    781801                     zvno = vn(ji,jj,jk) * e3v_a(ji,jj,jk) 
    782802                     zvnu = tabres(ji,jj,jk,1) 
    783                      vb(ji,jj,jk) = ( zvb + atfp * ( zvnu - zvno) ) &       
    784                                     & * vmask(ji,jj,jk) / e3v_b(ji,jj,jk) 
     803                     vb(ji,jj,jk) = ( zvb + rn_atfp * ( zvnu - zvno) ) / e3v_b(ji,jj,jk) * vmask(ji,jj,jk) 
    785804                  ENDIF 
    786805                  ! 
    787                   vn(ji,jj,jk) = tabres(ji,jj,jk,1) * vmask(ji,jj,jk) / e3v_n(ji,jj,jk) 
    788                END DO 
    789             END DO 
    790          END DO 
    791          ! 
    792          IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     806                  vn(ji,jj,jk) = tabres(ji,jj,jk,1) / e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
     807               END DO 
     808            END DO 
     809         END DO 
     810         ! 
     811         IF ( l_1st_euler .AND. Agrif_Nb_Step() == 0 ) THEN 
     812!!gm         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    793813            vb(i1:i2,j1:j2,k1:k2)  = vn(i1:i2,j1:j2,k1:k2) 
    794814         ENDIF 
    … …  
    801821 
    802822   SUBROUTINE correct_v_bdy( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
    803       !!--------------------------------------------- 
    804       !!           *** ROUTINE correct_u_bdy *** 
    805       !!--------------------------------------------- 
     823      !!---------------------------------------------------------------------- 
     824      !!                   *** ROUTINE correct_v_bdy *** 
     825      !!---------------------------------------------------------------------- 
    806826      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
    807827      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    … …  
    813833      INTEGER  :: ji, jk 
    814834      REAL(wp) :: zcor 
    815       !!--------------------------------------------- 
     835      !!---------------------------------------------------------------------- 
    816836      !  
    817837      IF( .NOT.before ) THEN 
    … …  
    847867   SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before ) 
    848868      !!---------------------------------------------------------------------- 
    849       !!                      *** ROUTINE updateu2d *** 
     869      !!                   *** ROUTINE updateu2d *** 
    850870      !!---------------------------------------------------------------------- 
    851871      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
    852872      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
    853873      LOGICAL                         , INTENT(in   ) ::   before 
    854       !!  
     874      ! 
    855875      INTEGER  :: ji, jj, jk 
    856876      REAL(wp) :: zrhoy 
    857877      REAL(wp) :: zcorr 
    858       !!--------------------------------------------- 
     878      !!---------------------------------------------------------------------- 
    859879      ! 
    860880      IF( before ) THEN 
    … …  
    883903               ! Update barotropic velocities: 
    884904               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 
    885                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     905                  IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN    ! Add asselin part 
     906!!gm                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    886907                     zcorr = (tabres(ji,jj) - un_b(ji,jj) * hu_a(ji,jj)) * r1_hu_b(ji,jj) 
    887                      ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 
     908                     ub_b(ji,jj) = ub_b(ji,jj) + rn_atfp * zcorr * umask(ji,jj,1) 
    888909                  END IF 
    889910               ENDIF     
    … …  
    904925         END DO 
    905926         ! 
    906          IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     927         IF ( l_1st_euler .AND. Agrif_Nb_Step() == 0 ) THEN 
     928!!gm         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    907929            ub_b(i1:i2,j1:j2)  = un_b(i1:i2,j1:j2) 
    908930         ENDIF 
    … …  
    948970               ! 
    949971               ! Update barotropic velocities: 
    950                IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 
    951                   IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     972               IF ( .NOT.ln_dynspg_ts .OR. ( ln_dynspg_ts .AND. .NOT.ln_bt_fw ) ) THEN 
     973                  IF ( .NOT.( lk_agrif_fstep. AND. l_1st_euler ) ) THEN    ! Add asselin part 
     974!!gm                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    952975                     zcorr = (tabres(ji,jj) - vn_b(ji,jj) * hv_a(ji,jj)) * r1_hv_b(ji,jj) 
    953                      vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 
     976                     vb_b(ji,jj) = vb_b(ji,jj) + rn_atfp * zcorr * vmask(ji,jj,1) 
    954977                  END IF 
    955978               ENDIF               
    … …  
    970993         END DO 
    971994         ! 
    972          IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     995         IF ( l_1st_euler .AND. Agrif_Nb_Step() == 0 ) THEN 
     996!!gm         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    973997            vb_b(i1:i2,j1:j2)  = vn_b(i1:i2,j1:j2) 
    974998         ENDIF 
    … …  
    9861010      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
    9871011      LOGICAL                         , INTENT(in   ) ::   before 
    988       !! 
     1012      ! 
    9891013      INTEGER :: ji, jj 
    9901014      !!---------------------------------------------------------------------- 
    … …  
    9971021         END DO 
    9981022      ELSE 
    999          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     1023         IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN 
     1024!!gm         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    10001025            DO jj=j1,j2 
    10011026               DO ji=i1,i2 
    1002                   sshb(ji,jj) =   sshb(ji,jj) & 
    1003                         & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
     1027                  sshb(ji,jj) = sshb(ji,jj) + rn_atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
    10041028               END DO 
    10051029            END DO 
    … …  
    10121036         END DO 
    10131037         ! 
    1014          IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     1038         IF ( l_1st_euler .AND. Agrif_Nb_Step() == 0 ) THEN 
     1039!!gm         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    10151040            sshb(i1:i2,j1:j2)  = sshn(i1:i2,j1:j2) 
    10161041         ENDIF 
    10171042         ! 
    1018  
    10191043      ENDIF 
    10201044      ! 
    … …  
    10621086   END SUBROUTINE updateub2b 
    10631087 
     1088 
    10641089   SUBROUTINE reflux_sshu( tabres, i1, i2, j1, j2, before, nb, ndir ) 
    1065       !!--------------------------------------------- 
    1066       !!          *** ROUTINE reflux_sshu *** 
    1067       !!--------------------------------------------- 
    1068       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    1069       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    1070       LOGICAL, INTENT(in) :: before 
    1071       INTEGER, INTENT(in) :: nb, ndir 
    1072       !! 
    1073       LOGICAL :: western_side, eastern_side  
    1074       INTEGER :: ji, jj 
    1075       REAL(wp) :: zrhoy, za1, zcor 
    1076       !!--------------------------------------------- 
     1090      !!---------------------------------------------------------------------- 
     1091      !!                   *** ROUTINE reflux_sshu *** 
     1092      !!---------------------------------------------------------------------- 
     1093      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     1094      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     1095      LOGICAL                         , INTENT(in   ) ::  before 
     1096      INTEGER                         , INTENT(in   ) ::  nb, ndir 
     1097      ! 
     1098      LOGICAL ::   western_side, eastern_side  
     1099      INTEGER ::   ji, jj 
     1100      REAL(wp)::  zrhoy, za1, zcor 
     1101      !!---------------------------------------------------------------------- 
    10771102      ! 
    10781103      IF (before) THEN 
    … …  
    10911116         eastern_side  = (nb == 1).AND.(ndir == 2) 
    10921117         ! 
    1093          IF (western_side) THEN 
     1118         IF ( western_side ) THEN 
    10941119            DO jj=j1,j2 
    1095                zcor = rdt * r1_e1e2t(i1  ,jj) * e2u(i1,jj) * (ub2_b(i1,jj)-tabres(i1,jj))  
     1120               zcor = rn_Dt * r1_e1e2t(i1  ,jj) * e2u(i1,jj) * (ub2_b(i1,jj)-tabres(i1,jj))  
    10961121               sshn(i1  ,jj) = sshn(i1  ,jj) + zcor 
    1097                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(i1  ,jj) = sshb(i1  ,jj) + atfp * zcor 
    1098             END DO 
    1099          ENDIF 
    1100          IF (eastern_side) THEN 
     1122               IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) )   sshb(i1  ,jj) = sshb(i1  ,jj) + rn_atfp * zcor 
     1123!!gm               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(i1  ,jj) = sshb(i1  ,jj) + rn_atfp * zcor 
     1124            END DO 
     1125         ENDIF 
     1126         IF ( eastern_side ) THEN 
    11011127            DO jj=j1,j2 
    1102                zcor = - rdt * r1_e1e2t(i2+1,jj) * e2u(i2,jj) * (ub2_b(i2,jj)-tabres(i2,jj)) 
     1128               zcor = - rn_Dt * r1_e1e2t(i2+1,jj) * e2u(i2,jj) * (ub2_b(i2,jj)-tabres(i2,jj)) 
    11031129               sshn(i2+1,jj) = sshn(i2+1,jj) + zcor 
    1104                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(i2+1,jj) = sshb(i2+1,jj) + atfp * zcor 
     1130               IF (.NOT.( lk_agrif_fstep .AND. l_1st_euler ) )   sshb(i2+1,jj) = sshb(i2+1,jj) + rn_atfp * zcor 
     1131!!gm               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(i2+1,jj) = sshb(i2+1,jj) + rn_atfp * zcor 
    11051132            END DO 
    11061133         ENDIF 
    … …  
    11101137   END SUBROUTINE reflux_sshu 
    11111138 
     1139 
    11121140   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 
    11131141      !!---------------------------------------------------------------------- 
    1114       !!                      *** ROUTINE updatevb2b *** 
     1142      !!                    *** ROUTINE updatevb2b *** 
    11151143      !!---------------------------------------------------------------------- 
    11161144      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
    11171145      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
    11181146      LOGICAL                         , INTENT(in   ) ::   before 
    1119       !! 
     1147      ! 
    11201148      INTEGER :: ji, jj 
    11211149      REAL(wp) :: zrhox, za1, zcor 
    1122       !!--------------------------------------------- 
     1150      !!--------------------------------------------------------------------- 
    11231151      ! 
    11241152      IF( before ) THEN 
    … …  
    11501178   END SUBROUTINE updatevb2b 
    11511179 
     1180 
    11521181   SUBROUTINE reflux_sshv( tabres, i1, i2, j1, j2, before, nb, ndir ) 
    1153       !!--------------------------------------------- 
    1154       !!          *** ROUTINE reflux_sshv *** 
    1155       !!--------------------------------------------- 
    1156       INTEGER, INTENT(in) :: i1, i2, j1, j2 
    1157       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    1158       LOGICAL, INTENT(in) :: before 
    1159       INTEGER, INTENT(in) :: nb, ndir 
     1182      !!---------------------------------------------------------------------- 
     1183      !!                   *** ROUTINE reflux_sshv *** 
     1184      !!---------------------------------------------------------------------- 
     1185      INTEGER                         , INTENT(in   ) ::  i1, i2, j1, j2 
     1186      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   tabres 
     1187      LOGICAL                         , INTENT(in   ) ::  before 
     1188      INTEGER                         , INTENT(in   ) ::  nb, ndir 
    11601189      !! 
    11611190      LOGICAL :: southern_side, northern_side  
    11621191      INTEGER :: ji, jj 
    11631192      REAL(wp) :: zrhox, za1, zcor 
    1164       !!--------------------------------------------- 
     1193      !!---------------------------------------------------------------------- 
    11651194      ! 
    11661195      IF (before) THEN 
    … …  
    11811210         IF (southern_side) THEN 
    11821211            DO ji=i1,i2 
    1183                zcor = rdt * r1_e1e2t(ji,j1  ) * e1v(ji,j1  ) * (vb2_b(ji,j1)-tabres(ji,j1)) 
     1212               zcor = rn_Dt * r1_e1e2t(ji,j1  ) * e1v(ji,j1  ) * (vb2_b(ji,j1)-tabres(ji,j1)) 
    11841213               sshn(ji,j1  ) = sshn(ji,j1  ) + zcor 
    1185                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(ji,j1  ) = sshb(ji,j1) + atfp * zcor 
     1214               IF ( .NOT.( lk_agrif_fstep .AND. l_euler ) )   sshb(ji,j1  ) = sshb(ji,j1) + rn_atfp * zcor 
     1215!!gm               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(ji,j1  ) = sshb(ji,j1) + rn_atfp * zcor 
    11861216            END DO 
    11871217         ENDIF 
    11881218         IF (northern_side) THEN                
    11891219            DO ji=i1,i2 
    1190                zcor = - rdt * r1_e1e2t(ji,j2+1) * e1v(ji,j2  ) * (vb2_b(ji,j2)-tabres(ji,j2)) 
     1220               zcor = - rn_Dt * r1_e1e2t(ji,j2+1) * e1v(ji,j2  ) * (vb2_b(ji,j2)-tabres(ji,j2)) 
    11911221               sshn(ji,j2+1) = sshn(ji,j2+1) + zcor 
    1192                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(ji,j2+1) = sshb(ji,j2+1) + atfp * zcor 
     1222               IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) )   sshb(ji,j2+1) = sshb(ji,j2+1) + rn_atfp * zcor 
     1223!!gm               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(ji,j2+1) = sshb(ji,j2+1) + rn_atfp * zcor 
    11931224            END DO 
    11941225         ENDIF 
    … …  
    11981229   END SUBROUTINE reflux_sshv 
    11991230 
     1231 
    12001232   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before ) 
     1233      !!---------------------------------------------------------------------- 
     1234      !!                      *** ROUTINE updateT *** 
    12011235      ! 
    12021236      ! ====>>>>>>>>>>    currently not used 
    12031237      ! 
    1204       !!---------------------------------------------------------------------- 
    1205       !!                      *** ROUTINE updateT *** 
    12061238      !!---------------------------------------------------------------------- 
    12071239      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
    … …  
    12841316 
    12851317   SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before ) 
    1286       !!--------------------------------------------- 
    1287       !!           *** ROUTINE updateavm *** 
     1318      !!---------------------------------------------------------------------- 
     1319      !!                      *** ROUTINE updateavm *** 
    12881320      !!---------------------------------------------------------------------- 
    12891321      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
    … …  
    12981330   END SUBROUTINE updateAVM 
    12991331 
     1332 
    13001333   SUBROUTINE updatee3t(ptab_dum, i1, i2, j1, j2, k1, k2, before ) 
    1301       !!--------------------------------------------- 
    1302       !!           *** ROUTINE updatee3t *** 
    1303       !!--------------------------------------------- 
     1334      !!---------------------------------------------------------------------- 
     1335      !!                   *** ROUTINE updatee3t *** 
     1336      !!---------------------------------------------------------------------- 
    13041337      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ptab_dum 
    13051338      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    … …  
    13131346      IF (.NOT.before) THEN 
    13141347         ! 
    1315          ALLOCATE(ptab(i1:i2,j1:j2,1:jpk))  
     1348         ALLOCATE( ptab(i1:i2,j1:j2,1:jpk) )  
    13161349         ! 
    13171350         ! Update e3t from ssh (z* case only) 
    … …  
    13351368!         hdivn(i1:i2,j1:j2,1:jpkm1)   = e3t_b(i1:i2,j1:j2,1:jpkm1) 
    13361369 
    1337          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 
     1370         IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler==0 ) ) THEN 
     1371!!gm         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 
    13381372            DO jk = 1, jpkm1 
    13391373               DO jj=j1,j2 
    13401374                  DO ji=i1,i2 
    1341                      e3t_b(ji,jj,jk) =  e3t_b(ji,jj,jk) & 
    1342                            & + atfp * ( ptab(ji,jj,jk) - e3t_n(ji,jj,jk) ) 
     1375                     e3t_b(ji,jj,jk) =  e3t_b(ji,jj,jk) + rn_atfp * ( ptab(ji,jj,jk) - e3t_n(ji,jj,jk) ) 
    13431376                  END DO 
    13441377               END DO 
    … …  
    13981431         END DO 
    13991432         ! 
    1400          IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     1433         IF ( l_1st_euler .AND. Agrif_Nb_Step()==0 ) THEN 
     1434!!gm         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    14011435            e3t_b (i1:i2,j1:j2,1:jpk)  = e3t_n (i1:i2,j1:j2,1:jpk) 
    14021436            e3w_b (i1:i2,j1:j2,1:jpk)  = e3w_n (i1:i2,j1:j2,1:jpk) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/NST/agrif_top_update.F90

    r9598 r9939  
    109109                  tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2) 
    110110                  h_in(N_in) = tabres(ji,jj,jk,n2) 
    111                ENDDO 
     111               END DO 
    112112               N_out = 0 
    113113               DO jk=1,jpk ! jpk of parent grid 
    … …  
    115115                  N_out = N_out + 1 
    116116                  h_out(N_out) = e3t_n(ji,jj,jk) !Parent grid scale factors. Could multiply by e1e2t here instead of division above 
    117                ENDDO 
     117               END DO 
    118118               IF (N_in > 0) THEN !Remove this? 
    119119                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    … …  
    126126                  DO jn=1,jptra 
    127127                     CALL reconstructandremap(tabin(1:N_in,jn),h_in(1:N_in),tabres_child(ji,jj,1:N_out,jn),h_out(1:N_out),N_in,N_out) 
    128                   ENDDO 
     128                  END DO 
    129129               ENDIF 
    130             ENDDO 
    131          ENDDO 
    132  
    133          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     130            END DO 
     131         END DO 
     132 
     133         IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN 
     134!!gm         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    134135            ! Add asselin part 
    135136            DO jn = 1,jptra 
    … …  
    139140                        IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 
    140141                           trb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) &  
    141                                  & + atfp * ( tabres_child(ji,jj,jk,jn) & 
    142                                  &          - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     142                                 & + rn_atfp * ( tabres_child(ji,jj,jk,jn) - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    143143                        ENDIF 
    144                      ENDDO 
    145                   ENDDO 
    146                ENDDO 
    147             ENDDO 
     144                     END DO 
     145                  END DO 
     146               END DO 
     147            END DO 
    148148         ENDIF 
    149149         DO jn = 1,jptra 
    … …  
    195195            tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & 
    196196                                         & * tmask(i1:i2,j1:j2,k1:k2) 
    197          ENDDO 
     197         END DO 
    198198!< jc tmp 
    199          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     199         IF (.NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN 
     200!!gm         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    200201            ! Add asselin part 
    201202            DO jn = n1,n2 
    … …  
    207208                           ztnu = tabres(ji,jj,jk,jn) 
    208209                           ztno = trn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) 
    209                            trb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) )  &  
    210                                      &        * tmask(ji,jj,jk) / e3t_b(ji,jj,jk) 
     210                           trb(ji,jj,jk,jn) = ( ztb + rn_atfp * ( ztnu - ztno) ) / e3t_b(ji,jj,jk) * tmask(ji,jj,jk) 
    211211                        ENDIF 
    212                      ENDDO 
    213                   ENDDO 
    214                ENDDO 
    215             ENDDO 
     212                     END DO 
     213                  END DO 
     214               END DO 
     215            END DO 
    216216         ENDIF 
    217217         DO jn = n1,n2 
    … …  
    227227         END DO 
    228228         ! 
    229          IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
     229         IF ( l_1st_euler .AND. Agrif_Nb_Step() == 0 ) THEN 
     230!!gm         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    230231            trb(i1:i2,j1:j2,k1:k2,n1:n2)  = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
    231232         ENDIF 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/NST/agrif_user.F90

    r9788 r9939  
    217217 
    218218      ! Check time steps            
    219       IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
    220          WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt)) 
    221          WRITE(cl_check2,*)  NINT(rdt) 
    222          WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 
     219      IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) /= Agrif_Parent(rn_Dt) ) THEN 
     220         WRITE(cl_check1,*)  NINT(Agrif_Parent(rn_Dt)) 
     221         WRITE(cl_check2,*)  NINT(rn_Dt) 
     222         WRITE(cl_check3,*)  NINT(Agrif_Parent(rn_Dt)/Agrif_Rhot()) 
    223223         CALL ctl_stop( 'Incompatible time step between ocean grids',   & 
    224224               &               'parent grid value : '//cl_check1    ,   &  
    … …  
    229229      ! Check run length 
    230230      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    231             Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
     231            Agrif_Parent(nit000)+1) /= (nitend-nit000+1) ) THEN 
    232232         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    233233         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    … …  
    601601   IF( check_namelist ) THEN 
    602602      ! Check time steps 
    603       IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
    604          WRITE(cl_check1,*)  Agrif_Parent(rdt) 
    605          WRITE(cl_check2,*)  rdt 
    606          WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
     603      IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN 
     604         WRITE(cl_check1,*)  Agrif_Parent(rn_Dt) 
     605         WRITE(cl_check2,*)  rn_Dt 
     606         WRITE(cl_check3,*)  rn_Dt*Agrif_Rhot() 
    607607         CALL ctl_stop( 'incompatible time step between grids',   & 
    608608               &               'parent grid value : '//cl_check1    ,   &  

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ASM/asminc.F90

    r9656 r9939  
    491491      ENDIF 
    492492      ! 
    493       IF(lwp) WRITE(numout,*) '   ==>>>   Euler time step switch is ', neuler 
     493      IF(lwp) WRITE(numout,*) '   ==>>>   Euler time step switch is ', ln_1st_euler 
    494494      ! 
    495495      IF( lk_asminc ) THEN                            !==  data assimilation  ==! 
    … …  
    536536            ! 
    537537            it = kt - nit000 + 1 
    538             zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step 
     538            zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step 
    539539            ! 
    540540            IF(lwp) THEN 
    … …  
    579579         IF ( kt == nitdin_r ) THEN 
    580580            ! 
    581             neuler = 0  ! Force Euler forward step 
     581            l_1st_euler = .TRUE.  ! Force Euler forward step 
    582582            ! 
    583583            ! Initialize the now fields with the background + increment 
    … …  
    651651            ! 
    652652            it = kt - nit000 + 1 
    653             zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step 
     653            zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step 
    654654            ! 
    655655            IF(lwp) THEN 
    … …  
    677677         IF ( kt == nitdin_r ) THEN 
    678678            ! 
    679             neuler = 0                    ! Force Euler forward step 
     679            l_1st_euler = .TRUE.          ! Force Euler forward step 
    680680            ! 
    681681            ! Initialize the now fields with the background + increment 
    … …  
    721721            ! 
    722722            it = kt - nit000 + 1 
    723             zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step 
     723            zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step 
    724724            ! 
    725725            IF(lwp) THEN 
    … …  
    752752         IF ( kt == nitdin_r ) THEN 
    753753            ! 
    754             neuler = 0                                   ! Force Euler forward step 
     754            l_1st_euler = .TRUE.                         ! Force Euler forward step 
    755755            ! 
    756756            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)   ! Initialize the now fields the background + increment 
    … …  
    758758            sshb(:,:) = sshn(:,:)                        ! Update before fields 
    759759            e3t_b(:,:,:) = e3t_n(:,:,:) 
    760 !!gm why not e3u_b, e3v_b, gdept_b ???? 
     760             
     761!!gm BUG :   missing the update of all other scale factors (e3u e3v e3w  etc... _n and _b)  
     762!!           see dom_vvl_init  
    761763            ! 
    762764            DEALLOCATE( ssh_bkg    ) 
    … …  
    839841            it = kt - nit000 + 1 
    840842            zincwgt = wgtiau(it)      ! IAU weight for the current time step  
    841             ! note this is not a tendency so should not be divided by rdt (as with the tracer and other increments) 
     843            ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 
    842844            ! 
    843845            IF(lwp) THEN 
    … …  
    874876#if defined key_cice && defined key_asminc 
    875877            ! Sea-ice : CICE case. Pass ice increment tendency into CICE 
    876             ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rdt 
     878            ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rn_Dt 
    877879#endif 
    878880            ! 
    … …  
    894896         IF ( kt == nitdin_r ) THEN 
    895897            ! 
    896             neuler = 0                    ! Force Euler forward step 
     898            l_1st_euler = .TRUE.             ! Force Euler forward step 
    897899            ! 
    898900            ! Sea-ice : SI3 case 
    … …  
    924926#if defined key_cice && defined key_asminc 
    925927            ! Sea-ice : CICE case. Pass ice increment tendency into CICE 
    926            ndaice_da(:,:) = seaice_bkginc(:,:) / rdt 
     928           ndaice_da(:,:) = seaice_bkginc(:,:) / rn_Dt 
    927929#endif 
    928930            IF ( .NOT. PRESENT(kindic) ) THEN 
    … …  
    957959!           ! fwf : ice formation and melting 
    958960! 
    959 !                 zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) )*rdt 
     961!                 zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) ) * rn_Dt 
    960962! 
    961963!           ! change salinity down to mixed layer depth 
    … …  
    10061008!      !!                                                     ! E-P (kg m-2 s-2) 
    10071009!      !            emp(ji,jj) = emp(ji,jj) + zpmess          ! E-P (kg m-2 s-2) 
    1008 !               ENDDO !ji 
    1009 !             ENDDO !jj! 
     1010!               END DO !ji 
     1011!             END DO !jj! 
    10101012! 
    10111013!            ENDIF !ln_seaicebal 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/BDY/bdyice.F90

    r9657 r9939  
    124124 
    125125            ! Then, a) transfer the snow excess into the ice (different from icethd_dh) 
    126             zdh = MAX( 0._wp, ( rhosn * h_s(ji,jj,jl) + ( rhoic - rau0 ) * h_i(ji,jj,jl) ) * r1_rau0 ) 
     126            zdh = MAX( 0._wp, ( rhos * h_s(ji,jj,jl) + ( rhoi - rho0 ) * h_i(ji,jj,jl) ) * r1_rho0 ) 
    127127            ! Or, b) transfer all the snow into ice (if incoming ice is likely to melt as it comes into a warmer environment) 
    128             !zdh = MAX( 0._wp, h_s(ji,jj,jl) * rhosn / rhoic ) 
     128            !zdh = MAX( 0._wp, h_s(ji,jj,jl) * rhos / rhoi ) 
    129129 
    130130            ! recompute h_i, h_s 
    131131            h_i(ji,jj,jl) = MIN( hi_max(jl), h_i(ji,jj,jl) + zdh ) 
    132             h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoic / rhosn )  
    133  
    134          ENDDO 
     132            h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoi / rhos )  
     133 
     134         END DO 
    135135         CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy ) 
    136136         CALL lbc_bdy_lnk( h_i(:,:,jl), 'T', 1., ib_bdy ) 
    137137         CALL lbc_bdy_lnk( h_s(:,:,jl), 'T', 1., ib_bdy ) 
    138       ENDDO 
     138      END DO 
    139139      ! retrieve at_i 
    140140      at_i(:,:) = 0._wp 
    … …  
    212212            DO jk = 1, nlay_s 
    213213               ! Snow energy of melting 
    214                e_s(ji,jj,jk,jl) = rswitch * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus ) 
     214               e_s(ji,jj,jk,jl) = rswitch * rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
    215215               ! Multiply by volume, so that heat content in J/m2 
    216216               e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 
    … …  
    219219               ztmelts          = - tmut * sz_i(ji,jj,jk,jl) + rt0 !Melting temperature in K                   
    220220               ! heat content per unit volume 
    221                e_i(ji,jj,jk,jl) = rswitch * rhoic * & 
    222                   (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    223                   +   lfus    * ( 1.0 - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 
    224                   - rcp      * ( ztmelts - rt0 ) ) 
     221               e_i(ji,jj,jk,jl) = rswitch * rhoi * & 
     222                  (   rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
     223                  +   rLfus * ( 1.0 - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) & 
     224                  -   rcp   * ( ztmelts - rt0 ) ) 
    225225               ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
    226226               e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * h_i(ji,jj,jl) * r1_nlay_i 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/BDY/bdylib.F90

    r9598 r9939  
    44   !! Unstructured Open Boundary Cond. :  Library module of generic boundary algorithms. 
    55   !!====================================================================== 
    6    !! History :  3.6  !  2013     (D. Storkey) original code 
    7    !!            4.0  !  2014     (T. Lovato) Generalize OBC structure 
     6   !! History :  3.6  !  2013     (D. Storkey)  original code 
     7   !!            4.0  !  2014     (T. Lovato)  Generalize OBC structure 
    88   !!---------------------------------------------------------------------- 
     9    
    910   !!---------------------------------------------------------------------- 
    10    !!   bdy_orlanski_2d 
    11    !!   bdy_orlanski_3d 
     11   !!  bdy_frs        : Apply the Flow Relaxation Scheme (tracers) 
     12   !!  bdy_spe        : Apply a specified value (tracers) 
     13   !!  bdy_orl        : Apply Orlanski radiation (tracers) 
     14   !!  bdy_orlanski_2d:   2D      -        -         - 
     15   !!  bdy_orlanski_3d:   3D      -        -         - 
     16   !!  bdy_nmn        : Duplicate the value at open boundaries (zero gradient) 
    1217   !!---------------------------------------------------------------------- 
    1318   USE oce            ! ocean dynamics and tracers  
    … …  
    2227   PRIVATE 
    2328 
    24    PUBLIC   bdy_frs, bdy_spe, bdy_nmn, bdy_orl 
    25    PUBLIC   bdy_orlanski_2d 
    26    PUBLIC   bdy_orlanski_3d 
     29   PUBLIC   bdy_frs, bdy_spe, bdy_nmn 
     30   PUBLIC   bdy_orl, bdy_orlanski_2d, bdy_orlanski_3d 
    2731 
    2832   !!---------------------------------------------------------------------- 
    … …  
    230234         ! Note no rdt factor in expression for zdt because it cancels in the expressions for  
    231235         ! zrx and zry. 
    232          zdt = phia(iibm1,ijbm1) - phib(iibm1,ijbm1) 
     236         zdt =     phia(iibm1,ijbm1) - phib(iibm1,ijbm1) 
    233237         zdx = ( ( phia(iibm1,ijbm1) - phia(iibm2,ijbm2) ) / zex2 ) * zmask_x  
    234238         zdy_1 = ( ( phib(iibm1   ,ijbm1   ) - phib(iibm1jm1,ijbm1jm1) ) / zey1 ) * zmask_y1     
    … …  
    247251         zout = sign( 1., zrx ) 
    248252         zout = 0.5*( zout + abs(zout) ) 
    249          zwgt = 2.*rdt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) ) 
     253         zwgt = rDt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) ) 
    250254         ! only apply radiation on outflow points  
    251255         if( ll_npo ) then     !! NPO version !! 
    … …  
    385389            ! Centred derivative is calculated as average of "left" and "right" derivatives for  
    386390            ! this reason.  
    387             zdt = phia(iibm1,ijbm1,jk) - phib(iibm1,ijbm1,jk) 
     391            zdt =     phia(iibm1,ijbm1,jk) - phib(iibm1,ijbm1,jk) 
    388392            zdx = ( ( phia(iibm1,ijbm1,jk) - phia(iibm2,ijbm2,jk) ) / zex2 ) * zmask_x                   
    389393            zdy_1 = ( ( phib(iibm1   ,ijbm1   ,jk) - phib(iibm1jm1,ijbm1jm1,jk) ) / zey1 ) * zmask_y1   
    … …  
    402406!!$            zrx = min(zrx,2.0_wp) 
    403407            zout = sign( 1., zrx ) 
    404             zout = 0.5*( zout + abs(zout) ) 
    405             zwgt = 2.*rdt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) ) 
     408            zout = 0.5 * ( zout + abs(zout) ) 
     409            zwgt = rDt * ( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) ) 
    406410            ! only apply radiation on outflow points  
    407411            if( ll_npo ) then     !! NPO version !! 
    … …  
    426430      ! 
    427431   END SUBROUTINE bdy_orlanski_3d 
     432 
    428433 
    429434   SUBROUTINE bdy_nmn( idx, igrd, phia ) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/BDY/bdytides.F90

    r9598 r9939  
    295295      !!---------------------------------------------------------------------- 
    296296      ! 
    297       ilen0(1) =  SIZE(td%ssh(:,1,1)) 
    298       ilen0(2) =  SIZE(td%u(:,1,1)) 
    299       ilen0(3) =  SIZE(td%v(:,1,1)) 
     297      ilen0(1) =  SIZE( td%ssh(:,1,1) ) 
     298      ilen0(2) =  SIZE( td%u  (:,1,1) ) 
     299      ilen0(3) =  SIZE( td%v  (:,1,1) ) 
    300300 
    301301      zflag=1 
    302302      IF ( PRESENT(jit) ) THEN 
    303         IF ( jit /= 1 ) zflag=0 
     303        IF ( jit /= 1 )   zflag=0 
    304304      ENDIF 
    305305 
    306       IF ( (nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000) .AND. zflag==1 ) THEN 
     306      IF ( ( nsec_day == NINT( 0.5_wp * rn_Dt )  .OR.  kt == nit000 ) .AND. zflag==1 ) THEN 
    307307        ! 
    308         kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 
     308        kt_tide = kt - (nsec_day - 0.5_wp * rn_Dt) / rn_Dt 
    309309        ! 
    310310        IF(lwp) THEN 
    311311           WRITE(numout,*) 
    312            WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=',kt 
     312           WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=', kt 
    313313           WRITE(numout,*) '~~~~~~~~~~~~~~ ' 
    314314        ENDIF 
    … …  
    325325          
    326326      IF( PRESENT(jit) ) THEN   
    327          z_arg = ((kt-kt_tide) * rdt + (jit+0.5_wp*(time_add-1)) * rdt / REAL(nn_baro,wp) ) 
     327         z_arg = ((kt-kt_tide) * rn_Dt + (jit+0.5_wp*(time_add-1)) * rn_Dt / REAL(nn_e,wp) ) 
    328328      ELSE                               
    329          z_arg = ((kt-kt_tide)+time_add) * rdt 
     329         z_arg = ((kt-kt_tide)+time_add) * rn_Dt 
    330330      ENDIF 
    331331 
    332332      ! Linear ramp on tidal component at open boundaries  
    333333      zramp = 1._wp 
    334       IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*rdt)/(rdttideramp*rday),0._wp),1._wp) 
     334      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*rn_Dt)/(rn_ramp*rday),0._wp),1._wp) 
    335335 
    336336      DO itide = 1, nb_harmo 
    … …  
    392392      ! Absolute time from model initialization:    
    393393      IF( PRESENT(kit) ) THEN   
    394          z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt 
     394         z_arg = ( kt + (kit+time_add-1) / REAL(nn_e,wp) ) * rn_Dt 
    395395      ELSE                               
    396          z_arg = ( kt + time_add ) * rdt 
     396         z_arg = ( kt + time_add ) * rn_Dt 
    397397      ENDIF 
    398398 
    399399      ! Linear ramp on tidal component at open boundaries  
    400400      zramp = 1. 
    401       IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - nit000*rdt)/(rdttideramp*rday),0.),1.) 
     401      IF ( ln_tide_ramp )   zramp = MIN(  MAX( 0. , (z_arg - nit000*rn_Dt)/(rn_ramp*rday) ) , 1.  ) 
    402402 
    403403      DO ib_bdy = 1,nb_bdy 
    … …  
    414414            ! We refresh nodal factors every day below 
    415415            ! This should be done somewhere else 
    416             IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN 
    417                ! 
    418                kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 
     416            IF ( ( nsec_day == NINT(0.5_wp * rn_Dt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN 
     417               ! 
     418               kt_tide = kt - (nsec_day - 0.5_wp * rn_Dt) / rn_Dt 
    419419               ! 
    420420               IF(lwp) THEN 
    … …  
    428428               ! 
    429429            ENDIF 
    430             zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time 
     430            zoff = -kt_tide * rn_Dt    ! time offset relative to nodal factor computation time 
    431431            ! 
    432432            ! If time splitting, initialize arrays from slow varying open boundary data: 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/BDY/bdyvol.F90

    r9598 r9939  
    8484      ! ----------------------------------------------------------------------- 
    8585!!gm replace these lines : 
    86       z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 
     86      z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rho0 
    8787      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain 
    8888!!gm   by : 
    89 !!gm      z_cflxemp = glob_sum(  ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rau0 
    90 !!gm 
     89!!gm      z_cflxemp = glob_sum(  ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rho0 
     90!!gm   ??? 
    9191 
    9292      ! Transport through the unstructured open boundary 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/dia25h.F90

    r9598 r9939  
    139139      ! ----------------- 
    140140      ! Define frequency of summing to create 25 h mean 
    141       IF( MOD( 3600,INT(rdt) ) == 0 ) THEN 
    142          i_steps = 3600/INT(rdt) 
     141      IF( MOD( 3600 , INT(rn_Dt) ) == 0 ) THEN 
     142         i_steps = 3600 / INT( rn_Dt ) 
    143143      ELSE 
    144          CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible') 
     144         CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rn_Dt) = 0 otherwise no hourly values are possible') 
    145145      ENDIF 
    146146 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diaar5.F90

    r9598 r9939  
    161161       
    162162         !                                         ! ocean bottom pressure 
    163          zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 
     163         zztmp = rho0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 
    164164         zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 
    165165         CALL iom_put( 'botpres', zbotpres ) 
    … …  
    198198         END IF 
    199199         ! 
    200          zmass = rau0 * ( zarho + zvol )                 ! total mass of liquid seawater 
     200         zmass = rho0 * ( zarho + zvol )                 ! total mass of liquid seawater 
    201201         ztemp = ztemp / zvol                            ! potential temperature in liquid seawater 
    202202         zsal  = zsal  / zvol                            ! Salinity of liquid seawater 
    … …  
    239239               DO ji = 1, jpi 
    240240                  DO jj = 1, jpj 
    241                      zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 
     241                     zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rho0 * e3w_n(ji, jj, jk) 
    242242                  END DO 
    243243               END DO 
    … …  
    287287       CALL lbc_lnk( z2d, 'U', -1. ) 
    288288       IF( cptr == 'adv' ) THEN 
    289           IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , rau0_rcp * z2d )  ! advective heat transport in i-direction 
    290           IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr" , rau0     * z2d )  ! advective salt transport in i-direction 
     289          IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , rho0_rcp * z2d )  ! advective heat transport in i-direction 
     290          IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr" , rho0     * z2d )  ! advective salt transport in i-direction 
    291291       ENDIF 
    292292       IF( cptr == 'ldf' ) THEN 
    293           IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in i-direction 
    294           IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr" , rau0     * z2d ) ! diffusive salt transport in i-direction 
     293          IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr" , rho0_rcp * z2d ) ! diffusive heat transport in i-direction 
     294          IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr" , rho0     * z2d ) ! diffusive salt transport in i-direction 
    295295       ENDIF 
    296296       ! 
    … …  
    305305       CALL lbc_lnk( z2d, 'V', -1. ) 
    306306       IF( cptr == 'adv' ) THEN 
    307           IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , rau0_rcp * z2d )  ! advective heat transport in j-direction 
    308           IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr" , rau0     * z2d )  ! advective salt transport in j-direction 
     307          IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , rho0_rcp * z2d )  ! advective heat transport in j-direction 
     308          IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr" , rho0     * z2d )  ! advective salt transport in j-direction 
    309309       ENDIF 
    310310       IF( cptr == 'ldf' ) THEN 
    311           IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in j-direction 
    312           IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr" , rau0     * z2d ) ! diffusive salt transport in j-direction 
     311          IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr" , rho0_rcp * z2d ) ! diffusive heat transport in j-direction 
     312          IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr" , rho0     * z2d ) ! diffusive salt transport in j-direction 
    313313       ENDIF 
    314314           

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diacfl.F90

    r9598 r9939  
    5555      ! 
    5656      INTEGER :: ji, jj, jk   ! dummy loop indices 
    57       REAL(wp)::   z2dt, zCu_max, zCv_max, zCw_max       ! local scalars 
     57      REAL(wp)::   zCu_max, zCv_max, zCw_max       ! local scalars 
    5858      INTEGER , DIMENSION(3)           ::   iloc_u , iloc_v , iloc_w , iloc   ! workspace 
    5959!!gm this does not work      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zCu_cfl, zCv_cfl, zCw_cfl         ! workspace 
    … …  
    6262      IF( ln_timing )   CALL timing_start('dia_cfl') 
    6363      ! 
    64       !                       ! setup timestep multiplier to account for initial Eulerian timestep 
    65       IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2dt = rdt 
    66       ELSE                                        ;    z2dt = rdt * 2._wp 
    67       ENDIF 
    68       ! 
    6964      !                 
    7065      DO jk = 1, jpk       ! calculate Courant numbers 
    7166         DO jj = 1, jpj 
    7267            DO ji = 1, fs_jpim1   ! vector opt. 
    73                zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u  (ji,jj)      ! for i-direction 
    74                zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v  (ji,jj)      ! for j-direction 
    75                zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * z2dt / e3w_n(ji,jj,jk)   ! for k-direction 
     68               zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * rDt / e1u  (ji,jj)      ! for i-direction 
     69               zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * rDt / e2v  (ji,jj)      ! for j-direction 
     70               zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * rDt / e3w_n(ji,jj,jk)   ! for k-direction 
    7671            END DO 
    7772         END DO          
    … …  
    120115         WRITE(numcfl,*) '******************************************' 
    121116         WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cu', rCu_max, nCu_loc(1), nCu_loc(2), nCu_loc(3) 
    122          WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCu_max 
     117         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCu_max 
    123118         WRITE(numcfl,*) '******************************************' 
    124119         WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cv', rCv_max, nCv_loc(1), nCv_loc(2), nCv_loc(3) 
    125          WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCv_max 
     120         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCv_max 
    126121         WRITE(numcfl,*) '******************************************' 
    127122         WRITE(numcfl,FMT='(3x,a12,6x,f7.4,1x,i4,1x,i4,1x,i4)') 'Run Max Cw', rCw_max, nCw_loc(1), nCw_loc(2), nCw_loc(3) 
    128          WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', z2dt/rCw_max 
     123         WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCw_max 
    129124         CLOSE( numcfl )  
    130125         ! 
    … …  
    133128         WRITE(numout,*) 'dia_cfl : Maximum Courant number information for the run ' 
    134129         WRITE(numout,*) '~~~~~~~' 
    135          WRITE(numout,*) '   Max Cu = ', rCu_max, ' at (i,j,k) = (',nCu_loc(1),nCu_loc(2),nCu_loc(3),') => dt/C = ', z2dt/rCu_max 
    136          WRITE(numout,*) '   Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', z2dt/rCv_max 
    137          WRITE(numout,*) '   Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', z2dt/rCw_max 
     130         WRITE(numout,*) '   Max Cu = ', rCu_max, ' at (i,j,k) = (',nCu_loc(1),nCu_loc(2),nCu_loc(3),') => dt/C = ', rDt/rCu_max 
     131         WRITE(numout,*) '   Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', rDt/rCv_max 
     132         WRITE(numout,*) '   Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', rDt/rCw_max 
    138133      ENDIF 
    139134      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diadct.F90

    r9598 r9939  
    679679                  zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )  
    680680                  zrhop = interp(k%I,k%J,jk,'V',rhop)  
    681                   zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)  
     681                  zrhoi = interp(k%I,k%J,jk,'V',rhd*rho0+rho0)  
    682682                  zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1)  
    683683               CASE(2,3)  
    … …  
    685685                  zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )  
    686686                  zrhop = interp(k%I,k%J,jk,'U',rhop)  
    687                   zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)  
     687                  zrhoi = interp(k%I,k%J,jk,'U',rhd*rho0+rho0)  
    688688                  zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)   
    689689               END SELECT  
    … …  
    851851                 zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )  
    852852                 zrhop = interp(k%I,k%J,jk,'V',rhop)  
    853                  zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)  
     853                 zrhoi = interp(k%I,k%J,jk,'V',rhd*rho0+rho0)  
    854854 
    855855              CASE(2,3)  
    … …  
    857857                 zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )  
    858858                 zrhop = interp(k%I,k%J,jk,'U',rhop)  
    859                  zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)  
     859                 zrhoi = interp(k%I,k%J,jk,'U',rhd*rho0+rho0)  
    860860                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)   
    861861              END SELECT  

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diaharm.F90

    r9598 r9939  
    181181      IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN 
    182182         ! 
    183          ztime = (kt-nit000+1) * rdt  
     183         ztime = ( kt - nit000+1 ) * rn_Dt  
    184184         ! 
    185185         nhc = 0 
    … …  
    231231      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    232232 
    233       ztime_ini = nit000_han*rdt                 ! Initial time in seconds at the beginning of analysis 
    234       ztime_end = nitend_han*rdt                 ! Final time in seconds at the end of analysis 
     233      ztime_ini = nit000_han*rn_Dt                 ! Initial time in seconds at the beginning of analysis 
     234      ztime_end = nitend_han*rn_Dt                 ! Final time in seconds at the end of analysis 
    235235      nhan = (nitend_han-nit000_han+1)/nstep_han ! Number of dumps used for analysis 
    236236 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diahsb.F90

    r9598 r9939  
    9191      ! 1 - Trends due to forcing ! 
    9292      ! ------------------------- ! 
    93       z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) )   ! volume fluxes 
     93      z_frc_trd_v = r1_rho0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) )   ! volume fluxes 
    9494      z_frc_trd_t =           glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) )                       ! heat fluxes 
    9595      z_frc_trd_s =           glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) )                       ! salt fluxes 
    … …  
    100100      IF( ln_isf    )   z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) ) 
    101101      !                    ! Add penetrative solar radiation 
    102       IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr     (:,:) * surf(:,:) ) 
     102      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rho0_rcp * glob_sum( qsr     (:,:) * surf(:,:) ) 
    103103      !                    ! Add geothermal heat flux 
    104104      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t +               glob_sum( qgh_trd0(:,:) * surf(:,:) ) 
    … …  
    120120      ENDIF 
    121121 
    122       frc_v = frc_v + z_frc_trd_v * rdt 
    123       frc_t = frc_t + z_frc_trd_t * rdt 
    124       frc_s = frc_s + z_frc_trd_s * rdt 
     122      frc_v = frc_v + z_frc_trd_v * rn_Dt 
     123      frc_t = frc_t + z_frc_trd_t * rn_Dt 
     124      frc_s = frc_s + z_frc_trd_s * rn_Dt 
    125125      !                                          ! Advection flux through fixed surface (z=0) 
    126126      IF( ln_linssh ) THEN 
    127          frc_wn_t = frc_wn_t + z_wn_trd_t * rdt 
    128          frc_wn_s = frc_wn_s + z_wn_trd_s * rdt 
     127         frc_wn_t = frc_wn_t + z_wn_trd_t * rn_Dt 
     128         frc_wn_s = frc_wn_s + z_wn_trd_s * rn_Dt 
    129129      ENDIF 
    130130 
    … …  
    196196 
    197197      CALL iom_put(   'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)  
    198       CALL iom_put(   'bgfrctem' , frc_t    * rau0 * rcp * 1.e-20 )   ! hc  - surface forcing (1.e20 J)  
    199       CALL iom_put(   'bgfrchfx' , frc_t    * rau0 * rcp /  &         ! hc  - surface forcing (W/m2)  
    200          &                       ( surf_tot * kt * rdt )        ) 
     198      CALL iom_put(   'bgfrctem' , frc_t    * rho0_rcp * 1.e-20 )     ! hc  - surface forcing (1.e20 J)  
     199      CALL iom_put(   'bgfrchfx' , frc_t    * rho0_rcp /  &           ! hc  - surface forcing (W/m2)  
     200         &                         ( surf_tot * kt * rn_Dt )    ) 
    201201      CALL iom_put(   'bgfrcsal' , frc_s    * 1.e-9    )              ! sc  - surface forcing (psu*km3)  
    202202 
    … …  
    204204         CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature drift     (C)  
    205205         CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    drift     (PSU) 
    206          CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp )   ! Heat content drift    (1.e20 J)  
    207          CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp /  &         ! Heat flux drift       (W/m2)  
    208             &                       ( surf_tot * kt * rdt )        ) 
     206         CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rho0_rcp )     ! Heat content drift    (1.e20 J)  
     207         CALL iom_put( 'bgheatfx' , zdiff_hc * rho0_rcp /  &           ! Heat flux drift       (W/m2)  
     208            &                       ( surf_tot * kt * rn_Dt )    ) 
    209209         CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9    )              ! Salt content drift    (psu*km3) 
    210210         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3)   
    … …  
    224224         CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content drift    (C)  
    225225         CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content drift    (PSU) 
    226          CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content drift    (1.e20 J)  
    227          CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp /  &        ! Heat flux drift       (W/m2)  
    228             &                       ( surf_tot * kt * rdt )         ) 
     226         CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rho0_rcp )    ! Heat content drift    (1.e20 J)  
     227         CALL iom_put( 'bgheatfx' , zdiff_hc1 * rho0_rcp /  &          ! Heat flux drift       (W/m2)  
     228            &                       ( surf_tot * kt * rn_Dt )     ) 
    229229         CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9    )             ! Salt content drift    (psu*km3) 
    230230         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh drift      (km3)   

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diahth.F90

    r9598 r9939  
    8989      REAL(wp)                         ::   zrho1 = 0.01_wp       ! density     criterion for mixed layer depth 
    9090      REAL(wp)                         ::   ztem2 = 0.2_wp        ! temperature criterion for mixed layer depth 
    91       REAL(wp)                         ::   zthick_0, zcoef       ! temporary scalars 
    92       REAL(wp)                         ::   zztmp, zzdep          ! temporary scalars inside do loop 
    93       REAL(wp)                         ::   zu, zv, zw, zut, zvt  ! temporary workspace 
     91      REAL(wp)                         ::   zthick_0              ! local scalars 
     92      REAL(wp)                         ::   zztmp, zzdep          ! local scalars inside do loop 
     93      REAL(wp)                         ::   zu, zv, zw, zut, zvt  ! local workspace 
    9494      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zabs2      ! MLD: abs( tn - tn(10m) ) = ztem2  
    9595      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ztm2       ! Top of thermocline: tn = tn(10m) - ztem2      
    … …  
    328328      END DO 
    329329      ! from temperature to heat contain 
    330       zcoef = rau0 * rcp 
    331       htc3(:,:) = zcoef * htc3(:,:) 
     330      htc3(:,:) = rho0_rcp * htc3(:,:) 
    332331      CALL iom_put( "hc300", htc3 )      ! first 300m heat content 
    333332      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/dianam.F90

    r9598 r9939  
    7171      ENDIF 
    7272 
    73       IF( llfsec .OR. kfreq < 0 ) THEN   ;   inbsec = kfreq                       ! output frequency already in seconds 
    74       ELSE                               ;   inbsec = kfreq * NINT( rdt )   ! from time-step to seconds 
     73      IF( llfsec .OR. kfreq < 0 ) THEN   ;   inbsec = kfreq                    ! output frequency already in seconds 
     74      ELSE                               ;   inbsec = kfreq * NINT( rn_Dt )    ! from time-step to seconds 
    7575      ENDIF 
    7676      iddss = NINT( rday          )                                         ! number of seconds in 1 day 
    … …  
    116116      ! date of the beginning and the end of the run 
    117117 
    118       zdrun = rdt / rday * REAL( nitend - nit000, wp )                ! length of the run in days 
    119       zjul  = fjulday - rdt / rday 
     118      zdrun = rn_Dt / rday * REAL( nitend - nit000, wp )              ! length of the run in days 
     119      zjul  = fjulday - rn_Dt / rday 
    120120      CALL ju2ymds( zjul        , iyear1, imonth1, iday1, zsec1 )           ! year/month/day of the beginning of run 
    121121      CALL ju2ymds( zjul + zdrun, iyear2, imonth2, iday2, zsec2 )           ! year/month/day of the end       of run 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diaptr.F90

    r9598 r9939  
    5252 
    5353   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup 
    54    REAL(wp) ::   rc_pwatt = 1.e-15_wp  ! conversion from W    to PW (further x rau0 x Cp) 
     54   REAL(wp) ::   rc_pwatt = 1.e-15_wp  ! conversion from W    to PW (further x rho0 x Cp) 
    5555   REAL(wp) ::   rc_ggram = 1.e-6_wp   ! conversion from g    to Pg 
    5656 
    … …  
    424424         IF( dia_ptr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 
    425425 
    426          rc_pwatt = rc_pwatt * rau0_rcp          ! conversion from K.s-1 to PetaWatt 
     426         rc_pwatt = rc_pwatt * rho0_rcp          ! conversion from K.s-1 to PetaWatt 
    427427 
    428428         IF( lk_mpp )   CALL mpp_ini_znl( numout )     ! Define MPI communicator for zonal sum 
    … …  
    448448         ! Initialise arrays to zero because diatpr is called before they are first calculated 
    449449         ! Note that this means diagnostics will not be exactly correct when model run is restarted. 
    450          htr_adv(:,:) = 0._wp  ;  str_adv(:,:) =  0._wp  
    451          htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp  
    452          htr_eiv(:,:) = 0._wp  ;  str_eiv(:,:) =  0._wp  
     450         htr_adv(:,:) = 0._wp  ;   str_adv(:,:) =  0._wp  
     451         htr_ldf(:,:) = 0._wp  ;   str_ldf(:,:) =  0._wp  
     452         htr_eiv(:,:) = 0._wp  ;   str_eiv(:,:) =  0._wp  
    453453         htr_ove(:,:) = 0._wp  ;   str_ove(:,:) =  0._wp 
    454454         htr_btr(:,:) = 0._wp  ;   str_btr(:,:) =  0._wp 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diawri.F90

    r9652 r9939  
    169169 
    170170      IF ( iom_use("taubot") ) THEN                ! bottom stress 
    171          zztmp = rau0 * 0.25 
     171         zztmp = rho0 * 0.25 
    172172         z2d(:,:) = 0._wp 
    173173         DO jj = 2, jpjm1 
    … …  
    212212      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    213213         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    214          z2d(:,:) = rau0 * e1e2t(:,:) 
     214         z2d(:,:) = rho0 * e1e2t(:,:) 
    215215         DO jk = 1, jpk 
    216216            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
    … …  
    253253            END DO 
    254254         END DO 
    255          CALL iom_put( "heatc", rau0_rcp * z2d )   ! vertically integrated heat content (J/m2) 
     255         CALL iom_put( "heatc", rho0_rcp * z2d )   ! vertically integrated heat content (J/m2) 
    256256      ENDIF 
    257257 
    … …  
    265265            END DO 
    266266         END DO 
    267          CALL iom_put( "saltc", rau0 * z2d )          ! vertically integrated salt content (PSU*kg/m2) 
     267         CALL iom_put( "saltc", rho0 * z2d )          ! vertically integrated salt content (PSU*kg/m2) 
    268268      ENDIF 
    269269      ! 
    … …  
    291291         z2d(:,:) = 0.e0 
    292292         DO jk = 1, jpkm1 
    293             z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 
     293            z3d(:,:,jk) = rho0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 
    294294            z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
    295295         END DO 
    … …  
    328328         z3d(:,:,jpk) = 0.e0 
    329329         DO jk = 1, jpkm1 
    330             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 
     330            z3d(:,:,jk) = rho0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 
    331331         END DO 
    332332         CALL iom_put( "v_masstr", z3d )              ! mass transport in j-direction 
    … …  
    369369         END DO 
    370370         CALL lbc_lnk( z2d, 'T', -1. ) 
    371          CALL iom_put( "tosmint", rau0 * z2d )        ! Vertical integral of temperature 
     371         CALL iom_put( "tosmint", rho0 * z2d )        ! Vertical integral of temperature 
    372372      ENDIF 
    373373      IF( iom_use("somint") ) THEN 
    … …  
    381381         END DO 
    382382         CALL lbc_lnk( z2d, 'T', -1. ) 
    383          CALL iom_put( "somint", rau0 * z2d )         ! Vertical integral of salinity 
     383         CALL iom_put( "somint", rho0 * z2d )         ! Vertical integral of salinity 
    384384      ENDIF 
    385385 
    … …  
    458458      clop = "x"         ! no use of the mask value (require less cpu time and otherwise the model crashes) 
    459459#if defined key_diainstant 
    460       zsto = nwrite * rdt 
     460      zsto = nwrite * rn_Dt 
    461461      clop = "inst("//TRIM(clop)//")" 
    462462#else 
    463       zsto=rdt 
     463      zsto = rn_Dt 
    464464      clop = "ave("//TRIM(clop)//")" 
    465465#endif 
    466       zout = nwrite * rdt 
    467       zmax = ( nitend - nit000 + 1 ) * rdt 
     466      zout = nwrite * rn_Dt 
     467      zmax = ( nitend - nit000 + 1 ) * rn_Dt 
    468468 
    469469      ! Define indices of the horizontal output zoom and vertical limit storage 
    … …  
    485485 
    486486         ! Compute julian date from starting date of the run 
    487          CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 
     487         CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 
    488488         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    489489         IF(lwp)WRITE(numout,*) 
    … …  
    507507         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
    508508            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    509             &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 
     509            &          nit000-1, zjulian, rn_Dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 
    510510         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept 
    511511            &           "m", ipk, gdept_1d, nz_T, "down" ) 
    … …  
    543543         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu 
    544544            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    545             &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 
     545            &          nit000-1, zjulian, rn_Dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 
    546546         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept 
    547547            &           "m", ipk, gdept_1d, nz_U, "down" ) 
    … …  
    556556         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv 
    557557            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    558             &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 
     558            &          nit000-1, zjulian, rn_Dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 
    559559         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept 
    560560            &          "m", ipk, gdept_1d, nz_V, "down" ) 
    … …  
    569569         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
    570570            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    571             &          nit000-1, zjulian, rdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set ) 
     571            &          nit000-1, zjulian, rn_Dt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set ) 
    572572         CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw 
    573573            &          "m", ipk, gdepw_1d, nz_W, "down" ) 
    … …  
    897897      clname = cdfile_name 
    898898      IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    899       zsto = rdt 
     899      zsto = rn_Dt 
    900900      clop = "inst(x)"           ! no use of the mask value (require less cpu time) 
    901       zout = rdt 
    902       zmax = ( nitend - nit000 + 1 ) * rdt 
     901      zout = rn_Dt 
     902      zmax = ( nitend - nit000 + 1 ) * rn_Dt 
    903903 
    904904      IF(lwp) WRITE(numout,*) 
    … …  
    912912 
    913913      ! Compute julian date from starting date of the run 
    914       CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis  
     914      CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian )         ! time axis  
    915915      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    916916      CALL histbeg( clname, jpi, glamt, jpj, gphit,   & 
    917           1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 
     917          1, jpi, 1, jpj, nit000-1, zjulian, rn_Dt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 
    918918      CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept 
    919919          "m", jpk, gdept_1d, nz_i, "down") 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIU/cool_skin.F90

    r9598 r9939  
    6868 
    6969 
    70    SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, rdt) 
     70   SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, pdt) 
    7171      !!---------------------------------------------------------------------- 
    7272      !! *** ROUTINE diurnal_sst_takaya_step *** 
    … …  
    8282      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux   ! Wind stress (kg/ m s^2) 
    8383      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho       ! Water density (kg/m^3) 
    84       REAL(wp), INTENT(IN) :: rdt                             ! Time-step 
     84      REAL(wp), INTENT(IN)                     :: pdt         ! Time-step (s) 
    8585      
    8686      ! Local variables 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIU/diurnal_bulk.F90

    r9168 r9939  
    7878 
    7979 
    80    SUBROUTINE diurnal_sst_takaya_step(kt, psolflux, pqflux, ptauflux, prho, p_rdt,   & 
     80   SUBROUTINE diurnal_sst_takaya_step(kt, psolflux, pqflux, ptauflux, prho, pdt,   & 
    8181            &                  pla, pthick, pcoolthick, pmu, & 
    8282            &                  p_fvel_bkginc, p_hflux_bkginc) 
    … …  
    9898      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   ptauflux       ! wind stress  (kg/ m s^2) 
    9999      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) ::   prho           ! water density  (kg/m^3) 
    100       REAL(wp)                              , INTENT(in) ::   p_rdt          ! time-step 
     100      REAL(wp)                              , INTENT(in) ::   pdt            ! time-step (s) 
    101101      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pLa            ! Langmuir number 
    102102      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) ::   pthick         ! warm layer thickness (m) 
    … …  
    167167       
    168168      ! Increment the temperature using the implicit solution 
    169       x_dsst(:,:) = t_imp( x_dsst(:,:), p_rdt, z_abflux(:,:), z_fvel(:,:),   & 
     169      x_dsst(:,:) = t_imp( x_dsst(:,:), pdt, z_abflux(:,:), z_fvel(:,:),   & 
    170170         &                       z_fla(:,:), zmu(:,:), zthick(:,:), prho(:,:) ) 
    171171      ! 
    … …  
    173173 
    174174    
    175    FUNCTION t_imp(p_dsst, p_rdt, p_abflux, p_fvel, & 
     175   FUNCTION t_imp(p_dsst, pdt, p_abflux, p_fvel, & 
    176176                          p_fla, pmu, pthick, prho ) 
    177177                           
    … …  
    182182      ! Dummy variables 
    183183      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_dsst     ! Delta SST 
    184       REAL(wp), INTENT(IN)                     :: p_rdt      ! Time-step 
     184      REAL(wp), INTENT(IN)                     :: pdt        ! Time-step (s) 
    185185      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_abflux   ! Heat forcing 
    186186      REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fvel     ! Friction velocity 
    … …  
    257257            &      ( pthick(ji,jj) * z_stabfunc ) )      
    258258           
    259             t_imp(ji,jj) = ( p_dsst(ji,jj) + p_rdt * z_term1 ) / & 
    260                            ( 1._wp - p_rdt * z_term2 ) 
     259            t_imp(ji,jj) = ( p_dsst(ji,jj) + pdt * z_term1 ) / & 
     260                           ( 1._wp - pdt * z_term2 ) 
    261261 
    262262         END DO 
    263263      END DO 
    264264       
    265       END FUNCTION t_imp 
    266  
     265   END FUNCTION t_imp 
     266 
     267   !!====================================================================== 
    267268END MODULE diurnal_bulk 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIU/step_diu.F90

    r9598 r9939  
    55   !!====================================================================== 
    66   !! History :  3.7  ! 2015-11  (J. While)  Original code 
     7   !!---------------------------------------------------------------------- 
    78 
    89   USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine)  
    … …  
    2728   !! Software governed by the CeCILL licence     (./LICENSE) 
    2829   !!---------------------------------------------------------------------- 
    29  
    3030   CONTAINS 
    3131 
    3232   SUBROUTINE stp_diurnal( kstp )  
    33       INTEGER, INTENT(in) ::   kstp   ! ocean time-step index  
    3433      !!----------------------------------------------------------------------  
    3534      !!                     ***  ROUTINE stp_diurnal  ***  
    … …  
    4645      !!              -8- Outputs and diagnostics  
    4746      !!----------------------------------------------------------------------  
     47      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index  
     48      ! 
    4849      INTEGER ::   jk       ! dummy loop indices 
    4950      INTEGER ::   indic    ! error indicator if < 0  
    … …  
    5152      !! ---------------------------------------------------------------------  
    5253       
    53       IF(ln_diurnal_only) THEN 
     54      IF( ln_diurnal_only ) THEN 
    5455         indic = 0                                 ! reset to no error condition  
    5556         IF( kstp /= nit000 )   CALL day( kstp )   ! Calendar (day was already called at nit000 in day_init)  
    … …  
    6061         ENDIF 
    6162        
    62             CALL sbc    ( kstp )                      ! Sea Boundary Conditions  
     63         CALL sbc( kstp )                          ! Sea Surface Boundary Conditions  
    6364      ENDIF 
    6465      
    65       ! Cool skin 
    6666      IF( .NOT.ln_diurnal )   CALL ctl_stop( "stp_diurnal: ln_diurnal not set" ) 
    6767          
    6868      IF( .NOT. ln_blk    )   CALL ctl_stop( "stp_diurnal: diurnal flux processing only implemented for bulk forcing" )  
    6969 
    70       CALL diurnal_sst_coolskin_step( qns, taum, rhop(:,:,1), rdt) 
     70      !                                            ! Cool skin 
     71      CALL diurnal_sst_coolskin_step( qns, taum, rhop(:,:,1), rn_Dt ) 
    7172 
    72       CALL iom_put( "sst_wl"   , x_dsst               )    ! warm layer (write out before update below). 
    73       CALL iom_put( "sst_cs"   , x_csdsst             )    ! cool skin 
     73      CALL iom_put( "sst_wl", x_dsst   )                 ! warm layer (write out before update below). 
     74      CALL iom_put( "sst_cs", x_csdsst )                 ! cool skin 
    7475 
    75       ! Diurnal warm layer model        
    76       CALL diurnal_sst_takaya_step( kstp, &  
    77       &    qsr, qns, taum, rhop(:,:,1), rdt)  
     76      !                                            ! Diurnal warm layer model        
     77      CALL diurnal_sst_takaya_step( kstp, qsr, qns, taum, rhop(:,:,1), rn_Dt )  
    7878 
    7979      IF( ln_diurnal_only ) THEN 
    80          IF( ln_diaobs )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
     80         IF( ln_diaobs )   CALL dia_obs( kstp )    ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    8181      
    8282         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  
    … …  
    8484         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
    8585         IF( kstp == nit000   )   CALL iom_close( numror )     ! close input  ocean restart file  
    86          IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file 
     86         IF( lrst_oce         )   CALL rst_write( kstp   )     ! write output ocean restart file 
    8787      
    8888         IF( ln_timing .AND.  kstp == nit000  )   CALL timing_reset  
    … …  
    9191   END SUBROUTINE stp_diurnal   
    9292    
     93   !!====================================================================== 
    9394END MODULE step_diu 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/daymod.F90

    r9598 r9939  
    2020   !!                    ------------------------------- 
    2121   !!   sbcmod assume that the time step is dividing the number of second of  
    22    !!   in a day, i.e. ===> MOD( rday, rdt ) == 0  
     22   !!   in a day, i.e. ===> MOD( rday, rn_Dt ) == 0  
    2323   !!   except when user defined forcing is used (see sbcmod.F90) 
    2424   !!---------------------------------------------------------------------- 
    … …  
    7272      ! 
    7373      ! max number of seconds between each restart 
    74       IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN 
     74      IF( REAL( nitend - nit000 + 1 ) * rn_Dt > REAL( HUGE( nsec1jan000 ) ) ) THEN 
    7575         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   & 
    7676            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 
    7777      ENDIF 
    78       nsecd   = NINT( rday       ) 
    79       nsecd05 = NINT( 0.5 * rday ) 
    80       ndt     = NINT(       rdt ) 
    81       ndt05   = NINT( 0.5 * rdt ) 
     78      nsecd   = NINT( rday         ) 
     79      nsecd05 = NINT( 0.5 * rday   ) 
     80      ndt     = NINT(       rn_Dt ) 
     81      ndt05   = NINT( 0.5 * rn_Dt ) 
    8282 
    8383      IF( .NOT. l_offline )   CALL day_rst( nit000, 'READ' ) 
    … …  
    239239      nsec_week  = nsec_week  + ndt 
    240240      nsec_day   = nsec_day   + ndt 
    241       adatrj  = adatrj  + rdt / rday 
    242       fjulday = fjulday + rdt / rday 
     241      adatrj  = adatrj  + rn_Dt / rday 
     242      fjulday = fjulday + rn_Dt / rday 
    243243      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error 
    244244      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error 
    … …  
    309309      !!       In both those options, the  exact duration of the experiment 
    310310      !!       since the beginning (cumulated duration of all previous restart runs) 
    311       !!       is not stored in the restart and is assumed to be (nit000-1)*rdt. 
     311      !!       is not stored in the restart and is assumed to be (nit000-1)*rn_Dt. 
    312312      !!       This is valid is the time step has remained constant. 
    313313      !! 
    … …  
    378378               nminute = ( nn_time0 - nhour * 100 ) 
    379379               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0) 
    380                adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 
     380               adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 
    381381               ! note this is wrong if time step has changed during run 
    382382            ENDIF 
    … …  
    387387       nminute = ( nn_time0 - nhour * 100 ) 
    388388            IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0) 
    389             adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 
     389            adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 
    390390         ENDIF 
    391391         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/dom_oce.F90

    r9667 r9939  
    3333   LOGICAL , PUBLIC ::   ln_meshmask    !: =T  create a mesh-mask file (mesh_mask.nc) 
    3434   REAL(wp), PUBLIC ::   rn_isfhmin     !: threshold to discriminate grounded ice to floating ice 
    35    REAL(wp), PUBLIC ::   rn_rdt         !: time step for the dynamics and tracer 
     35   REAL(wp), PUBLIC ::   rn_dt          !: time step for the dynamics and tracer 
    3636   REAL(wp), PUBLIC ::   rn_atfp        !: asselin time filter parameter 
    37    INTEGER , PUBLIC ::   nn_euler       !: =0 start with forward time step or not (=1) 
     37   LOGICAL , PUBLIC ::   ln_1st_euler   !: =0 start with forward time step or not (=1) 
    3838   LOGICAL , PUBLIC ::   ln_iscpl       !: coupling with ice sheet 
    3939   LOGICAL , PUBLIC ::   ln_crs         !: Apply grid coarsening to dynamical model output or online passive tracers 
    … …  
    5050   LOGICAL,  PUBLIC :: ln_bt_auto       !: Set number of barotropic iterations automatically 
    5151   INTEGER,  PUBLIC :: nn_bt_flt        !: Filter choice 
    52    INTEGER,  PUBLIC :: nn_baro          !: Number of barotropic iterations during one baroclinic step (rdt) 
     52   INTEGER,  PUBLIC :: nn_e             !: Number of external mode sub-step used at each ocean time-step 
    5353   REAL(wp), PUBLIC :: rn_bt_cmax       !: Maximum allowed courant number (used if ln_bt_auto=T) 
    5454   REAL(wp), PUBLIC :: rn_bt_alpha      !: Time stepping diffusion parameter 
    5555 
    56  
    57    !                                   !! old non-DOCTOR names still used in the model 
    58    REAL(wp), PUBLIC ::   atfp           !: asselin time filter parameter 
    59    REAL(wp), PUBLIC ::   rdt            !: time step for the dynamics and tracer 
    60  
    6156   !                                   !!! associated variables 
    62    INTEGER , PUBLIC ::   neuler         !: restart euler forward option (0=Euler) 
    63    REAL(wp), PUBLIC ::   r2dt           !: = 2*rdt except at nit000 (=rdt) if neuler=0 
     57   LOGICAL , PUBLIC ::   l_1st_euler    !: Euler 1st time-step flag (=T if ln_restart=F or ln_1st_euler=T) 
     58   REAL(wp), PUBLIC ::   rDt, r1_Dt     !: MLF: = 2*rn_Dt and 1/(2*rn_Dt) except if l_1st_euler=T where half the value is used 
     59   !                                    !  RK3: = rn_Dt 
    6460 
    6561   !!---------------------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domain.F90

    r9598 r9939  
    288288      INTEGER  ::   ios   ! Local integer 
    289289      ! 
    290       NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 & 
    291          &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     & 
    292          &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     & 
    293          &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     & 
     290      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                   & 
     291         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl   ,     & 
     292         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate   ,     & 
     293         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, ln_1st_euler,     & 
    294294         &             ln_cfmeta, ln_iscpl, ln_xios_read, nn_wxios 
    295       NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask 
     295      NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_Dt, rn_atfp, ln_crs, ln_meshmask 
    296296#if defined key_netcdf4 
    297297      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
    … …  
    323323         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir ) 
    324324         WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart 
    325          WRITE(numout,*) '      start with forward time step    nn_euler        = ', nn_euler 
     325         WRITE(numout,*) '      start with forward time step    ln_1st_euler    = ', ln_1st_euler 
    326326         WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl 
    327327         WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000 
    … …  
    361361      nstocklist = nn_stocklist 
    362362      nwrite = nn_write 
    363       neuler = nn_euler 
    364       IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN 
     363      IF( ln_rstart ) THEN       ! restart : set 1st time-step scheme (LF or forward)  
     364         l_1st_euler = ln_1st_euler 
     365      ELSE                       ! start from rest : always an Euler scheme for the 1st time-step 
    365366         IF(lwp) WRITE(numout,*)   
    366367         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)' 
    367          IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : nn_euler is forced to 0 '    
    368          neuler = 0 
     368         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used '    
     369         l_1st_euler = .TRUE. 
    369370      ENDIF 
    370371      !                             ! control of output frequency 
    … …  
    374375         nstock = nitend 
    375376      ENDIF 
    376       IF ( nwrite == 0 ) THEN 
     377      IF( nwrite == 0 ) THEN 
    377378         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend 
    378379         CALL ctl_warn( ctmp1 ) 
    … …  
    413414         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask 
    414415         WRITE(numout,*) '      treshold to open the isf cavity         rn_isfhmin  = ', rn_isfhmin, ' [m]' 
    415          WRITE(numout,*) '      ocean time step                         rn_rdt      = ', rn_rdt 
     416         WRITE(numout,*) '      ocean time step                         rn_dt       = ', rn_dt 
    416417         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp 
    417418         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs 
    418419      ENDIF 
    419420      ! 
    420       !          ! conversion DOCTOR names into model names (this should disappear soon) 
    421       atfp = rn_atfp 
    422       rdt  = rn_rdt 
    423  
    424421      IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    425422         lrxios = ln_xios_read.AND.ln_rstart 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domvvl.F90

    r9598 r9939  
    5454   LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE.                ! debug control prints 
    5555 
    56    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                ! thickness diffusion transport 
    57    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                     ! low frequency part of hz divergence 
    58    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n    ! baroclinic scale factors 
    59    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a   ! baroclinic scale factors 
    60    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                 ! retoring period for scale factors 
    61    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                 ! retoring period for low freq. divergence 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td      ! thickness diffusion transport 
     57   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf           ! low frequency part of hz divergence 
     58   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: te3t_b, te3t_n    ! baroclinic scale factors 
     59   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: te3t_a, dte3t_a   ! baroclinic scale factors 
     60   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t       ! retoring period for scale factors 
     61   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv       ! retoring period for low freq. divergence 
    6262 
    6363   !! * Substitutions 
    … …  
    7676      IF( ln_vvl_zstar )   dom_vvl_alloc = 0 
    7777      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
    78          ALLOCATE( tilde_e3t_b(jpi,jpj,jpk)  , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) ,   & 
    79             &      dtilde_e3t_a(jpi,jpj,jpk) , un_td  (jpi,jpj,jpk)     , vn_td  (jpi,jpj,jpk)     ,   & 
     78         ALLOCATE( te3t_b(jpi,jpj,jpk)  , te3t_n(jpi,jpj,jpk) , te3t_a(jpi,jpj,jpk) ,   & 
     79            &      dte3t_a(jpi,jpj,jpk) , un_td  (jpi,jpj,jpk)     , vn_td  (jpi,jpj,jpk)     ,   & 
    8080            &      STAT = dom_vvl_alloc        ) 
    8181         IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc ) 
    … …  
    103103      !!               - interpolate scale factors 
    104104      !! 
    105       !! ** Action  : - e3t_(n/b) and tilde_e3t_(n/b) 
     105      !! ** Action  : - e3t_(n/b) and te3t_(n/b) 
    106106      !!              - Regrid: e3(u/v)_n 
    107107      !!                        e3(u/v)_b        
    … …  
    117117      INTEGER ::   ji, jj, jk 
    118118      INTEGER ::   ii0, ii1, ij0, ij1 
    119       REAL(wp)::   zcoef 
     119      REAL(wp)::   zcoef, z1_Dt 
    120120      !!---------------------------------------------------------------------- 
    121121      ! 
    … …  
    129129      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' ) 
    130130      ! 
    131       !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 
     131      !                    ! Read or initialize e3t_(b/n), te3t_(b/n) and hdiv_lf 
    132132      CALL dom_vvl_rst( nit000, 'READ' ) 
    133133      e3t_a(:,:,jpk) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all 
    … …  
    208208         IF( ln_vvl_ztilde_as_zstar ) THEN   ! z-star emulation using z-tile 
    209209            frq_rst_e3t(:,:) = 0._wp               !Ignore namelist settings 
    210             frq_rst_hdv(:,:) = 1._wp / rdt 
     210            frq_rst_hdv(:,:) = 1._wp / rn_Dt 
    211211         ENDIF 
    212212         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator 
     213            z1_Dt = 1._wp / rn_Dt 
    213214            DO jj = 1, jpj 
    214215               DO ji = 1, jpi 
    … …  
    216217                  IF( ABS(gphit(ji,jj)) >= 6.) THEN 
    217218                     ! values outside the equatorial band and transition zone (ztilde) 
    218                      frq_rst_e3t(ji,jj) =  2.0_wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.e0_wp ) 
    219                      frq_rst_hdv(ji,jj) =  2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 
     219                     frq_rst_e3t(ji,jj) =  2._wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400._wp ) 
     220                     frq_rst_hdv(ji,jj) =  2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400._wp ) 
    220221                  ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN    ! Equator strip ==> z-star 
    221222                     ! values inside the equatorial band (ztilde as zstar) 
    222                      frq_rst_e3t(ji,jj) =  0.0_wp 
    223                      frq_rst_hdv(ji,jj) =  1.0_wp / rdt 
     223                     frq_rst_e3t(ji,jj) =  0._wp 
     224                     frq_rst_hdv(ji,jj) =  z1_Dt 
    224225                  ELSE                                      ! transition band (2.5 to 6 degrees N/S) 
    225226                     !                                      ! (linearly transition from z-tilde to z-star) 
    226                      frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp   & 
    227                         &            * (  1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
    228                         &                                          * 180._wp / 3.5_wp ) ) 
    229                      frq_rst_hdv(ji,jj) = (1.0_wp / rdt)                                & 
    230                         &            + (  frq_rst_hdv(ji,jj)-(1.e0_wp / rdt) )*0.5_wp   & 
    231                         &            * (  1._wp  - COS( rad*(ABS(gphit(ji,jj))-2.5_wp)  & 
    232                         &                                          * 180._wp / 3.5_wp ) ) 
     227                     frq_rst_e3t(ji,jj) = 0._wp + ( frq_rst_e3t(ji,jj) - 0._wp  ) * 0.5_wp                             & 
     228                        &                       * (  1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) * 180._wp / 3.5_wp )  ) 
     229                     frq_rst_hdv(ji,jj) = z1_Dt + (  frq_rst_hdv(ji,jj) - z1_Dt ) * 0.5_wp                             & 
     230                        &                       * (  1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) * 180._wp / 3.5_wp )  ) 
    233231                  ENDIF 
    234232               END DO 
    … …  
    237235               ii0 = 103   ;   ii1 = 111        
    238236               ij0 = 128   ;   ij1 = 135   ;    
    239                frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    240                frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rdt 
     237               frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0._wp 
     238               frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  z1_Dt 
    241239            ENDIF 
    242240         ENDIF 
    … …  
    280278      !! 
    281279      !! ** Action  :  - hdiv_lf    : restoring towards full baroclinic divergence in z_tilde case 
    282       !!               - tilde_e3t_a: after increment of vertical scale factor  
     280      !!               - te3t_a: after increment of vertical scale factor  
    283281      !!                              in z_tilde case 
    284282      !!               - e3(t/u/v)_a 
    … …  
    345343            IF( kt > nit000 ) THEN 
    346344               DO jk = 1, jpkm1 
    347                   hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:)   & 
     345                  hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rn_Dt * frq_rst_hdv(:,:)   & 
    348346                     &          * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) ) 
    349347               END DO 
    … …  
    353351         ! II - after z_tilde increments of vertical scale factors 
    354352         ! ======================================================= 
    355          tilde_e3t_a(:,:,:) = 0._wp  ! tilde_e3t_a used to store tendency terms 
     353         te3t_a(:,:,:) = 0._wp  ! te3t_a used to store tendency terms 
    356354 
    357355         ! 1 - High frequency divergence term 
    … …  
    359357         IF( ln_vvl_ztilde ) THEN     ! z_tilde case 
    360358            DO jk = 1, jpkm1 
    361                tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 
     359               te3t_a(:,:,jk) = te3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 
    362360            END DO 
    363361         ELSE                         ! layer case 
    364362            DO jk = 1, jpkm1 
    365                tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 
     363               te3t_a(:,:,jk) = te3t_a(:,:,jk) -   e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 
    366364            END DO 
    367365         ENDIF 
    … …  
    371369         IF( ln_vvl_ztilde ) THEN 
    372370            DO jk = 1, jpk 
    373                tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk) 
     371               te3t_a(:,:,jk) = te3t_a(:,:,jk) - frq_rst_e3t(:,:) * te3t_b(:,:,jk) 
    374372            END DO 
    375373         ENDIF 
    … …  
    383381               DO ji = 1, fs_jpim1   ! vector opt. 
    384382                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
    385                      &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
     383                     &            * ( te3t_b(ji,jj,jk) - te3t_b(ji+1,jj  ,jk) ) 
    386384                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)           &  
    387                      &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
     385                     &            * ( te3t_b(ji,jj,jk) - te3t_b(ji  ,jj+1,jk) ) 
    388386                  zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
    389387                  zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
    … …  
    400398            DO jj = 2, jpjm1 
    401399               DO ji = fs_2, fs_jpim1   ! vector opt. 
    402                   tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    & 
     400                  te3t_a(ji,jj,jk) = te3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    & 
    403401                     &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    & 
    404402                     &                                            ) * r1_e1e2t(ji,jj) 
    … …  
    414412         ! Leapfrog time stepping 
    415413         ! ~~~~~~~~~~~~~~~~~~~~~~ 
    416          IF( neuler == 0 .AND. kt == nit000 ) THEN 
    417             z2dt =  rdt 
    418          ELSE 
    419             z2dt = 2.0_wp * rdt 
    420          ENDIF 
    421          CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp ) 
    422          tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 
     414         CALL lbc_lnk( te3t_a(:,:,:), 'T', 1._wp ) 
     415         te3t_a(:,:,:) = te3t_b(:,:,:) + z2dt * tmask(:,:,:) * te3t_a(:,:,:) 
    423416 
    424417         ! Maximum deformation control 
    … …  
    426419         ze3t(:,:,jpk) = 0._wp 
    427420         DO jk = 1, jpkm1 
    428             ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
     421            ze3t(:,:,jk) = te3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    429422         END DO 
    430423         z_tmax = MAXVAL( ze3t(:,:,:) ) 
    … …  
    446439            ENDIF 
    447440            IF (lwp) THEN 
    448                WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 
     441               WRITE(numout, *) 'MAX( te3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 
    449442               WRITE(numout, *) 'at i, j, k=', ijk_max 
    450                WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 
     443               WRITE(numout, *) 'MIN( te3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 
    451444               WRITE(numout, *) 'at i, j, k=', ijk_min             
    452                CALL ctl_warn('MAX( ABS( tilde_e3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high') 
     445               CALL ctl_warn('MAX( ABS( te3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high') 
    453446            ENDIF 
    454447         ENDIF 
    455448         ! - ML - end test 
    456449         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
    457          tilde_e3t_a(:,:,:) = MIN( tilde_e3t_a(:,:,:),   rn_zdef_max * e3t_0(:,:,:) ) 
    458          tilde_e3t_a(:,:,:) = MAX( tilde_e3t_a(:,:,:), - rn_zdef_max * e3t_0(:,:,:) ) 
     450         te3t_a(:,:,:) = MIN( te3t_a(:,:,:),   rn_zdef_max * e3t_0(:,:,:) ) 
     451         te3t_a(:,:,:) = MAX( te3t_a(:,:,:), - rn_zdef_max * e3t_0(:,:,:) ) 
    459452 
    460453         ! 
    … …  
    462455         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    463456         DO jk = 1, jpkm1 
    464             dtilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - tilde_e3t_b(:,:,jk) 
     457            dte3t_a(:,:,jk) = te3t_a(:,:,jk) - te3t_b(:,:,jk) 
    465458         END DO 
    466459         ! III - Barotropic repartition of the sea surface height over the baroclinic profile 
    … …  
    470463         !        i.e. locally and not spread over the water column. 
    471464         !        (keep in mind that the idea is to reduce Eulerian velocity as much as possible) 
    472          zht(:,:) = 0. 
     465         zht(:,:) = 0._wp 
    473466         DO jk = 1, jpkm1 
    474             zht(:,:)  = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
     467            zht(:,:)  = zht(:,:) + te3t_a(:,:,jk) * tmask(:,:,jk) 
    475468         END DO 
    476469         z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 
    477470         DO jk = 1, jpkm1 
    478             dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
     471            dte3t_a(:,:,jk) = dte3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
    479472         END DO 
    480473 
    … …  
    484477      !                                           ! ---baroclinic part--------- ! 
    485478         DO jk = 1, jpkm1 
    486             e3t_a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
     479            e3t_a(:,:,jk) = e3t_a(:,:,jk) + dte3t_a(:,:,jk) * tmask(:,:,jk) 
    487480         END DO 
    488481      ENDIF 
    … …  
    494487            z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) ) 
    495488            IF( lk_mpp ) CALL mpp_max( z_tmax )                             ! max over the global domain 
    496             IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(tilde_e3t_a))) =', z_tmax 
     489            IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(te3t_a))) =', z_tmax 
    497490         END IF 
    498491         ! 
    … …  
    573566      !!               - recompute depths and water height fields 
    574567      !! 
    575       !! ** Action  :  - e3t_(b/n), tilde_e3t_(b/n) and e3(u/v)_n ready for next time step 
     568      !! ** Action  :  - e3t_(b/n), te3t_(b/n) and e3(u/v)_n ready for next time step 
    576569      !!               - Recompute: 
    577570      !!                    e3(u/v)_b        
    … …  
    587580      INTEGER, INTENT( in ) ::   kt   ! time step 
    588581      ! 
    589       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    590       REAL(wp) ::   zcoef        ! local scalar 
     582      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
     583      REAL(wp) ::   zcoef, ze3f   ! local scalar 
    591584      !!---------------------------------------------------------------------- 
    592585      ! 
    … …  
    605598      ! - ML - e3(t/u/v)_b are allready computed in dynnxt. 
    606599      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
    607          IF( neuler == 0 .AND. kt == nit000 ) THEN 
    608             tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 
     600         IF( l_1st_euler ) THEN 
     601            te3t_n(:,:,:) = te3t_a(:,:,:) 
    609602         ELSE 
    610             tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) &  
    611             &         + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 
     603            DO jk = 1, jpk 
     604               DO jj = 1, jpj 
     605                  DO ji = 1, jpi 
     606                     ze3f = te3t_n(ji,jj,jk)   & 
     607                        & + rn_atfp * ( te3t_b(ji,jj,jk) - 2.0_wp * te3t_n(ji,jj,jk) + te3t_a(ji,jj,jk) ) 
     608                     te3t_b(ji,jj,jk) = ze3f 
     609                     te3t_n(ji,jj,jk) = te3t_a(ji,jj,jk) 
     610                  END DO 
     611               END DO 
     612            END DO 
    612613         ENDIF 
    613          tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 
    614614      ENDIF 
    615615      gdept_b(:,:,:) = gdept_n(:,:,:) 
    … …  
    806806            CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, ldxios = lrxios    ) 
    807807            ! 
    808             id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    809             id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 
     808            id1 = iom_varid( numror, 'e3t_b'      , ldstop = .FALSE. ) 
     809            id2 = iom_varid( numror, 'e3t_n'      , ldstop = .FALSE. ) 
    810810            id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 
    811811            id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
    812             id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
     812            id5 = iom_varid( numror, 'hdiv_lf'    , ldstop = .FALSE. ) 
    813813            !                             ! --------- ! 
    814814            !                             ! all cases ! 
    … …  
    823823                  e3t_b(:,:,:) = e3t_0(:,:,:) 
    824824               END WHERE 
    825                IF( neuler == 0 ) THEN 
     825               IF( l_1st_euler ) THEN 
    826826                  e3t_b(:,:,:) = e3t_n(:,:,:) 
    827827               ENDIF 
    … …  
    829829               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart files' 
    830830               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    831                IF(lwp) write(numout,*) 'neuler is forced to 0' 
     831               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    832832               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), ldxios = lrxios ) 
    833833               e3t_n(:,:,:) = e3t_b(:,:,:) 
    834                neuler = 0 
     834               l_1st_euler = .TRUE. 
    835835            ELSE IF( id2 > 0 ) THEN 
    836836               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_b not found in restart files' 
    837837               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    838                IF(lwp) write(numout,*) 'neuler is forced to 0' 
     838               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    839839               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), ldxios = lrxios ) 
    840840               e3t_b(:,:,:) = e3t_n(:,:,:) 
    841                neuler = 0 
     841               l_1st_euler = .TRUE. 
    842842            ELSE 
    843843               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart file' 
    844844               IF(lwp) write(numout,*) 'Compute scale factor from sshn' 
    845                IF(lwp) write(numout,*) 'neuler is forced to 0' 
     845               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    846846               DO jk = 1, jpk 
    847847                  e3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) & 
    … …  
    850850               END DO 
    851851               e3t_b(:,:,:) = e3t_n(:,:,:) 
    852                neuler = 0 
     852               l_1st_euler = .TRUE. 
    853853            ENDIF 
    854854            !                             ! ----------- ! 
    … …  
    862862               !                          ! ----------------------- ! 
    863863               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    864                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    865                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     864                  CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', te3t_b(:,:,:), ldxios = lrxios ) 
     865                  CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', te3t_n(:,:,:), ldxios = lrxios ) 
    866866               ELSE                            ! one at least array is missing 
    867                   tilde_e3t_b(:,:,:) = 0.0_wp 
    868                   tilde_e3t_n(:,:,:) = 0.0_wp 
     867                  te3t_b(:,:,:) = 0.0_wp 
     868                  te3t_n(:,:,:) = 0.0_wp 
    869869               ENDIF 
    870870               !                          ! ------------ ! 
    … …  
    942942 
    943943            IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 
    944                tilde_e3t_b(:,:,:) = 0._wp 
    945                tilde_e3t_n(:,:,:) = 0._wp 
     944               te3t_b(:,:,:) = 0._wp 
     945               te3t_n(:,:,:) = 0._wp 
    946946               IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0._wp 
    947947            END IF 
    … …  
    960960         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    961961            !                                        ! ----------------------- ! 
    962             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lwxios) 
    963             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 
     962            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', te3t_b(:,:,:), ldxios = lwxios) 
     963            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', te3t_n(:,:,:), ldxios = lwxios) 
    964964         END IF 
    965965         !                                           ! -------------!     
    … …  
    10161016            WRITE(numout,*) '                         rn_rst_e3t     = 0.e0' 
    10171017            WRITE(numout,*) '            hard-wired : z-tilde cutoff frequency of low-pass filter (days)' 
    1018             WRITE(numout,*) '                         rn_lf_cutoff   = 1.0/rdt' 
     1018            WRITE(numout,*) '                         rn_lf_cutoff   = 1/rn_Dt' 
    10191019         ELSE 
    10201020            WRITE(numout,*) '      z-tilde to zstar restoration timescale (days)        rn_rst_e3t   = ', rn_rst_e3t 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/iscplini.F90

    r9598 r9939  
    7171      ! 
    7272      nstp_iscpl=MIN( nn_fiscpl, nitend-nit000+1 ) ! the coupling period have to be less or egal than the total number of time step 
    73       rdt_iscpl = nstp_iscpl * rn_rdt 
     73      rdt_iscpl = nstp_iscpl * rn_Dt 
    7474      ! 
    7575      IF (lwp) THEN 
    … …  
    7979         WRITE(numout,*) ' conservation flag (ln_hsb   )            = ', ln_hsb 
    8080         WRITE(numout,*) ' nb of stp for cons (rn_fiscpl)           = ', nstp_iscpl 
    81          IF (nstp_iscpl .NE. nn_fiscpl) WRITE(numout,*) 'W A R N I N G: nb of stp for cons has been modified & 
     81         IF (nstp_iscpl /= nn_fiscpl) WRITE(numout,*) 'W A R N I N G: nb of stp for cons has been modified & 
    8282            &                                           (larger than run length)' 
    8383         WRITE(numout,*) ' coupling time step                       = ', rdt_iscpl 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/iscplrst.F90

    r9598 r9939  
    8989      END IF 
    9090      ! 
    91       neuler = 0              ! next step is an euler time step 
     91      l_1st_euler = .TRUE.    ! next step is an euler time step 
    9292      ! 
    9393      !                       ! set _b and _n variables equal 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/istate.F90

    r9598 r9939  
    9292         !                                    ! --------------- 
    9393         numror = 0                           ! define numror = 0 -> no restart file to read 
    94          neuler = 0                           ! Set time-step indicator at nit000 (euler forward) 
     94         l_1st_euler = .TRUE.                 ! Set a Euler forward 1sr time-step 
    9595         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    9696         !                                    ! Initialization of ocean to zero 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/phycst.F90

    r9656 r9939  
    3434   REAL(wp), PUBLIC ::   rhhmm =  60._wp        !: number of minutes in one hour 
    3535   REAL(wp), PUBLIC ::   rmmss =  60._wp        !: number of seconds in one minute 
    36    REAL(wp), PUBLIC ::   omega                  !: earth rotation parameter           [s-1] 
    37    REAL(wp), PUBLIC ::   ra    = 6371229._wp    !: earth radius                       [m] 
    38    REAL(wp), PUBLIC ::   grav  = 9.80665_wp     !: gravity                            [m/s2] 
     36   REAL(wp), PUBLIC ::   omega                  !: earth rotation parameter               [s-1] 
     37   REAL(wp), PUBLIC ::   ra    = 6371229._wp    !: earth radius                           [m] 
     38   REAL(wp), PUBLIC ::   grav  = 9.80665_wp     !: gravity                                [m/s2] 
    3939    
    40    REAL(wp), PUBLIC ::   rtt      = 273.16_wp        !: triple point of temperature   [Kelvin] 
    41    REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin] 
    42    REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp        !: melting point of snow         [Kelvin] 
    43 #if defined key_si3 
    44    REAL(wp), PUBLIC ::   rt0_ice  = 273.15_wp        !: melting point of ice          [Kelvin] 
    45 #else 
    46    REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp        !: melting point of ice          [Kelvin] 
    47 #endif 
    48    REAL(wp), PUBLIC ::   rau0                        !: volumic mass of reference     [kg/m3] 
    49    REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg] 
    50    REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin] 
    51    REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
    52    REAL(wp), PUBLIC ::   rau0_rcp                    !: = rau0 * rcp  
    53    REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp ) 
     40   REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water     [Kelvin] 
     41   REAL(wp), PUBLIC ::   rho0                        !: volumic mass of reference         [kg/m3] 
     42   REAL(wp), PUBLIC ::   r1_rho0                     !: = 1. / rho0                       [m3/kg] 
     43   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat               [J/Kelvin] 
     44   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                        [Kelvin/J] 
     45   REAL(wp), PUBLIC ::   rho0_rcp                    !: = rho0 * rcp  
     46   REAL(wp), PUBLIC ::   r1_rho0_rcp                 !: = 1. / ( rho0 * rcp ) 
    5447 
    55    REAL(wp), PUBLIC ::   rhosn    =  330._wp         !: volumic mass of snow          [kg/m3] 
    56    REAL(wp), PUBLIC ::   rhofw    = 1000._wp         !: volumic mass of freshwater in melt ponds [kg/m3] 
     48   REAL(wp), PUBLIC ::   rhoi     =  917._wp         !: sea ice density                   [kg/m3] 
     49   REAL(wp), PUBLIC ::   rhos     =  330._wp         !: snow    density                   [kg/m3] 
     50   REAL(wp), PUBLIC ::   rhow     = 1000._wp         !: water   density (in melt ponds)   [kg/m3] 
     51   REAL(wp), PUBLIC ::   rcnd_i   =    2.034396_wp   !: thermal conductivity of fresh ice [W/m/K] 
     52   REAL(wp), PUBLIC ::   rcpi     = 2067.0_wp        !: specific heat of fresh ice        [J/kg/K] 
     53   REAL(wp), PUBLIC ::   rLsub    =    2.834e+6_wp   !: pure ice latent heat of sublimation   [J/kg] 
     54   REAL(wp), PUBLIC ::   rLfus    =    0.334e+6_wp   !: latent heat of fusion of fresh ice    [J/kg] 
     55   REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity 
    5756   REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice 
    58    REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice               [psu] 
    59    REAL(wp), PUBLIC ::   soce     =   34.7_wp        !: salinity of sea               [psu] 
    60    REAL(wp), PUBLIC ::   cevap    =    2.5e+6_wp     !: latent heat of evaporation (water) 
    61    REAL(wp), PUBLIC ::   srgamma  =    0.9_wp        !: correction factor for solar radiation (Oberhuber, 1974) 
     57   REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice                   [psu] 
     58   REAL(wp), PUBLIC ::   soce     =   34.7_wp        !: salinity of sea                   [psu] 
    6259   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant 
    6360   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant  
    6461 
    65 #if defined key_si3 || defined key_cice 
    66    REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
    67    REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K] 
    68    REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat of fresh ice                            [J/kg/K] 
    69    REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
    70    REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
    71    REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity 
    72    REAL(wp), PUBLIC ::   xlsn                        !: = lfus*rhosn (volumetric latent heat fusion of snow)  [J/m3] 
    73 #else 
    74    REAL(wp), PUBLIC ::   rhoic    =  900._wp         !: volumic mass of sea ice                               [kg/m3] 
    75    REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: conductivity of the ice                               [W/m/K] 
    76    REAL(wp), PUBLIC ::   rcpic    =    1.8837e+6_wp  !: volumetric specific heat for ice                      [J/m3/K] 
    77    REAL(wp), PUBLIC ::   cpic                        !: = rcpic / rhoic  (specific heat for ice)              [J/Kg/K] 
    78    REAL(wp), PUBLIC ::   rcdsn    =    0.22_wp       !: conductivity of the snow                              [W/m/K] 
    79    REAL(wp), PUBLIC ::   rcpsn    =    6.9069e+5_wp  !: volumetric specific heat for snow                     [J/m3/K] 
    80    REAL(wp), PUBLIC ::   xlsn     =  110.121e+6_wp   !: volumetric latent heat fusion of snow                 [J/m3] 
    81    REAL(wp), PUBLIC ::   lfus                        !: = xlsn / rhosn   (latent heat of fusion of fresh ice) [J/Kg] 
    82    REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3] 
    83    REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3] 
    84 #endif 
    85 #if defined key_cice 
    86    REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow                          [W/m/K] 
    87 #endif 
    88 #if defined key_si3 
    89    REAL(wp), PUBLIC ::   r1_rhoic                    !: 1 / rhoic 
    90    REAL(wp), PUBLIC ::   r1_rhosn                    !: 1 / rhosn 
    91    REAL(wp), PUBLIC ::   r1_cpic                     !: 1 / cpic 
    92 #endif 
     62   REAL(wp), PUBLIC ::   r1_rhoi                     !: 1 / rhoi 
     63   REAL(wp), PUBLIC ::   r1_rhos                     !: 1 / rhos 
     64   REAL(wp), PUBLIC ::   r1_rhow                     !: 1 / rhow 
     65   REAL(wp), PUBLIC ::   r1_cpi                      !: 1 / rcpi 
     66   REAL(wp), PUBLIC ::   r1_Lsub                     !: 1 / rLsub 
     67   REAL(wp), PUBLIC ::   r1_Lfus                     !: 1 / rLfus 
     68 
    9369   !!---------------------------------------------------------------------- 
    9470   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    10581      !! ** Purpose :   set and print the constants 
    10682      !!---------------------------------------------------------------------- 
    107  
     83      ! 
    10884      IF(lwp) WRITE(numout,*) 
    10985      IF(lwp) WRITE(numout,*) 'phy_cst : initialization of ocean parameters and constants' 
    11086      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    11187 
    112       ! Define & print constants 
    113       ! ------------------------ 
    114       IF(lwp) WRITE(numout,*) 
    115       IF(lwp) WRITE(numout,*) '   Constants' 
    116  
    117       IF(lwp) WRITE(numout,*) 
    118       IF(lwp) WRITE(numout,*) '      mathematical constant                 rpi = ', rpi 
     88      !                 !==  Define derived constant  ==! 
    11989 
    12090      rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp 
    … …  
    12595      omega  = 2._wp * rpi / rsiday  
    12696#endif 
    127       IF(lwp) WRITE(numout,*) 
    128       IF(lwp) WRITE(numout,*) '      day                                rday   = ', rday,   ' s' 
    129       IF(lwp) WRITE(numout,*) '      sideral year                       rsiyea = ', rsiyea, ' s' 
    130       IF(lwp) WRITE(numout,*) '      sideral day                        rsiday = ', rsiday, ' s' 
    131       IF(lwp) WRITE(numout,*) '      omega                              omega  = ', omega,  ' s^-1' 
    132       IF(lwp) WRITE(numout,*) 
    133       IF(lwp) WRITE(numout,*) '      nb of months per year               raamo = ', raamo, ' months' 
    134       IF(lwp) WRITE(numout,*) '      nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
    135       IF(lwp) WRITE(numout,*) '      nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
    136       IF(lwp) WRITE(numout,*) '      nb of seconds per minute            rmmss = ', rmmss, ' s' 
    137       IF(lwp) WRITE(numout,*) 
    138       IF(lwp) WRITE(numout,*) '      earth radius                         ra   = ', ra, ' m' 
    139       IF(lwp) WRITE(numout,*) '      gravity                              grav = ', grav , ' m/s^2' 
    140       IF(lwp) WRITE(numout,*) 
    141       IF(lwp) WRITE(numout,*) '      triple point of temperature      rtt      = ', rtt     , ' K' 
    142       IF(lwp) WRITE(numout,*) '      freezing point of water          rt0      = ', rt0     , ' K' 
    143       IF(lwp) WRITE(numout,*) '      melting point of snow            rt0_snow = ', rt0_snow, ' K' 
    144       IF(lwp) WRITE(numout,*) '      melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
    145       IF(lwp) WRITE(numout,*) 
    146       IF(lwp) WRITE(numout,*) '   reference density and heat capacity now defined in eosbn2.f90' 
    147                
    148 #if defined key_si3 || defined key_cice 
    149       xlsn = lfus * rhosn        ! volumetric latent heat fusion of snow [J/m3] 
    150 #else 
    151       cpic = rcpic / rhoic       ! specific heat for ice   [J/Kg/K] 
    152       lfus = xlsn / rhosn        ! latent heat of fusion of fresh ice 
    153 #endif 
    154 #if defined key_si3 
    155       r1_rhoic = 1._wp / rhoic 
    156       r1_rhosn = 1._wp / rhosn 
    157       r1_cpic  = 1._wp / cpic 
    158 #endif 
    159       IF(lwp) THEN 
     97 
     98      r1_rhoi = 1._wp / rhoi 
     99      r1_rhos = 1._wp / rhos 
     100      r1_cpi  = 1._wp / rcpi 
     101      r1_Lsub = 1._wp / rLsub 
     102      r1_Lfus = 1._wp / rLfus 
     103 
     104      IF(lwp) THEN      !==  print constants  ==! 
    160105         WRITE(numout,*) 
    161 #if defined key_cice 
    162          WRITE(numout,*) '      thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
    163 #endif 
    164          WRITE(numout,*) '      thermal conductivity of pure ice          = ', rcdic   , ' J/s/m/K' 
    165          WRITE(numout,*) '      fresh ice specific heat                   = ', cpic    , ' J/kg/K' 
    166          WRITE(numout,*) '      latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
    167 #if defined key_si3 || defined key_cice 
    168          WRITE(numout,*) '      latent heat of subl.  of fresh ice / snow = ', lsub    , ' J/kg' 
    169 #else 
    170          WRITE(numout,*) '      density times specific heat for snow      = ', rcpsn   , ' J/m^3/K'  
    171          WRITE(numout,*) '      density times specific heat for ice       = ', rcpic   , ' J/m^3/K' 
    172          WRITE(numout,*) '      volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m'  
    173          WRITE(numout,*) '      latent heat of sublimation of snow        = ', xsn     , ' J/kg'  
    174 #endif 
    175          WRITE(numout,*) '      volumetric latent heat fusion of snow     = ', xlsn    , ' J/m^3'  
    176          WRITE(numout,*) '      density of sea ice                        = ', rhoic   , ' kg/m^3' 
    177          WRITE(numout,*) '      density of snow                           = ', rhosn   , ' kg/m^3' 
    178          WRITE(numout,*) '      density of freshwater (in melt ponds)     = ', rhofw   , ' kg/m^3' 
    179          WRITE(numout,*) '      emissivity of snow or ice                 = ', emic   
    180          WRITE(numout,*) '      salinity of ice                           = ', sice    , ' psu' 
    181          WRITE(numout,*) '      salinity of sea                           = ', soce    , ' psu' 
    182          WRITE(numout,*) '      latent heat of evaporation (water)        = ', cevap   , ' J/m^3'  
    183          WRITE(numout,*) '      correction factor for solar radiation     = ', srgamma  
    184          WRITE(numout,*) '      von Karman constant                       = ', vkarmn  
    185          WRITE(numout,*) '      Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4' 
     106         WRITE(numout,*) '   Constants' 
    186107         WRITE(numout,*) 
    187          WRITE(numout,*) '      conversion: degre ==> radian          rad = ', rad 
     108         WRITE(numout,*) '      mathematical constant              rpi    = ', rpi 
     109         WRITE(numout,*) '      conversion: degre ==> radian       rad    = ', rad 
    188110         WRITE(numout,*) 
    189          WRITE(numout,*) '      smallest real computer value       rsmall = ', rsmall 
     111         WRITE(numout,*) '      day in seconds                     rday   = ', rday  , ' s' 
     112         WRITE(numout,*) '      sideral year                       rsiyea = ', rsiyea, ' s' 
     113         WRITE(numout,*) '      sideral day                        rsiday = ', rsiday, ' s' 
     114         WRITE(numout,*) '      omega = 2 pi / rsiday              omega  = ', omega , ' s^-1' 
     115         WRITE(numout,*) '      earth radius                       ra     = ', ra    , ' m' 
     116         WRITE(numout,*) '      gravity                            grav   = ', grav  , ' m/s^2' 
     117         WRITE(numout,*) 
     118         WRITE(numout,*) '      nb of months per year              raamo  = ', raamo, ' months' 
     119         WRITE(numout,*) '      nb of hours per day                rjjhh  = ', rjjhh, ' hours' 
     120         WRITE(numout,*) '      nb of minutes per hour             rhhmm  = ', rhhmm, ' mn' 
     121         WRITE(numout,*) '      nb of seconds per minute           rmmss  = ', rmmss, ' s' 
     122         WRITE(numout,*) 
     123         WRITE(numout,*) '   reference ocean density and heat capacity now defined in eosbn2.f90' 
     124         WRITE(numout,*) 
     125         WRITE(numout,*) '      freezing point of freshwater                rt0    = ', rt0   , ' K' 
     126         WRITE(numout,*) '      sea ice density                             rhoi   = ', rhoi  , ' kg/m^3' 
     127         WRITE(numout,*) '      snow    density                             rhos   = ', rhos  , ' kg/m^3' 
     128         WRITE(numout,*) '      freshwater density (in melt ponds)          rhow   = ', rhow  , ' kg/m^3' 
     129         WRITE(numout,*) '      thermal conductivity of pure ice            rcnd_i = ', rcnd_i, ' J/s/m/K' 
     130         WRITE(numout,*) '      fresh ice specific heat                     rcpi   = ', rcpi  , ' J/kg/K' 
     131         WRITE(numout,*) '      latent heat of fusion of fresh ice / snow   rLfus  = ', rLfus , ' J/kg' 
     132         WRITE(numout,*) '      latent heat of subl.  of fresh ice / snow   rLsub  = ', rLsub , ' J/kg' 
     133         WRITE(numout,*) '      emissivity of snow or ice                   emic   = ', emic   
     134         WRITE(numout,*) '      salinity of ice                             sice   = ', sice  , ' psu' 
     135         WRITE(numout,*) '      salinity of sea                             soce   = ', soce  , ' psu' 
     136         WRITE(numout,*) '      von Karman constant                         vkarmn = ', vkarmn  
     137         WRITE(numout,*) '      Stefan-Boltzmann constant                   stefan = ', stefan, ' J/s/m^2/K^4' 
     138         WRITE(numout,*) 
     139         WRITE(numout,*) 
     140         WRITE(numout,*) '      smallest real computer value                rsmall = ', rsmall 
    190141      ENDIF 
    191  
     142      ! 
    192143   END SUBROUTINE phy_cst 
    193144 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/restart.F90

    r9838 r9939  
    88   !!            2.0  !  2006-07  (S. Masson)  use IOM for restart 
    99   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  modified LF-RA 
    10    !!            - -  !  2010-10  (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D) 
    11    !!            3.7  !  2014-01  (G. Madec) suppression of curl and hdiv from the restart 
    12    !!             -   !  2014-12  (G. Madec) remove KPP scheme 
    13    !!---------------------------------------------------------------------- 
    14  
    15    !!---------------------------------------------------------------------- 
    16    !!   rst_opn    : open the ocean restart file 
    17    !!   rst_write  : write the ocean restart file 
    18    !!   rst_read   : read the ocean restart file 
    19    !!---------------------------------------------------------------------- 
    20    USE oce             ! ocean dynamics and tracers  
    21    USE dom_oce         ! ocean space and time domain 
    22    USE sbc_ice         ! only lk_si3  
    23    USE phycst          ! physical constants 
    24    USE eosbn2          ! equation of state            (eos bn2 routine) 
    25    USE trdmxl_oce      ! ocean active mixed layer tracers trends variables 
     10   !!            - -  !  2010-10  (C. Ethe, G. Madec)  TRC-TRA merge (T-S in 4D) 
     11   !!            3.7  !  2014-01  (G. Madec)  suppression of curl and hdiv from the restart 
     12   !!             -   !  2014-12  (G. Madec)  remove KPP scheme 
     13   !!            4.0  !  2018-06  (G. Madec)  introduce l_1st_euler 
     14   !!---------------------------------------------------------------------- 
     15 
     16   !!---------------------------------------------------------------------- 
     17   !!   rst_opn       : open the ocean restart file in write mode 
     18   !!   rst_write     : write the ocean restart file 
     19   !!   rst_read_open : open the ocean restart file in read mode 
     20   !!   rst_read      : read the ocean restart file 
     21   !!---------------------------------------------------------------------- 
     22   USE oce            ! ocean dynamics and tracers  
     23   USE dom_oce        ! ocean space and time domain 
     24   USE sbc_ice        ! only lk_si3  
     25   USE phycst         ! physical constants 
     26   USE eosbn2         ! equation of state            (eos bn2 routine) 
     27   USE trdmxl_oce     ! ocean active mixed layer tracers trends variables 
     28   USE diurnal_bulk   !  
    2629   ! 
    27    USE in_out_manager  ! I/O manager 
    28    USE iom             ! I/O module 
    29    USE diurnal_bulk 
     30   USE in_out_manager ! I/O manager 
     31   USE iom            ! I/O module 
    3032 
    3133   IMPLICIT NONE 
    … …  
    3436   PUBLIC   rst_opn         ! routine called by step module 
    3537   PUBLIC   rst_write       ! routine called by step module 
     38   PUBLIC   rst_read_open   ! routine called in rst_read and (possibly) in dom_vvl_init 
    3639   PUBLIC   rst_read        ! routine called by istate module 
    37    PUBLIC   rst_read_open   ! routine called in rst_read and (possibly) in dom_vvl_init 
    3840 
    3941   !! * Substitutions 
    … …  
    144146      INTEGER, INTENT(in) ::   kt   ! ocean time-step 
    145147      !!---------------------------------------------------------------------- 
    146                      IF(lwxios) CALL iom_swap(      cwxios_context          ) 
    147                      CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       , ldxios = lwxios)   ! dynamics time step 
    148  
    149       IF ( .NOT. ln_diurnal_only ) THEN 
    150                      CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub, ldxios = lwxios        )     ! before fields 
    151                      CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb, ldxios = lwxios        ) 
    152                      CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lwxios ) 
    153                      CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lwxios ) 
    154                      CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb, ldxios = lwxios      ) 
    155                      ! 
    156                      CALL iom_rstput( kt, nitrst, numrow, 'un'     , un, ldxios = lwxios        )     ! now fields 
    157                      CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn, ldxios = lwxios        ) 
    158                      CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lwxios ) 
    159                      CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lwxios ) 
    160                      CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn, ldxios = lwxios      ) 
    161                      CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop, ldxios = lwxios      ) 
    162                   ! extra variable needed for the ice sheet coupling 
    163                   IF ( ln_iscpl ) THEN  
    164                      CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask, ldxios = lwxios ) ! need to extrapolate T/S 
    165                      CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask, ldxios = lwxios ) ! need to correct barotropic velocity 
    166                      CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask, ldxios = lwxios ) ! need to correct barotropic velocity 
    167                      CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask, ldxios = lwxios) ! need to correct barotropic velocity 
    168                      CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios )   ! need to compute temperature correction 
    169                      CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation 
    170                      CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation 
    171                      CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl 
    172                   END IF 
    173       ENDIF 
    174        
    175       IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst, ldxios = lwxios )   
    176       IF(lwxios) CALL iom_swap(      cxios_context          ) 
     148      IF( lwxios )   CALL iom_swap( cwxios_context ) 
     149          
     150      CALL    iom_rstput( kt, nitrst, numrow, 'rdt'    , rn_Dt            , ldxios = lwxios )   ! dynamics time step 
     151      ! 
     152      IF( .NOT. ln_diurnal_only ) THEN 
     153         CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub               , ldxios = lwxios )   ! before fields 
     154         CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb               , ldxios = lwxios ) 
     155         CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lwxios ) 
     156         CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lwxios ) 
     157         CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb             , ldxios = lwxios ) 
     158         ! 
     159         CALL iom_rstput( kt, nitrst, numrow, 'un'     , un               , ldxios = lwxios )     ! now fields 
     160         CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn               , ldxios = lwxios ) 
     161         CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lwxios ) 
     162         CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lwxios ) 
     163         CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn             , ldxios = lwxios ) 
     164         CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop             , ldxios = lwxios ) 
     165         ! 
     166         IF( ln_iscpl ) THEN          ! extra variable needed for the ice sheet coupling 
     167            CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask  , ldxios = lwxios )    ! need to extrapolate T/S 
     168            CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask  , ldxios = lwxios )    ! need to correct barotropic velocity 
     169            CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask  , ldxios = lwxios )    ! need to correct barotropic velocity 
     170            CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask , ldxios = lwxios )    ! need to correct barotropic velocity 
     171            CALL iom_rstput( kt, nitrst, numrow, 'e3t_n'  , e3t_n  , ldxios = lwxios )    ! need to compute temperature correction 
     172            CALL iom_rstput( kt, nitrst, numrow, 'e3u_n'  , e3u_n  , ldxios = lwxios )    ! need to compute bt conservation 
     173            CALL iom_rstput( kt, nitrst, numrow, 'e3v_n'  , e3v_n  , ldxios = lwxios )    ! need to compute bt conservation 
     174            CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n, ldxios = lwxios )    ! need to compute extrapolation if vvl 
     175         ENDIF 
     176      ENDIF 
     177      ! 
     178      IF( ln_diurnal )   CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst, ldxios = lwxios )   
     179      IF( lwxios     )   CALL iom_swap( cxios_context ) 
    177180      IF( kt == nitrst ) THEN 
    178          IF(.NOT.lwxios) THEN 
    179             CALL iom_close( numrow )     ! close the restart file (only at last time step) 
    180          ELSE 
    181             CALL iom_context_finalize(      cwxios_context          ) 
     181         IF( lwxios ) THEN   ;   CALL iom_context_finalize( cwxios_context ) 
     182         ELSE                ;   CALL iom_close( numrow )     ! close the restart file (only at last time step) 
    182183         ENDIF 
    183184!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE. 
    184185!!gm  not sure what to do here   ===>>>  ask to Sebastian 
    185186         lrst_oce = .FALSE. 
    186             IF( ln_rst_list ) THEN 
    187                nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 
    188                nitrst = nstocklist( nrst_lst ) 
    189             ENDIF 
     187         IF( ln_rst_list ) THEN 
     188            nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 
     189            nitrst = nstocklist( nrst_lst ) 
     190         ENDIF 
    190191      ENDIF 
    191192      ! 
    … …  
    202203      !!                the file has already been opened 
    203204      !!---------------------------------------------------------------------- 
    204       INTEGER        ::   jlibalt = jprstlib 
    205       LOGICAL        ::   llok 
    206       CHARACTER(lc)  ::   clpath   ! full path to ocean output restart file 
     205      INTEGER       ::   jlibalt = jprstlib 
     206      LOGICAL       ::   llok 
     207      CHARACTER(lc) ::   clpath   ! full path to ocean output restart file 
    207208      !!---------------------------------------------------------------------- 
    208209      ! 
    … …  
    238239         ENDIF  
    239240      ENDIF 
    240  
     241      ! 
    241242   END SUBROUTINE rst_read_open 
    242243 
    … …  
    254255      REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d 
    255256      !!---------------------------------------------------------------------- 
    256  
     257      ! 
    257258      CALL rst_read_open           ! open restart for reading (if not already opened) 
    258259 
    … …  
    260261      IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN 
    261262         CALL iom_get( numror, 'rdt', zrdt, ldxios = lrxios ) 
    262          IF( zrdt /= rdt )   neuler = 0 
     263         IF( zrdt /= rn_Dt ) THEN 
     264            IF(lwp) WRITE( numout,*) 
     265            IF(lwp) WRITE( numout,*) 'rst_read:  rdt not equal to the read one' 
     266            IF(lwp) WRITE( numout,*) 
     267            IF(lwp) WRITE( numout,*) '      ==>>>   forced euler first time-step' 
     268            l_1st_euler =  .TRUE. 
     269         ENDIF 
    263270      ENDIF 
    264271 
    … …  
    266273      IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios )  
    267274      IF ( ln_diurnal_only ) THEN  
    268          IF(lwp) WRITE( numout, * ) & 
    269          &   "rst_read:- ln_diurnal_only set, setting rhop=rau0"  
    270          rhop = rau0 
     275         IF(lwp) WRITE( numout,*) 'rst_read: ln_diurnal_only set, setting rhop=rho0' 
     276         rhop = rho0 
    271277         CALL iom_get( numror, jpdom_autoglo, 'tn'     , w3d, ldxios = lrxios )  
    272278         tsn(:,:,1,jp_tem) = w3d(:,:,1) 
    … …  
    274280      ENDIF   
    275281       
    276       IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
     282      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0  .AND. .NOT.l_1st_euler ) THEN 
    277283         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub, ldxios = lrxios                )   ! before fields 
    278284         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb, ldxios = lrxios                ) 
    … …  
    281287         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb, ldxios = lrxios              ) 
    282288      ELSE 
    283          neuler = 0 
     289         l_1st_euler =  .TRUE.      ! before field not found, forced euler 1st time-step 
    284290      ENDIF 
    285291      ! 
    … …  
    295301      ENDIF 
    296302      ! 
    297       IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0) 
    298          tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values 
    299          ub   (:,:,:)   = un   (:,:,:) 
    300          vb   (:,:,:)   = vn   (:,:,:) 
    301          sshb (:,:)     = sshn (:,:) 
    302          ! 
    303          IF( .NOT.ln_linssh ) THEN 
    304             DO jk = 1, jpk 
    305                e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    306             END DO 
    307          ENDIF 
    308          ! 
     303      IF( l_1st_euler ) THEN              ! Euler restart 
     304         tsb (:,:,:,:) = tsn (:,:,:,:)          ! all before fields set to now values 
     305         ub  (:,:,:)   = un  (:,:,:) 
     306         vb  (:,:,:)   = vn  (:,:,:) 
     307         sshb(:,:)     = sshn(:,:) 
     308         IF( .NOT.ln_linssh )   e3t_b(:,:,:) = e3t_n(:,:,:) 
    309309      ENDIF 
    310310      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/divhor.F90

    r9598 r9939  
    6363      ! 
    6464      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    65       REAL(wp) ::   zraur, zdep   ! local scalars 
     65      REAL(wp) ::   zdep          ! local scalars 
    6666      !!---------------------------------------------------------------------- 
    6767      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynnxt.F90

    r9598 r9939  
    6464CONTAINS 
    6565 
    66    SUBROUTINE dyn_nxt ( kt ) 
     66   SUBROUTINE dyn_nxt( kt ) 
    6767      !!---------------------------------------------------------------------- 
    6868      !!                  ***  ROUTINE dyn_nxt  *** 
    … …  
    8383      !!              * Apply the time filter applied and swap of the dynamics 
    8484      !!             arrays to start the next time step: 
    85       !!                (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ] 
     85      !!                (ub,vb) = (un,vn) + rn_atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ] 
    8686      !!                (un,vn) = (ua,va). 
    8787      !!             Note that with flux form advection and non linear free surface, 
    … …  
    9292      !!               un,vn   now horizontal velocity of next time-step 
    9393      !!---------------------------------------------------------------------- 
    94       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     94      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    9595      ! 
    9696      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    9797      INTEGER  ::   ikt          ! local integers 
    98       REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zcoef    ! local scalars 
    99       REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      - 
     98      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zcoef   ! local scalars 
     99      REAL(wp) ::   zve3a, zve3n, zve3b, zvf          !   -      - 
    100100      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve 
    101101      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3u_f, ze3v_f, zua, zva  
    … …  
    132132            ! so that asselin contribution is removed at the same time  
    133133            DO jk = 1, jpkm1 
    134                un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:) + un_b(:,:) )*umask(:,:,jk) 
    135                vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:) + vn_b(:,:) )*vmask(:,:,jk) 
     134               un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:) + un_b(:,:) ) * umask(:,:,jk) 
     135               vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:) + vn_b(:,:) ) * vmask(:,:,jk) 
    136136            END DO   
    137137         ENDIF 
    … …  
    152152!!$   Do we need a call to bdy_vol here?? 
    153153      ! 
    154       IF( l_trddyn ) THEN             ! prepare the atf trend computation + some diagnostics 
    155          z1_2dt = 1._wp / (2. * rdt)        ! Euler or leap-frog time step  
    156          IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1._wp / rdt 
    157          ! 
    158          !                                  ! Kinetic energy and Conversion 
    159          IF( ln_KE_trd  )   CALL trd_dyn( ua, va, jpdyn_ken, kt ) 
    160          ! 
    161          IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends 
    162             zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 
    163             zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 
    164             CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter 
     154      IF( l_trddyn ) THEN             !* prepare the atf trend computation + some diagnostics 
     155         IF( ln_KE_trd  )   CALL trd_dyn( ua, va, jpdyn_ken, kt )    ! Kinetic energy and Conversion 
     156         IF( ln_dyn_trd ) THEN                                       ! 3D output: total momentum trends 
     157            IF( ln_dynadv_vec ) THEN  
     158               zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * r1_Dt 
     159               zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * r1_Dt 
     160            ELSE 
     161               zua(:,:,:) = ( e3u_a(:,:,:)*ua(:,:,:) - e3u_b(:,:,:)*ub(:,:,:) ) / e3u_n(:,:,:) * r1_Dt 
     162               zva(:,:,:) = ( e3v_a(:,:,:)*va(:,:,:) - e3v_b(:,:,:)*vb(:,:,:) ) / e3v_n(:,:,:) * r1_Dt 
     163            ENDIF 
     164            CALL iom_put( "utrd_tot", zua )                          ! total momentum trends, except the asselin filter 
    165165            CALL iom_put( "vtrd_tot", zva ) 
    166166         ENDIF 
    167          ! 
    168          zua(:,:,:) = un(:,:,:)             ! save the now velocity before the asselin filter 
    169          zva(:,:,:) = vn(:,:,:)             ! (caution: there will be a shift by 1 timestep in the 
    170          !                                  !  computation of the asselin filter trends) 
     167         zua(:,:,:) = un(:,:,:)                    ! save the now velocity before the asselin filter 
     168         zva(:,:,:) = vn(:,:,:)                    ! (caution: the Asselin filter trends computation will be shifted by 1 timestep) 
    171169      ENDIF 
    172170 
    173171      ! Time filter and swap of dynamics arrays 
    174       ! ------------------------------------------ 
    175       IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap 
     172      ! --------------------------------------- 
     173      IF( l_1st_euler ) THEN        !==  Euler at 1st time-step  ==!   (swap only) 
    176174         DO jk = 1, jpkm1 
    177175            un(:,:,jk) = ua(:,:,jk)                         ! un <-- ua 
    178176            vn(:,:,jk) = va(:,:,jk) 
    179177         END DO 
    180          IF( .NOT.ln_linssh ) THEN                          ! e3._b <-- e3._n 
    181 !!gm BUG ????    I don't understand why it is not : e3._n <-- e3._a   
     178         IF( .NOT.ln_linssh ) THEN                          ! e3._n <-- e3._a 
    182179            DO jk = 1, jpkm1 
    183 !               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    184 !               e3u_b(:,:,jk) = e3u_n(:,:,jk) 
    185 !               e3v_b(:,:,jk) = e3v_n(:,:,jk) 
    186                ! 
    187180               e3t_n(:,:,jk) = e3t_a(:,:,jk) 
    188181               e3u_n(:,:,jk) = e3u_a(:,:,jk) 
    189182               e3v_n(:,:,jk) = e3v_a(:,:,jk) 
    190183            END DO 
    191 !!gm BUG end 
    192          ENDIF 
    193                                                             !  
    194           
    195       ELSE                                             !* Leap-Frog : Asselin filter and swap 
     184         ENDIF 
     185         ! 
     186      ELSE                          !==  Leap-Frog  ==!   (Asselin filter and swap) 
     187         ! 
    196188         !                                ! =============! 
    197189         IF( ln_linssh ) THEN             ! Fixed volume ! 
    … …  
    200192               DO jj = 1, jpj 
    201193                  DO ji = 1, jpi     
    202                      zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) ) 
    203                      zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) ) 
     194                     zuf = un(ji,jj,jk) + rn_atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) ) 
     195                     zvf = vn(ji,jj,jk) + rn_atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) ) 
    204196                     ! 
    205197                     ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
    … …  
    213205         ELSE                             ! Variable volume ! 
    214206            !                             ! ================! 
    215             ! Before scale factor at t-points 
    216             ! (used as a now filtered scale factor until the swap) 
    217             ! ---------------------------------------------------- 
     207            ! Before scale factor at t-points   (used as a now filtered scale factor until the swap) 
    218208            DO jk = 1, jpkm1 
    219                e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 
     209               e3t_b(:,:,jk) = e3t_n(:,:,jk) + rn_atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 
    220210            END DO 
    221211            ! Add volume filter correction: compatibility with tracer advection scheme 
    222             ! => time filter + conservation correction (only at the first level) 
    223             zcoef = atfp * rdt * r1_rau0 
     212            !    => time filter + conservation correction (only at the first level) 
     213            zcoef = rn_atfp * rn_Dt * r1_rho0 
    224214 
    225215            e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 
    … …  
    232222                           IF( jk <=  nk_rnf(ji,jj)  ) THEN 
    233223                               e3t_b(ji,jj,jk) =   e3t_b(ji,jj,jk) - zcoef *  ( - rnf_b(ji,jj) + rnf(ji,jj) ) & 
    234                                       &          * ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) ) * tmask(ji,jj,jk) 
     224                                  &              * ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) ) * tmask(ji,jj,jk) 
    235225                           ENDIF 
    236                         ENDDO 
    237                      ENDDO 
    238                   ENDDO 
     226                        END DO 
     227                     END DO 
     228                  END DO 
    239229               ELSE 
    240230                  e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef *  ( -rnf_b(:,:) + rnf(:,:))*tmask(:,:,1) 
    241231               ENDIF 
    242             END IF 
     232            ENDIF 
    243233 
    244234            IF ( ln_isf ) THEN   ! if ice shelf melting 
    … …  
    253243                  END DO 
    254244               END DO 
    255             END IF 
     245            ENDIF 
    256246            ! 
    257247            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity 
    … …  
    262252                  DO jj = 1, jpj 
    263253                     DO ji = 1, jpi 
    264                         zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) ) 
    265                         zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) ) 
     254                        zuf = un(ji,jj,jk) + rn_atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) ) 
     255                        zvf = vn(ji,jj,jk) + rn_atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) ) 
    266256                        ! 
    267257                        ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
    … …  
    289279                        zve3b = e3v_b(ji,jj,jk) * vb(ji,jj,jk) 
    290280                        ! 
    291                         zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk) 
    292                         zvf = ( zve3n + atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk) 
     281                        zuf = ( zue3n + rn_atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk) 
     282                        zvf = ( zve3n + rn_atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk) 
    293283                        ! 
    294284                        ub(ji,jj,jk) = zuf                     ! ub <-- filtered velocity 
    … …  
    322312         ENDIF 
    323313         ! 
    324       ENDIF ! neuler =/0 
     314      ENDIF    ! end Leap-Frog time stepping 
    325315      ! 
    326316      ! Set "now" and "before" barotropic velocities for next time step: 
    327       ! JC: Would be more clever to swap variables than to make a full vertical 
    328       ! integration 
     317      ! JC: Would be more clever to swap variables than to make a full vertical integration 
    329318      ! 
    330319      ! 
    … …  
    360349      ENDIF 
    361350      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum 
    362          zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 
    363          zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 
     351         zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * r1_Dt 
     352         zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * r1_Dt 
    364353         CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 
    365354      ENDIF 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynspg.F90

    r9598 r9939  
    6666      !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied  
    6767      !!             as the gradient of the inverse barometer ssh: 
    68       !!                apgu = - 1/rau0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb] 
    69       !!                apgv = - 1/rau0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb] 
     68      !!                apgu = - 1/rho0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb] 
     69      !!                apgv = - 1/rho0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb] 
    7070      !!             Note that as all external forcing a time averaging over a two rdt 
    7171      !!             period is used to prevent the divergence of odd and even time step. 
    … …  
    7474      ! 
    7575      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
    76       REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r, zld   ! local scalars 
     76      REAL(wp) ::   zg_2, zintp, zg_rho0, zld   ! local scalars 
    7777      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zpice 
    7878      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
    … …  
    110110         ENDIF 
    111111         ! 
    112          !                                    !==  tide potential forcing term  ==! 
    113          IF( .NOT.ln_dynspg_ts .AND. ( ln_tide_pot .AND. ln_tide )  ) THEN   ! N.B. added directly at sub-time-step in ts-case 
    114             ! 
    115             CALL upd_tide( kt )                      ! update tide potential 
    116             ! 
    117             DO jj = 2, jpjm1                         ! add tide potential forcing 
    118                DO ji = fs_2, fs_jpim1   ! vector opt. 
    119                   spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
    120                   spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
    121                END DO  
    122             END DO 
    123             ! 
    124             IF (ln_scal_load) THEN 
    125                zld = rn_scal_load * grav 
    126                DO jj = 2, jpjm1                    ! add scalar approximation for load potential 
    127                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    128                      spgu(ji,jj) = spgu(ji,jj) + zld * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 
    129                      spgv(ji,jj) = spgv(ji,jj) + zld * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 
    130                   END DO  
    131                END DO 
     112         IF( .NOT.ln_dynspg_ts ) THEN   
     113            !                                    !==  tide potential forcing term  ==! 
     114            IF( ln_tide_pot .AND. ln_tide ) THEN      ! N.B. added directly at sub-time-step in ts-case 
     115               ! 
     116               CALL upd_tide( kt )                    ! update tide potential 
     117               ! 
     118               IF ( ln_scal_load ) THEN               
     119                  zld = rn_load * grav 
     120                  DO jj = 2, jpjm1                    ! add tide potential + scalar approximation of load potential 
     121                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     122                        spgu(ji,jj) = spgu(ji,jj) + (  grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) )  & 
     123                           &                         + zld  * ( sshn     (ji+1,jj) - sshn     (ji,jj) )  ) * r1_e1u(ji,jj) 
     124                        spgv(ji,jj) = spgv(ji,jj) + (  grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) )  & 
     125                           &                         + zld  * ( sshn     (ji,jj+1) - sshn     (ji,jj) )  ) * r1_e2v(ji,jj) 
     126                     END DO  
     127                  END DO 
     128               ELSE 
     129                  DO jj = 2, jpjm1                    ! add tide potential 
     130                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     131                        spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
     132                        spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
     133                     END DO  
     134                  END DO 
     135               ENDIF 
    132136            ENDIF 
    133137         ENDIF 
    … …  
    136140            ALLOCATE( zpice(jpi,jpj) ) 
    137141            zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 
    138             zgrau0r     = - grav * r1_rau0 
    139             zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r 
     142            zg_rho0     = - grav * r1_rho0 
     143            zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zg_rho0 
    140144            DO jj = 2, jpjm1 
    141145               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    191195      NAMELIST/namdyn_spg/ ln_dynspg_exp       , ln_dynspg_ts,   & 
    192196      &                    ln_bt_fw, ln_bt_av  , ln_bt_auto  ,   & 
    193       &                    nn_baro , rn_bt_cmax, nn_bt_flt, rn_bt_alpha 
     197      &                    nn_e    , rn_bt_cmax, nn_bt_flt, rn_bt_alpha 
    194198      !!---------------------------------------------------------------------- 
    195199      ! 
    … …  
    227231         WRITE(numout,*) 
    228232         IF( nspg == np_EXP )   WRITE(numout,*) '   ==>>>   explicit free surface' 
    229          IF( nspg == np_TS  )   WRITE(numout,*) '   ==>>>   free surface with time splitting scheme' 
     233         IF( nspg == np_TS  )   WRITE(numout,*) '   ==>>>   split-explicit free surface' 
    230234         IF( nspg == np_NO  )   WRITE(numout,*) '   ==>>>   No surface surface pressure gradient trend in momentum Eqs.' 
    231235      ENDIF 
    232236      ! 
    233237      IF( nspg == np_TS ) THEN   ! split-explicit scheme initialisation 
    234          CALL dyn_spg_ts_init          ! do it first: set nn_baro used to allocate some arrays later on 
     238         CALL dyn_spg_ts_init          ! do it first: set nn_e used to allocate some arrays later on 
    235239      ENDIF 
    236240      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynspg_exp.F90

    r9598 r9939  
    4949      !!              momentum trend the surface pressure gradient : 
    5050      !!                      (ua,va) = (ua,va) + (spgu,spgv) 
    51       !!              where spgu = -1/rau0 d/dx(ps) = -g/e1u di( sshn ) 
    52       !!                    spgv = -1/rau0 d/dy(ps) = -g/e2v dj( sshn ) 
     51      !!              where spgu = -1/rho0 d/dx(ps) = -g/e1u di( sshn ) 
     52      !!                    spgv = -1/rho0 d/dy(ps) = -g/e2v dj( sshn ) 
    5353      !! 
    5454      !! ** Action :   (ua,va)   trend of horizontal velocity increased by  

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynspg_ts.F90

    r9598 r9939  
    11MODULE dynspg_ts 
    2  
    3    !! Includes ROMS wd scheme with diagnostic outputs ; un and ua updates are commented out !  
    4  
    52   !!====================================================================== 
    63   !!                   ***  MODULE  dynspg_ts  *** 
    … …  
    3532   USE sbcisf          ! ice shelf variable (fwfisf) 
    3633   USE sbcapr          ! surface boundary condition: atmospheric pressure 
    37    USE dynadv    , ONLY: ln_dynadv_vec 
     34   USE dynadv   , ONLY : ln_dynadv_vec 
    3835   USE dynvor          ! vortivity scheme indicators 
    3936   USE phycst          ! physical constants 
    … …  
    7269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv , vn_adv   !: Advection vel. at "now" barocl. step 
    7370   ! 
    74    INTEGER, SAVE :: icycle      ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro 
    75    REAL(wp),SAVE :: rdtbt       ! Barotropic time step 
     71   INTEGER, SAVE :: icycle      ! Number of barotropic sub-steps for each internal step nn_e <= 2.5*nn_e 
     72   REAL(wp),SAVE :: rDt_e       ! external mode time-step 
    7673   ! 
    7774   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   wgtbtp1, wgtbtp2   ! 1st & 2nd weights used in time filtering of barotropic fields 
    … …  
    8481   REAL(wp) ::   r1_4  = 0.25_wp          ! 
    8582   REAL(wp) ::   r1_2  = 0.5_wp           ! 
    86  
     83    
    8784   !! * Substitutions 
    8885#  include "vectopt_loop_substitute.h90" 
    … …  
    10299      ierr(:) = 0 
    103100      ! 
    104       ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT=ierr(1) ) 
     101      ALLOCATE( wgtbtp1(3*nn_e), wgtbtp2(3*nn_e), zwz(jpi,jpj), STAT=ierr(1) ) 
    105102      ! 
    106103      IF( ln_dynvor_een .OR. ln_dynvor_eeT )   & 
    … …  
    151148      INTEGER  ::   ikbu, iktu, noffset   ! local integers 
    152149      INTEGER  ::   ikbv, iktv            !   -      - 
    153       REAL(wp) ::   r1_2dt_b, z2dt_bf               ! local scalars 
     150      INTEGER  ::   iwdg, jwdg, kwdg      ! short-hand values for the indices of the output point 
    154151      REAL(wp) ::   zx1, zx2, zu_spg, zhura, z1_hu  !   -      - 
    155152      REAL(wp) ::   zy1, zy2, zv_spg, zhvra, z1_hv  !   -      - 
    156153      REAL(wp) ::   za0, za1, za2, za3              !   -      - 
    157154      REAL(wp) ::   zmdi, zztmp            , z1_ht  !   -      - 
     155      REAL(wp) ::   zwdramp                         ! local scalar - only used if ln_wd_dl = .True.  
     156      REAL(wp) ::   zload       
    158157      REAL(wp), DIMENSION(jpi,jpj) :: zsshp2_e, zhf 
    159158      REAL(wp), DIMENSION(jpi,jpj) :: zwx, zu_trd, zu_frc, zssh_frc 
    … …  
    163162      REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v   ! top/bottom stress at u- & v-points 
    164163      ! 
    165       REAL(wp) ::   zwdramp                     ! local scalar - only used if ln_wd_dl = .True.  
    166  
    167       INTEGER  :: iwdg, jwdg, kwdg   ! short-hand values for the indices of the output point 
     164 
    168165 
    169166      REAL(wp) ::   zepsilon, zgamma            !   -      - 
    … …  
    181178      zwdramp = r_rn_wdmin1               ! simplest ramp  
    182179!     zwdramp = 1._wp / (rn_wdmin2 - rn_wdmin1) ! more general ramp 
    183       !                                         ! reciprocal of baroclinic time step  
    184       IF( kt == nit000 .AND. neuler == 0 ) THEN   ;   z2dt_bf =          rdt 
    185       ELSE                                        ;   z2dt_bf = 2.0_wp * rdt 
    186       ENDIF 
    187       r1_2dt_b = 1.0_wp / z2dt_bf  
    188180      ! 
    189181      ll_init     = ln_bt_av                    ! if no time averaging, then no specific restart  
    190182      ll_fw_start = .FALSE. 
    191183      !                                         ! time offset in steps for bdy data update 
    192       IF( .NOT.ln_bt_fw ) THEN   ;   noffset = - nn_baro 
     184      IF( .NOT.ln_bt_fw ) THEN   ;   noffset = - nn_e 
    193185      ELSE                       ;   noffset =   0  
    194186      ENDIF 
    195187      ! 
    196       IF( kt == nit000 ) THEN                   !* initialisation 
     188      IF( kt == nit000 ) THEN                   !* initialisation 1st time-step 
    197189         ! 
    198190         IF(lwp) WRITE(numout,*) 
    … …  
    201193         IF(lwp) WRITE(numout,*) 
    202194         ! 
    203          IF( neuler == 0 )   ll_init=.TRUE. 
    204          ! 
    205          IF( ln_bt_fw .OR. neuler == 0 ) THEN 
     195         IF( l_1st_euler )   ll_init = .TRUE. 
     196         ! 
     197         IF( ln_bt_fw .OR. l_1st_euler ) THEN 
    206198            ll_fw_start =.TRUE. 
    207199            noffset     = 0 
    … …  
    212204         ! Set averaging weights and cycle length: 
    213205         CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 
     206         ! 
     207      ELSEIF( kt == nit000 + 1 ) THEN           !* initialisation 2nd time-step 
     208         ! 
     209         IF( .NOT.ln_bt_fw .AND. l_1st_euler ) THEN 
     210            ll_fw_start = .FALSE. 
     211            CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 
     212         ENDIF 
    214213         ! 
    215214      ENDIF 
    … …  
    340339         END SELECT 
    341340      ENDIF 
    342       ! 
    343       ! If forward start at previous time step, and centered integration,  
    344       ! then update averaging weights: 
    345       IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN 
    346          ll_fw_start=.FALSE. 
    347          CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 
    348       ENDIF 
    349                            
     341      !                           
    350342      ! ----------------------------------------------------------------------------- 
    351343      !  Phase 1 : Coupling between general trend and barotropic estimates (1st step) 
    … …  
    461453                     zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) & 
    462454                                 &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) ) 
    463                      zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp) 
     455                     zcpx(ji,jj) = MAX(  0._wp , MIN( zcpx(ji,jj) , 1._wp )  ) 
    464456                  ELSE 
    465457                     zcpx(ji,jj) = 0._wp 
    … …  
    538530      ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 
    539531      IF( ln_wd_il ) THEN 
    540          zztmp = -1._wp / rdtbt 
     532         zztmp = -1._wp / rDt_e 
    541533         DO jj = 2, jpjm1 
    542534            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    589581         DO jj = 2, jpjm1 
    590582            DO ji = fs_2, fs_jpim1   ! vector opt. 
    591                zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj) 
    592                zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj) 
     583               zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu_n(ji,jj) 
     584               zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rho0 * vtau(ji,jj) * r1_hv_n(ji,jj) 
    593585            END DO 
    594586         END DO 
    595587      ELSE 
    596          zztmp = r1_rau0 * r1_2 
     588         zztmp = r1_rho0 * r1_2 
    597589         DO jj = 2, jpjm1 
    598590            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    631623      !                                         ! Surface net water flux and rivers 
    632624      IF (ln_bt_fw) THEN 
    633          zssh_frc(:,:) = r1_rau0 * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 
     625         zssh_frc(:,:) = r1_rho0 * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 
    634626      ELSE 
    635          zztmp = r1_rau0 * r1_2 
     627         zztmp = r1_rho0 * r1_2 
    636628         zssh_frc(:,:) = zztmp * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   & 
    637629                &                 + fwfisf(:,:) + fwfisf_b(:,:)                     ) 
    … …  
    820812         ENDIF 
    821813#endif 
    822          IF( ln_wd_il )   CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rdtbt) 
     814         IF( ln_wd_il )   CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rDt_e) 
    823815 
    824816         IF ( ln_wd_dl ) THEN  
    … …  
    866858            END DO 
    867859         END DO 
    868          ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:) 
     860         ssha_e(:,:) = (  sshn_e(:,:) - rDt_e * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:) 
    869861          
    870862         CALL lbc_lnk( ssha_e, 'T',  1._wp ) 
    … …  
    10701062         ENDIF  
    10711063         ! 
    1072          ! Surface pressure trend: 
     1064         ! Surface pressure trend 
     1065         IF( ln_scal_load ) THEN   ;   zload = 1._wp 
     1066         ELSE                      ;   zload = 1._wp - rn_load 
     1067         ENDIF 
    10731068         IF( ln_wd_il ) THEN 
    10741069           DO jj = 2, jpjm1 
    … …  
    10771072                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 
    10781073                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 
    1079                  zwx(ji,jj) = (1._wp - rn_scal_load) * zu_spg * zcpx(ji,jj)  
    1080                  zwy(ji,jj) = (1._wp - rn_scal_load) * zv_spg * zcpy(ji,jj) 
     1074                 zwx(ji,jj) = zload * zu_spg * zcpx(ji,jj)  
     1075                 zwy(ji,jj) = zload * zv_spg * zcpy(ji,jj) 
    10811076              END DO 
    10821077           END DO 
    … …  
    10871082                 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 
    10881083                 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 
    1089                  zwx(ji,jj) = (1._wp - rn_scal_load) * zu_spg 
    1090                  zwy(ji,jj) = (1._wp - rn_scal_load) * zv_spg 
     1084                 zwx(ji,jj) = zload * zu_spg 
     1085                 zwy(ji,jj) = zload * zv_spg 
    10911086              END DO 
    10921087           END DO 
    … …  
    10991094               DO ji = fs_2, fs_jpim1   ! vector opt. 
    11001095                  ua_e(ji,jj) = (                                 un_e(ji,jj)   &  
    1101                             &     + rdtbt * (                      zwx(ji,jj)   & 
     1096                            &     + rDt_e * (                      zwx(ji,jj)   & 
    11021097                            &                                 + zu_trd(ji,jj)   & 
    11031098                            &                                 + zu_frc(ji,jj) ) &  
    … …  
    11051100 
    11061101                  va_e(ji,jj) = (                                 vn_e(ji,jj)   & 
    1107                             &     + rdtbt * (                      zwy(ji,jj)   & 
     1102                            &     + rDt_e * (                      zwy(ji,jj)   & 
    11081103                            &                                 + zv_trd(ji,jj)   & 
    11091104                            &                                 + zv_frc(ji,jj) ) & 
    … …  
    11121107!jth implicit bottom friction: 
    11131108                  IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 
    1114                      ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rdtbt * zCdU_u(ji,jj) * hur_e(ji,jj)) 
    1115                      va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rdtbt * zCdU_v(ji,jj) * hvr_e(ji,jj)) 
     1109                     ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj)) 
     1110                     va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj)) 
    11161111                  ENDIF 
    11171112 
    … …  
    11301125 
    11311126                  ua_e(ji,jj) = (                hu_e(ji,jj)  *   un_e(ji,jj)   &  
    1132                             &     + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)   &  
     1127                            &     + rDt_e * ( zhust_e(ji,jj)  *    zwx(ji,jj)   &  
    11331128                            &               + zhup2_e(ji,jj)  * zu_trd(ji,jj)   & 
    11341129                            &               +    hu_n(ji,jj)  * zu_frc(ji,jj) ) & 
    … …  
    11361131 
    11371132                  va_e(ji,jj) = (                hv_e(ji,jj)  *   vn_e(ji,jj)   & 
    1138                             &     + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)   & 
     1133                            &     + rDt_e * ( zhvst_e(ji,jj)  *    zwy(ji,jj)   & 
    11391134                            &               + zhvp2_e(ji,jj)  * zv_trd(ji,jj)   & 
    11401135                            &               +    hv_n(ji,jj)  * zv_frc(ji,jj) ) & 
    … …  
    12031198         zwx(:,:) = un_adv(:,:) 
    12041199         zwy(:,:) = vn_adv(:,:) 
    1205          IF( .NOT.( kt == nit000 .AND. neuler==0 ) ) THEN 
    1206             un_adv(:,:) = r1_2 * ( ub2_b(:,:) + zwx(:,:) - atfp * un_bf(:,:) ) 
    1207             vn_adv(:,:) = r1_2 * ( vb2_b(:,:) + zwy(:,:) - atfp * vn_bf(:,:) ) 
     1200         IF( .NOT.l_1st_euler ) THEN 
     1201            un_adv(:,:) = r1_2 * ( ub2_b(:,:) + zwx(:,:) - rn_atfp * un_bf(:,:) ) 
     1202            vn_adv(:,:) = r1_2 * ( vb2_b(:,:) + zwy(:,:) - rn_atfp * vn_bf(:,:) ) 
    12081203            ! 
    12091204            ! Update corrective fluxes for next time step: 
    1210             un_bf(:,:)  = atfp * un_bf(:,:) + (zwx(:,:) - ub2_b(:,:)) 
    1211             vn_bf(:,:)  = atfp * vn_bf(:,:) + (zwy(:,:) - vb2_b(:,:)) 
     1205            un_bf(:,:)  = rn_atfp * un_bf(:,:) + (zwx(:,:) - ub2_b(:,:)) 
     1206            vn_bf(:,:)  = rn_atfp * vn_bf(:,:) + (zwy(:,:) - vb2_b(:,:)) 
    12121207         ELSE 
    12131208            un_bf(:,:) = 0._wp 
    … …  
    12241219      IF( ln_dynadv_vec .OR. ln_linssh ) THEN 
    12251220         DO jk=1,jpkm1 
    1226             ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * r1_2dt_b 
    1227             va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * r1_2dt_b 
     1221            ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * r1_Dt 
     1222            va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * r1_Dt 
    12281223         END DO 
    12291224      ELSE 
    … …  
    12311226         DO jj = 1, jpjm1 
    12321227            DO ji = 1, jpim1      ! NO Vector Opt. 
    1233                zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) & 
    1234                   &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)      & 
    1235                   &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 
    1236                zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) & 
    1237                   &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )      & 
    1238                   &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 
     1228               zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) * (   e1e2t(ji  ,jj) * ssha(ji  ,jj)   & 
     1229                  &                                                          + e1e2t(ji+1,jj) * ssha(ji+1,jj)   ) 
     1230               zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) * (   e1e2t(ji,jj  ) * ssha(ji,jj  )   & 
     1231                  &                                                          + e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 
    12391232            END DO 
    12401233         END DO 
    … …  
    12421235         ! 
    12431236         DO jk=1,jpkm1 
    1244             ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * r1_2dt_b 
    1245             va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * r1_2dt_b 
     1237            ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * r1_Dt 
     1238            va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * r1_Dt 
    12461239         END DO 
    12471240         ! Save barotropic velocities not transport: 
    … …  
    13051298      !! ** Purpose : Set time-splitting weights for temporal averaging (or not) 
    13061299      !!---------------------------------------------------------------------- 
    1307       LOGICAL, INTENT(in) ::   ll_av      ! temporal averaging=.true. 
    1308       LOGICAL, INTENT(in) ::   ll_fw      ! forward time splitting =.true. 
    1309       INTEGER, INTENT(inout) :: jpit      ! cycle length     
    1310       REAL(wp), DIMENSION(3*nn_baro), INTENT(inout) ::   zwgt1, & ! Primary weights 
    1311                                                          zwgt2    ! Secondary weights 
    1312        
     1300      LOGICAL                       , INTENT(in   ) ::   ll_av          ! temporal averaging=.true. 
     1301      LOGICAL                       , INTENT(in   ) ::   ll_fw          ! forward time splitting =.true. 
     1302      INTEGER                       , INTENT(inout) ::   jpit           ! cycle length     
     1303      REAL(wp), DIMENSION(3*nn_e), INTENT(inout) ::   zwgt1, zwgt2   ! Primary & Secondary weights 
     1304      ! 
    13131305      INTEGER ::  jic, jn, ji                      ! temporary integers 
    13141306      REAL(wp) :: za1, za2 
    13151307      !!---------------------------------------------------------------------- 
    1316  
     1308      ! 
    13171309      zwgt1(:) = 0._wp 
    13181310      zwgt2(:) = 0._wp 
    1319  
     1311      ! 
    13201312      ! Set time index when averaged value is requested 
    1321       IF (ll_fw) THEN  
    1322          jic = nn_baro 
    1323       ELSE 
    1324          jic = 2 * nn_baro 
    1325       ENDIF 
    1326  
    1327       ! Set primary weights: 
    1328       IF (ll_av) THEN 
    1329            ! Define simple boxcar window for primary weights  
    1330            ! (width = nn_baro, centered around jic)      
     1313      IF ( ll_fw ) THEN   ;   jic =     nn_e 
     1314      ELSE                ;   jic = 2 * nn_e 
     1315      ENDIF 
     1316 
     1317      !                 !==  Set primary weights  ==! 
     1318      ! 
     1319      IF (ll_av) THEN         !* Define simple boxcar window for primary weights  
     1320         !                    !  (width = nn_e, centered around jic)      
    13311321         SELECT CASE ( nn_bt_flt ) 
    1332               CASE( 0 )  ! No averaging 
    1333                  zwgt1(jic) = 1._wp 
    1334                  jpit = jic 
    1335  
    1336               CASE( 1 )  ! Boxcar, width = nn_baro 
    1337                  DO jn = 1, 3*nn_baro 
    1338                     za1 = ABS(float(jn-jic))/float(nn_baro)  
    1339                     IF (za1 < 0.5_wp) THEN 
    1340                       zwgt1(jn) = 1._wp 
    1341                       jpit = jn 
    1342                     ENDIF 
    1343                  ENDDO 
    1344  
    1345               CASE( 2 )  ! Boxcar, width = 2 * nn_baro 
    1346                  DO jn = 1, 3*nn_baro 
    1347                     za1 = ABS(float(jn-jic))/float(nn_baro)  
    1348                     IF (za1 < 1._wp) THEN 
    1349                       zwgt1(jn) = 1._wp 
    1350                       jpit = jn 
    1351                     ENDIF 
    1352                  ENDDO 
    1353               CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt' ) 
     1322         CASE( 0 )  ! No averaging 
     1323            zwgt1(jic) = 1._wp 
     1324            jpit = jic 
     1325            ! 
     1326         CASE( 1 )  ! Boxcar, width = nn_e 
     1327            DO jn = 1, 3*nn_e 
     1328               za1 = ABS(float(jn-jic))/float(nn_e)  
     1329               IF ( za1 < 0.5_wp ) THEN 
     1330                  zwgt1(jn) = 1._wp 
     1331                  jpit = jn 
     1332               ENDIF 
     1333            END DO 
     1334            ! 
     1335         CASE( 2 )  ! Boxcar, width = 2 * nn_e 
     1336            DO jn = 1, 3*nn_e 
     1337               za1 = ABS(float(jn-jic))/float(nn_e)  
     1338                  IF ( za1 < 1._wp ) THEN 
     1339                     zwgt1(jn) = 1._wp 
     1340                     jpit = jn 
     1341                  ENDIF 
     1342               END DO 
     1343         CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt' ) 
    13541344         END SELECT 
    1355  
    1356       ELSE ! No time averaging 
     1345         ! 
     1346      ELSE                    !* No time averaging 
    13571347         zwgt1(jic) = 1._wp 
    13581348         jpit = jic 
    13591349      ENDIF 
    13601350     
    1361       ! Set secondary weights 
     1351      !                 !==  Set secondary weights  ==! 
     1352      ! 
    13621353      DO jn = 1, jpit 
    1363         DO ji = jn, jpit 
    1364              zwgt2(jn) = zwgt2(jn) + zwgt1(ji) 
    1365         END DO 
     1354         DO ji = jn, jpit 
     1355            zwgt2(jn) = zwgt2(jn) + zwgt1(ji) 
     1356         END DO 
    13661357      END DO 
    13671358 
    1368       ! Normalize weigths: 
    1369       za1 = 1._wp / SUM(zwgt1(1:jpit)) 
    1370       za2 = 1._wp / SUM(zwgt2(1:jpit)) 
     1359      !                 !==  Normalize weights  ==! 
     1360      ! 
     1361      za1 = 1._wp / SUM( zwgt1(1:jpit) ) 
     1362      za2 = 1._wp / SUM( zwgt2(1:jpit) ) 
    13711363      DO jn = 1, jpit 
    1372         zwgt1(jn) = zwgt1(jn) * za1 
    1373         zwgt2(jn) = zwgt2(jn) * za2 
     1364         zwgt1(jn) = zwgt1(jn) * za1 
     1365         zwgt2(jn) = zwgt2(jn) * za2 
    13741366      END DO 
    13751367      ! 
    … …  
    14771469 
    14781470      ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax 
    1479       IF( ln_bt_auto )   nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 
     1471      IF( ln_bt_auto )   nn_e = CEILING( rn_Dt / rn_bt_cmax * zcmax) 
    14801472       
    1481       rdtbt = rdt / REAL( nn_baro , wp ) 
    1482       zcmax = zcmax * rdtbt 
     1473      rDt_e = rn_Dt / REAL( nn_e , wp ) 
     1474      zcmax = zcmax * rDt_e 
    14831475      ! Print results 
    14841476      IF(lwp) WRITE(numout,*) 
    … …  
    14861478      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    14871479      IF( ln_bt_auto ) THEN 
    1488          IF(lwp) WRITE(numout,*) '     ln_ts_auto =.true. Automatically set nn_baro ' 
     1480         IF(lwp) WRITE(numout,*) '     ln_ts_auto =.true. Automatically set nn_e ' 
    14891481         IF(lwp) WRITE(numout,*) '     Max. courant number allowed: ', rn_bt_cmax 
    14901482      ELSE 
    1491          IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_baro in namelist   nn_baro = ', nn_baro 
     1483         IF(lwp) WRITE(numout,*) '     ln_ts_auto=.false.: Use nn_e in namelist   nn_e = ', nn_e 
    14921484      ENDIF 
    14931485 
    14941486      IF(ln_bt_av) THEN 
    1495          IF(lwp) WRITE(numout,*) '     ln_bt_av =.true.  ==> Time averaging over nn_baro time steps is on ' 
     1487         IF(lwp) WRITE(numout,*) '     ln_bt_av =.true.  ==> Time averaging over nn_e time steps is on ' 
    14961488      ELSE 
    14971489         IF(lwp) WRITE(numout,*) '     ln_bt_av =.false. => No time averaging of barotropic variables ' 
    … …  
    15131505      SELECT CASE ( nn_bt_flt ) 
    15141506         CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '           Dirac' 
    1515          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_baro' 
    1516          CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_baro'  
     1507         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = nn_e' 
     1508         CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '           Boxcar: width = 2*nn_e'  
    15171509         CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1, or 2' ) 
    15181510      END SELECT 
    15191511      ! 
    15201512      IF(lwp) WRITE(numout,*) ' ' 
    1521       IF(lwp) WRITE(numout,*) '     nn_baro = ', nn_baro 
    1522       IF(lwp) WRITE(numout,*) '     Barotropic time step [s] is :', rdtbt 
    1523       IF(lwp) WRITE(numout,*) '     Maximum Courant number is   :', zcmax 
     1513      IF(lwp) WRITE(numout,*) '     nn_e = ', nn_e 
     1514      IF(lwp) WRITE(numout,*) '     external mode time step is : rDt_e', rDt_e, ' [s]' 
     1515      IF(lwp) WRITE(numout,*) '     Maximum Courant number  is :      ', zcmax 
    15241516      ! 
    15251517      IF(lwp) WRITE(numout,*)    '     Time diffusion parameter rn_bt_alpha: ', rn_bt_alpha 
    … …  
    15321524      ENDIF 
    15331525      IF( zcmax>0.9_wp ) THEN 
    1534          CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_baro !' )           
     1526         CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_e !' )           
    15351527      ENDIF 
    15361528      ! 
    … …  
    15391531      ! 
    15401532      !                             ! read restart when needed 
     1533!!gm what's happen when starting with an euler time-step BUT not from rest ? 
     1534!!   this case correspond to a restart with only now time-step available... 
    15411535      CALL ts_rst( nit000, 'READ' ) 
    15421536      ! 
    … …  
    15481542         CALL iom_set_rstw_var_active('vn_bf') 
    15491543         ! 
    1550          IF (.NOT.ln_bt_av) THEN 
     1544         IF ( .NOT.ln_bt_av ) THEN 
    15511545            CALL iom_set_rstw_var_active('sshbb_e') 
    15521546            CALL iom_set_rstw_var_active('ubb_e') 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynzdf.F90

    r9598 r9939  
    1111   !!---------------------------------------------------------------------- 
    1212   !!   dyn_zdf       : compute the after velocity through implicit calculation of vertical mixing 
     13   !!       zdf_trd   : diagnose the zdf velocity trends and the KE dissipation trend  
     14!!gm                        ==>>> zdf_trd currently not used 
    1315   !!---------------------------------------------------------------------- 
    1416   USE oce            ! ocean dynamics and tracers variables 
    … …  
    2628   USE in_out_manager ! I/O manager 
    2729   USE lib_mpp        ! MPP library 
     30   USE iom             ! IOM library 
    2831   USE prtctl         ! Print control 
    2932   USE timing         ! Timing 
    … …  
    6770      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    6871      ! 
    69       INTEGER  ::   ji, jj, jk         ! dummy loop indices 
    70       INTEGER  ::   iku, ikv           ! local integers 
    71       REAL(wp) ::   zzwi, ze3ua, zdt   ! local scalars 
    72       REAL(wp) ::   zzws, ze3va        !   -      - 
    73       REAL(wp), DIMENSION(jpi,jpj,jpk)        ::  zwi, zwd, zws   ! 3D workspace  
    74       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv   !  -      - 
     72      INTEGER  ::   ji, jj, jk            ! dummy loop indices 
     73      INTEGER  ::   iku, ikv              ! local integers 
     74      REAL(wp) ::   zzwi, ze3ua, z2dt_2   ! local scalars 
     75      REAL(wp) ::   zzws, ze3va           !   -      - 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, zwd, zws   ! 3D workspace  
     77      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv    !  -      - 
    7578      !!--------------------------------------------------------------------- 
    7679      ! 
    … …  
    8689         ENDIF 
    8790      ENDIF 
    88       !                             !* set time step 
    89       IF( neuler == 0 .AND. kt == nit000     ) THEN   ;   r2dt =      rdt   ! = rdt (restart with Euler time stepping) 
    90       ELSEIF(               kt <= nit000 + 1 ) THEN   ;   r2dt = 2. * rdt   ! = 2 rdt (leapfrog) 
    91       ENDIF 
     91      ! 
     92      z2dt_2 = rDt * 0.5_wp        !* =rn_Dt except in 1st Euler time step where it is equal to rn_Dt/2 
     93      ! 
    9294      ! 
    9395      !                             !* explicit top/bottom drag case 
    … …  
    106108      IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity 
    107109         DO jk = 1, jpkm1 
    108             ua(:,:,jk) = ( ub(:,:,jk) + r2dt * ua(:,:,jk) ) * umask(:,:,jk) 
    109             va(:,:,jk) = ( vb(:,:,jk) + r2dt * va(:,:,jk) ) * vmask(:,:,jk) 
     110            ua(:,:,jk) = ( ub(:,:,jk) + rDt * ua(:,:,jk) ) * umask(:,:,jk) 
     111            va(:,:,jk) = ( vb(:,:,jk) + rDt * va(:,:,jk) ) * vmask(:,:,jk) 
    110112         END DO 
    111113      ELSE                                      ! applied on thickness weighted velocity 
    112114         DO jk = 1, jpkm1 
    113             ua(:,:,jk) = (         e3u_b(:,:,jk) * ub(:,:,jk)  & 
    114                &          + r2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk) 
    115             va(:,:,jk) = (         e3v_b(:,:,jk) * vb(:,:,jk)  & 
    116                &          + r2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk) 
     115            ua(:,:,jk) = ( e3u_b(:,:,jk)*ub(:,:,jk) + rDt * e3u_n(:,:,jk)*ua(:,:,jk) ) / e3u_a(:,:,jk) * umask(:,:,jk) 
     116            va(:,:,jk) = ( e3v_b(:,:,jk)*vb(:,:,jk) + rDt * e3v_n(:,:,jk)*va(:,:,jk) ) / e3v_a(:,:,jk) * vmask(:,:,jk) 
    117117         END DO 
    118118      ENDIF 
    … …  
    133133               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 
    134134               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) 
    135                ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua 
    136                va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va 
     135               ua(ji,jj,iku) = ua(ji,jj,iku) + z2dt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua 
     136               va(ji,jj,ikv) = va(ji,jj,ikv) + z2dt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va 
    137137            END DO 
    138138         END DO 
    … …  
    144144                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 
    145145                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) 
    146                   ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua 
    147                   va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va 
     146                  ua(ji,jj,iku) = ua(ji,jj,iku) + z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua 
     147                  va(ji,jj,ikv) = va(ji,jj,ikv) + z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va 
    148148               END DO 
    149149            END DO 
    … …  
    153153      !              !==  Vertical diffusion on u  ==! 
    154154      ! 
    155       !                    !* Matrix construction 
    156       zdt = r2dt * 0.5 
    157       SELECT CASE( nldf_dyn ) 
    158       CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu) 
     155      SELECT CASE( nldf_dyn )    !* Matrix construction 
     156      ! 
     157      CASE( np_lap_i )              ! rotated lateral mixing: add its vertical mixing (akzu) 
    159158         DO jk = 1, jpkm1 
    160159            DO jj = 2, jpjm1  
    161160               DO ji = fs_2, fs_jpim1   ! vector opt. 
    162161                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at T-point 
    163                   zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk ) + akzu(ji,jj,jk  ) )   & 
    164                      &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
    165                   zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   & 
    166                      &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 
     162                  zzwi = - rDt * ( 0.5 * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) + akzu(ji,jj,jk  ) )   & 
     163                     &            / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
     164                  zzws = - rDt * ( 0.5 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) + akzu(ji,jj,jk+1) )   & 
     165                     &            / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 
    167166                  zwi(ji,jj,jk) = zzwi 
    168167                  zws(ji,jj,jk) = zzws 
    … …  
    171170            END DO 
    172171         END DO 
    173       CASE DEFAULT               ! iso-level lateral mixing 
     172      CASE DEFAULT                  ! iso-level lateral mixing 
    174173         DO jk = 1, jpkm1 
    175174            DO jj = 2, jpjm1  
    176175               DO ji = fs_2, fs_jpim1   ! vector opt. 
    177176                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at T-point 
    178                   zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
    179                   zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 
     177                  zzwi = - z2dt_2 * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
     178                  zzws = - z2dt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 
    180179                  zwi(ji,jj,jk) = zzwi 
    181180                  zws(ji,jj,jk) = zzws 
    … …  
    186185      END SELECT 
    187186      ! 
    188       DO jj = 2, jpjm1     !* Surface boundary conditions 
    189          DO ji = fs_2, fs_jpim1   ! vector opt. 
     187      DO jj = 2, jpjm1           !* Surface boundary conditions 
     188         DO ji = fs_2, fs_jpim1     ! vector opt. 
    190189            zwi(ji,jj,1) = 0._wp 
    191190            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 
    … …  
    204203               iku = mbku(ji,jj)       ! ocean bottom level at u- and v-points 
    205204               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point 
    206                zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 
     205               zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 
    207206            END DO 
    208207         END DO 
    … …  
    213212                  iku = miku(ji,jj)       ! ocean top level at u- and v-points  
    214213                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point 
    215                   zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua 
     214                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua 
    216215               END DO 
    217216            END DO 
    … …  
    245244         DO ji = fs_2, fs_jpim1   ! vector opt. 
    246245            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1)  
    247             ua(ji,jj,1) = ua(ji,jj,1) + r2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    248                &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1)  
     246            ua(ji,jj,1) = ua(ji,jj,1) + z2dt_2 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( ze3ua * rho0 ) * umask(ji,jj,1) 
    249247         END DO 
    250248      END DO 
    … …  
    272270      !              !==  Vertical diffusion on v  ==! 
    273271      ! 
    274       !                       !* Matrix construction 
    275       zdt = r2dt * 0.5 
    276       SELECT CASE( nldf_dyn ) 
    277       CASE( np_lap_i )           ! rotated lateral mixing: add its vertical mixing (akzu) 
     272      !                       
     273      SELECT CASE( nldf_dyn )    !* Matrix construction 
     274      CASE( np_lap_i )              ! rotated lateral mixing: add its vertical mixing (akzu) 
    278275         DO jk = 1, jpkm1 
    279276            DO jj = 2, jpjm1    
    280277               DO ji = fs_2, fs_jpim1   ! vector opt. 
    281278                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at T-point 
    282                   zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk ) + akzv(ji,jj,jk  ) )   & 
    283                      &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
    284                   zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   & 
    285                      &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 
     279                  zzwi = - rDt * ( 0.5 * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) + akzv(ji,jj,jk  ) )   & 
     280                     &            / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
     281                  zzws = - rDt * ( 0.5 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) + akzv(ji,jj,jk+1) )   & 
     282                     &            / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 
    286283                  zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk  ) 
    287284                  zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) 
    … …  
    290287            END DO 
    291288         END DO 
    292       CASE DEFAULT               ! iso-level lateral mixing 
     289      CASE DEFAULT                  ! iso-level lateral mixing 
    293290         DO jk = 1, jpkm1 
    294291            DO jj = 2, jpjm1    
    295292               DO ji = fs_2, fs_jpim1   ! vector opt. 
    296293                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at T-point 
    297                   zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
    298                   zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 
     294                  zzwi = - z2dt_2 * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
     295                  zzws = - z2dt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 
    299296                  zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk  ) 
    300297                  zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) 
    … …  
    305302      END SELECT 
    306303      ! 
    307       DO jj = 2, jpjm1        !* Surface boundary conditions 
    308          DO ji = fs_2, fs_jpim1   ! vector opt. 
     304      DO jj = 2, jpjm1           !* Surface boundary conditions 
     305         DO ji = fs_2, fs_jpim1     ! vector opt. 
    309306            zwi(ji,jj,1) = 0._wp 
    310307            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 
    … …  
    322319               ikv = mbkv(ji,jj)       ! (deepest ocean u- and v-points) 
    323320               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point 
    324                zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va            
     321               zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - z2dt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va            
    325322            END DO 
    326323         END DO 
    … …  
    330327                  ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points) 
    331328                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point 
    332                   zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va 
     329                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va 
    333330               END DO 
    334331            END DO 
    … …  
    362359         DO ji = fs_2, fs_jpim1   ! vector opt.           
    363360            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1)  
    364             va(ji,jj,1) = va(ji,jj,1) + r2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    365                &                                      / ( ze3va * rau0 ) * vmask(ji,jj,1)  
     361            va(ji,jj,1) = va(ji,jj,1) + z2dt_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( ze3va * rho0 ) * vmask(ji,jj,1) 
    366362         END DO 
    367363      END DO 
    … …  
    387383      END DO 
    388384      ! 
    389       IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    390          ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:) 
    391          ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:) 
     385      IF( l_trddyn ) THEN                        ! save the vertical diffusive trends for further diagnostics 
     386         IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity 
     387            ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * r1_Dt - ztrdu(:,:,:) 
     388            ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * r1_Dt - ztrdv(:,:,:) 
     389         ELSE                                      ! applied on thickness weighted velocity 
     390            ztrdu(:,:,:) = ( e3u_a(:,:,:)*ua(:,:,:) - e3u_b(:,:,:)*ub(:,:,:) ) / e3u_n(:,:,:) * r1_Dt - ztrdu(:,:,:) 
     391            ztrdv(:,:,:) = ( e3v_a(:,:,:)*va(:,:,:) - e3v_b(:,:,:)*vb(:,:,:) ) / e3v_n(:,:,:) * r1_Dt - ztrdv(:,:,:) 
     392         ENDIF 
    392393         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 
    393394         DEALLOCATE( ztrdu, ztrdv )  
    … …  
    401402   END SUBROUTINE dyn_zdf 
    402403 
     404!!gm currently not used : just for memory to be able to add dissipation trend through vertical mixing 
     405 
     406   SUBROUTINE zdf_trd( ptrdu, ptrdv ,kt ) 
     407      !!---------------------------------------------------------------------- 
     408      !!                  ***  ROUTINE zdf_trd  *** 
     409      !! 
     410      !! ** Purpose :   compute the trend due to the vert. momentum diffusion 
     411      !!              together with the Leap-Frog time stepping using an  
     412      !!              implicit scheme. 
     413      !! 
     414      !! ** Method  :  - Leap-Frog time stepping on all trends but the vertical mixing 
     415      !!         ua =         ub + 2*dt *       ua             vector form or linear free surf. 
     416      !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise 
     417      !!               - update the after velocity with the implicit vertical mixing. 
     418      !!      This requires to solver the following system:  
     419      !!         ua = ua + 1/e3u_a dk+1[ mi(avm) / e3uw_a dk[ua] ] 
     420      !!      with the following surface/top/bottom boundary condition: 
     421      !!      surface: wind stress input (averaged over kt-1/2 & kt+1/2) 
     422      !!      top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfdrg.F90) 
     423      !! 
     424      !! ** Action :   (ua,va)   after velocity  
     425      !!--------------------------------------------------------------------- 
     426      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   ptrdu, ptrdv   ! 3D work arrays use for zdf trends diag 
     427      INTEGER , INTENT(in   )                         ::   kt             ! ocean time-step index 
     428      ! 
     429      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
     430      REAL(wp) ::   zzz              ! local scalar 
     431      REAL(wp) ::   zavmu, zavmum1   !   -      - 
     432      REAL(wp) ::   zavmv, zavmvm1   !   -      - 
     433      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   z2d    !  -      - 
     434      !!--------------------------------------------------------------------- 
     435      ! 
     436      CALL lbc_lnk_multi( ua, 'U', -1., va, 'V', -1. )   ! apply lateral boundary condition on (ua,va) 
     437      ! 
     438      ! 
     439      !                 !==  momentum trend due to vertical diffusion  ==! 
     440      ! 
     441      IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity 
     442         ptrdu(:,:,:) = (              ua(:,:,:) -              ub(:,:,:) )                * r1_Dt - ptrdu(:,:,:) 
     443         ptrdv(:,:,:) = (              va(:,:,:) -              vb(:,:,:) )                * r1_Dt - ptrdv(:,:,:) 
     444      ELSE                                      ! applied on thickness weighted velocity 
     445         ptrdu(:,:,:) = ( e3u_a(:,:,:)*ua(:,:,:) - e3u_b(:,:,:)*ub(:,:,:) ) / e3u_n(:,:,:) * r1_Dt - ptrdu(:,:,:) 
     446         ptrdv(:,:,:) = ( e3v_a(:,:,:)*va(:,:,:) - e3v_b(:,:,:)*vb(:,:,:) ) / e3v_n(:,:,:) * r1_Dt - ptrdv(:,:,:) 
     447      ENDIF 
     448      CALL trd_dyn( ptrdu, ptrdv, jpdyn_zdf, kt ) 
     449      ! 
     450      ! 
     451      !                 !==  KE dissipation trend due to vertical diffusion  ==! 
     452      ! 
     453      IF( iom_use( 'dispkevfo' ) ) THEN   ! ocean kinetic energy dissipation per unit area 
     454         !                                ! due to v friction (v=vertical)  
     455         !                                ! see NEMO_book appendix C, §C.8 (N.B. here averaged at t-points) 
     456         !                                ! Note that formally, in a Leap-Frog environment, the shear**2 should be the product of  
     457         !                                ! now by before shears, i.e. the source term of TKE (local positivity is not ensured). 
     458         !                                ! Note also that now e3 scale factors are used as after one are not computed ! 
     459         ! 
     460         CALL wrk_alloc(jpi,jpj,   z2d ) 
     461         z2d(:,:) = 0._wp 
     462         DO jk = 1, jpkm1 
     463            DO jj = 2, jpjm1 
     464               DO ji = 2, jpim1 
     465                  zavmu   = 0.5 * ( avm(ji+1,jj,jk) + avm(ji  ,jj,jk) ) 
     466                  zavmum1 = 0.5 * ( avm(ji  ,jj,jk) + avm(ji-1,jj,jk) ) 
     467                  zavmv   = 0.5 * ( avm(ji,jj+1,jk) + avm(ji,jj  ,jk) ) 
     468                  zavmvm1 = 0.5 * ( avm(ji,jj  ,jk) + avm(ji,jj-1,jk) ) 
     469                
     470                  z2d(ji,jj) = z2d(ji,jj)  +  (                                                                                  & 
     471                     &   zavmu   * ( ua(ji  ,jj,jk-1) - ua(ji  ,jj,jk) )**2 / e3uw_n(ji  ,jj,jk) * wumask(ji  ,jj,jk)   & 
     472                     & + zavmum1 * ( ua(ji-1,jj,jk-1) - ua(ji-1,jj,jk) )**2 / e3uw_n(ji-1,jj,jk) * wumask(ji-1,jj,jk)   & 
     473                     & + zavmv   * ( va(ji,jj  ,jk-1) - va(ji,jj  ,jk) )**2 / e3vw_n(ji,jj  ,jk) * wvmask(ji,jj  ,jk)   & 
     474                     & + zavmvm1 * ( va(ji,jj-1,jk-1) - va(ji,jj-1,jk) )**2 / e3vw_n(ji,jj-1,jk) * wvmask(ji,jj-1,jk)   & 
     475                     &                        ) 
     476!!gm --- This trends is in fact properly computed in zdf_sh2 but with a backward shift of one time-step  ===>>> use it ? 
     477!!                                                                                     No since in zdfshé only kz tke (or gls) is used 
     478!! 
     479!!gm --- formally, as done below, in a Leap-Frog environment, the shear**2 should be the product of 
     480!!gm     now by before shears, i.e. the source term of TKE (local positivity is not ensured). 
     481!!       CAUTION: requires to compute e3uw_a and e3vw_a !!! 
     482!                  z2d(ji,jj) = z2d(ji,jj)  + (                                                                                 & 
     483!                     &    avmu(ji  ,jj,jk) * ( un(ji  ,jj,jk-1) - un(ji  ,jj,jk) ) / e3uw_n(ji  ,jj,jk)                        & 
     484!                     &                     * ( ua(ji  ,jj,jk-1) - ua(ji  ,jj,jk) ) / e3uw_a(ji  ,jj,jk) * wumask(ji  ,jj,jk)   & 
     485!                     &  + avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) / e3uw_n(ji-1,jj,jk)                        & 
     486!                     &                       ( ua(ji-1,jj,jk-1) - ua(ji-1,jj,jk) ) / e3uw_a(ji-1,jj,jk) * wumask(ji-1,jj,jk)   & 
     487!                     &  + avmv(ji,jj  ,jk) * ( vn(ji,jj  ,jk-1) - vn(ji,jj  ,jk) ) / e3vw_n(ji,jj  ,jk)                        & 
     488!                     &                       ( va(ji,jj  ,jk-1) - va(ji,jj  ,jk) ) / e3vw_a(ji,jj  ,jk) * wvmask(ji,jj  ,jk)   & 
     489!                     &  + avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) / e3vw_n(ji,jj-1,jk)                        & 
     490!                     &                       ( va(ji,jj-1,jk-1) - va(ji,jj-1,jk) ) / e3vw_a(ji,jj-1,jk) * wvmask(ji,jj-1,jk)   & 
     491!                     &                       ) 
     492!!gm end 
     493               END DO 
     494            END DO 
     495         END DO 
     496         zzz= - 0.5_wp* rho0           ! caution sign minus here 
     497         z2d(:,:) = zzz * z2d(:,:)  
     498         CALL lbc_lnk( z2d,'T', 1. ) 
     499         CALL iom_put( 'dispkevfo', z2d ) 
     500      ENDIF 
     501      ! 
     502   END SUBROUTINE zdf_trd 
     503    
     504!!gm end not used 
     505 
    403506   !!============================================================================== 
    404507END MODULE dynzdf 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/sshwzv.F90

    r9598 r9939  
    6868      INTEGER, INTENT(in) ::   kt   ! time step 
    6969      !  
    70       INTEGER  ::   jk            ! dummy loop indice 
    71       REAL(wp) ::   z2dt, zcoef   ! local scalars 
     70      INTEGER  ::   jk         ! dummy loop indice 
     71      REAL(wp) ::   z1_2rho0   ! local scalars 
    7272      REAL(wp), DIMENSION(jpi,jpj) ::   zhdiv   ! 2D workspace 
    7373      !!---------------------------------------------------------------------- 
    … …  
    8181      ENDIF 
    8282      ! 
    83       z2dt = 2._wp * rdt                          ! set time step size (Euler/Leapfrog) 
    84       IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt 
    85       zcoef = 0.5_wp * r1_rau0 
     83      z1_2rho0 = 0.5_wp * r1_rho0 
    8684 
    8785      !                                           !------------------------------! 
    8886      !                                           !   After Sea Surface Height   ! 
    8987      !                                           !------------------------------! 
    90       IF(ln_wd_il) THEN 
    91          CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 
    92       ENDIF 
     88 
     89      IF(ln_wd_il)   CALL wad_lmt( sshb, z1_2rho0 * (emp_b(:,:) + emp(:,:)), rDt ) 
    9390 
    9491      CALL div_hor( kt )                               ! Horizontal divergence 
    … …  
    10299      ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 
    103100      !  
    104       ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:) 
     101      ssha(:,:) = (  sshb(:,:) - rDt * ( z1_2rho0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:) 
    105102      ! 
    106103#if defined key_agrif 
    … …  
    143140      ! 
    144141      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    145       REAL(wp) ::   z1_2dt       ! local scalars 
    146142      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zhdiv 
    147143      !!---------------------------------------------------------------------- 
    … …  
    159155      !                                           !     Now Vertical Velocity    ! 
    160156      !                                           !------------------------------! 
    161       z1_2dt = 1. / ( 2. * rdt )                         ! set time step size (Euler/Leapfrog) 
    162       IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1. / rdt 
    163157      ! 
    164158      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      ! z_tilde and layer cases 
    … …  
    180174            ! computation of w 
    181175            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)    & 
    182                &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )     ) * tmask(:,:,jk) 
     176               &                         + r1_Dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )      ) * tmask(:,:,jk) 
    183177         END DO 
    184178         !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 
    … …  
    188182            ! computation of w 
    189183            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk)                 & 
    190                &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )  ) * tmask(:,:,jk) 
     184               &                         + r1_Dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )  ) * tmask(:,:,jk) 
    191185         END DO 
    192186      ENDIF 
    … …  
    200194#if defined key_agrif  
    201195      IF( .NOT. AGRIF_Root() ) THEN  
    202          IF ((nbondi ==  1).OR.(nbondi == 2)) wn(nlci-1 , :     ,:) = 0.e0      ! east  
    203          IF ((nbondi == -1).OR.(nbondi == 2)) wn(2      , :     ,:) = 0.e0      ! west  
    204          IF ((nbondj ==  1).OR.(nbondj == 2)) wn(:      ,nlcj-1 ,:) = 0.e0      ! north  
    205          IF ((nbondj == -1).OR.(nbondj == 2)) wn(:      ,2      ,:) = 0.e0      ! south  
     196         IF ( nbondi ==  1 .OR. nbondi == 2 )   wn(nlci-1 ,   :   ,:) = 0._wp    ! east  
     197         IF ( nbondi == -1 .OR. nbondi == 2 )   wn(   2   ,   :   ,:) = 0._wp    ! west  
     198         IF ( nbondj ==  1 .OR. nbondj == 2 )   wn(   :   ,nlcj-1 ,:) = 0._wp    ! north  
     199         IF ( nbondj == -1 .OR. nbondj == 2 )   wn(   :   ,   2   ,:) = 0._wp    ! south  
    206200      ENDIF  
    207201#endif  
    … …  
    222216      !! ** Method  : - apply Asselin time fiter to now ssh (excluding the forcing 
    223217      !!              from the filter, see Leclair and Madec 2010) and swap : 
    224       !!                sshn = ssha + atfp * ( sshb -2 sshn + ssha ) 
    225       !!                            - atfp * rdt * ( emp_b - emp ) / rau0 
     218      !!                sshn = ssha + rn_atfp * ( sshb -2 sshn + ssha ) 
     219      !!                            - rn_atfp * rn_Dt * ( emp_b - emp ) / rho0 
    226220      !!                sshn = ssha 
    227221      !! 
    … …  
    243237         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    244238      ENDIF 
    245       !              !==  Euler time-stepping: no filter, just swap  ==! 
    246       IF ( neuler == 0 .AND. kt == nit000 ) THEN 
    247          sshn(:,:) = ssha(:,:)                              ! now    <-- after  (before already = now) 
    248          ! 
    249       ELSE           !==  Leap-Frog time-stepping: Asselin filter + swap  ==! 
    250          !                                                  ! before <-- now filtered 
    251          sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 
    252          IF( .NOT.ln_linssh ) THEN                          ! before <-- with forcing removed 
    253             zcoef = atfp * rdt * r1_rau0 
     239      !               
     240      IF ( l_1st_euler ) THEN    !==  Euler time-stepping  ==!   no filter, just swap 
     241         ! 
     242         sshn(:,:) = ssha(:,:)               ! now    <-- after  (before already = now) 
     243         ! 
     244      ELSE                       !==  Leap-Frog time-stepping  ==!   Asselin filter + swap 
     245         ! 
     246         !                                   ! before <-- now filtered 
     247         sshb(:,:) = sshn(:,:) + rn_atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 
     248         IF( .NOT.ln_linssh ) THEN           ! before <-- with forcing removed 
     249            zcoef = rn_atfp * rn_Dt * r1_rho0 
    254250            sshb(:,:) = sshb(:,:) - zcoef * (     emp_b(:,:) - emp   (:,:)   & 
    255251               &                             -    rnf_b(:,:) + rnf   (:,:)   & 
    256252               &                             + fwfisf_b(:,:) - fwfisf(:,:)   ) * ssmask(:,:) 
    257253         ENDIF 
    258          sshn(:,:) = ssha(:,:)                              ! now <-- after 
     254         sshn(:,:) = ssha(:,:)               ! now <-- after 
    259255      ENDIF 
    260256      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/wet_dry.F90

    r9168 r9939  
    117117 
    118118 
    119    SUBROUTINE wad_lmt( sshb1, sshemp, z2dt ) 
     119   SUBROUTINE wad_lmt( sshb1, sshemp, p2dt ) 
    120120      !!---------------------------------------------------------------------- 
    121121      !!                  ***  ROUTINE wad_lmt  *** 
    … …  
    129129      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1        !!gm DOCTOR names: should start with p ! 
    130130      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sshemp 
    131       REAL(wp)                , INTENT(in   ) ::   z2dt 
     131      REAL(wp)                , INTENT(in   ) ::   p2dt 
    132132      ! 
    133133      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices 
    … …  
    220220                  &   + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji,  jj-1) , 0._wp)  
    221221               ! 
    222                zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    223                zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) 
     222               zdep1 = (zzflxp + zzflxn) * p2dt / ztmp 
     223               zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - p2dt * sshemp(ji,jj) 
    224224               ! 
    225225               IF( zdep1 > zdep2 ) THEN 
    226226                  wdmask(ji, jj) = 0._wp 
    227                   zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
    228                   !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
     227                  zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * p2dt ) / ( zflxp(ji,jj) * p2dt ) 
     228                  !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * p2dt ) / ( zzflxp * p2dt ) 
    229229                  ! flag if the limiter has been used but stop flagging if the only 
    230230                  ! changes have zeroed the coefficient since further iterations will 
    … …  
    270270 
    271271 
    272    SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt ) 
     272   SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, pdt ) 
    273273      !!---------------------------------------------------------------------- 
    274274      !!                  ***  ROUTINE wad_lmt  *** 
    … …  
    280280      !! ** Action  : - calculate flux limiter and W/D flag 
    281281      !!---------------------------------------------------------------------- 
    282       REAL(wp)                , INTENT(in   ) ::   rdtbt    ! ocean time-step index 
     282      REAL(wp)                , INTENT(in   ) ::   pdt    ! external mode time-step [s] 
    283283      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zflxu,  zflxv, sshn_e, zssh_frc   
    284284      ! 
    285285      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices 
    286286      INTEGER  ::   jflag               ! local integer 
    287       REAL(wp) ::   z2dt 
    288287      REAL(wp) ::   zcoef, zdep1, zdep2 ! local scalars 
    289288      REAL(wp) ::   zzflxp, zzflxn      ! local scalars 
    … …  
    298297      jflag  = 0 
    299298      zdepwd = 50._wp   ! maximum depth that ocean cells can have W/D processes 
    300       ! 
    301       z2dt = rdtbt    
    302299      ! 
    303300      zflxp(:,:)   = 0._wp 
    … …  
    347344                  &   + min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp)  
    348345           
    349                zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    350                zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj) 
     346               zdep1 = (zzflxp + zzflxn) * pdt / ztmp 
     347               zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - pdt * zssh_frc(ji,jj) 
    351348           
    352349               IF(zdep1 > zdep2) THEN 
    353                  zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 
    354                  !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt ) 
     350                 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * pdt ) / ( zflxp(ji,jj) * pdt ) 
     351                 !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * pdt ) / ( zzflxp * pdt ) 
    355352                 ! flag if the limiter has been used but stop flagging if the only 
    356353                 ! changes have zeroed the coefficient since further iterations will 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/FLO/flo4rk.F90

    r9598 r9939  
    131131         ! computation of Runge-Kutta factor 
    132132         DO jfl = 1, jpnfl 
    133             zrkxfl(jfl,jind) = rdt*zufl(jfl) 
    134             zrkyfl(jfl,jind) = rdt*zvfl(jfl) 
    135             zrkzfl(jfl,jind) = rdt*zwfl(jfl) 
     133            zrkxfl(jfl,jind) = rn_Dt*zufl(jfl) 
     134            zrkyfl(jfl,jind) = rn_Dt*zvfl(jfl) 
     135            zrkzfl(jfl,jind) = rn_Dt*zwfl(jfl) 
    136136         END DO 
    137137         IF( jind /= 4 ) THEN 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/FLO/floblk.F90

    r9598 r9939  
    234234            ! test to know if the "age" of the float is not bigger than the  
    235235            ! time step 
    236             IF( zagenewfl(jfl) > rdt ) THEN 
    237                zttfl(jfl) = (rdt-zagefl(jfl)) / zvol 
    238                zagenewfl(jfl) = rdt 
     236            IF( zagenewfl(jfl) > rn_Dt ) THEN 
     237               zttfl(jfl) = (rn_Dt-zagefl(jfl)) / zvol 
     238               zagenewfl(jfl) = rn_Dt 
    239239            ENDIF 
    240240             
    … …  
    341341         ifin = 1 
    342342         DO jfl = 1, jpnfl 
    343             IF( zagefl(jfl) < rdt )   ifin = 0 
     343            IF( zagefl(jfl) < rn_Dt )   ifin = 0 
    344344            tpifl(jfl) = zgifl(jfl) + 0.5 
    345345            tpjfl(jfl) = zgjfl(jfl) + 0.5 
    … …  
    348348         ifin = 1 
    349349         DO jfl = 1, jpnfl 
    350             IF( zagefl(jfl) < rdt )   ifin = 0 
     350            IF( zagefl(jfl) < rn_Dt )   ifin = 0 
    351351            tpifl(jfl) = zgifl(jfl) + 0.5 
    352352            tpjfl(jfl) = zgjfl(jfl) + 0.5 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/FLO/flowri.F90

    r9598 r9939  
    125125               ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) 
    126126               zsal (jfl) = tsn(iafloc,ibfloc,icfl,jp_sal) 
    127                zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 
     127               zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0 
    128128 
    129129            ENDIF 
    … …  
    145145            ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) 
    146146            zsal(jfl) = tsn(iafloc,ibfloc,icfl,jp_sal) 
    147             zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 
     147            zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0 
    148148           
    149149         ENDIF 
    … …  
    248248            !------------------------------- 
    249249            irec =  INT( (kt-nn_it000+1)/nn_writefl ) +1 
    250             ztime = ( kt-nn_it000 + 1 ) * rdt 
     250            ztime = ( kt-nn_it000 + 1 ) * rn_Dt 
    251251 
    252252            CALL flioputv( numflo , 'time_counter', ztime , start=(/irec/) ) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ICB/icbini.F90

    r9598 r9939  
    5858      !!              - setup either test icebergs or calving file 
    5959      !!---------------------------------------------------------------------- 
    60       REAL(wp), INTENT(in) ::   pdt   ! iceberg time-step (rdt*nn_fsbc) 
     60      REAL(wp), INTENT(in) ::   pdt   ! iceberg time-step (rn_Dt*nn_fsbc) 
    6161      INTEGER , INTENT(in) ::   kt    ! time step number 
    6262      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ICB/icbtrj.F90

    r9598 r9939  
    6969      !!---------------------------------------------------------------------- 
    7070 
     71!!gm we could probably use the daymod calculation here.... 
     72!!               ===>>> TO BE checked by someone 
     73 
    7174      ! compute initial time step date 
    7275      CALL ju2ymds( fjulday, iyear, imonth, iday, zsec ) 
    … …  
    7477 
    7578      ! compute end time step date 
    76       zfjulday = fjulday + rdt / rday * REAL( nitend - nit000 + 1 , wp) 
     79      zfjulday = fjulday + rn_Dt / rday * REAL( nitend - nit000 + 1 , wp) 
    7780      IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error 
    7881      CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec ) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/IOM/iom.F90

    r9802 r9939  
    239239      ! 
    240240      ! end file definition 
    241       dtime%second = rdt 
     241      dtime%second = rn_Dt 
    242242      CALL xios_set_timestep( dtime ) 
    243243      CALL xios_close_context_definition() 
    … …  
    23582358            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    23592359            DO WHILE ( idx /= 0 )  
    2360                cldate = iom_sdate( fjulday - rdt / rday ) 
     2360               cldate = iom_sdate( fjulday - rn_Dt / rday ) 
    23612361               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 
    23622362               idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    … …  
    23652365            idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 
    23662366            DO WHILE ( idx /= 0 )  
    2367                cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. ) 
     2367               cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. ) 
    23682368               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 
    23692369               idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 
    … …  
    23722372            idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 
    23732373            DO WHILE ( idx /= 0 )  
    2374                cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 
     2374               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 
    23752375               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 
    23762376               idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 
    … …  
    23792379            idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 
    23802380            DO WHILE ( idx /= 0 )  
    2381                cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 
     2381               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 
    23822382               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 
    23832383               idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/LDF/ldfdyn.F90

    r9598 r9939  
    408408            zcmsmag = (rn_csmc/rpi)**2                                              ! (C_smag/pi)^2 
    409409            zstabf_lo  = rn_minfac * rn_minfac / ( 2._wp * 4._wp * zcmsmag )        ! lower limit stability factor scaling 
    410             zstabf_up  = rn_maxfac / ( 4._wp * zcmsmag * 2._wp * rdt )              ! upper limit stability factor scaling 
     410            zstabf_up  = rn_maxfac / ( 4._wp * zcmsmag * 2._wp * rn_Dt )            ! upper limit stability factor scaling 
    411411            IF( ln_dynldf_blp ) zstabf_lo = ( 16._wp / 9._wp ) * zstabf_lo          ! provide |U|L^3/12 lower limit instead  
    412412            !                                                                       ! of |U|L^3/16 in blp case 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/LDF/ldftra.F90

    r9737 r9939  
    852852      ! 
    853853      ! 
    854       zztmp = 0.5_wp * rau0 * rcp  
     854      zztmp = 0.5_wp * rho0_rcp 
    855855      IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 
    856856        zw2d(:,:)   = 0._wp  

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/OBS/diaobs.F90

    r9656 r9939  
    539539      ENDIF 
    540540 
    541       idaystp = NINT( rday / rdt ) 
     541      idaystp = NINT( rday / rn_Dt ) 
    542542 
    543543      !----------------------------------------------------------------------- 
    … …  
    630630 
    631631      ENDIF 
    632  
     632      ! 
    633633   END SUBROUTINE dia_obs 
     634 
    634635 
    635636   SUBROUTINE dia_obs_wri 
    … …  
    651652      !!        !  15-08  (M. Martin) Combined writing for prof and surf types 
    652653      !!---------------------------------------------------------------------- 
    653       !! * Modules used 
    654654      USE obs_rot_vel          ! Rotation of velocities 
    655655 
    656656      IMPLICIT NONE 
    657657 
    658       !! * Local declarations 
    659658      INTEGER :: jtype                    ! Data set loop variable 
    660659      INTEGER :: jo, jvar, jk 
    661       REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    662          & zu, & 
    663          & zv 
     660      REAL(wp), DIMENSION(:), ALLOCATABLE ::   zu, zv 
    664661 
    665662      !----------------------------------------------------------------------- 
    … …  
    771768      !!        !  2014-09  (D. Lea) New generic routine now deals with arbitrary initial time of day 
    772769      !!---------------------------------------------------------------------- 
    773       USE phycst, ONLY : &            ! Physical constants 
    774          & rday 
    775       USE dom_oce, ONLY : &           ! Ocean space and time domain variables 
    776          & rdt 
     770      USE phycst , ONLY :   rday    ! Physical constants 
     771      USE dom_oce, ONLY :   rn_Dt   ! Ocean space and time domain variables 
    777772 
    778773      IMPLICIT NONE 
    779774 
    780       !! * Arguments 
    781       REAL(KIND=dp), INTENT(OUT) :: ddobs                        ! Date in YYYYMMDD.HHMMSS 
    782       INTEGER :: kstp 
    783  
    784       !! * Local declarations 
     775      REAL(KIND=dp), INTENT(  out) ::   ddobs   ! Date in YYYYMMDD.HHMMSS 
     776      INTEGER      , INTENT(in   ) ::   kstp 
     777 
    785778      INTEGER :: iyea        ! date - (year, month, day, hour, minute) 
    786779      INTEGER :: imon 
    … …  
    805798      !! Compute number of days + number of hours + min since initial time 
    806799      !!---------------------------------------------------------------------- 
    807       zdayfrc = kstp * rdt / rday 
     800      zdayfrc = kstp * rn_Dt / rday 
    808801      zdayfrc = zdayfrc - aint(zdayfrc) 
    809802      imin = imin + int( zdayfrc * 24 * 60 )  
    … …  
    816809        iday=iday+1 
    817810      END DO  
    818       iday = iday + kstp * rdt / rday  
     811      iday = iday + kstp * rn_Dt / rday  
    819812 
    820813      !----------------------------------------------------------------------- 
    … …  
    842835   END SUBROUTINE calc_date 
    843836 
     837 
    844838   SUBROUTINE ini_date( ddobsini ) 
    845839      !!---------------------------------------------------------------------- 
    … …  
    859853      !!        !  2014-09  (D. Lea) Change to call generic routine calc_date 
    860854      !!---------------------------------------------------------------------- 
    861  
    862855      IMPLICIT NONE 
    863  
    864       !! * Arguments 
    865       REAL(KIND=dp), INTENT(OUT) :: ddobsini                   ! Initial date in YYYYMMDD.HHMMSS 
    866  
     856      ! 
     857      REAL(KIND=dp), INTENT(out) ::   ddobsini   ! Initial date in YYYYMMDD.HHMMSS 
     858      !!---------------------------------------------------------------------- 
     859      ! 
    867860      CALL calc_date( nit000 - 1, ddobsini ) 
    868  
     861      ! 
    869862   END SUBROUTINE ini_date 
     863 
    870864 
    871865   SUBROUTINE fin_date( ddobsfin ) 
    … …  
    10111005    END SUBROUTINE obs_setinterpopts 
    10121006 
     1007   !!====================================================================== 
    10131008END MODULE diaobs 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/OBS/obs_prep.F90

    r9598 r9939  
    610610      !!        !  2010-05  (D. Lea) Fix in leap year calculation for NEMO vn3.2 
    611611      !!---------------------------------------------------------------------- 
    612       !! * Modules used 
    613       USE dom_oce, ONLY : &  ! Geographical information 
    614          & rdt 
    615       USE phycst, ONLY : &   ! Physical constants 
    616          & rday,  &              
    617          & rmmss, &              
    618          & rhhmm                         
    619       !! * Arguments 
     612      USE dom_oce, ONLY :   rn_Dt                ! Geographical information 
     613      USE phycst , ONLY :   rday, rmmss, rhhmm   ! Physical constants 
     614 
    620615      INTEGER, INTENT(IN) :: kcycle     ! Current cycle 
    621616      INTEGER, INTENT(IN) :: kyea0      ! Initial date coordinates 
    … …  
    632627         & kobshou,  & 
    633628         & kobsmin 
    634       INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & 
    635          & kobsqc           ! Quality control flag 
    636       INTEGER, DIMENSION(kobsno), INTENT(OUT) :: & 
    637          & kobsstp          ! Number of time steps up to the  
    638                             ! observation time 
    639  
    640       !! * Local declarations 
     629      INTEGER, DIMENSION(kobsno), INTENT(inout) ::   kobsqc    ! Quality control flag 
     630      INTEGER, DIMENSION(kobsno), INTENT(  out) ::   kobsstp   ! Number of time steps up to the observation time 
     631      ! 
    641632      INTEGER :: jyea 
    642633      INTEGER :: jmon 
    … …  
    661652 
    662653      ! Intialize the number of time steps per day 
    663       idaystp = NINT( rday / rdt ) 
     654      idaystp = NINT( rday / rn_Dt ) 
    664655 
    665656      !--------------------------------------------------------------------- 
    … …  
    731722 
    732723         ! Add in the number of time steps to the observation minute 
    733          zminstp = rmmss / rdt 
     724         zminstp = rmmss / rn_Dt 
    734725         zhoustp = rhhmm * zminstp 
    735726 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/fldread.F90

    r9807 r9939  
    180180      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
    181181      IF( present(kit) ) THEN   ! ignore kn_fsbc in this case 
    182          isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) ) 
     182         isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rn_Dt/REAL(nn_e,wp) ) 
    183183      ELSE                      ! middle of sbc time step 
    184          isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdt) + it_offset * NINT(rdt) 
     184         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rn_Dt) + it_offset * NINT(rn_Dt) 
    185185      ENDIF 
    186186      imf = SIZE( sd ) 
    … …  
    213213               CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit )    ! update after record informations 
    214214 
    215                ! if kn_fsbc*rdt is larger than nfreqh (which is kind of odd), 
     215               ! if kn_fsbc*rn_Dt is larger than nfreqh (which is kind of odd), 
    216216               ! it is possible that the before value is no more the good one... we have to re-read it 
    217217               ! if before is not the last record of the file currently opened and after is the first record to be read 
    … …  
    234234               IF( sd(jf)%ln_tint ) THEN 
    235235                   
    236                   ! if kn_fsbc*rdt is larger than nfreqh (which is kind of odd), 
     236                  ! if kn_fsbc*rn_Dt is larger than nfreqh (which is kind of odd), 
    237237                  ! it is possible that the before value is no more the good one... we have to re-read it 
    238238                  ! if before record is not just just before the after record... 
    … …  
    267267                     ! year/month/week/day file to be not present. If the run continue further than the current 
    268268                     ! year/month/week/day, next year/month/week/day file must exist 
    269                      isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdt)   ! second at the end of the run 
    270                      llstop = isecend > sd(jf)%nrec_a(2)                                   ! read more than 1 record of next year 
     269                     isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rn_Dt)   ! second at the end of the run 
     270                     llstop = isecend > sd(jf)%nrec_a(2)                                ! read more than 1 record of next year 
    271271                     ! we suppose that the date of next file is next day (should be ok even for weekly files...) 
    272272                     CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         & 
    … …  
    485485      ENDIF 
    486486      IF( PRESENT(kt_offset) )   it_offset = kt_offset 
    487       IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) 
    488       ELSE                      ;   it_offset =         it_offset   * NINT(       rdt            ) 
     487      IF( PRESENT(kit) ) THEN   ;   it_offset = ( kit + it_offset ) * NINT( rn_Dt / REAL(nn_e,wp) ) 
     488      ELSE                      ;   it_offset =         it_offset   * NINT( rn_Dt                 ) 
    489489      ENDIF 
    490490      ! 
    … …  
    563563         ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year 
    564564         ENDIF 
    565          ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdt + REAL( it_offset, wp )        ! centrered in the middle of sbc time step 
    566          ztmp = ztmp + 0.01 * rdt                                                       ! avoid truncation error  
     565         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rn_Dt + REAL( it_offset, wp )      ! centrered in the middle of sbc time step 
     566         ztmp = ztmp + 0.01 * rn_Dt                                                     ! avoid truncation error  
    567567         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record 
    568568            ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcapr.F90

    r9598 r9939  
    3636    
    3737   REAL(wp) ::   tarea                ! whole domain mean masked ocean surface 
    38    REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0) 
     38   REAL(wp) ::   r1_rhog              ! = 1 / (rho0*grav) 
    3939    
    4040   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read) 
    … …  
    100100      ENDIF 
    101101      ! 
    102       r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization 
     102      r1_rhog = 1._wp / (rho0*grav)                !* constant for optimization 
    103103      ! 
    104104      !                                            !* control check 
    … …  
    144144         ! 
    145145         !                                                  !* Patm related forcing at kt 
    146          ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau    ! equivalent ssh (inverse barometer) 
     146         ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_rhog    ! equivalent ssh (inverse barometer) 
    147147         apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                        ! atmospheric pressure 
    148148         ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcblk.F90

    r9767 r9939  
    225225         ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    226226         IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    227          IF( slf_i(ifpr)%nfreqh > 0. .AND. MOD( 3600. * slf_i(ifpr)%nfreqh , REAL(nn_fsbc) * rdt) /= 0. )   & 
    228             &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
    229             &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
     227         IF( slf_i(ifpr)%nfreqh > 0. .AND. MOD( 3600. * slf_i(ifpr)%nfreqh , REAL(nn_fsbc) * rn_Dt) /= 0. )   & 
     228            &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmos. forcing frequency.',   & 
     229            &                 '               This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' ) 
    230230 
    231231      END DO 
    … …  
    323323      ! 
    324324      !                                            ! compute the surface ocean fluxes using bulk formulea 
    325       IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce( kt, sf, sst_m, ssu_m, ssv_m ) 
     325      IF( MOD( kt-1, nn_fsbc ) == 0 )   CALL blk_oce( kt, sf, sst_m, ssu_m, ssv_m ) 
    326326 
    327327#if defined key_cice 
    328       IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN 
     328      IF( MOD( kt-1, nn_fsbc ) == 0 )   THEN 
    329329         qlw_ice(:,:,1)   = sf(jp_qlw )%fnow(:,:,1) 
    330330         IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 
    … …  
    504504      ENDIF 
    505505 
    506       zqla(:,:) = L_vap(zst(:,:)) * zevap(:,:)     ! Latent Heat flux 
     506      zqla(:,:) = L_vap( zst(:,:) ) * zevap(:,:)     ! Latent Heat flux 
    507507 
    508508 
    … …  
    526526      ! 
    527527      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar 
    528          &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
     528         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * rLfus                        &   ! remove latent melting heat for solid precip 
    529529         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST 
    530530         &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair 
    531531         &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          & 
    532532         &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow) 
    533          &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic 
     533         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi 
    534534      qns(:,:) = qns(:,:) * tmask(:,:,1) 
    535535      ! 
    … …  
    643643      !! ** Purpose : Compute the moist adiabatic lapse-rate. 
    644644      !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate 
    645       !!     => http://www.geog.ucsb.edu/~joel/g266_s10/lecture_notes/chapt03/oh10_3_01/oh10_3_01.html 
    646645      !! 
    647646      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    … …  
    652651      ! 
    653652      INTEGER  ::   ji, jj         ! dummy loop indices 
    654       REAL(wp) :: zrv, ziRT        ! local scalar 
     653      REAL(wp) ::   zrv, ziRT      ! local scalar 
     654      REAL(wp) ::   zLv = 2.5e+6_wp   ! latent heat of vaporisation  
    655655      !!---------------------------------------------------------------------------------- 
    656656      ! 
    … …  
    659659            zrv = pqa(ji,jj) / (1. - pqa(ji,jj)) 
    660660            ziRT = 1. / (R_dry*ptak(ji,jj))    ! 1/RT 
    661             gamma_moist(ji,jj) = grav * ( 1. + cevap*zrv*ziRT ) / ( Cp_dry + cevap*cevap*zrv*reps0*ziRT/ptak(ji,jj) ) 
     661            gamma_moist(ji,jj) = grav * ( 1. + zLv*zrv*ziRT ) / ( Cp_dry + zLv*zLv*zrv*reps0*ziRT/ptak(ji,jj) ) 
    662662         END DO 
    663663      END DO 
    … …  
    792792      REAL(wp) ::   zst3                     ! local variable 
    793793      REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      - 
    794       REAL(wp) ::   zztmp, z1_lsub           !   -      - 
     794      REAL(wp) ::   zztmp                    !   -      - 
    795795      REAL(wp) ::   zfr1, zfr2               ! local variables 
    796796      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature 
    … …  
    868868 
    869869      ! --- evaporation --- ! 
    870       z1_lsub = 1._wp / Lsub 
    871       evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_lsub    ! sublimation 
    872       devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_lsub    ! d(sublimation)/dT 
     870      evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * r1_Lsub    ! sublimation 
     871      devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * r1_Lsub    ! d(sublimation)/dT 
    873872      zevap    (:,:)   = rn_efac * ( emp(:,:) + tprecip(:,:) )  ! evaporation over ocean 
    874873 
    … …  
    884883         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair 
    885884         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow) 
    886          &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     885         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
    887886      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only) 
    888          &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     887         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
    889888 
    890889      ! --- total solar and non solar fluxes --- ! 
    … …  
    894893 
    895894      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    896       qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     895      qprec_ice(:,:) = rhos * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 
    897896 
    898897      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 
    899898      DO jl = 1, jpl 
    900          qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) ) 
     899         qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * rcpi * tmask(:,:,1) ) 
    901900         !                         ! But we do not have Tice => consider it at 0degC => evap=0  
    902901      END DO 
    … …  
    971970      CASE ( 1 , 2 ) 
    972971         ! 
    973          zfac  = 1._wp /  ( rn_cnd_s + rcdic ) 
     972         zfac  = 1._wp /  ( rn_cnd_s + rcnd_i ) 
    974973         zfac2 = EXP(1._wp) * 0.5_wp * zepsilon 
    975974         zfac3 = 2._wp / zepsilon 
    … …  
    978977            DO jj = 1 , jpj 
    979978               DO ji = 1, jpi 
    980                   zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcdic * phs(ji,jj,jl) ) * zfac                             ! Effective thickness 
    981                   IF( zhe >=  zfac2 )   zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor 
     979                  zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac                             ! Effective thickness 
     980                  IF( zhe >=  zfac2 )   zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) )  ! Enhanced conduction factor 
    982981               END DO 
    983982            END DO 
    … …  
    990989      ! -------------------------------------------------------------! 
    991990      ! 
    992       zfac = rcdic * rn_cnd_s 
     991      zfac = rcnd_i * rn_cnd_s 
    993992      ! 
    994993      DO jl = 1, jpl 
    995994         DO jj = 1 , jpj 
    996995            DO ji = 1, jpi 
    997                !                     
    998                zkeff_h = zfac * zgfac(ji,jj,jl) / &                                    ! Effective conductivity of the snow-ice system divided by thickness 
    999                   &      ( rcdic * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) ) 
     996               !                                                                       ! Effective conductivity of the snow-ice system divided by thickness 
     997               zkeff_h = zfac * zgfac(ji,jj,jl) / ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) ) 
    1000998               ztsu    = ptsu(ji,jj,jl)                                                ! Store current iteration temperature 
    1001999               ztsu0   = ptsu(ji,jj,jl)                                                ! Store initial surface temperature 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbccpl.F90

    r9767 r9939  
    193193 
    194194   REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2]  
    195    REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0)  
     195   REAL(wp) ::   r1_rhog              ! = 1 / (rho0*grav)  
    196196 
    197197   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nrcvinfo           ! OASIS info argument 
    … …  
    11001100      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module?? 
    11011101      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    1102       INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdt did not change since nit000) 
     1102      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rn_Dt did not change since nit000) 
    11031103      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
    11041104      REAL(wp) ::   zcoef                  ! temporary scalar 
    … …  
    11141114      !                                                      ! Receive all the atmos. fields (including ice information) 
    11151115      !                                                      ! ======================================================= ! 
    1116       isec = ( kt - nit000 ) * NINT( rdt )                      ! date of exchanges 
     1116      isec = ( kt - nit000 ) * NINT( rn_Dt )                   ! date of exchanges 
    11171117      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere 
    11181118         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
    … …  
    12591259          IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields  
    12601260 
    1261           r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization  
    1262           ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)  
     1261          r1_rhog = 1.e0 / (grav * rho0)               !* constant for optimization  
     1262          ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_rhog    ! equivalent ssh (inverse barometer)  
    12631263          apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure  
    12641264     
    … …  
    14181418            zqns(:,:) =  zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp         ! remove heat content due to mass flux (assumed to be at SST) 
    14191419            IF( srcv(jpr_snow  )%laction ) THEN 
    1420                zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
     1420               zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * rLfus   ! energy for melting solid precipitation over the free ocean 
    14211421            ENDIF 
    14221422         ENDIF 
    14231423         ! 
    1424          IF( srcv(jpr_icb)%laction )  zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting 
     1424         IF( srcv(jpr_icb)%laction )  zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove heat content associated to iceberg melting 
    14251425         ! 
    14261426         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 
    … …  
    18111811      !                                      
    18121812      ! --- calving (removed from qns_tot) --- ! 
    1813       IF( srcv(jpr_cal)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus  ! remove latent heat of calving 
    1814                                                                                                     ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 
     1813      IF( srcv(jpr_cal)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus  ! remove latent heat of calving 
     1814                                                                                                     ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 
    18151815      ! --- iceberg (removed from qns_tot) --- ! 
    1816       IF( srcv(jpr_icb)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus  ! remove latent heat of iceberg melting 
     1816      IF( srcv(jpr_icb)%laction )   zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus  ! remove latent heat of iceberg melting 
    18171817 
    18181818#if defined key_si3       
    … …  
    18231823 
    18241824      ! Heat content per unit mass of snow (J/kg) 
    1825       WHERE( SUM( a_i, dim=3 ) > 1.e-10 )   ;   zcptsnw(:,:) = cpic * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1825      WHERE( SUM( a_i, dim=3 ) > 1.e-10 )   ;   zcptsnw(:,:) = rcpi * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
    18261826      ELSEWHERE                             ;   zcptsnw(:,:) = zcptn(:,:) 
    1827       ENDWHERE 
     1827      END WHERE 
    18281828      ! Heat content per unit mass of rain (J/kg) 
    18291829      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) )  
    18301830 
    18311831      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    1832       zqprec_ice(:,:) = rhosn * ( zcptsnw(:,:) - lfus ) 
     1832      zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus ) 
    18331833 
    18341834      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 
    18351835      DO jl = 1, jpl 
    1836          zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but atm. does not take it into account 
     1836         zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * rcpi ) but atm. does not take it into account 
    18371837      END DO 
    18381838 
    … …  
    18401840      zqemp_oce(:,:) = -  zevap_oce(:,:)                                      *   zcptn   (:,:)   &        ! evap 
    18411841         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptrain(:,:)   &        ! liquid precip 
    1842          &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus )   ! solid precip over ocean + snow melting 
    1843       zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * ( zcptsnw (:,:) - lfus )   ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 
     1842         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus )   ! solid precip over ocean + snow melting 
     1843      zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * ( zcptsnw (:,:) - rLfus )   ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 
    18441844!!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * picefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap 
    1845 !!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice 
     1845!!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhos  ! solid precip over ice 
    18461846       
    18471847      ! --- total non solar flux (including evap/precip) --- ! 
    … …  
    18751875      ! clem: this formulation is certainly wrong... but better than it was... 
    18761876      zqns_tot(:,:) = zqns_tot(:,:)                            &          ! zqns_tot update over free ocean with: 
    1877          &          - (  ziceld(:,:) * zsprecip(:,:) * lfus )  &          ! remove the latent heat flux of solid precip. melting 
     1877         &          - (  ziceld(:,:) * zsprecip(:,:) * rLfus )  &         ! remove the latent heat flux of solid precip. melting 
    18781878         &          - (  zemp_tot(:,:)                         &          ! remove the heat content of mass flux (assumed to be at SST) 
    18791879         &             - zemp_ice(:,:) ) * zcptn(:,:)  
    … …  
    18921892#endif 
    18931893      ! outputs 
    1894       IF ( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * lfus )                       ! latent heat from calving 
    1895       IF ( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * lfus )                       ! latent heat from icebergs melting 
     1894      IF ( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving 
     1895      IF ( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting 
    18961896      IF ( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average) 
    18971897      IF ( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 
    18981898           &                                                              * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average) 
    1899       IF ( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - Lfus )   )               ! heat flux from snow (cell average) 
    1900       IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) & 
     1899      IF ( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )   )               ! heat flux from snow (cell average) 
     1900      IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
    19011901           &                                                              * ( 1._wp - zsnw(:,:) )                  )               ! heat flux from snow (over ocean) 
    1902       IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) & 
     1902      IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
    19031903           &                                                              *           zsnw(:,:)                    )               ! heat flux from snow (over ice) 
    19041904      ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. 
    … …  
    20472047      !!---------------------------------------------------------------------- 
    20482048      ! 
    2049       isec = ( kt - nit000 ) * NINT( rdt )        ! date of exchanges 
     2049      isec = ( kt - nit000 ) * NINT( rn_Dt )        ! date of exchanges 
    20502050 
    20512051      zfr_l(:,:) = 1.- fr_i(:,:) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcdcy.F90

    r9598 r9939  
    8888 
    8989      ! When are we during the day (from 0 to 1) 
    90       zlo = ( REAL(nsec_day, wp) - 0.5_wp * rdt ) / rday 
    91       zup = zlo + ( REAL(nn_fsbc, wp)     * rdt ) / rday 
     90      zlo = ( REAL(nsec_day, wp) - 0.5_wp * rn_Dt ) / rday 
     91      zup = zlo + ( REAL(nn_fsbc, wp)     * rn_Dt ) / rday 
    9292      !                                           
    9393      IF( nday_qsr == -1 ) THEN       ! first time step only   
    … …  
    187187         END DO   
    188188         ! 
    189          ztmp = rday / ( rdt * REAL(nn_fsbc, wp) ) 
     189         ztmp = rday / ( rn_Dt * REAL(nn_fsbc, wp) ) 
    190190         rscal(:,:) = rscal(:,:) * ztmp 
    191191         ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcfwb.F90

    r9598 r9939  
    123123         ENDIF    
    124124         !                                         ! Update fwfold if new year start 
    125          ikty = 365 * 86400 / rdt                  !!bug  use of 365 days leap year or 360d year !!!!!!! 
     125         ikty = 365 * 86400 / rn_Dt         !!bug  use of 365 days leap year or 360d year !!!!!!! 
    126126         IF( MOD( kt, ikty ) == 0 ) THEN 
    127127            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow 
    128128                                                      ! sum over the global domain 
    129             a_fwb   = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) ) 
     129            a_fwb   = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rho0 ) ) 
    130130            a_fwb   = a_fwb * 1.e+3 / ( area * rday * 365. )     ! convert in Kg/m3/s = mm/s 
    131131!!gm        !                                                      !!bug 365d year  

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcice_cice.F90

    r9598 r9939  
    1313   USE dom_oce         ! ocean space and time domain 
    1414   USE domvvl 
    15    USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 
     15   USE phycst   , ONLY : rcp, rho0, r1_rho0, rhos, rhoi 
    1616   USE in_out_manager  ! I/O manager 
    1717   USE iom, ONLY : iom_put,iom_use              ! I/O manager library !!Joakim edit 
    … …  
    222222      CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
    223223      CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
    224       snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
     224      snwice_mass  (:,:) = ( rhos * ztmp1(:,:) + rhoi * ztmp2(:,:)  ) 
    225225      snwice_mass_b(:,:) = snwice_mass(:,:) 
    226226 
    227227      IF( .NOT.ln_rstart ) THEN 
    228228         IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area 
    229             sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
    230             sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     229            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rho0 
     230            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rho0 
    231231 
    232232!!gm This should be put elsewhere....   (same remark for limsbc) 
    … …  
    422422! Freezing/melting potential 
    423423! Calculated over NEMO leapfrog timestep (hence 2*dt) 
    424       nfrzmlt(:,:) = rau0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt ) 
     424      nfrzmlt(:,:) = rho0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt ) 
    425425 
    426426      ztmp(:,:) = nfrzmlt(:,:) 
    … …  
    459459         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
    460460          ! 
    461          zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0 
     461         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rho0 
    462462          ! 
    463463         ! 
    … …  
    644644      CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
    645645      CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
    646       snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
     646      snwice_mass  (:,:) = ( rhos * ztmp1(:,:) + rhoi * ztmp2(:,:)  ) 
    647647      snwice_mass_b(:,:) = snwice_mass(:,:) 
    648648      snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcisf.F90

    r9728 r9939  
    5252   LOGICAL, PUBLIC ::   l_isfcpl = .false.       !: isf recieved from oasis 
    5353 
    54    REAL(wp), PUBLIC, SAVE ::   rcpi     = 2000.0_wp     !: specific heat of ice shelf             [J/kg/K] 
     54   REAL(wp)        , SAVE ::   rcp_isf  = 2000.0_wp     !: specific heat of ice shelf             [J/kg/K] 
    5555   REAL(wp), PUBLIC, SAVE ::   rkappa   = 1.54e-6_wp    !: heat diffusivity through the ice-shelf [m2/s] 
    56    REAL(wp), PUBLIC, SAVE ::   rhoisf   = 920.0_wp      !: volumic mass of ice shelf              [kg/m3] 
     56   REAL(wp), PUBLIC, SAVE ::   rho_isf  = 920.0_wp      !: volumic mass of ice shelf              [kg/m3] 
    5757   REAL(wp), PUBLIC, SAVE ::   tsurf    = -20.0_wp      !: air temperature on top of ice shelf    [C] 
    58    REAL(wp), PUBLIC, SAVE ::   rlfusisf = 0.334e6_wp    !: latent heat of fusion of ice shelf     [J/kg] 
    5958 
    6059!: Variable used in fldread to read the forcing file (nn_isf == 4 .OR. nn_isf == 3) 
    … …  
    114113            ! compute fwf and heat flux 
    115114            IF( .NOT.l_isfcpl ) THEN    ;   CALL sbc_isf_cav (kt) 
    116             ELSE                        ;   qisf(:,:)  = fwfisf(:,:) * rlfusisf  ! heat        flux 
     115            ELSE                        ;   qisf(:,:)  = fwfisf(:,:) * rLfus    ! heat flux 
    117116            ENDIF 
    118117            ! 
    … …  
    127126               fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting)  
    128127            ENDIF 
    129             qisf(:,:)   = fwfisf(:,:) * rlfusisf             ! heat flux 
     128            qisf(:,:)   = fwfisf(:,:) * rLfus                   ! heat flux 
    130129            stbl(:,:)   = soce 
    131130            ! 
    … …  
    137136               fwfisf(:,:) = -sf_fwfisf(1)%fnow(:,:,1)            ! fwf 
    138137            ENDIF 
    139             qisf(:,:)   = fwfisf(:,:) * rlfusisf               ! heat flux 
     138            qisf(:,:)   = fwfisf(:,:) * rLfus                     ! heat flux 
    140139            stbl(:,:)   = soce 
    141140            ! 
    … …  
    144143         ! compute tsc due to isf 
    145144         ! isf melting implemented as a volume flux and we assume that melt water is at 0 PSU. 
    146          ! WARNING water add at temp = 0C, need to add a correction term (fwfisf * tfreez / rau0). 
     145         ! WARNING water add at temp = 0C, need to add a correction term (fwfisf * tfreez / rho0). 
    147146         ! compute freezing point beneath ice shelf (or top cell if nn_isf = 3) 
    148147         DO jj = 1,jpj 
    … …  
    153152         CALL eos_fzp( stbl(:,:), zt_frz(:,:), zdep(:,:) ) 
    154153          
    155          risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - fwfisf(:,:) * zt_frz(:,:) * r1_rau0 ! 
     154         risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rho0_rcp - fwfisf(:,:) * zt_frz(:,:) * r1_rho0 ! 
    156155         risf_tsc(:,:,jp_sal) = 0.0_wp 
    157156 
    … …  
    160159         ! output 
    161160         IF( iom_use('iceshelf_cea') )   CALL iom_put( 'iceshelf_cea', -fwfisf(:,:)                      )   ! isf mass flux 
    162          IF( iom_use('hflx_isf_cea') )   CALL iom_put( 'hflx_isf_cea', risf_tsc(:,:,jp_tem) * rau0 * rcp )   ! isf sensible+latent heat (W/m2) 
     161         IF( iom_use('hflx_isf_cea') )   CALL iom_put( 'hflx_isf_cea', risf_tsc(:,:,jp_tem) * rho0 * rcp )   ! isf sensible+latent heat (W/m2) 
    163162         IF( iom_use('qlatisf' ) )       CALL iom_put( 'qlatisf'     , qisf(:,:)                         )   ! isf latent heat 
    164163         IF( iom_use('fwfisf'  ) )       CALL iom_put( 'fwfisf'      , fwfisf(:,:)                       )   ! isf mass flux (opposite sign) 
    … …  
    308307      qisf    (:,:)    = 0._wp   ;   fwfisf  (:,:) = 0._wp 
    309308      risf_tsc(:,:,:)  = 0._wp   ;   fwfisf_b(:,:) = 0._wp 
    310       ! 
    311       ! define isf tbl tickness, top and bottom indice 
    312       SELECT CASE ( nn_isf ) 
     309 
     310      SELECT CASE ( nn_isf )      ! define isf tbl tickness, top and bottom indice 
     311      ! 
    313312      CASE ( 1 )  
    314313         IF(lwp) WRITE(numout,*) 
    … …  
    452451               ! 2. ------------Net heat flux and fresh water flux due to the ice shelf 
    453452               ! For those corresponding to zonal boundary     
    454                qisf(ji,jj) = - rau0 * rcp * rn_gammat0 * risfLeff(ji,jj) * e1t(ji,jj) * zt_ave  & 
     453               qisf(ji,jj) = - rho0 * rcp * rn_gammat0 * risfLeff(ji,jj) * e1t(ji,jj) * zt_ave  & 
    455454                           & * r1_e1e2t(ji,jj) * tmask(ji,jj,jk) 
    456455              
    457                fwfisf(ji,jj) = qisf(ji,jj) / rlfusisf          !fresh water flux kg/(m2s)                   
     456               fwfisf(ji,jj) = qisf(ji,jj) * r1_Lfus                        ! fresh water flux kg/(m2s)                   
    458457               fwfisf(ji,jj) = fwfisf(ji,jj) * ( soce / stbl(ji,jj) ) 
    459458               !add to salinity trend 
    … …  
    500499         zlamb1 =-0.0564_wp 
    501500         zlamb2 = 0.0773_wp 
    502          zlamb3 =-7.8633e-8 * grav * rau0 
     501         zlamb3 =-7.8633e-8 * grav * rho0 
    503502      ELSE                  ! linearisation from table 4 (Asay-Davis et al., 2015) 
    504503         zlamb1 =-0.0573_wp 
    505504         zlamb2 = 0.0832_wp 
    506          zlamb3 =-7.53e-8 * grav * rau0 
     505         zlamb3 =-7.53e-8 * grav * rho0 
    507506      ENDIF 
    508507      ! 
    … …  
    526525            DO jj = 1, jpj 
    527526               DO ji = 1, jpi 
    528                   zhtflx(ji,jj) =   zgammat(ji,jj)*rcp*rau0*(ttbl(ji,jj)-zfrz(ji,jj)) 
    529                   zfwflx(ji,jj) = - zhtflx(ji,jj)/rlfusisf 
     527                  zhtflx(ji,jj) =   zgammat(ji,jj)*rcp*rho0*(ttbl(ji,jj)-zfrz(ji,jj)) 
     528                  zfwflx(ji,jj) = - zhtflx(ji,jj) * r1_Lfus 
    530529               END DO 
    531530            END DO 
    … …  
    544543               DO ji = 1, jpi 
    545544                  ! compute coeficient to solve the 2nd order equation 
    546                   zeps1 = rcp*rau0*zgammat(ji,jj) 
    547                   zeps2 = rlfusisf*rau0*zgammas(ji,jj) 
    548                   zeps3 = rhoisf*rcpi*rkappa/MAX(risfdep(ji,jj),zeps) 
     545                  zeps1 = rcp*rho0*zgammat(ji,jj) 
     546                  zeps2 = rLfus*rho0*zgammas(ji,jj) 
     547                  zeps3 = rho_isf*rcp_isf*rkappa/MAX(risfdep(ji,jj),zeps) 
    549548                  zeps4 = zlamb2+zlamb3*risfdep(ji,jj) 
    550549                  zeps6 = zeps4-ttbl(ji,jj) 
    … …  
    567566                  ! zhtflx is upward heat flux (out of ocean) 
    568567                  ! compute the upward water and heat flux (eq. 28 and eq. 29) 
    569                   zfwflx(ji,jj) = rau0 * zgammas(ji,jj) * (zsfrz-stbl(ji,jj)) / MAX(zsfrz,zeps) 
    570                   zhtflx(ji,jj) = zgammat(ji,jj) * rau0 * rcp * (ttbl(ji,jj) - zfrz(ji,jj) )  
     568                  zfwflx(ji,jj) = rho0 * zgammas(ji,jj) * (zsfrz-stbl(ji,jj)) / MAX(zsfrz,zeps) 
     569                  zhtflx(ji,jj) = zgammat(ji,jj) * rho0 * rcp * (ttbl(ji,jj) - zfrz(ji,jj) )  
    571570               END DO 
    572571            END DO 
    … …  
    890889               DO jk = ikt, ikb - 1 
    891890                  phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + ( fwfisf(ji,jj) + fwfisf_b(ji,jj) ) & 
    892                     &              * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact 
     891                    &              * r1_hisf_tbl(ji,jj) * r1_rho0 * zfact 
    893892               END DO 
    894893               ! level partially include in ice shelf boundary layer  
    895894               phdivn(ji,jj,ikb) = phdivn(ji,jj,ikb) + ( fwfisf(ji,jj) & 
    896                     &            + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rau0 * zfact * ralpha(ji,jj)  
     895                    &            + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rho0 * zfact * ralpha(ji,jj)  
    897896         END DO 
    898897      END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcmod.F90

    r9656 r9939  
    177177      ! 
    178178      IF( .NOT.ln_usr ) THEN     ! the model calendar needs some specificities (except in user defined case) 
    179          IF( MOD( rday , rdt ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' ) 
    180          IF( MOD( rday , 2.  ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    ) 
    181          IF( MOD( rdt  , 2.  ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           ) 
     179         IF( MOD( rday  , rn_Dt ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' ) 
     180         IF( MOD( rday  ,  2.  ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    ) 
     181         IF( MOD( rn_Dt,   2.   ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           ) 
    182182      ENDIF 
    183183      !                       !**  check option consistency 
    … …  
    288288      !     SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 
    289289      IF( nn_components /= jp_iam_nemo ) THEN 
    290          IF( nn_components == jp_iam_opa )   nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt) 
    291          IF( nn_components == jp_iam_sas )   nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt) 
     290         IF( nn_components == jp_iam_opa )   nn_fsbc = cpl_freq('O_SFLX') / NINT(rn_Dt) 
     291         IF( nn_components == jp_iam_sas )   nn_fsbc = cpl_freq('I_SFLX') / NINT(rn_Dt) 
    292292         ! 
    293293         IF(lwp)THEN 
    … …  
    306306      ENDIF 
    307307      ! 
    308       IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   & 
     308      IF( MOD( rday, REAL(nn_fsbc, wp) * rn_Dt ) /= 0 )   & 
    309309         &  CALL ctl_warn( 'sbc_init : nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
    310310      ! 
    311       IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(rdt) ) < 8  )   & 
     311      IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(rn_Dt) ) < 8  )   & 
    312312         &   CALL ctl_warn( 'sbc_init : diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 
    313313      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcrnf.F90

    r9727 r9939  
    116116      IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required 
    117117      ! 
    118       IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     118      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    119119         ! 
    120120         IF( .NOT. l_rnfcpl )   rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1)       ! updated runoff value at time step kt 
    … …  
    122122         !                                                           ! set temperature & salinity content of runoffs 
    123123         IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
    124             rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
     124            rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rho0 
    125125            CALL eos_fzp( sss_m(:,:), ztfrz(:,:) ) 
    126126            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature 
    127                rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
     127               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rho0 
    128128            END WHERE 
    129129            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg 
    130                rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * rlfusisf * r1_rau0_rcp 
     130               rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rho0 - rnf(:,:) * rLfus * r1_rho0_rcp 
    131131            END WHERE 
    132132         ELSE                                                        ! use SST as runoffs temperature 
    133133            !CEOD River is fresh water so must at least be 0 unless we consider ice 
    134             rnf_tsc(:,:,jp_tem) = MAX(sst_m(:,:),0.0_wp) * rnf(:,:) * r1_rau0 
     134            rnf_tsc(:,:,jp_tem) = MAX(sst_m(:,:),0.0_wp) * rnf(:,:) * r1_rho0 
    135135         ENDIF 
    136136         !                                                           ! use runoffs salinity data 
    137          IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
     137         IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rho0 
    138138         !                                                           ! else use S=0 for runoffs (done one for all in the init) 
    139139         IF( iom_use('runoffs') )        CALL iom_put( 'runoffs'     , rnf(:,:)                         )   ! output runoff mass flux 
    140          IF( iom_use('hflx_rnf_cea') )   CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * rau0 * rcp )   ! output runoff sensible heat (W/m2) 
     140         IF( iom_use('hflx_rnf_cea') )   CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * rho0 * rcp )   ! output runoff sensible heat (W/m2) 
    141141      ENDIF 
    142142      ! 
    … …  
    198198               DO ji = 1, jpi 
    199199                  DO jk = 1, nk_rnf(ji,jj) 
    200                      phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj) 
     200                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj) 
    201201                  END DO 
    202202               END DO 
    … …  
    211211                  !                          ! apply the runoff input flow 
    212212                  DO jk = 1, nk_rnf(ji,jj) 
    213                      phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj) 
     213                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj) 
    214214                  END DO 
    215215               END DO 
    … …  
    218218      ELSE                       !==   runoff put only at the surface   ==! 
    219219         h_rnf (:,:)   = e3t_n (:,:,1)        ! update h_rnf to be depth of top box 
    220          phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1) 
     220         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rho0 / e3t_n(:,:,1) 
    221221      ENDIF 
    222222      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcssm.F90

    r9598 r9939  
    106106            frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 
    107107            !                                             ! ---------------------------------------- ! 
    108          ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   ! 
     108         ELSEIF( MOD( kt-2, nn_fsbc ) == 0 ) THEN         !   Initialisation: New mean computation   ! 
    109109            !                                             ! ---------------------------------------- ! 
    110110            ssu_m(:,:) = 0._wp     ! reset to zero ocean mean sbc fields 
    … …  
    135135 
    136136         !                                                ! ---------------------------------------- ! 
    137          IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   ! 
     137         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN             !   Mean value at each nn_fsbc time-step   ! 
    138138            !                                             ! ---------------------------------------- ! 
    139139            zcoef = 1. / REAL( nn_fsbc, wp ) 
    … …  
    263263         CALL iom_set_rstw_var_active('frq_m') 
    264264      ENDIF 
    265  
     265      ! 
    266266   END SUBROUTINE sbc_ssm_init 
    267267 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbctide.F90

    r9598 r9939  
    4848      !!---------------------------------------------------------------------- 
    4949       
    50       IF( nsec_day == NINT(0.5_wp * rdt) .OR. kt == nit000 ) THEN      ! start a new day 
     50      IF( nsec_day == NINT(0.5_wp * rn_Dt) .OR. kt == nit000 ) THEN      ! start a new day 
    5151         ! 
    5252         IF( kt == nit000 )THEN 
    … …  
    7272         ! Temporarily set nsec_day to beginning of day. 
    7373         nsec_day_orig = nsec_day 
    74          IF ( nsec_day /= NINT(0.5_wp * rdt) ) THEN  
    75             kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 
    76             nsec_day = NINT(0.5_wp * rdt) 
     74         IF ( nsec_day /= NINT(0.5_wp * rn_Dt) ) THEN  
     75            kt_tide = kt - (nsec_day - 0.5_wp * rn_Dt) / rn_Dt 
     76            nsec_day = NINT(0.5_wp * rn_Dt) 
    7777         ELSE 
    7878            kt_tide = kt  

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/tideini.F90

    r9598 r9939  
    2020   PUBLIC 
    2121 
    22    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   omega_tide   !: 
    23    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   v0tide       !: 
    24    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   utide        !: 
    25    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ftide        !: 
     22   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   omega_tide   !:  
     23   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   v0tide       !:  
     24   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   utide        !:  
     25   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ftide        !:  
    2626 
    27    LOGICAL , PUBLIC ::   ln_tide         !: 
    28    LOGICAL , PUBLIC ::   ln_tide_pot     !: 
    29    LOGICAL , PUBLIC ::   ln_read_load    !: 
    30    LOGICAL , PUBLIC ::   ln_scal_load    !: 
    31    LOGICAL , PUBLIC ::   ln_tide_ramp    !: 
    32    INTEGER , PUBLIC ::   nb_harmo        !: 
    33    INTEGER , PUBLIC ::   kt_tide         !: 
    34    REAL(wp), PUBLIC ::   rdttideramp     !: 
    35    REAL(wp), PUBLIC ::   rn_scal_load    !: 
    36    CHARACTER(lc), PUBLIC ::   cn_tide_load   !:  
     27   !                                        !!* nam_tide namelist * 
     28   LOGICAL , PUBLIC ::   ln_tide             !: Use tidal components 
     29   LOGICAL , PUBLIC ::   ln_tide_pot         !: Apply astronomical potential 
     30   LOGICAL , PUBLIC ::   ln_read_load        !: Read load potential from file 
     31   CHARACTER(lc), PUBLIC ::   cn_tide_load      !: associated file name 
     32   LOGICAL , PUBLIC ::   ln_scal_load        !: Use a scalar approximation for load potential 
     33   REAL(wp), PUBLIC ::      rn_load             !: SSH fraction used in scalar approximation 
     34   LOGICAL , PUBLIC ::   ln_tide_ramp        !: Apply ramp on tides at startup 
     35   REAL(wp), PUBLIC ::      rn_ramp             !: Duration of ramp [days] 
     36   INTEGER , PUBLIC ::   nb_harmo            !: number of tidal harmonique used 
     37   INTEGER , PUBLIC ::   kt_tide             !: ??? 
    3738 
    38    INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ntide   !: 
     39   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ntide   !: ??? 
    3940 
    4041   !!---------------------------------------------------------------------- 
    … …  
    5253      CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname 
    5354      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    54       ! 
     55      !! 
    5556      NAMELIST/nam_tide/ln_tide, ln_tide_pot, ln_scal_load, ln_read_load, cn_tide_load, & 
    56                   &     ln_tide_ramp, rn_scal_load, rdttideramp, clname 
     57                  &     ln_tide_ramp, rn_load, rn_ramp, clname 
    5758      !!---------------------------------------------------------------------- 
    5859      ! 
    … …  
    7677            WRITE(numout,*) '         Apply astronomical potential            ln_tide_pot  = ', ln_tide_pot 
    7778            WRITE(numout,*) '         Use scalar approx. for load potential   ln_scal_load = ', ln_scal_load 
     79            WRITE(numout,*) '            SSH fraction used in scal. approx.      rn_load   = ', rn_load 
    7880            WRITE(numout,*) '         Read load potential from file           ln_read_load = ', ln_read_load 
    7981            WRITE(numout,*) '         Apply ramp on tides at startup          ln_tide_ramp = ', ln_tide_ramp 
    80             WRITE(numout,*) '         Fraction of SSH used in scal. approx.   rn_scal_load = ', rn_scal_load 
    81             WRITE(numout,*) '         Duration (days) of ramp                 rdttideramp  = ', rdttideramp 
     82            WRITE(numout,*) '         Duration of ramp                           rn_ramp   = ', rn_ramp, ' [days]' 
    8283         ENDIF 
    8384      ELSE 
    84          rn_scal_load = 0._wp  
    85  
     85         rn_load = 0._wp  
     86         ! 
    8687         IF(lwp) WRITE(numout,*) 
    8788         IF(lwp) WRITE(numout,*) 'tide_init : tidal components not used (ln_tide = F)' 
    … …  
    9293      CALL tide_init_Wave 
    9394      ! 
    94       nb_harmo=0 
     95      nb_harmo = 0 
    9596      DO jk = 1, jpmax_harmo 
    9697         DO ji = 1,jpmax_harmo 
    … …  
    108109      IF( ln_scal_load.AND.ln_read_load ) & 
    109110          &   CALL ctl_stop('Choose between ln_scal_load and ln_read_load') 
    110       IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) )   & 
    111          &   CALL ctl_stop('rdttideramp must be lower than run duration') 
    112       IF( ln_tide_ramp.AND.(rdttideramp<0.) ) & 
    113          &   CALL ctl_stop('rdttideramp must be positive') 
     111      IF( ln_tide_ramp.AND.((nitend-nit000+1)*rn_Dt/rday < rn_ramp) )   & 
     112         &   CALL ctl_stop('rn_ramp must be lower than run duration') 
     113      IF( ln_tide_ramp.AND.(rn_ramp<0.) ) & 
     114         &   CALL ctl_stop('rn_ramp must be positive') 
    114115      ! 
    115116      ALLOCATE( ntide(nb_harmo) ) 
    … …  
    123124      END DO 
    124125      ! 
    125       ALLOCATE( omega_tide(nb_harmo), v0tide    (nb_harmo),   & 
    126          &      utide     (nb_harmo), ftide     (nb_harmo)  ) 
     126      ALLOCATE( omega_tide(nb_harmo), v0tide(nb_harmo),   & 
     127         &      utide     (nb_harmo), ftide (nb_harmo)  ) 
    127128      kt_tide = nit000 
    128129      ! 
    129       IF (.NOT.ln_scal_load ) rn_scal_load = 0._wp 
     130      IF (.NOT.ln_scal_load )   rn_load = 0._wp 
    130131      ! 
    131132   END SUBROUTINE tide_init 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/updtide.F90

    r9598 r9939  
    66   !! History :  9.0  !  07  (O. Le Galloudec)  Original code 
    77   !!---------------------------------------------------------------------- 
    8    !!   upd_tide       : update tidal potential 
     8 
    99   !!---------------------------------------------------------------------- 
    10    USE oce             ! ocean dynamics and tracers variables 
    11    USE dom_oce         ! ocean space and time domain 
    12    USE in_out_manager  ! I/O units 
    13    USE phycst          ! physical constant 
    14    USE sbctide         ! tide potential variable 
    15    USE tideini, ONLY: ln_tide_ramp, rdttideramp 
     10   !!   upd_tide      : update tidal potential 
     11   !!---------------------------------------------------------------------- 
     12   USE oce            ! ocean dynamics and tracers variables 
     13   USE dom_oce        ! ocean space and time domain 
     14   USE in_out_manager ! I/O units 
     15   USE phycst         ! physical constant 
     16   USE sbctide        ! tide potential variable 
     17   USE tideini , ONLY : ln_tide_ramp, rn_ramp 
    1618 
    1719   IMPLICIT NONE 
    … …  
    3739      !! ** Action  :   pot_astro   actronomical potential 
    3840      !!----------------------------------------------------------------------       
    39       INTEGER, INTENT(in)           ::   kt      ! ocean time-step index 
    40       INTEGER, INTENT(in), OPTIONAL ::   kit     ! external mode sub-time-step index (lk_dynspg_ts=T) 
    41       INTEGER, INTENT(in), OPTIONAL ::   time_offset ! time offset in number  
    42                                                      ! of internal steps             (lk_dynspg_ts=F) 
    43                                                      ! of external steps             (lk_dynspg_ts=T) 
     41      INTEGER, INTENT(in)           ::   kt          ! ocean time-step index 
     42      INTEGER, INTENT(in), OPTIONAL ::   kit         ! external mode sub-time-step index (lk_dynspg_ts=T) 
     43      INTEGER, INTENT(in), OPTIONAL ::   time_offset ! time offset in number  of internal steps (lk_dynspg_ts=F) 
     44      !                                              !                        of external steps (lk_dynspg_ts=T) 
    4445      ! 
     46      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    4547      INTEGER  ::   joffset      ! local integer 
    46       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    4748      REAL(wp) ::   zt, zramp    ! local scalar 
    4849      REAL(wp), DIMENSION(nb_harmo) ::   zwt  
    … …  
    5051      ! 
    5152      !                               ! tide pulsation at model time step (or sub-time-step) 
    52       zt = ( kt - kt_tide ) * rdt 
     53      zt = ( kt - kt_tide ) * rn_Dt 
    5354      ! 
    5455      joffset = 0 
    … …  
    5657      ! 
    5758      IF( PRESENT( kit ) )   THEN 
    58          zt = zt + ( kit +  joffset - 1 ) * rdt / REAL( nn_baro, wp ) 
     59         zt = zt + ( kit +  joffset - 1 ) * rn_Dt / REAL( nn_e, wp ) 
    5960      ELSE 
    60          zt = zt + joffset * rdt 
     61         zt = zt + joffset * rn_Dt 
    6162      ENDIF 
    6263      ! 
    … …  
    6970      ! 
    7071      IF( ln_tide_ramp ) THEN         ! linear increase if asked 
    71          zt = ( kt - nit000 ) * rdt 
    72          IF( PRESENT( kit ) )   zt = zt + ( kit + joffset -1) * rdt / REAL( nn_baro, wp ) 
    73          zramp = MIN(  MAX( zt / (rdttideramp*rday) , 0._wp ) , 1._wp  ) 
     72         zt = ( kt - nit000 ) * rn_Dt 
     73         IF( PRESENT( kit ) )   zt = zt + ( kit + joffset -1) * rn_Dt / REAL( nn_e, wp ) 
     74         zramp = MIN(  MAX( 0._wp , zt / (rn_ramp*rday) ) , 1._wp  ) 
    7475         pot_astro(:,:) = zramp * pot_astro(:,:) 
    7576      ENDIF 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/eosbn2.F90

    r9757 r9939  
    190190      !!                   ***  ROUTINE eos_insitu  *** 
    191191      !! 
    192       !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from 
     192      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) from 
    193193      !!       potential temperature and salinity using an equation of state 
    194194      !!       selected in the nameos namelist 
    195195      !! 
    196       !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0 
     196      !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rho0 ) / rho0 
    197197      !!         with   prd    in situ density anomaly      no units 
    198198      !!                t      TEOS10: CT or EOS80: PT      Celsius 
    … …  
    200200      !!                z      depth                        meters 
    201201      !!                rho    in situ density              kg/m^3 
    202       !!                rau0   reference density            kg/m^3 
     202      !!                rho0   reference density            kg/m^3 
    203203      !! 
    204204      !!     ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z). 
    … …  
    209209      !! 
    210210      !!     ln_seos : simplified equation of state 
    211       !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0 
     211      !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rho0 
    212212      !!              linear case function of T only: rn_alpha<>0, other coefficients = 0 
    213213      !!              linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0 
    … …  
    268268                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    269269                  ! 
    270                   prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm  ! density anomaly (masked) 
     270                  prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm  ! density anomaly (masked) 
    271271                  ! 
    272272               END DO 
    … …  
    288288                     &  - rn_nu * zt * zs 
    289289                     !                                  
    290                   prd(ji,jj,jk) = zn * r1_rau0 * ztm                ! density anomaly (masked) 
     290                  prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked) 
    291291               END DO 
    292292            END DO 
    … …  
    306306      !!                  ***  ROUTINE eos_insitu_pot  *** 
    307307      !! 
    308       !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the 
     308      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) and the 
    309309      !!      potential volumic mass (Kg/m3) from potential temperature and 
    310310      !!      salinity fields using an equation of state selected in the 
    … …  
    388388                        prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface 
    389389                        ! 
    390                         prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rau0 - 1._wp  )   ! density anomaly (masked) 
     390                        prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rho0 - 1._wp  )   ! density anomaly (masked) 
    391391                     END DO 
    392392                     prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 
    … …  
    432432                     prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
    433433                     ! 
    434                      prd(ji,jj,jk) = (  zn * r1_rau0 - 1._wp  ) * ztm      ! density anomaly (masked) 
     434                     prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm      ! density anomaly (masked) 
    435435                  END DO 
    436436               END DO 
    … …  
    451451                     &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
    452452                     &  - rn_nu * zt * zs 
    453                   prhop(ji,jj,jk) = ( rau0 + zn ) * ztm 
     453                  prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 
    454454                  !                                                     ! density anomaly (masked) 
    455455                  zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 
    456                   prd(ji,jj,jk) = zn * r1_rau0 * ztm 
     456                  prd(ji,jj,jk) = zn * r1_rho0 * ztm 
    457457                  ! 
    458458               END DO 
    … …  
    473473      !!                  ***  ROUTINE eos_insitu_2d  *** 
    474474      !! 
    475       !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from 
     475      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) from 
    476476      !!      potential temperature and salinity using an equation of state 
    477477      !!      selected in the nameos namelist. * 2D field case 
    … …  
    528528               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    529529               ! 
    530                prd(ji,jj) = zn * r1_rau0 - 1._wp               ! unmasked in situ density anomaly 
     530               prd(ji,jj) = zn * r1_rho0 - 1._wp               ! unmasked in situ density anomaly 
    531531               ! 
    532532            END DO 
    … …  
    548548                  &  - rn_nu * zt * zs 
    549549                  ! 
    550                prd(ji,jj) = zn * r1_rau0               ! unmasked in situ density anomaly 
     550               prd(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly 
    551551               ! 
    552552            END DO 
    … …  
    616616                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    617617                  ! 
    618                   pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm 
     618                  pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 
    619619                  ! 
    620620                  ! beta 
    … …  
    637637                  zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    638638                  ! 
    639                   pab(ji,jj,jk,jp_sal) = zn / zs * r1_rau0 * ztm 
     639                  pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 
    640640                  ! 
    641641               END DO 
    … …  
    654654                  ! 
    655655                  zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
    656                   pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm   ! alpha 
     656                  pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm   ! alpha 
    657657                  ! 
    658658                  zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
    659                   pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm   ! beta 
     659                  pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm   ! beta 
    660660                  ! 
    661661               END DO 
    … …  
    729729               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    730730               ! 
    731                pab(ji,jj,jp_tem) = zn * r1_rau0 
     731               pab(ji,jj,jp_tem) = zn * r1_rho0 
    732732               ! 
    733733               ! beta 
    … …  
    750750               zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    751751               ! 
    752                pab(ji,jj,jp_sal) = zn / zs * r1_rau0 
     752               pab(ji,jj,jp_sal) = zn / zs * r1_rho0 
    753753               ! 
    754754               ! 
    … …  
    768768               ! 
    769769               zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
    770                pab(ji,jj,jp_tem) = zn * r1_rau0   ! alpha 
     770               pab(ji,jj,jp_tem) = zn * r1_rho0   ! alpha 
    771771               ! 
    772772               zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
    773                pab(ji,jj,jp_sal) = zn * r1_rau0   ! beta 
     773               pab(ji,jj,jp_sal) = zn * r1_rho0   ! beta 
    774774               ! 
    775775            END DO 
    … …  
    841841         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    842842         ! 
    843          pab(jp_tem) = zn * r1_rau0 
     843         pab(jp_tem) = zn * r1_rho0 
    844844         ! 
    845845         ! beta 
    … …  
    862862         zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    863863         ! 
    864          pab(jp_sal) = zn / zs * r1_rau0 
     864         pab(jp_sal) = zn / zs * r1_rho0 
    865865         ! 
    866866         ! 
    … …  
    873873         ! 
    874874         zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
    875          pab(jp_tem) = zn * r1_rau0   ! alpha 
     875         pab(jp_tem) = zn * r1_rho0   ! alpha 
    876876         ! 
    877877         zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
    878          pab(jp_sal) = zn * r1_rau0   ! beta 
     878         pab(jp_sal) = zn * r1_rho0   ! beta 
    879879         ! 
    880880      CASE DEFAULT 
    … …  
    11041104      !! ** Method  :   PE is defined analytically as the vertical  
    11051105      !!                   primitive of EOS times -g integrated between 0 and z>0. 
    1106       !!                pen is the nonlinear bsq-PE anomaly: pen = ( PE - rau0 gz ) / rau0 gz - rd 
     1106      !!                pen is the nonlinear bsq-PE anomaly: pen = ( PE - rho0 gz ) / rho0 gz - rd 
    11071107      !!                                                      = 1/z * /int_0^z rd dz - rd  
    11081108      !!                                where rd is the density anomaly (see eos_rhd function) 
    11091109      !!                ab_pe are partial derivatives of PE anomaly with respect to T and S: 
    1110       !!                    ab_pe(1) = - 1/(rau0 gz) * dPE/dT + drd/dT = - d(pen)/dT 
    1111       !!                    ab_pe(2) =   1/(rau0 gz) * dPE/dS + drd/dS =   d(pen)/dS 
     1110      !!                    ab_pe(1) = - 1/(rho0 gz) * dPE/dT + drd/dT = - d(pen)/dT 
     1111      !!                    ab_pe(2) =   1/(rho0 gz) * dPE/dS + drd/dS =   d(pen)/dS 
    11121112      !! 
    11131113      !! ** Action  : - pen         : PE anomaly given at T-points 
    … …  
    11561156                  zn  = ( zn2 * zh + zn1 ) * zh + zn0 
    11571157                  ! 
    1158                   ppen(ji,jj,jk)  = zn * zh * r1_rau0 * ztm 
     1158                  ppen(ji,jj,jk)  = zn * zh * r1_rho0 * ztm 
    11591159                  ! 
    11601160                  ! alphaPE non-linear anomaly 
    … …  
    11711171                  zn  = ( zn2 * zh + zn1 ) * zh + zn0 
    11721172                  !                               
    1173                   pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rau0 * ztm 
     1173                  pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 
    11741174                  ! 
    11751175                  ! betaPE non-linear anomaly 
    … …  
    11861186                  zn  = ( zn2 * zh + zn1 ) * zh + zn0 
    11871187                  !                               
    1188                   pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rau0 * ztm 
     1188                  pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 
    11891189                  ! 
    11901190               END DO 
    … …  
    12011201                  zh  = gdept_n(ji,jj,jk)              ! depth in meters  at t-point 
    12021202                  ztm = tmask(ji,jj,jk)                ! tmask 
    1203                   zn  = 0.5_wp * zh * r1_rau0 * ztm 
     1203                  zn  = 0.5_wp * zh * r1_rho0 * ztm 
    12041204                  !                                    ! Potential Energy 
    12051205                  ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 
    … …  
    12481248      IF(lwm) WRITE( numond, nameos ) 
    12491249      ! 
    1250       rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3] 
     1250      rho0        = 1026._wp                 !: volumic mass of reference     [kg/m3] 
    12511251      rcp         = 3991.86795711963_wp      !: heat capacity     [J/K] 
    12521252      ! 
    … …  
    16571657            WRITE(numout,*) '   ==>>>   use of simplified eos:    ' 
    16581658            WRITE(numout,*) '              rhd(dT=T-10,dS=S-35,Z) = [-a0*(1+lambda1/2*dT+mu1*Z)*dT ' 
    1659             WRITE(numout,*) '                                       + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rau0' 
     1659            WRITE(numout,*) '                                       + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rho0' 
    16601660            WRITE(numout,*) '              with the following coefficients :' 
    16611661            WRITE(numout,*) '                 thermal exp. coef.    rn_a0      = ', rn_a0 
    … …  
    16761676      END SELECT 
    16771677      ! 
    1678       rau0_rcp    = rau0 * rcp  
    1679       r1_rau0     = 1._wp / rau0 
     1678      rho0_rcp    = rho0 * rcp  
     1679      r1_rho0     = 1._wp / rho0 
    16801680      r1_rcp      = 1._wp / rcp 
    1681       r1_rau0_rcp = 1._wp / rau0_rcp  
     1681      r1_rho0_rcp = 1._wp / rho0_rcp  
    16821682      ! 
    16831683      IF(lwp) THEN 
    … …  
    16941694      IF(lwp) WRITE(numout,*) 
    16951695      IF(lwp) WRITE(numout,*) '   Associated physical constant' 
    1696       IF(lwp) WRITE(numout,*) '      volumic mass of reference           rau0  = ', rau0   , ' kg/m^3' 
    1697       IF(lwp) WRITE(numout,*) '      1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
     1696      IF(lwp) WRITE(numout,*) '      volumic mass of reference           rho0  = ', rho0   , ' kg/m^3' 
     1697      IF(lwp) WRITE(numout,*) '      1. / rho0                        r1_rho0  = ', r1_rho0, ' m^3/kg' 
    16981698      IF(lwp) WRITE(numout,*) '      ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
    1699       IF(lwp) WRITE(numout,*) '      rau0 * rcp                       rau0_rcp = ', rau0_rcp 
    1700       IF(lwp) WRITE(numout,*) '      1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
     1699      IF(lwp) WRITE(numout,*) '      rho0 * rcp                       rho0_rcp = ', rho0_rcp 
     1700      IF(lwp) WRITE(numout,*) '      1. / ( rho0 * rcp )           r1_rho0_rcp = ', r1_rho0_rcp 
    17011701      ! 
    17021702   END SUBROUTINE eos_init 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traadv.F90

    r9598 r9939  
    8787      INTEGER ::   jk   ! dummy loop index 
    8888      REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zun, zvn, zwn   ! 3D workspace 
    89       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds 
     89      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrd 
    9090      !!---------------------------------------------------------------------- 
    9191      ! 
    9292      IF( ln_timing )   CALL timing_start('tra_adv') 
    93       ! 
    94       !                                          ! set time step 
    95       IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =         rdt   ! at nit000             (Euler) 
    96       ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp * rdt   ! at nit000 or nit000+1 (Leapfrog) 
    97       ENDIF 
    9893      ! 
    9994      !                                         !==  effective transport  ==! 
    … …  
    138133      ! 
    139134      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    140          ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
    141          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    142          ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     135         ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 
     136         ztrd(:,:,:,:) = tsa(:,:,:,:) 
    143137      ENDIF 
    144138      ! 
    … …  
    146140      ! 
    147141      CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
    148          CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v ) 
     142         CALL tra_adv_cen    ( kt, nit000, 'TRA',      zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v ) 
    149143      CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    150          CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v ) 
     144         CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v ) 
    151145      CASE ( np_MUS )                                 ! MUSCL 
    152          CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups )  
     146         CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups )  
    153147      CASE ( np_UBS )                                 ! UBS 
    154          CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   ) 
     148         CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   ) 
    155149      CASE ( np_QCK )                                 ! QUICKEST 
    156          CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     ) 
     150         CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     ) 
    157151      ! 
    158152      END SELECT 
    … …  
    160154      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics 
    161155         DO jk = 1, jpkm1 
    162             ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 
    163             ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 
     156            ztrd(:,:,jk,:) = tsa(:,:,jk,:) - ztrd(:,:,jk,:) 
    164157         END DO 
    165          CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 
    166          CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 
    167          DEALLOCATE( ztrdt, ztrds ) 
     158         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrd(:,:,:,jp_tem) ) 
     159         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrd(:,:,:,jp_sal) ) 
     160         DEALLOCATE( ztrd ) 
    168161      ENDIF 
    169162      !                                              ! print mean trends (used for debugging) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traadv_fct.F90

    r9598 r9939  
    2020   USE diaptr         ! poleward transport diagnostics 
    2121   USE diaar5         ! AR5 diagnostics 
    22    USE phycst  , ONLY : rau0_rcp 
    2322   ! 
    2423   USE in_out_manager ! I/O manager 
    … …  
    131130                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) ) 
    132131                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) ) 
     132!!gm faster coding ?   ===>>> to be tested : 
     133!                  zwx(ji,jj,jk) = MAX( pun(ji,jj,jk) , 0._wp ) * ptb(ji  ,jj,jk,jn)   & 
     134!                     &          + MIN( pun(ji,jj,jk) , 0._wp ) * ptb(ji+1,jj,jk,jn) 
     135!                  zwy(ji,jj,jk) = MAX( pvn(ji,jj,jk) , 0._wp ) * ptb(ji,jj  ,jk,jn)   & 
     136!                     &          + MIN( pvn(ji,jj,jk) , 0._wp ) * ptb(ji,jj+1,jk,jn) 
     137!!gm 
     138                   
    133139               END DO 
    134140            END DO 
    … …  
    141147                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
    142148                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
     149!!gm faster coding ?   ===>>> to be tested : 
     150!                  zwx(ji,jj,jk) = MAX( pwn(ji,jj,jk) , 0._wp ) * pwn(ji,jj,jk  ,jn)   & 
     151!                     &          + MIN( pwn(ji,jj,jk) , 0._wp ) * pwn(ji,jj,jk-1,jn) 
     152!!gm 
    143153               END DO 
    144154            END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trabbc.F90

    r9598 r9939  
    6464      !!       ocean bottom can be computed once and is added to the temperature 
    6565      !!       trend juste above the bottom at each time step: 
    66       !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbkt 
     66      !!            ta = ta + Qsf / (rho0 rcp e3T) for k= mbkt 
    6767      !!       Where Qsf is the geothermal heat flux. 
    6868      !! 
    … …  
    7676      ! 
    7777      INTEGER  ::   ji, jj    ! dummy loop indices 
    78       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt   ! 3D workspace 
     78      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrd   ! 3D workspace 
    7979      !!---------------------------------------------------------------------- 
    8080      ! 
    … …  
    8282      ! 
    8383      IF( l_trdtra )   THEN         ! Save the input temperature trend 
    84          ALLOCATE( ztrdt(jpi,jpj,jpk) ) 
    85          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     84         ALLOCATE( ztrd(jpi,jpj,jpk) ) 
     85         ztrd(:,:,:) = tsa(:,:,:,jp_tem) 
    8686      ENDIF 
    8787      !                             !  Add the geothermal trend on temperature 
    … …  
    9595      ! 
    9696      IF( l_trdtra ) THEN        ! Send the trend for diagnostics 
    97          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    98          CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 
    99          DEALLOCATE( ztrdt ) 
     97         ztrd(:,:,:) = tsa(:,:,:,jp_tem) - ztrd(:,:,:) 
     98         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrd ) 
     99         DEALLOCATE( ztrd ) 
    100100      ENDIF 
    101101      ! 
    … …  
    157157         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation 
    158158         ! 
    159          SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp) 
     159         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rhoO * Cp) 
    160160         ! 
    161161         CASE ( 1 )                          !* constant flux 
    162162            IF(lwp) WRITE(numout,*) '   ==>>>   constant heat flux  =   ', rn_geoflx_cst 
    163             qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst 
     163            qgh_trd0(:,:) = r1_rho0_rcp * rn_geoflx_cst 
    164164            ! 
    165165         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 
    … …  
    178178 
    179179            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data 
    180             qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2 
     180            qgh_trd0(:,:) = r1_rho0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2 
    181181            ! 
    182182         CASE DEFAULT 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trabbl.F90

    r9598 r9939  
    103103      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    104104      ! 
    105       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     105      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd 
    106106      !!---------------------------------------------------------------------- 
    107107      ! 
    … …  
    109109      ! 
    110110      IF( l_trdtra )   THEN                         !* Save the T-S input trends 
    111          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    112          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    113          ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     111         ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 
     112         ztrd(:,:,:,:) = tsa(:,:,:,:) 
    114113      ENDIF 
    115114 
    … …  
    143142 
    144143      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics 
    145          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    146          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    147          CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    148          CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    149          DEALLOCATE( ztrdt, ztrds ) 
     144         ztrd(:,:,:,:) = tsa(:,:,:,:) - ztrd(:,:,:,:) 
     145         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrd(:,:,:,jp_tem) ) 
     146         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrd(:,:,:,jp_sal) ) 
     147         DEALLOCATE( ztrd ) 
    150148      ENDIF 
    151149      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tradmp.F90

    r9598 r9939  
    9494      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    9595      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta 
    96       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts 
     96      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrd 
    9797      !!---------------------------------------------------------------------- 
    9898      ! 
    … …  
    100100      ! 
    101101      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    102          ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) )  
    103          ztrdts(:,:,:,:) = tsa(:,:,:,:)  
     102         ALLOCATE( ztrd(jpi,jpj,jpk,jpts) )  
     103         ztrd(:,:,:,:) = tsa(:,:,:,:)  
    104104      ENDIF 
    105105      !                           !==  input T-S data at kt  ==! 
    … …  
    150150      ! 
    151151      IF( l_trdtra )   THEN       ! trend diagnostic 
    152          ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:) 
    153          CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 
    154          CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 
    155          DEALLOCATE( ztrdts )  
     152         ztrd(:,:,:,:) = tsa(:,:,:,:) - ztrd(:,:,:,:) 
     153         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrd(:,:,:,jp_tem) ) 
     154         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrd(:,:,:,jp_sal) ) 
     155         DEALLOCATE( ztrd )  
    156156      ENDIF 
    157157      !                           ! Control print 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traldf.F90

    r9598 r9939  
    5555      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5656      !! 
    57       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     57      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd   ! 4D workspace 
    5858      !!---------------------------------------------------------------------- 
    5959      ! 
    … …  
    6161      ! 
    6262      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    63          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    64          ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    65          ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     63         ALLOCATE( ztrd(jpi,jpj,jpk,jpts) )  
     64         ztrd(:,:,:,:) = tsa(:,:,:,:)  
    6665      ENDIF 
    6766      ! 
    … …  
    7877      ! 
    7978      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
    80          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    81          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    82          CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    83          CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 
    84          DEALLOCATE( ztrdt, ztrds )  
     79         ztrd(:,:,:,:) = tsa(:,:,:,:) - ztrd(:,:,:,:) 
     80         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrd(:,:,:,jp_tem) ) 
     81         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrd(:,:,:,jp_sal) ) 
     82         DEALLOCATE( ztrd )  
    8583      ENDIF 
    8684      !                                        !* print mean trends (used for debugging) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traldf_iso.F90

    r9779 r9939  
    108108      REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars 
    109109      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      - 
    110       REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt   !   -      - 
     110      REAL(wp) ::  zcoef0, ze3w_2, zsign                 !   -      - 
    111111      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt, zdk1t, z2d 
    112112      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, zftu, zftv, ztfw  
    … …  
    127127      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    128128         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE. 
    129       ! 
    130       !                                            ! set time step size (Euler/Leapfrog) 
    131       IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler) 
    132       ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog) 
    133       ENDIF 
    134       z1_2dt = 1._wp / z2dt 
    135129      ! 
    136130      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
    … …  
    191185                     DO ji = 1, fs_jpim1 
    192186                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) 
    193                         zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
    194                         akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 
     187                        zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
     188                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * r1_Dt 
    195189                     END DO 
    196190                  END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traldf_triad.F90

    r9598 r9939  
    8585      INTEGER  ::  ip,jp,kp         ! dummy loop indices 
    8686      INTEGER  ::  ierr            ! local integer 
    87       REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3          ! local scalars 
    88       REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4          !   -      - 
    89       REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt  !   -      - 
     87      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars 
     88      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
     89      REAL(wp) ::  zcoef0, ze3w_2, zsign         !   -      - 
    9090      ! 
    9191      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv 
    … …  
    110110      l_hst = .FALSE. 
    111111      l_ptr = .FALSE. 
    112       IF( cdtype == 'TRA' .AND. ln_diaptr )                                                 l_ptr = .TRUE.  
    113       IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    114          &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )   l_hst = .TRUE. 
    115       ! 
    116       !                                                        ! set time step size (Euler/Leapfrog) 
    117       IF( neuler == 0 .AND. kt == kit000 ) THEN   ;   z2dt =     rdt      ! at nit000   (Euler) 
    118       ELSE                                        ;   z2dt = 2.* rdt      !             (Leapfrog) 
     112      IF( cdtype == 'TRA' ) THEN 
     113         IF ( ln_diaptr )                                                 l_ptr = .TRUE.  
     114         IF ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     115            & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")      )   l_hst = .TRUE. 
    119116      ENDIF 
    120       z1_2dt = 1._wp / z2dt 
    121117      ! 
    122118      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
    … …  
    202198                     DO ji = 1, fs_jpim1 
    203199                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) 
    204                         zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
    205                         akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 
     200                        zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
     201                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * r1_Dt 
    206202                     END DO 
    207203                  END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tramle.F90

    r9598 r9939  
    4141 
    4242   REAL(wp) ::   r5_21 = 5.e0 / 21.e0   ! factor used in mle streamfunction computation 
    43    REAL(wp) ::   rb_c                   ! ML buoyancy criteria = g rho_c /rau0 where rho_c is defined in zdfmld 
     43   REAL(wp) ::   rb_c                   ! ML buoyancy criteria = g rho_c /rho0 where rho_c is defined in zdfmld 
    4444   REAL(wp) ::   rc_f                   ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_mle=1 case 
    4545 
    … …  
    115115               zc = e3t_n(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
    116116               zmld(ji,jj) = zmld(ji,jj) + zc 
    117                zbm (ji,jj) = zbm (ji,jj) + zc * (rau0 - rhop(ji,jj,jk) ) * r1_rau0 
     117               zbm (ji,jj) = zbm (ji,jj) + zc * (rho0 - rhop(ji,jj,jk) ) * r1_rho0 
    118118               zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp 
    119119            END DO 
    … …  
    302302      IF( ln_mle ) THEN                ! MLE initialisation 
    303303         ! 
    304          rb_c = grav * rn_rho_c_mle /rau0        ! Mixed Layer buoyancy criteria 
     304         rb_c = grav * rn_rho_c_mle / rho0       ! Mixed Layer buoyancy criteria 
    305305         IF(lwp) WRITE(numout,*) 
    306306         IF(lwp) WRITE(numout,*) '      ML buoyancy criteria = ', rb_c, ' m/s2 ' 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tranpc.F90

    r9598 r9939  
    6565      LOGICAL  ::   l_bottom_reached, l_column_treated 
    6666      REAL(wp) ::   zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 
    67       REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt 
     67      REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw 
    6868      REAL(wp), PARAMETER ::   zn2_zero = 1.e-14_wp      ! acceptance criteria for neutrality (N2==0) 
    6969      REAL(wp), DIMENSION(        jpk     ) ::   zvn2         ! vertical profile of N2 at 1 given point... 
    … …  
    7171      REAL(wp), DIMENSION(jpi,jpj,jpk     ) ::   zn2          ! N^2  
    7272      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   zab          ! alpha and beta 
    73       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
     73      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd   ! 4D workspace 
    7474      ! 
    7575      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is 
    … …  
    8282      IF( MOD( kt, nn_npc ) == 0 ) THEN 
    8383         ! 
    84          IF( l_trdtra )   THEN                    !* Save initial after fields 
    85             ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    86             ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    87             ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     84         IF( l_trdtra )   THEN                    !* Save input after fields 
     85            ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 
     86            ztrd(:,:,:,:) = tsa(:,:,:,:)  
    8887         ENDIF 
    8988         ! 
    … …  
    301300         ! 
    302301         IF( l_trdtra ) THEN         ! send the Non penetrative mixing trends for diagnostic 
    303             z1_r2dt = 1._wp / (2._wp * rdt) 
    304             ztrdt(:,:,:) = ( tsa(:,:,:,jp_tem) - ztrdt(:,:,:) ) * z1_r2dt 
    305             ztrds(:,:,:) = ( tsa(:,:,:,jp_sal) - ztrds(:,:,:) ) * z1_r2dt 
    306             CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt ) 
    307             CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds ) 
    308             DEALLOCATE( ztrdt, ztrds ) 
     302            ztrd(:,:,:,:) = ( tsa(:,:,:,:) - ztrd(:,:,:,:) ) * r1_Dt 
     303            CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrd(:,:,:,jp_tem) ) 
     304            CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrd(:,:,:,jp_sal) ) 
     305            DEALLOCATE( ztrd ) 
    309306         ENDIF 
    310307         ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tranxt.F90

    r9598 r9939  
    9090      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    9191      REAL(wp) ::   zfact            ! local scalars 
    92       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     92      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrd   ! 4D workspace 
    9393      !!---------------------------------------------------------------------- 
    9494      ! 
    … …  
    111111      IF( ln_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries 
    112112  
    113       ! set time step size (Euler/Leapfrog) 
    114       IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =        rdt   ! at nit000             (Euler) 
    115       ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog) 
    116       ENDIF 
    117  
    118       ! trends computation initialisation 
    119       IF( l_trdtra )   THEN                     
    120          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    121          ztrdt(:,:,jpk) = 0._wp 
    122          ztrds(:,:,jpk) = 0._wp 
     113      IF( l_trdtra )   THEN               ! trends computation initialisation 
     114         ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 
     115         ztrd(:,:,jpk,:) = 0._wp 
    123116         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend  
    124             CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 
    125             CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds ) 
     117            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrd(:,:,:,jp_tem) ) 
     118            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrd(:,:,:,jp_sal) ) 
    126119         ENDIF 
    127120         ! total trend for the non-time-filtered variables.  
    128          zfact = 1.0 / rdt 
     121         zfact = 1.0 / rn_Dt 
    129122         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms 
    130          DO jk = 1, jpkm1 
    131             ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact 
    132             ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact 
    133          END DO 
    134          CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 
    135          CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 
    136          IF( ln_linssh ) THEN       ! linear sea surface height only 
    137             ! Store now fields before applying the Asselin filter  
    138             ! in order to calculate Asselin filter trend later. 
    139             ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
    140             ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
    141          ENDIF 
    142       ENDIF 
    143  
    144       IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap) 
     123         DO jn = 1, jpts 
     124            DO jk = 1, jpkm1 
     125               ztrd(:,:,jk,jn) = ( tsa(:,:,jk,jn)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jn)) * zfact 
     126            END DO 
     127         END DO 
     128         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrd(:,:,:,jp_tem) ) 
     129         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrd(:,:,:,jp_sal) ) 
     130         IF( ln_linssh ) THEN       ! linear sea surface height only Store now fields before applying  
     131            !                       ! the Asselin filter in order to calculate Asselin filter trend later. 
     132            ztrd(:,:,:,:) = tsn(:,:,:,:)  
     133         ENDIF 
     134      ENDIF 
     135 
     136      IF( l_1st_euler ) THEN        ! Euler time-stepping at first time-step (only swap) 
    145137         DO jn = 1, jpts 
    146138            DO jk = 1, jpkm1 
    … …  
    150142         IF (l_trdtra .AND. .NOT. ln_linssh ) THEN   ! Zero Asselin filter contribution must be explicitly written out since for vvl 
    151143            !                                        ! Asselin filter is output by tra_nxt_vvl that is not called on this time step 
    152             ztrdt(:,:,:) = 0._wp 
    153             ztrds(:,:,:) = 0._wp 
    154             CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
    155             CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 
     144            ztrd(:,:,:,:) = 0._wp 
     145            CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrd(:,:,:,jp_tem) ) 
     146            CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrd(:,:,:,jp_sal) ) 
    156147         END IF 
    157148         ! 
    158       ELSE                                            ! Leap-Frog + Asselin filter time stepping 
    159          ! 
    160          IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nit000,      'TRA', tsb, tsn, tsa, jpts )  ! linear free surface  
    161          ELSE                   ;   CALL tra_nxt_vvl( kt, nit000, rdt, 'TRA', tsb, tsn, tsa,   & 
    162            &                                                                sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface 
    163          ENDIF 
    164          ! 
    165          CALL lbc_lnk_multi( tsb(:,:,:,jp_tem), 'T', 1., tsb(:,:,:,jp_sal), 'T', 1., & 
    166                   &          tsn(:,:,:,jp_tem), 'T', 1., tsn(:,:,:,jp_sal), 'T', 1., & 
    167                   &          tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1.  ) 
     149      ELSE                          ! Leap-Frog + Asselin filter time stepping 
     150         ! 
     151         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nit000,       'TRA', tsb, tsn, tsa, jpts )  ! linear free surface  
     152         ELSE                   ;   CALL tra_nxt_vvl( kt, nit000, rn_Dt,'TRA', tsb, tsn, tsa,   & 
     153           &                                                               sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface 
     154         ENDIF 
     155         ! 
     156         CALL lbc_lnk_multi( tsb, 'T', 1., tsn, 'T', 1., tsa, 'T', 1.  ) 
    168157         ! 
    169158      ENDIF      
    170159      ! 
    171160      IF( l_trdtra .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    172          zfact = 1._wp / r2dt              
    173161         DO jk = 1, jpkm1 
    174             ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 
    175             ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 
    176          END DO 
    177          CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
    178          CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 
     162            ztrd(:,:,jk,:) = ( tsb(:,:,jk,:) - ztrd(:,:,jk,:) ) * r1_Dt 
     163         END DO 
     164         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrd(:,:,:,jp_tem) ) 
     165         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrd(:,:,:,jp_sal) ) 
    179166      END IF 
    180       IF( l_trdtra )   DEALLOCATE( ztrdt , ztrds ) 
     167      IF( l_trdtra )   DEALLOCATE( ztrd ) 
    181168      ! 
    182169      !                        ! control print 
    … …  
    227214                  ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn)  ! time laplacian on tracers 
    228215                  ! 
    229                   ptb(ji,jj,jk,jn) = ztn + atfp * ztd                      ! ptb <-- filtered ptn  
     216                  ptb(ji,jj,jk,jn) = ztn + rn_atfp * ztd                   ! ptb <-- filtered ptn  
    230217                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                      ! ptn <-- pta 
    231218               END DO 
    … …  
    238225 
    239226 
    240    SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt ) 
     227   SUBROUTINE tra_nxt_vvl( kt, kit000, pdt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt ) 
    241228      !!---------------------------------------------------------------------- 
    242229      !!                   ***  ROUTINE tra_nxt_vvl  *** 
    … …  
    247234      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields. 
    248235      !!              - swap tracer fields to prepare the next time_step. 
    249       !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 
    250       !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] ) 
     236      !!             tb  = ( e3t_n*tn + rn_atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 
     237      !!                  /( e3t_n    + rn_atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] ) 
    251238      !!             tn  = ta  
    252239      !! 
    … …  
    255242      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index 
    256243      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index 
    257       REAL(wp)                             , INTENT(in   ) ::  p2dt      ! time-step 
     244      REAL(wp)                             , INTENT(in   ) ::  pdt       ! time-step 
    258245      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator) 
    259246      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers 
    … …  
    289276      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN 
    290277         ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) ) 
    291          ztrd_atf(:,:,:,:) = 0.0_wp 
    292       ENDIF 
    293       zfact = 1._wp / r2dt 
    294       zfact1 = atfp * p2dt 
    295       zfact2 = zfact1 * r1_rau0 
    296       DO jn = 1, kjpt       
     278         ztrd_atf(:,:,:,:) = 0._wp 
     279      ENDIF 
     280      ! 
     281      zfact = r1_Dt 
     282      zfact1 = rn_atfp * pdt 
     283      zfact2 = zfact1 * r1_rho0 
     284      DO jn = 1, kjpt 
    297285         DO jk = 1, jpkm1 
    298286            DO jj = 2, jpjm1 
    … …  
    309297                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b 
    310298                  ! 
    311                   ze3t_f = ze3t_n + atfp * ze3t_d 
    312                   ztc_f  = ztc_n  + atfp * ztc_d 
     299                  ze3t_f = ze3t_n + rn_atfp * ze3t_d 
     300                  ztc_f  = ztc_n  + rn_atfp * ztc_d 
    313301                  ! 
    314302                  IF( jk == mikt(ji,jj) ) THEN           ! first level  

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traqsr.F90

    r9598 r9939  
    8787      !!         I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) ) 
    8888      !!         The temperature trend associated with the solar radiation penetration  
    89       !!         is given by : zta = 1/e3t dk[ I ] / (rau0*Cp) 
     89      !!         is given by : zta = 1/e3t dk[ I ] / (rho0*Cp) 
    9090      !!         At the bottom, boudary condition for the radiation is no flux : 
    9191      !!      all heat which has not been absorbed in the above levels is put 
    … …  
    112112      REAL(wp) ::   zlogc, zlogc2, zlogc3  
    113113      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: zekb, zekg, zekr 
    114       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
     114      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrd 
    115115      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d 
    116116      !!---------------------------------------------------------------------- 
    … …  
    125125      ! 
    126126      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend 
    127          ALLOCATE( ztrdt(jpi,jpj,jpk) )  
    128          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     127         ALLOCATE( ztrd(jpi,jpj,jpk) )  
     128         ztrd(:,:,:) = tsa(:,:,:,jp_tem) 
    129129      ENDIF 
    130130      ! 
    … …  
    133133      !                         !-----------------------------------! 
    134134      IF( kt == nit000 ) THEN          !==  1st time step  ==! 
    135 !!gm case neuler  not taken into account.... 
    136          IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN    ! read in restart 
     135         IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0  .AND. .NOT.l_1st_euler ) THEN    ! read in restart 
    137136            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file' 
    138137            z1_2 = 0.5_wp 
    … …  
    154153         ! 
    155154         DO jk = 1, nksr 
    156             qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 
     155            qsr_hc(:,:,jk) = r1_rho0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 
    157156         END DO 
    158157         ! 
    … …  
    234233            DO jj = 2, jpjm1 
    235234               DO ji = fs_2, fs_jpim1 
    236                   qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) ) 
     235                  qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) ) 
    237236               END DO 
    238237            END DO 
    … …  
    243242      CASE( np_2BD  )            !==  2-bands fluxes  ==! 
    244243         ! 
    245          zz0 =        rn_abs   * r1_rau0_rcp      ! surface equi-partition in 2-bands 
    246          zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 
     244         zz0 =        rn_abs   * r1_rho0_rcp      ! surface equi-partition in 2-bands 
     245         zz1 = ( 1. - rn_abs ) * r1_rho0_rcp 
    247246         DO jk = 1, nksr                          ! solar heat absorbed at T-point in the top 400m  
    248247            DO jj = 2, jpjm1 
    … …  
    270269      DO jj = 2, jpjm1  
    271270         DO ji = fs_2, fs_jpim1   ! vector opt. 
    272             IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 
     271            IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) ) 
    273272            ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp 
    274273            ENDIF 
    … …  
    281280         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
    282281         DO jk = nksr, 1, -1 
    283             zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rau0_rcp 
     282            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp 
    284283         END DO          
    285284         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation 
    … …  
    295294      ! 
    296295      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics 
    297          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    298          CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
    299          DEALLOCATE( ztrdt )  
     296         ztrd(:,:,:) = tsa(:,:,:,jp_tem) - ztrd(:,:,:) 
     297         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrd ) 
     298         DEALLOCATE( ztrd )  
    300299      ENDIF 
    301300      !                       ! print mean trends (used for debugging) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trasbc.F90

    r9598 r9939  
    7878      INTEGER  ::   ikt, ikb                    ! local integers 
    7979      REAL(wp) ::   zfact, z1_e3t, zdep, ztim   ! local scalar 
    80       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds 
     80      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrd   ! 4D workspace 
    8181      !!---------------------------------------------------------------------- 
    8282      ! 
    … …  
    8989      ENDIF 
    9090      ! 
    91       IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    92          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    93          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    94          ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     91      IF( l_trdtra ) THEN                    !* Save input tsa trends 
     92         ALLOCATE( ztrd(jpi,jpj,jpk,jpts) )  
     93         ztrd(:,:,:,:) = tsa(:,:,:,:) 
    9594      ENDIF 
    9695      ! 
    … …  
    9897      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration 
    9998         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns 
    100          qsr(:,:) = 0._wp                     ! qsr set to zero 
     99         qsr(:,:) = 0._wp                    ! qsr set to zero 
    101100      ENDIF 
    102101 
    … …  
    127126            IF ( ll_wd ) THEN     ! If near WAD point limit the flux for now 
    128127               IF ( sshn(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN 
    129                   sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux 
     128                  sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux 
    130129               ELSE IF ( sshn(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN 
    131                   sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj) & 
     130                  sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) & 
    132131                       &                * tanh ( 5._wp * ( ( sshn(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 ) * r_rn_wdmin1 ) ) 
    133132               ELSE 
    … …  
    135134               ENDIF 
    136135            ELSE  
    137                sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)   ! non solar heat flux 
     136               sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux 
    138137            ENDIF 
    139138 
    140             sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)   ! salt flux due to freezing/melting 
     139            sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting 
    141140         END DO 
    142141      END DO 
    … …  
    144143         DO jj = 2, jpj                         !==>> add concentration/dilution effect due to constant volume cell 
    145144            DO ji = fs_2, fs_jpim1   ! vector opt. 
    146                sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem) 
    147                sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rau0 * emp(ji,jj) * tsn(ji,jj,1,jp_sal) 
     145               sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem) 
     146               sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * tsn(ji,jj,1,jp_sal) 
    148147            END DO 
    149148         END DO                                 !==>> output c./d. term 
    … …  
    272271 
    273272      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    274          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    275          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    276          CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
    277          CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 
    278          DEALLOCATE( ztrdt , ztrds )  
     273         ztrd(:,:,:,:) = tsa(:,:,:,:) - ztrd(:,:,:,:) 
     274         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrd(:,:,:,jp_tem) ) 
     275         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrd(:,:,:,jp_sal) ) 
     276         DEALLOCATE( ztrd )  
    279277      ENDIF 
    280278      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trazdf.F90

    r9598 r9939  
    5252      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    5353      ! 
    54       INTEGER  ::   jk   ! Dummy loop indices 
    55       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace 
     54      INTEGER  ::   jk, jts   ! Dummy loop indices 
     55      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrd   ! 4D workspace 
    5656      !!--------------------------------------------------------------------- 
    5757      ! 
    … …  
    6464      ENDIF 
    6565      ! 
    66       IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =      rdt   ! at nit000, =   rdt (restarting with Euler time stepping) 
    67       ELSEIF( kt <= nit000 + 1           ) THEN   ;   r2dt = 2. * rdt   ! otherwise, = 2 rdt (leapfrog) 
     66      IF( l_trdtra )   THEN                  !* Save input tsa  trend 
     67         ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 
     68         ztrd(:,:,:,:) = tsa(:,:,:,:) 
    6869      ENDIF 
    6970      ! 
    70       IF( l_trdtra )   THEN                  !* Save ta and sa trends 
    71          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    72          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    73          ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    74       ENDIF 
    75       ! 
    7671      !                                      !* compute lateral mixing trend and add it to the general trend 
    77       CALL tra_zdf_imp( kt, nit000, 'TRA', r2dt, tsb, tsa, jpts )  
     72      CALL tra_zdf_imp( kt, nit000, 'TRA', rDt, tsb, tsa, jpts )  
    7873 
    7974!!gm WHY here !   and I don't like that ! 
    … …  
    8580 
    8681      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    87          DO jk = 1, jpkm1 
    88             ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem)*e3t_a(:,:,jk) - tsb(:,:,jk,jp_tem)*e3t_b(:,:,jk) ) & 
    89                &          / (e3t_n(:,:,jk)*r2dt) ) - ztrdt(:,:,jk) 
    90             ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal)*e3t_a(:,:,jk) - tsb(:,:,jk,jp_sal)*e3t_b(:,:,jk) ) & 
    91               &           / (e3t_n(:,:,jk)*r2dt) ) - ztrds(:,:,jk) 
     82         DO jts = 1, jpts 
     83            DO jk = 1, jpkm1 
     84               ztrd(:,:,jk,jts) = ( ( tsa(:,:,jk,jts)*e3t_a(:,:,jk) - tsb(:,:,jk,jts)*e3t_b(:,:,jk) ) / (e3t_n(:,:,jk)*rDt) )   & 
     85                  &            - ztrd(:,:,jk,jts) 
     86            END DO 
    9287         END DO 
    9388!!gm this should be moved in trdtra.F90 and done on all trends 
    94          CALL lbc_lnk_multi( ztrdt, 'T', 1. , ztrds, 'T', 1. ) 
     89         CALL lbc_lnk( ztrd, 'T', 1. ) 
    9590!!gm 
    96          CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) 
    97          CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds ) 
    98          DEALLOCATE( ztrdt , ztrds ) 
     91         CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrd(:,:,:,jp_tem) ) 
     92         CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrd(:,:,:,jp_sal) ) 
     93         DEALLOCATE( ztrd ) 
    9994      ENDIF 
    10095      !                                          ! print mean trends (used for debugging) 
    … …  
    180175               DO jj = 2, jpjm1 
    181176                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    182 !!gm BUG  I think, use e3w_a instead of e3w_n, not sure of that 
    183177                     zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk  ) / e3w_n(ji,jj,jk  ) 
    184178                     zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trddyn.F90

    r9598 r9939  
    142142                              !                                    ! wind stress trends 
    143143                              ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) ) 
    144                               z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 ) 
    145                               z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 ) 
     144                              z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rho0 ) 
     145                              z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rho0 ) 
    146146                              CALL iom_put( "utrd_tau", z2dx ) 
    147147                              CALL iom_put( "vtrd_tau", z2dy ) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdglo.F90

    r9598 r9939  
    7575      INTEGER ::   ji, jj, jk      ! dummy loop indices 
    7676      INTEGER ::   ikbu, ikbv      ! local integers 
    77       REAL(wp)::   zvm, zvt, zvs, z1_2rau0   ! local scalars 
     77      REAL(wp)::   zvm, zvt, zvs, z1_2rho0   ! local scalars 
    7878      REAL(wp), DIMENSION(jpi,jpj)  :: ztswu, ztswv, z2dx, z2dy   ! 2D workspace  
    7979      !!---------------------------------------------------------------------- 
    … …  
    132132            !                  
    133133            IF( ktrd == jpdyn_zdf ) THEN      ! zdf trend: compute separately the surface forcing trend 
    134                z1_2rau0 = 0.5_wp / rau0 
     134               z1_2rho0 = 0.5_wp / rho0 
    135135               DO jj = 1, jpjm1 
    136136                  DO ji = 1, jpim1 
    137137                     zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    138                         &                                                     * z1_2rau0       * e1e2u(ji,jj) 
     138                        &                                                     * z1_2rho0       * e1e2u(ji,jj) 
    139139                     zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
    140                         &                                                     * z1_2rau0       * e1e2v(ji,jj) 
     140                        &                                                     * z1_2rho0       * e1e2v(ji,jj) 
    141141                     umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 
    142142                     vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 
    … …  
    150150!               ! 
    151151!               IF( ln_drgimp ) THEN                   ! implicit drag case: compute separately the bottom friction  
    152 !                  z1_2rau0 = 0.5_wp / rau0 
     152!                  z1_2rho0 = 0.5_wp / rho0 
    153153!                  DO jj = 1, jpjm1 
    154154!                     DO ji = 1, jpim1 
    … …  
    211211         CALL eos( tsn, rhd, rhop )       ! now potential density 
    212212 
    213          zcof = 0.5_wp / rau0             ! Density flux at w-point 
     213         zcof = 0.5_wp / rho0             ! Density flux at w-point 
    214214         zkz(:,:,1) = 0._wp 
    215215         DO jk = 2, jpk 
    … …  
    217217         END DO 
    218218          
    219          zcof   = 0.5_wp / rau0           ! Density flux at u and v-points 
     219         zcof   = 0.5_wp / rho0           ! Density flux at u and v-points 
    220220         DO jk = 1, jpkm1 
    221221            DO jj = 1, jpjm1 
    … …  
    363363 9546    FORMAT(' 0 < horizontal diffusion                                  : ', e20.13) 
    364364 9547    FORMAT(' 0 < vertical diffusion                                    : ', e20.13) 
    365  9548    FORMAT(' pressure gradient u2 = - 1/rau0 u.dz(rhop)                : ', e20.13, '  u.dz(rhop) =', e20.13) 
     365 9548    FORMAT(' pressure gradient u2 = - 1/rho0 u.dz(rho)                 : ', e20.13, '  u.dz(rho) =', e20.13) 
    366366         ! 
    367367         ! Save potential to kinetic energy conversion for next time step 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdken.F90

    r9598 r9939  
    103103         DO jj = 2, jpj 
    104104            DO ji = 2, jpi 
    105                zke(ji,jj,jk) = 0.5_wp * rau0 *( un(ji  ,jj,jk) * putrd(ji  ,jj,jk) * bu(ji  ,jj,jk)  & 
     105               zke(ji,jj,jk) = 0.5_wp * rho0 *( un(ji  ,jj,jk) * putrd(ji  ,jj,jk) * bu(ji  ,jj,jk)  & 
    106106                  &                           + un(ji-1,jj,jk) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk)  & 
    107107                  &                           + vn(ji,jj  ,jk) * pvtrd(ji,jj  ,jk) * bv(ji,jj  ,jk)  & 
    … …  
    127127                           DO jj = 2, jpj 
    128128                              DO ji = 2, jpi 
    129                                  zke2d(ji,jj) = r1_rau0 * 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
     129                                 zke2d(ji,jj) = r1_rho0 * 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
    130130                                 &                                   + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
    131131                              END DO 
    … …  
    184184                    ! 
    185185                    CALL ken_p2k( kt , zke ) 
    186                       CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
     186                      CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rho*g*w 
    187187         ! 
    188188      END SELECT 
    … …  
    197197      !! ** Purpose :   compute rate of conversion from potential to kinetic energy 
    198198      !! 
    199       !! ** Method  : - compute conv defined as -rau*g*w on T-grid points 
     199      !! ** Method  : - compute conv defined as -rho*g*w on T-grid points 
    200200      !!  
    201201      !! ** Work only for full steps and partial steps (ln_hpg_zco or ln_hpg_zps) 
    … …  
    211211      ! 
    212212      ! Local constant initialization  
    213       zcoef = - rau0 * grav * 0.5_wp       
     213      zcoef = - rho0 * grav * 0.5_wp       
    214214       
    215215      !  Surface value (also valid in partial step case) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdtra.F90

    r9598 r9939  
    238238      !!---------------------------------------------------------------------- 
    239239 
    240       IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdt (restart with Euler time stepping) 
    241       ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdt (leapfrog) 
    242       ENDIF 
    243  
    244240      !                   ! 3D output of tracers trends using IOM interface 
    245241      IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt ) 
    … …  
    249245 
    250246      !                   ! Potential ENergy trends 
    251       IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt ) 
     247      IF( ln_PE_trd  )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, rDt ) 
    252248 
    253249      !                   ! Mixed layer trends for active tracers 
    … …  
    282278         CASE ( jptra_atf )        ;   CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_atf, '3D' )   ! asselin time filter (last trend) 
    283279                                   ! 
    284                                        CALL trd_mxl( kt, r2dt )                             ! trends: Mixed-layer (output) 
     280                                       CALL trd_mxl( kt, rDt )                              ! trends: Mixed-layer (output) 
    285281         END SELECT 
    286282         ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdvor.F90

    r9598 r9939  
    105105         DO jj = 2, jpjm1                                                             ! wind stress trends 
    106106            DO ji = fs_2, fs_jpim1   ! vector opt. 
    107                ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rau0 ) 
    108                ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rau0 ) 
     107               ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rho0 ) 
     108               ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rho0 ) 
    109109            END DO 
    110110         END DO 
    … …  
    385385         ! III.1 compute total trend 
    386386         ! ------------------------ 
    387          zmean = 1._wp / (  REAL( nmoydpvor, wp ) * 2._wp * rdt  ) 
     387         zmean = 1._wp / (  REAL( nmoydpvor, wp ) * 2._wp * rn_Dt  ) 
    388388         vor_avrtot(:,:) = (  vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean 
    389389 
    … …  
    504504      ENDIF 
    505505#if defined key_diainstant 
    506       zsto = nwrite*rdt 
     506      zsto = nwrite * rn_Dt 
    507507      clop = "inst("//TRIM(clop)//")" 
    508508#else 
    509       zsto = rdt 
     509      zsto = rn_Dt 
    510510      clop = "ave("//TRIM(clop)//")" 
    511511#endif 
    512       zout = nn_trd*rdt 
     512      zout = nn_trd * rn_Dt 
    513513 
    514514      IF(lwp) WRITE(numout,*) '               netCDF initialization' 
    … …  
    516516      ! II.2 Compute julian date from starting date of the run 
    517517      ! ------------------------ 
    518       CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 
     518      CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 
    519519      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    520520      IF(lwp) WRITE(numout,*)' '   
    … …  
    528528      IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam 
    529529      CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi,   &  ! Horizontal grid : glamt and gphit 
    530          &          1, jpj, nit000-1, zjulian, rdt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set ) 
     530         &          1, jpj, nit000-1, zjulian, rn_Dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set ) 
    531531      CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 )    ! surface 
    532532 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/USR/usrdef_sbc.F90

    r9598 r9939  
    8888 
    8989      ! current day (in hours) since january the 1st of the current year 
    90       ztime = REAL( kt ) * rdt / (rmmss * rhhmm)   &       !  total incrementation (in hours) 
     90      ztime = REAL( kt ) * rn_Dt / (rmmss * rhhmm)   &     !  total incrementation (in hours) 
    9191         &      - (nyear  - 1) * rjjhh * zyydd             !  minus years since beginning of experiment (in hours) 
    9292 
    … …  
    155155      !accumulates days of previous months of this year 
    156156      ! day (in hours) since january the 1st 
    157       ztime = FLOAT( kt ) * rdt / (rmmss * rhhmm)  &  ! incrementation in hour 
    158          &     - (nyear - 1) * rjjhh * zyydd          !  - nber of hours the precedent years 
     157      ztime    = REAL( kt ) * rn_Dt / (rmmss * rhhmm)  &   ! incrementation in hour 
     158         &     - (nyear - 1) * rjjhh * zyydd               !  - nber of hours the precedent years 
    159159      ztimemax = ((5.*30.)+21.)* 24.               ! 21th june     in hours 
    160160      ztimemin = ztimemax + rjjhh * zyydd / 2      ! 21th december in hours 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfddm.F90

    r9598 r9939  
    77   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
    88   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    9    !!            3.6  ! 2013-04  (G. Madec, F. Roquet) zrau compute locally using interpolation of alpha & beta 
     9   !!            3.6  ! 2013-04  (G. Madec, F. Roquet) zrho compute locally using interpolation of alpha & beta 
    1010   !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only  
    1111   !!---------------------------------------------------------------------- 
    … …  
    7979      REAL(wp) ::   zavft, zavfs    !   -      - 
    8080      REAL(wp) ::   zavdt, zavds    !   -      - 
    81       REAL(wp), DIMENSION(jpi,jpj) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 
     81      REAL(wp), DIMENSION(jpi,jpj) ::   zrho, zmsks, zmskf, zmskd1, zmskd2, zmskd3 
    8282      !!---------------------------------------------------------------------- 
    8383      ! 
    … …  
    9191!!gm                            and many acces in memory 
    9292          
    93          DO jj = 1, jpj                !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==! 
     93         DO jj = 1, jpj                !==  R=zrho = (alpha / beta) (dk[t] / dk[s])  ==! 
    9494            DO ji = 1, jpi 
    9595               zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   & 
    … …  
    105105               zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) )  
    106106               IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp 
    107                zrau(ji,jj) = MAX(  1.e-20, zdt / zds  )    ! only retains positive value of zrau 
     107               zrho(ji,jj) = MAX(  1.e-20, zdt / zds  )    ! only retains positive value of zrho 
    108108            END DO 
    109109         END DO 
    … …  
    116116               ENDIF 
    117117               ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere             
    118                IF( zrau(ji,jj) <= 1.             ) THEN   ;   zmskf(ji,jj) = 0._wp 
     118               IF( zrho(ji,jj) <= 1.             ) THEN   ;   zmskf(ji,jj) = 0._wp 
    119119               ELSE                                       ;   zmskf(ji,jj) = 1._wp 
    120120               ENDIF 
    121121               ! diffusive layering indicators:  
    122122               !     ! mskdl1=1 if 0< R <1; 0 elsewhere 
    123                IF( zrau(ji,jj) >= 1.             ) THEN   ;   zmskd1(ji,jj) = 0._wp 
     123               IF( zrho(ji,jj) >= 1.             ) THEN   ;   zmskd1(ji,jj) = 0._wp 
    124124               ELSE                                       ;   zmskd1(ji,jj) = 1._wp 
    125125               ENDIF 
    126126               !     ! mskdl2=1 if 0< R <0.5; 0 elsewhere 
    127                IF( zrau(ji,jj) >= 0.5            ) THEN   ;   zmskd2(ji,jj) = 0._wp 
     127               IF( zrho(ji,jj) >= 0.5            ) THEN   ;   zmskd2(ji,jj) = 0._wp 
    128128               ELSE                                       ;   zmskd2(ji,jj) = 1._wp 
    129129               ENDIF 
    130130               !   mskdl3=1 if 0.5< R <1; 0 elsewhere 
    131                IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp 
     131               IF( zrho(ji,jj) <= 0.5 .OR. zrho(ji,jj) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp 
    132132               ELSE                                                   ;   zmskd3(ji,jj) = 1._wp 
    133133               ENDIF 
    … …  
    143143         DO jj = 1, jpj 
    144144            DO ji = 1, jpi 
    145                zinr = 1._wp / zrau(ji,jj) 
     145               zinr = 1._wp / zrho(ji,jj) 
    146146               ! salt fingering 
    147                zrr = zrau(ji,jj) / rn_hsbfr 
     147               zrr = zrho(ji,jj) / rn_hsbfr 
    148148               zrr = zrr * zrr 
    149149               zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) 
    … …  
    151151               ! diffusive layering 
    152152               zavdt = 1.3635e-6 * EXP(  4.6 * EXP( -0.54*(zinr-1.) )  ) * zmsks(ji,jj) * zmskd1(ji,jj) 
    153                zavds = zavdt * zmsks(ji,jj) * (  ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj)   & 
    154                   &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  ) 
     153               zavds = zavdt * zmsks(ji,jj) * (  ( 1.85 * zrho(ji,jj) - 0.85 ) * zmskd3(ji,jj)   & 
     154                  &                             +  0.15 * zrho(ji,jj)          * zmskd2(ji,jj)  ) 
    155155               ! add to the eddy viscosity coef. previously computed 
    156156               p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfdrg.F90

    r9598 r9939  
    162162      INTEGER  ::   ji, jj       ! dummy loop indexes 
    163163      INTEGER  ::   ikbu, ikbv   ! local integers 
    164       REAL(wp) ::   zm1_2dt      ! local scalar 
    165164      REAL(wp) ::   zCdu, zCdv   !   -      - 
    166165      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv 
    167166      !!--------------------------------------------------------------------- 
    168167      ! 
    169 !!gm bug : time step is only rdt (not 2 rdt if euler start !) 
    170       zm1_2dt = - 1._wp / ( 2._wp * rdt ) 
    171  
    172168      IF( l_trddyn ) THEN      ! trends: store the input trends 
    173169         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    … …  
    185181            zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv) 
    186182            ! 
    187             pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu) 
    188             pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv) 
     183            pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , - r1_Dt  ) * pub(ji,jj,ikbu) 
     184            pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , - r1_Dt  ) * pvb(ji,jj,ikbv) 
    189185         END DO 
    190186      END DO 
    … …  
    200196               zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 
    201197               ! 
    202                pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu) 
    203                pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv) 
     198               pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , - r1_Dt  ) * pub(ji,jj,ikbu) 
     199               pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , - r1_Dt  ) * pvb(ji,jj,ikbv) 
    204200           END DO 
    205201         END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfgls.F90

    r9598 r9939  
    170170            ! 
    171171            ! surface friction 
    172             ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 
     172            ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1) 
    173173            !    
    174174!!gm Rq we may add here r_ke0(_top/_bot) ?  ==>> think about that... 
    … …  
    280280               zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) ) 
    281281               !                                               ! diagonal 
    282                zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk)  + rdt * zdiss * wmask(ji,jj,jk)  
     282               zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk)  + rn_Dt * zdiss * wmask(ji,jj,jk)  
    283283               !                                               ! right hand side in en 
    284                en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) 
     284               en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * zesh2 * wmask(ji,jj,jk) 
    285285            END DO 
    286286         END DO 
    … …  
    530530               zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) ) 
    531531               !                                               ! diagonal 
    532                zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) 
     532               zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rn_Dt * zdiss * wmask(ji,jj,jk) 
    533533               !                                               ! right hand side in psi 
    534                psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) 
     534               psi(ji,jj,jk) = psi(ji,jj,jk) + rn_Dt * zesh2 * wmask(ji,jj,jk) 
    535535            END DO 
    536536         END DO 
    … …  
    11051105      rc04  = rc03 * rc0 
    11061106      rsbc_tke1 = -3._wp/2._wp*rn_crban*ra_sf*rl_sf                      ! Dirichlet + Wave breaking 
    1107       rsbc_tke2 = rdt * rn_crban / rl_sf                                 ! Neumann + Wave breaking  
     1107      rsbc_tke2 = rn_Dt * rn_crban / rl_sf                               ! Neumann + Wave breaking  
    11081108      zcr = MAX(rsmall, rsbc_tke1**(1./(-ra_sf*3._wp/2._wp))-1._wp ) 
    11091109      rtrans = 0.2_wp / zcr                                              ! Ad. inverse transition length between log and wave layer  
    11101110      rsbc_zs1  = rn_charn/grav                                          ! Charnock formula for surface roughness 
    11111111      rsbc_zs2  = rn_frac_hs / 0.85_wp / grav * 665._wp                  ! Rascle formula for surface roughness  
    1112       rsbc_psi1 = -0.5_wp * rdt * rc0**(rpp-2._wp*rmm) / rsc_psi 
    1113       rsbc_psi2 = -0.5_wp * rdt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking  
    1114       ! 
    1115       rfact_tke = -0.5_wp / rsc_tke * rdt                                ! Cst used for the Diffusion term of tke 
    1116       rfact_psi = -0.5_wp / rsc_psi * rdt                                ! Cst used for the Diffusion term of tke 
     1112      rsbc_psi1 = -0.5_wp * rn_Dt * rc0**(rpp-2._wp*rmm) / rsc_psi 
     1113      rsbc_psi2 = -0.5_wp * rn_Dt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking  
     1114      ! 
     1115      rfact_tke = -0.5_wp / rsc_tke * rn_Dt                              ! Cst used for the Diffusion term of tke 
     1116      rfact_psi = -0.5_wp / rsc_psi * rn_Dt                              ! Cst used for the Diffusion term of tke 
    11171117      ! 
    11181118      !                                !* Wall proximity function 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfiwm.F90

    r9598 r9939  
    8787      !!              This is divided into three components: 
    8888      !!                 1. Bottom-intensified low-mode dissipation at critical slopes 
    89       !!                     zemx_iwm(z) = ( ecri_iwm / rau0 ) * EXP( -(H-z)/hcri_iwm ) 
     89      !!                     zemx_iwm(z) = ( ecri_iwm / rho0 ) * EXP( -(H-z)/hcri_iwm ) 
    9090      !!                                   / ( 1. - EXP( - H/hcri_iwm ) ) * hcri_iwm 
    9191      !!              where hcri_iwm is the characteristic length scale of the bottom  
    9292      !!              intensification, ecri_iwm a map of available power, and H the ocean depth. 
    9393      !!                 2. Pycnocline-intensified low-mode dissipation 
    94       !!                     zemx_iwm(z) = ( epyc_iwm / rau0 ) * ( sqrt(rn2(z))^nn_zpyc ) 
     94      !!                     zemx_iwm(z) = ( epyc_iwm / rho0 ) * ( sqrt(rn2(z))^nn_zpyc ) 
    9595      !!                                   / SUM( sqrt(rn2(z))^nn_zpyc * e3w(z) ) 
    9696      !!              where epyc_iwm is a map of available power, and nn_zpyc 
    … …  
    9898      !!              energy dissipation. 
    9999      !!                 3. WKB-height dependent high mode dissipation 
    100       !!                     zemx_iwm(z) = ( ebot_iwm / rau0 ) * rn2(z) * EXP(-z_wkb(z)/hbot_iwm) 
     100      !!                     zemx_iwm(z) = ( ebot_iwm / rho0 ) * rn2(z) * EXP(-z_wkb(z)/hbot_iwm) 
    101101      !!                                   / SUM( rn2(z) * EXP(-z_wkb(z)/hbot_iwm) * e3w(z) ) 
    102102      !!              where hbot_iwm is the characteristic length scale of the WKB bottom  
    … …  
    151151         DO ji = 1, jpi 
    152152            zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean 
    153             zfact(ji,jj) = rau0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  ) 
     153            zfact(ji,jj) = rho0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  ) 
    154154            IF( zfact(ji,jj) /= 0._wp )   zfact(ji,jj) = ecri_iwm(ji,jj) / zfact(ji,jj) 
    155155         END DO 
    … …  
    180180         DO jj = 1, jpj 
    181181            DO ji = 1, jpi 
    182                IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 
     182               IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    183183            END DO 
    184184         END DO 
    … …  
    197197         DO jj= 1, jpj 
    198198            DO ji = 1, jpi 
    199                IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 
     199               IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    200200            END DO 
    201201         END DO 
    … …  
    247247      DO jj = 1, jpj 
    248248         DO ji = 1, jpi 
    249             IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 
     249            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    250250         END DO 
    251251      END DO 
    … …  
    260260      ! Calculate molecular kinematic viscosity 
    261261      znu_t(:,:,:) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * tsn(:,:,:,jp_tem) + 0.00694_wp * tsn(:,:,:,jp_tem) * tsn(:,:,:,jp_tem)  & 
    262          &                                  + 0.02305_wp * tsn(:,:,:,jp_sal)  ) * tmask(:,:,:) * r1_rau0 
     262         &                                  + 0.02305_wp * tsn(:,:,:,jp_sal)  ) * tmask(:,:,:) * r1_rho0 
    263263      DO jk = 2, jpkm1 
    264264         znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) 
    … …  
    306306         END DO 
    307307         IF( lk_mpp )   CALL mpp_sum( zztmp ) 
    308          zztmp = rau0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing  
     308         zztmp = rho0 * zztmp ! Global integral of rhoo * Kz * N^2 = power contributing to mixing  
    309309         ! 
    310310         IF(lwp) THEN 
    … …  
    350350                                    !* output useful diagnostics: Kz*N^2 ,  
    351351!!gm Kz*N2 should take into account the ratio avs/avt if it is used.... (see diaar5) 
    352                                     !  vertical integral of rau0 * Kz * N^2 , energy density (zemx_iwm) 
     352                                    !  vertical integral of rho0 * Kz * N^2 , energy density (zemx_iwm) 
    353353      IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN 
    354354         ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) ) 
    … …  
    358358            z2d(:,:) = z2d(:,:) + e3w_n(:,:,jk) * z3d(:,:,jk) * wmask(:,:,jk) 
    359359         END DO 
    360          z2d(:,:) = rau0 * z2d(:,:) 
     360         z2d(:,:) = rho0 * z2d(:,:) 
    361361         CALL iom_put( "bflx_iwm", z3d ) 
    362362         CALL iom_put( "pcmap_iwm", z2d ) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfmxl.F90

    r9598 r9939  
    9393      nmln(:,:)  = nlb10               ! Initialization to the number of w ocean point 
    9494      hmlp(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2 
    95       zN2_c = grav * rho_c * r1_rau0   ! convert density criteria into N^2 criteria 
     95      zN2_c = grav * rho_c * r1_rho0   ! convert density criteria into N^2 criteria 
    9696      DO jk = nlb10, jpkm1 
    9797         DO jj = 1, jpj                ! Mixed layer level: w-level  

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfosm.F90

    r9598 r9939  
    298298        DO ji = 2, jpim1 
    299299           ! Surface downward irradiance (so always +ve) 
    300            zrad0(ji,jj) = qsr(ji,jj) * r1_rau0_rcp 
     300           zrad0(ji,jj) = qsr(ji,jj) * r1_rho0_rcp 
    301301           ! Downwards irradiance at base of boundary layer 
    302302           zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) ) 
    … …  
    312312           zbeta    = rab_n(ji,jj,1,jp_sal) 
    313313           ! Upwards surface Temperature flux for non-local term 
    314            zwth0(ji,jj) = - qns(ji,jj) * r1_rau0_rcp * tmask(ji,jj,1) 
     314           zwth0(ji,jj) = - qns(ji,jj) * r1_rho0_rcp * tmask(ji,jj,1) 
    315315           ! Upwards surface salinity flux for non-local term 
    316            zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal)  + sfx(ji,jj) ) * r1_rau0 * tmask(ji,jj,1) 
     316           zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal)  + sfx(ji,jj) ) * r1_rho0 * tmask(ji,jj,1) 
    317317           ! Non radiative upwards surface buoyancy flux 
    318318           zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) -  grav * zbeta * zws0(ji,jj) 
    … …  
    324324           zwbav(ji,jj) = grav  * zthermal * zwthav(ji,jj) - grav  * zbeta * zwsav(ji,jj) 
    325325           ! Surface upward velocity fluxes 
    326            zuw0(ji,jj) = -utau(ji,jj) * r1_rau0 * tmask(ji,jj,1) 
    327            zvw0(ji,jj) = -vtau(ji,jj) * r1_rau0 * tmask(ji,jj,1) 
     326           zuw0(ji,jj) = -utau(ji,jj) * r1_rho0 * tmask(ji,jj,1) 
     327           zvw0(ji,jj) = -vtau(ji,jj) * r1_rho0 * tmask(ji,jj,1) 
    328328           ! Friction velocity (zustar), at T-point : LMD94 eq. 2 
    329329           zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) 
    … …  
    455455                           &            + 0.135 * zla(ji,jj) * zwstrl(ji,jj)**3/hbl(ji,jj) ) 
    456456 
    457                       zvel_max =  - ( 1.0 + 1.0 * ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) & 
     457                      zvel_max =  - ( 1.0 + 1.0 * ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) & 
    458458                           &   * zwb_ent(ji,jj) / ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    459459! Entrainment including component due to shear turbulence. Modified Langmuir component, but gives same result for La=0.3 For testing uncomment. 
    … …  
    461461!                           &            + ( 0.15 * ( 1.0 - EXP( -0.5 * zla(ji,jj) ) ) + 0.03 / zla(ji,jj)**2 ) * zustar(ji,jj)**3/hbl(ji,jj) ) 
    462462 
    463 !                      zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / zhbl(ji,jj) ) * zwb_ent(ji,jj) / & 
     463!                      zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / zhbl(ji,jj) ) * zwb_ent(ji,jj) / & 
    464464!                           &       ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    465465                      zzdhdt = - zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj),0.0) ) 
    … …  
    472472                      IF ( zzdhdt < 0._wp ) THEN 
    473473                      ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 
    474                          zpert   = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) 
     474                         zpert   = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_Dt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) 
    475475                      ELSE 
    476                          zpert   = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) & 
     476                         zpert   = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_Dt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) & 
    477477                              &  + MAX( zdb_bl(ji,jj), 0.0 ) 
    478478                      ENDIF 
    … …  
    487487      ibld(:,:) = 3 
    488488 
    489       zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - wn(ji,jj,ibld(ji,jj)))* rn_rdt ! certainly need wb here, so subtract it 
     489      zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - wn(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need wb here, so subtract it 
    490490      zhbl_t(:,:) = MIN(zhbl_t(:,:), ht_n(:,:)) 
    491       zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_rdt + wn(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 
     491      zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_Dt + wn(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 
    492492 
    493493      DO jk = 4, jpkm1 
    … …  
    516516               IF ( lconv(ji,jj) ) THEN 
    517517!unstable 
    518                   zvel_max =  - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) & 
     518                  zvel_max =  - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) & 
    519519                       &   * zwb_ent(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    520520 
    … …  
    523523                          & - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ), 0.0 ) + zvel_max 
    524524 
    525                      zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_rdt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), e3w_n(ji,jj,jk) ) 
     525                     zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_Dt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), e3w_n(ji,jj,jk) ) 
    526526                     zhbl_s = MIN(zhbl_s, ht_n(ji,jj)) 
    527527 
    … …  
    13271327            IF ( iom_use("us_x") ) CALL iom_put( "us_x", tmask(:,:,1)*zustke*zcos_wind )   ! x surface Stokes drift 
    13281328            IF ( iom_use("us_y") ) CALL iom_put( "us_y", tmask(:,:,1)*zustke*zsin_wind )  ! y surface Stokes drift 
    1329             IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rau0*tmask(:,:,1)*zustar**2*zustke ) 
     1329            IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke ) 
    13301330         ! Stokes drift read in from sbcwave  (=2). 
    13311331         CASE(2) 
    13321332            IF ( iom_use("us_x") ) CALL iom_put( "us_x", ut0sd )               ! x surface Stokes drift 
    13331333            IF ( iom_use("us_y") ) CALL iom_put( "us_y", vt0sd )               ! y surface Stokes drift 
    1334             IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rau0*tmask(:,:,1)*zustar**2* & 
     1334            IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2* & 
    13351335                 & SQRT(ut0sd**2 + vt0sd**2 ) ) 
    13361336         END SELECT 
    … …  
    13481348         IF ( iom_use("zwstrl") ) CALL iom_put( "zwstrl", tmask(:,:,1)*zwstrl )         ! Langmuir velocity scale 
    13491349         IF ( iom_use("zustar") ) CALL iom_put( "zustar", tmask(:,:,1)*zustar )         ! friction velocity scale 
    1350          IF ( iom_use("wind_power") ) CALL iom_put( "wind_power", 1000.*rau0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine 
    1351          IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*rau0*tmask(:,:,1)*zustar**2*zustke ) 
     1350         IF ( iom_use("wind_power") ) CALL iom_put( "wind_power", 1000.*rho0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine 
     1351         IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke ) 
    13521352         IF ( iom_use("zhbl") ) CALL iom_put( "zhbl", tmask(:,:,1)*zhbl )               ! BL depth internal to zdf_osm routine 
    13531353         IF ( iom_use("zhml") ) CALL iom_put( "zhml", tmask(:,:,1)*zhml )               ! ML depth internal to zdf_osm routine 
    … …  
    15841584     imld_rst(:,:)  = nlb10         ! Initialization to the number of w ocean point 
    15851585     hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2 
    1586      zN2_c = grav * rho_c * r1_rau0 ! convert density criteria into N^2 criteria 
     1586     zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 
    15871587     ! 
    15881588     hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfric.F90

    r9598 r9939  
    181181         DO jj = 2, jpjm1        !* Ekman depth 
    182182            DO ji = 2, jpim1 
    183                zustar = SQRT( taum(ji,jj) * r1_rau0 ) 
     183               zustar = SQRT( taum(ji,jj) * r1_rho0 ) 
    184184               zhek   = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall )   ! Ekman depth 
    185185               zh_ekm(ji,jj) = MAX(  rn_mldmin , MIN( zhek , rn_mldmax )  )   ! set allowed range 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdftke.F90

    r9598 r9939  
    195195      REAL(wp) ::   zrhoa  = 1.22              ! Air density kg/m3 
    196196      REAL(wp) ::   zcdrag = 1.5e-3            ! drag coefficient 
    197       REAL(wp) ::   zbbrau, zri                ! local scalars 
     197      REAL(wp) ::   zbbrho, zri                ! local scalars 
    198198      REAL(wp) ::   zfact1, zfact2, zfact3     !   -         - 
    199199      REAL(wp) ::   ztx2  , zty2  , zcof       !   -         - 
    … …  
    206206      !!-------------------------------------------------------------------- 
    207207      ! 
    208       zbbrau = rn_ebb / rau0       ! Local constant initialisation 
    209       zfact1 = -.5_wp * rdt  
    210       zfact2 = 1.5_wp * rdt * rn_ediss 
    211       zfact3 = 0.5_wp       * rn_ediss 
     208      zbbrho = rn_ebb * r1_rho0       ! Local constant initialisation 
     209      zfact1 = -.5_wp * rn_Dt  
     210      zfact2 = 1.5_wp * rn_Dt * rn_ediss 
     211      zfact3 = 0.5_wp         * rn_ediss 
    212212      ! 
    213213      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    … …  
    215215      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    216216       
    217       DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0) 
     217      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rho0  (min value rn_emin0) 
    218218         DO ji = fs_2, fs_jpim1   ! vector opt. 
    219             en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 
     219            en(ji,jj,1) = MAX( rn_emin0, zbbrho * taum(ji,jj) ) * tmask(ji,jj,1) 
    220220         END DO 
    221221      END DO 
    … …  
    232232      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    233233      ! 
    234       !   en(bot)   = (ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin) 
     234      !   en(bot)   = (ebb0/rho0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin) 
    235235      ! where ebb0 does not includes surface wave enhancement (i.e. ebb0=3.75) 
    236236      ! Note that stress averaged is done using an wet-only calculation of u and v at t-point like in zdfsh2 
    … …  
    242242               zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    243243               zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 
    244                !                       ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 
     244               !                       ! where 0.001875 = (rn_ebb0/rho0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 
    245245               zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2  & 
    246246                  &                                           + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2  ) 
    … …  
    253253                  zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    254254                  zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 
    255                   !                             ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000.  (CAUTION CdU<0) 
     255                  !                             ! where 0.001875 = (rn_ebb0/rho0) * 0.5 = 3.75*0.5/1000.  (CAUTION CdU<0) 
    256256                  zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2  & 
    257257                     &                                           + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2  ) 
    … …  
    298298                  zwlc = zind * rn_lc * zus * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) 
    299299                  !                                           ! TKE Langmuir circulation source term 
    300                   en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   & 
    301                      &                              / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     300                  en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   & 
     301                     &                                / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    302302               END DO 
    303303            END DO 
    … …  
    342342               ! 
    343343               !                                   ! right hand side in en 
    344                en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  p_sh2(ji,jj,jk)                          &   ! shear 
    345                   &                                 - p_avt(ji,jj,jk) * rn2(ji,jj,jk)          &   ! stratification 
    346                   &                                 + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk)  &   ! dissipation 
    347                   &                                ) * wmask(ji,jj,jk) 
     344               en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * (  p_sh2(ji,jj,jk)                          &   ! shear 
     345                  &                                   - p_avt(ji,jj,jk) * rn2(ji,jj,jk)          &   ! stratification 
     346                  &                                   + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk)  &   ! dissipation 
     347                  &                                  ) * wmask(ji,jj,jk) 
    348348            END DO 
    349349         END DO 
    … …  
    422422                  zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean  
    423423                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    424                   en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
     424                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrho * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    425425                     &                        * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    426426               END DO 
    … …  
    473473      ! 
    474474      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    475       REAL(wp) ::   zrn2, zraug, zcoef, zav   ! local scalars 
     475      REAL(wp) ::   zrn2, zrhog, zcoef, zav   ! local scalars 
    476476      REAL(wp) ::   zdku,   zdkv, zsqen       !   -      - 
    477477      REAL(wp) ::   zemxl, zemlm, zemlp       !   -      - 
    … …  
    489489      zmxld(:,:,:)  = rmxl_min 
    490490      ! 
    491       IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 
    492          zraug = vkarmn * 2.e5_wp / ( rau0 * grav ) 
     491      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
     492         zrhog = vkarmn * 2.e5_wp / ( rho0 * grav ) 
    493493         DO jj = 2, jpjm1 
    494494            DO ji = fs_2, fs_jpim1 
    495                zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) ) 
     495               zmxlm(ji,jj,1) = MAX( rn_mxl0, zrhog * taum(ji,jj) * tmask(ji,jj,1) ) 
    496496            END DO 
    497497         END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/module_example

    r9598 r9939  
    9393      INTEGER  ::   ji, jj, jk       ! dummy loop arguments  (DOCTOR : start with j, but not jp) 
    9494      INTEGER  ::   itoto, itata     ! temporary integers    (DOCTOR : start with i 
    95       REAL(wp) ::   zmlmin, zbbrau   ! temporary scalars     (DOCTOR : start with z) 
     95      REAL(wp) ::   zmlmin, zbbrho   ! temporary scalars     (DOCTOR : start with z) 
    9696      REAL(wp) ::   zfact1, zfact2   ! do not use continuation lines in declaration 
    9797      REAL(wp), DIMENSION(jpi,jpj) ::   zwrk_2d   ! 2D workspace 
    … …  
    101101 
    102102      zmlmin = 1.e-8                             ! Local constant initialization 
    103       zbbrau =  .5 * ebb / rau0 
    104       zfact1 = -.5 * rdt * efave 
    105       zfact2 = 1.5 * rdt * ediss 
     103      zbbrho =  .5 * ebb / rho0 
     104      zfact1 = -.5 * rn_Dt * efave 
     105      zfact2 = 1.5 * rn_Dt * ediss 
    106106 
    107107      SELECT CASE ( npdl )                       ! short description of the action 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/nemogcm.F90

    r9780 r9939  
    151151      !                            !==   time stepping   ==! 
    152152      !                            !-----------------------! 
     153      ! 
     154      !                                               !== set the model time-step  ==! 
     155      ! 
     156      IF( l_1st_euler ) THEN   ;   rDt =         rn_Dt   ;   l_1st_euler = .TRUE.    ! start or restart with Euler 1st time-step 
     157      ELSE                     ;   rDt = 2._wp * rn_Dt   ;   l_1st_euler = .FALSE.   ! restart with leapfrog 
     158      ENDIF 
     159      r1_Dt = 1._wp / rDt 
     160      ! NB: if l_1st_euler=T, rDt will be set to 2*rn_Dt at the end of the 1st time-step (in step.F90) 
     161      !     Done here (not in domain.F90) as in ASM initialization an Euler 1st time step can be forced 
     162      ! 
     163      ! 
    153164      istp = nit000 
    154165      ! 
    … …  
    429440 
    430441      !                                      ! Icebergs 
    431                            CALL icb_init( rdt, nit000)   ! initialise icebergs instance 
     442                           CALL icb_init( rn_Dt, nit000 )   ! initialise icebergs instance 
    432443 
    433444      !                                      ! Misc. options 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/oce.F90

    r9598 r9939  
    2727   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2] 
    2828   ! 
    29    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units] 
     29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rho0)/rho0  [no units] 
    3030   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3] 
    3131 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/step.F90

    r9780 r9939  
    3434 
    3535   !!---------------------------------------------------------------------- 
    36    !!   stp             : OPA system time-stepping 
    37    !!---------------------------------------------------------------------- 
    38    USE step_oce         ! time stepping definition modules 
     36   !!   stp           : NEMO system time-stepping 
     37   !!---------------------------------------------------------------------- 
     38   USE step_oce       ! time stepping definition modules 
    3939   ! 
    40    USE iom              ! xIOs server 
     40   USE iom            ! xIOs server 
    4141 
    4242   IMPLICIT NONE 
    … …  
    323323#endif 
    324324      ! 
     325      IF( l_1st_euler ) THEN 
     326         rDt    = 2._wp * rn_Dt                             ! recover Leap-frog time-step 
     327         r1_Dt = 1._wp / rDt 
     328         l_1st_euler = .FALSE. 
     329      ENDIF 
     330      ! 
    325331      IF( ln_timing )   CALL timing_stop('stp') 
    326332      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OFF/dtadyn.F90

    r9598 r9939  
    438438      ENDIF 
    439439 
    440       sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:))  ! before <-- now filtered 
     440      sshb(:,:) = sshn(:,:) + rn_atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )   ! before <-- now filtered 
    441441      sshn(:,:) = ssha(:,:) 
    442442 
    … …  
    511511      INTEGER                       :: jk 
    512512      REAL(wp), DIMENSION(jpi,jpj)  :: zhdiv   
    513       REAL(wp)  :: z2dt   
    514       !!---------------------------------------------------------------------- 
    515       ! 
    516       z2dt = 2._wp * rdt 
     513      !!---------------------------------------------------------------------- 
    517514      ! 
    518515      zhdiv(:,:) = 0._wp 
    … …  
    521518      END DO 
    522519      !                                                ! Sea surface  elevation time-stepping 
    523       pssha(:,:) = ( psshb(:,:) - z2dt * ( r1_rau0 * pemp(:,:)  + zhdiv(:,:) ) ) * ssmask(:,:) 
     520      pssha(:,:) = ( psshb(:,:) - rDt * ( r1_rho0 * pemp(:,:)  + zhdiv(:,:) ) ) * ssmask(:,:) 
    524521      !                                                 !  
    525522      !                                                 ! After acale factors at t-points ( z_star coordinate ) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OFF/nemogcm.F90

    r9751 r9939  
    100100      !                            !==   time stepping   ==! 
    101101      !                            !-----------------------! 
     102      !                                               !== set the model time-step  ==! 
     103      ! 
     104      IF( l_1st_euler ) THEN   ;   rDt =         rn_Dt   ;   l_1st_euler = .TRUE.    ! start or restart with Euler 1st time-step 
     105      ELSE                     ;   rDt = 2._wp * rn_Dt   ;   l_1st_euler = .FALSE.   ! restart with leapfrog 
     106      ENDIF 
     107      r1_Dt = 1._wp / rDt 
     108      ! NB: if l_1st_euler=T, rDt will be set to 2*rn_Dt at the end of the 1st time-step (see the DO WHILE below) 
     109      ! 
     110      ! 
    102111      istp = nit000 
    103112      ! 
    … …  
    115124                                CALL trc_stp    ( istp )         ! time-stepping 
    116125                                CALL stp_ctl    ( istp, indic )  ! Time loop: control and print 
     126         IF( l_1st_euler ) THEN 
     127            rDt   = 2._wp * rDt                                  ! recover Leap-frog time-step 
     128            r1_Dt = 1._wp / rDt 
     129            l_1st_euler = .FALSE. 
     130         ENDIF 
     131         ! 
    117132         istp = istp + 1 
    118133      END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/SAS/daymod.F90

    r9598 r9939  
    2020   !!                    ------------------------------- 
    2121   !!   sbcmod assume that the time step is dividing the number of second of  
    22    !!   in a day, i.e. ===> MOD( rday, rdt ) == 0  
     22   !!   in a day, i.e. ===> MOD( rday, rn_Dt ) == 0  
    2323   !!   except when user defined forcing is used (see sbcmod.F90) 
    2424   !!---------------------------------------------------------------------- 
    … …  
    7272      ! 
    7373      ! max number of seconds between each restart 
    74       IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN 
     74      IF( REAL( nitend - nit000 + 1 ) * rn_Dt > REAL( HUGE( nsec1jan000 ) ) ) THEN 
    7575         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   & 
    7676            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 
    7777      ENDIF 
    78       nsecd   = NINT( rday       ) 
    79       nsecd05 = NINT( 0.5 * rday ) 
    80       ndt     = NINT(       rdt ) 
    81       ndt05   = NINT( 0.5 * rdt ) 
     78      nsecd   = NINT( rday        ) 
     79      nsecd05 = NINT( 0.5 * rday  ) 
     80      ndt     = NINT(       rn_Dt ) 
     81      ndt05   = NINT( 0.5 * rn_Dt ) 
    8282 
    8383      IF( .NOT. l_offline )   CALL day_rst( nit000, 'READ' ) 
    … …  
    237237      nsec_week  = nsec_week  + ndt 
    238238      nsec_day   = nsec_day   + ndt 
    239       adatrj  = adatrj  + rdt / rday 
    240       fjulday = fjulday + rdt / rday 
     239      adatrj  = adatrj  + rn_Dt / rday 
     240      fjulday = fjulday + rn_Dt / rday 
    241241      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error 
    242242      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error 
    … …  
    307307      !!       In both those options, the  exact duration of the experiment 
    308308      !!       since the beginning (cumulated duration of all previous restart runs) 
    309       !!       is not stored in the restart and is assumed to be (nit000-1)*rdt. 
     309      !!       is not stored in the restart and is assumed to be (nit000-1)*rn_Dt. 
    310310      !!       This is valid is the time step has remained constant. 
    311311      !! 
    … …  
    376376               nminute = ( nn_time0 - nhour * 100 ) 
    377377               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0) 
    378                adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 
     378               adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 
    379379               ! note this is wrong if time step has changed during run 
    380380            ENDIF 
    … …  
    385385       nminute = ( nn_time0 - nhour * 100 ) 
    386386            IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0) 
    387             adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 
     387            adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 
    388388         ENDIF 
    389389         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/SAS/diawri.F90

    r9652 r9939  
    158158      ENDIF 
    159159#if defined key_diainstant 
    160       zsto = nwrite * rdt 
     160      zsto = nwrite * rn_Dt 
    161161      clop = "inst("//TRIM(clop)//")" 
    162162#else 
    163       zsto=rdt 
     163      zsto = rn_Dt 
    164164      clop = "ave("//TRIM(clop)//")" 
    165165#endif 
    166       zout = nwrite * rdt 
    167       zmax = ( nitend - nit000 + 1 ) * rdt 
     166      zout = nwrite * rn_Dt 
     167      zmax = ( nitend - nit000 + 1 ) * rn_Dt 
    168168 
    169169      ! Define indices of the horizontal output zoom and vertical limit storage 
    … …  
    185185 
    186186         ! Compute julian date from starting date of the run 
    187          CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 
     187         CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 
    188188         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    189189         IF(lwp)WRITE(numout,*) 
    … …  
    207207         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
    208208            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    209             &          nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 
     209            &          nit000-1, zjulian, rn_Dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 
    210210         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept 
    211211            &           "m", ipk, gdept_1d, nz_T, "down" ) 
    … …  
    219219         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu 
    220220            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    221             &          nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 
     221            &          nit000-1, zjulian, rn_Dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 
    222222         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept 
    223223            &           "m", ipk, gdept_1d, nz_U, "down" ) 
    … …  
    231231         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv 
    232232            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    233             &          nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 
     233            &          nit000-1, zjulian, rn_Dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 
    234234         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept 
    235235            &          "m", ipk, gdept_1d, nz_V, "down" ) 
    … …  
    360360      clname = cdfile_name 
    361361      IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    362       zsto = rdt 
     362      zsto = rn_Dt 
    363363      clop = "inst(x)"           ! no use of the mask value (require less cpu time) 
    364       zout = rdt 
    365       zmax = ( nitend - nit000 + 1 ) * rdt 
     364      zout = rn_Dt 
     365      zmax = ( nitend - nit000 + 1 ) * rn_Dt 
    366366 
    367367      IF(lwp) WRITE(numout,*) 
    … …  
    375375 
    376376      ! Compute julian date from starting date of the run 
    377       CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )         ! time axis  
     377      CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian )         ! time axis  
    378378      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    379379      CALL histbeg( clname, jpi, glamt, jpj, gphit,   & 
    380           1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 
     380          1, jpi, 1, jpj, nit000-1, zjulian, rn_Dt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 
    381381      CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept 
    382382          "m", jpk, gdept_1d, nz_i, "down") 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/C14/trcatm_c14.F90

    r9598 r9939  
    223223      IF(kc14typ >= 1) THEN  ! Transient C14 & CO2 
    224224      ! 
    225          tyrc14_now = tyrc14_now + ( rdt / ( rday * nyear_len(1)) )    !  current time step in yr relative to tyrc14_beg 
     225         tyrc14_now = tyrc14_now + ( rn_Dt / ( rday * nyear_len(1) ) )    !  current time step in yr relative to tyrc14_beg 
    226226      ! 
    227227      ! CO2 -------------------------------------------------------- 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/C14/trcsms_c14.F90

    r9598 r9939  
    123123             
    124124      ! cumulation of air-to-sea flux at each time step 
    125       qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rdttrc 
     125      qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rn_Dt_trc 
    126126      ! 
    127127      ! Add the surface flux to the trend of jp_c14 
    … …  
    148148         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    149149         ! 
    150          CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc )       ! These five need      & 
     150         CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc )     ! These five need      & 
    151151         CALL iom_rstput( kt, nitrst, numrtw, 'c14sbc', c14sbc )     ! &    to be written   & 
    152152         CALL iom_rstput( kt, nitrst, numrtw, 'exch_co2', exch_co2 ) ! &    for temporal    & 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/CFC/trcsms_cfc.F90

    r9613 r9939  
    161161 
    162162               ! cumulation of surface flux at each time step 
    163                qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rdt 
     163               qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rn_Dt 
    164164               !                                               !----------------! 
    165165            END DO                                             !  end i-j loop  ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/P2Z/p2zexp.F90

    r9788 r9939  
    44   !! TOP :   LOBSTER Compute loss of organic matter in the sediments 
    55   !!====================================================================== 
    6    !! History :    -   !  1999    (O. Aumont, C. Le Quere)  original code 
    7    !!              -   !  2001-05 (O. Aumont, E. Kestenare) add sediment computations 
    8    !!             1.0  !  2005-06 (A.-S. Kremeur) new temporal integration for sedpoc 
    9    !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 
    10    !!             3.5  !  2012-03  (C. Ethe)  Merge PISCES-LOBSTER 
    11    !!---------------------------------------------------------------------- 
    12    !!   p2z_exp        :  Compute loss of organic matter in the sediments 
    13    !!---------------------------------------------------------------------- 
    14    USE oce_trc         ! 
    15    USE trc 
    16    USE sms_pisces 
    17    USE p2zsed 
    18    USE lbclnk 
    19    USE prtctl_trc      ! Print control for debbuging 
    20    USE trd_oce 
    21    USE trdtrc 
    22    USE iom 
     6   !! History :   -   !  1999    (O. Aumont, C. Le Quere)  original code 
     7   !!             -   !  2001-05 (O. Aumont, E. Kestenare) add sediment computations 
     8   !!            1.0  !  2005-06 (A.-S. Kremeur) new temporal integration for sedpoc 
     9   !!            2.0  !  2007-12  (C. Deltel, G. Madec)  F90 
     10   !!            3.5  !  2012-03  (C. Ethe)  Merge PISCES-LOBSTER 
     11   !!---------------------------------------------------------------------- 
     12 
     13   !!---------------------------------------------------------------------- 
     14   !!   p2z_exp       :  Compute loss of organic matter in the sediments 
     15   !!---------------------------------------------------------------------- 
     16   USE oce_trc        ! 
     17   USE trc            ! 
     18   USE sms_pisces     ! 
     19   USE p2zsed         ! 
     20   USE lbclnk         ! 
     21   USE prtctl_trc     ! Print control for debbuging 
     22   USE trd_oce        ! 
     23   USE trdtrc         ! 
     24   USE iom            ! 
    2325 
    2426   IMPLICIT NONE 
    … …  
    3032 
    3133   ! 
    32    REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   dminl     !: fraction of sinking POC released in sediments 
    33    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   dmin3     !: fraction of sinking POC released at each level 
    34    REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   sedpocb   !: mass of POC in sediments 
    35    REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   sedpocn   !: mass of POC in sediments 
    36    REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   cmask     !: Coastal mask area 
    37    REAL(wp)                                ::   areacot   !: surface coastal area 
     34   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   dminl     ! fraction of sinking POC released in sediments 
     35   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   dmin3     ! fraction of sinking POC released at each level 
     36   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   sedpocb   ! mass of POC in sediments 
     37   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   sedpocn   ! mass of POC in sediments 
     38   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   cmask     ! Coastal mask area 
     39   REAL(wp)                                ::   areacot   ! surface coastal area 
    3840 
    3941   !! * Substitutions 
    … …  
    5961      !!              COLUMN BELOW THE SURFACE LAYER. 
    6062      !!--------------------------------------------------------------------- 
    61       !! 
    62       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     63      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index       
    6364      !! 
    6465      INTEGER  ::   ji, jj, jk, jl, ikt 
    6566      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt 
    6667      REAL(wp), DIMENSION(jpi,jpj)   ::  zsedpoca 
    67       CHARACTER (len=25) :: charout 
     68      CHARACTER (len=25) ::   charout 
    6869      !!--------------------------------------------------------------------- 
    6970      ! 
    … …  
    7273      IF( kt == nittrc000 )   CALL p2z_exp_init 
    7374 
    74       zsedpoca(:,:) = 0. 
    75  
    76  
    77       ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC 
    78       ! POC IN THE WATER COLUMN 
     75      zsedpoca(:,:) = 0._wp 
     76 
     77 
     78      ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC POC IN THE WATER COLUMN 
    7979      ! (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT 
    8080      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90 
    … …  
    9393    
    9494 
    95       zgeolpoc = 0.e0         !     Initialization 
    96       ! Release of nutrients from the "simple" sediment 
    97       DO jj = 2, jpjm1 
     95      zgeolpoc = 0._wp        !     Initialization 
     96      DO jj = 2, jpjm1           ! Release of nutrients from the "simple" sediment 
    9897         DO ji = fs_2, fs_jpim1 
    9998            ikt = mbkt(ji,jj)  
    … …  
    102101            zwork = vsed * trn(ji,jj,ikt,jpdet) 
    103102            zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   & 
    104                &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 
     103               &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rn_Dt 
    105104            zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 
    106105         END DO 
    … …  
    121120      ! Time filter and swap of arrays 
    122121      ! ------------------------------ 
    123       IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step 
    124         !                                             ! (only swap) 
     122      IF( l_1st_euler ) THEN        ! Euler time-stepping at first time-step   (only swap) 
    125123        sedpocn(:,:) = zsedpoca(:,:) 
    126124        !                                               
    127       ELSE 
     125      ELSE                          ! Leap-Frog + Asselin filter 
    128126        ! 
    129127        DO jj = 1, jpj 
    130128           DO ji = 1, jpi 
    131               zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers 
    132               sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn 
    133               sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca 
     129              zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)     ! time laplacian on tracers 
     130              sedpocb(ji,jj) = sedpocn(ji,jj) + rn_atfp * zsedpocd                  ! sedpocb <-- filtered sedpocn 
     131              sedpocn(ji,jj) = zsedpoca(ji,jj)                                      ! sedpocn <-- sedpoca 
    134132           END DO 
    135133        END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/P2Z/p2zsms.F90

    r9598 r9939  
    44   !! TOP :   Time loop of LOBSTER model 
    55   !!====================================================================== 
    6    !! History :   1.0  !            M. Levy 
    7    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
     6   !! History :  1.0  !            M. Levy 
     7   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    88   !!---------------------------------------------------------------------- 
    99 
    … …  
    1111   !!   p2zsms        :  Time loop of passive tracers sms 
    1212   !!---------------------------------------------------------------------- 
    13    USE oce_trc          ! 
    14    USE trc 
    15    USE sms_pisces 
    16    USE p2zbio 
    17    USE p2zopt 
    18    USE p2zsed 
    19    USE p2zexp 
    20    USE trd_oce 
    21    USE trdtrc_oce 
    22    USE trdtrc 
    23    USE trdmxl_trc 
     13   USE oce_trc        ! 
     14   USE trc            ! 
     15   USE sms_pisces     ! 
     16   USE p2zbio         ! 
     17   USE p2zopt         ! 
     18   USE p2zsed         ! 
     19   USE p2zexp         ! 
     20   USE trd_oce        ! 
     21   USE trdtrc_oce     ! 
     22   USE trdtrc         ! 
     23   USE trdmxl_trc     ! 
    2424 
    2525   IMPLICIT NONE 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/P4Z/p4zsms.F90

    r9751 r9939  
    44   !! TOP :   PISCES Source Minus Sink manager 
    55   !!====================================================================== 
    6    !! History :   1.0  !  2004-03 (O. Aumont) Original code 
    7    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     6   !! History :  1.0  !  2004-03 (O. Aumont) Original code 
     7   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!---------------------------------------------------------------------- 
    9    !!   p4z_sms        : Time loop of passive tracers sms 
     9 
    1010   !!---------------------------------------------------------------------- 
    11    USE oce_trc         ! shared variables between ocean and passive tracers 
    12    USE trc             ! passive tracers common variables  
    13    USE trcdta          !  
    14    USE sms_pisces      ! PISCES Source Minus Sink variables 
    15    USE p4zbio          ! Biological model 
    16    USE p4zche          ! Chemical model 
    17    USE p4zlys          ! Calcite saturation 
    18    USE p4zflx          ! Gas exchange 
    19    USE p4zsbc          ! External source of nutrients 
    20    USE p4zsed          ! Sedimentation 
    21    USE p4zint          ! time interpolation 
    22    USE p4zrem          ! remineralisation 
    23    USE iom             ! I/O manager 
    24    USE trd_oce         ! Ocean trends variables 
    25    USE trdtrc          ! TOP trends variables 
    26    USE sedmodel        ! Sediment model 
    27    USE prtctl_trc      ! print control for debugging 
     11   !!   p4z_sms       : Time loop of passive tracers sms 
     12   !!   p4z_sms_init  : initialisation 
     13   !!   p4z_rst       : Read or write variables in restart file 
     14   !!   p4z_dmp       : Relaxation of some tracers 
     15   !!   p4z_chk_mass  : mass conservation check 
     16   !!---------------------------------------------------------------------- 
     17   USE oce_trc        ! shared variables between ocean and passive tracers 
     18   USE trc            ! passive tracers common variables  
     19   USE trcdta         !  
     20   USE sms_pisces     ! PISCES Source Minus Sink variables 
     21   USE p4zbio         ! Biological model 
     22   USE p4zche         ! Chemical model 
     23   USE p4zlys         ! Calcite saturation 
     24   USE p4zflx         ! Gas exchange 
     25   USE p4zsbc         ! External source of nutrients 
     26   USE p4zsed         ! Sedimentation 
     27   USE p4zint         ! time interpolation 
     28   USE p4zrem         ! remineralisation 
     29   USE trd_oce        ! Ocean trends variables 
     30   USE trdtrc         ! TOP trends variables 
     31   USE sedmodel       ! Sediment model 
     32   ! 
     33   USE iom            ! I/O manager 
     34   USE prtctl_trc     ! print control for debugging 
    2835 
    2936   IMPLICIT NONE 
    … …  
    3744   REAL(wp) ::   xfact1, xfact2, xfact3 
    3845 
    39    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     ! Array used to indicate negative tracer values 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr   ! Array used to indicate negative tracer values 
    4047 
    4148   !!---------------------------------------------------------------------- 
    … …  
    8289      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers 
    8390      ! 
    84       rfact = r2dttrc 
     91      rfact = rDt_trc 
    8592      ! 
    8693      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN 
    … …  
    9097         xstep = rfact2 / rday         ! Time step duration for biology 
    9198         IF(lwp) WRITE(numout,*)  
    92          IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdt 
     99         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rn_Dt = ', rn_Dt, ' [s]' 
    93100         IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2 
    94101         IF(lwp) WRITE(numout,*) 
    95102      ENDIF 
    96103 
    97       IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 
     104      IF( l_1st_euler .OR. ln_top_euler ) THEN 
    98105         DO jn = jp_pcs0, jp_pcs1              !   SMS on tracer without Asselin time-filter 
    99106            trb(:,:,:,jn) = trn(:,:,:,jn) 
    … …  
    277284         IF(lwp) WRITE(numout,*) 
    278285         IF(lwp) WRITE(numout,*) ' p4z_rst : Read specific variables from pisces model ' 
    279          IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     286         IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
    280287         !  
    281288         IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN 
    … …  
    407414      !! 
    408415      !!--------------------------------------------------------------------- 
    409       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     416      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     417      ! 
    410418      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot 
    411419      CHARACTER(LEN=100)   ::   cltxt 
    412       INTEGER :: jk 
    413       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork 
     420      INTEGER ::   jk 
     421      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwork 
    414422      !!---------------------------------------------------------------------- 
    415423      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/SED/sedwri.F90

    r5215 r9939  
    11MODULE sedwri 
    2 #if defined key_sed 
    32   !!====================================================================== 
    43   !!                     ***  MODULE  sedwri  *** 
    54   !!         Sediment diagnostics :  write sediment output files 
    65   !!====================================================================== 
     6   !!   History :       !  06-07  (C. Ethe)  original 
     7   !!---------------------------------------------------------------------- 
     8#if defined key_sed 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_sed'                                           PISCES sediment 
     11   !!---------------------------------------------------------------------- 
    712   USE sed 
    813   USE sedarr 
    … …  
    1318   PRIVATE 
    1419 
    15    !! * Accessibility 
    16    PUBLIC sed_wri  
    17  
    18    INTEGER  :: nised 
    19    INTEGER  :: nhorised 
    20    INTEGER  :: ndimt52 
    21    INTEGER  :: ndimt51 
    22    INTEGER  :: ndepsed 
    23    REAL(wp) :: zjulian 
    24    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext52   
    25    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51 
    26  
     20   PUBLIC   sed_wri  
     21 
     22   INTEGER  ::   nised 
     23   INTEGER  ::   nhorised 
     24   INTEGER  ::   ndimt52 
     25   INTEGER  ::   ndimt51 
     26   INTEGER  ::   ndepsed 
     27   REAL(wp) ::   zjulian 
     28   ! 
     29   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::   ndext52   
     30   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::   ndext51 
     31 
     32   !!---------------------------------------------------------------------- 
     33   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    2734   !! $Id$ 
     35   !! Software governed by the CeCILL licence     (./LICENSE) 
     36   !!---------------------------------------------------------------------- 
    2837CONTAINS 
    2938 
    30    !!---------------------------------------------------------------------- 
    31    !!                                                   NetCDF output file 
    32    !!---------------------------------------------------------------------- 
    3339   SUBROUTINE sed_wri( kt ) 
    3440      !!---------------------------------------------------------------------- 
    … …  
    3743      !! ** Purpose :  output of sediment passive tracer 
    3844      !! 
    39       !!   History : 
    40       !!        !  06-07  (C. Ethe)  original 
    4145      !!---------------------------------------------------------------------- 
    42  
    4346      INTEGER, INTENT(in) :: kt 
    44  
     47      ! 
    4548      CHARACTER(len = 60)  ::  clhstnam, clop 
    4649      INTEGER  :: ji, jk, js, jw, jn 
    … …  
    5154      REAL(wp)  :: zrate 
    5255      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta, zflx 
    53  
    5456      !!------------------------------------------------------------------- 
    5557 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/sms_pisces.F90

    r9598 r9939  
    1313   PUBLIC 
    1414 
    15    INTEGER ::   numnatp_ref = -1           !! Logical units for namelist pisces 
    16    INTEGER ::   numnatp_cfg = -1           !! Logical units for namelist pisces 
    17    INTEGER ::   numonp      = -1           !! Logical unit for namelist pisces output 
     15   INTEGER ::   numnatp_ref = -1   ! Logical units for namelist pisces 
     16   INTEGER ::   numnatp_cfg = -1   ! Logical units for namelist pisces 
     17   INTEGER ::   numonp      = -1   ! Logical unit for namelist pisces output 
    1818 
    1919   !                                                       !:  PISCES  : silicon dependant half saturation 
    … …  
    2626 
    2727   !!*  Time variables 
    28    INTEGER  ::   nrdttrc           !: ??? 
     28   INTEGER  ::   nrdttrc           !: frequency for the biology 
    2929   REAL(wp) ::   rfact , rfactr    !: ??? 
    3030   REAL(wp) ::   rfact2, rfact2r   !: ??? 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/TRP/trcadv.F90

    r9598 r9939  
    125125         CALL tra_adv_cen( kt, nittrc000,'TRC',          zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v ) 
    126126      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
    127          CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
     127         CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
    128128      CASE ( np_MUS )                                 ! MUSCL 
    129          CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
     129         CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
    130130      CASE ( np_UBS )                                 ! UBS 
    131          CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra          , nn_ubs_v ) 
     131         CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zun, zvn, zwn, trb, trn, tra, jptra          , nn_ubs_v ) 
    132132      CASE ( np_QCK )                                 ! QUICKEST 
    133          CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
     133         CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
    134134      ! 
    135135      END SELECT 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/TRP/trcnxt.F90

    r9598 r9939  
    2424   !!   'key_top'                                                TOP models 
    2525   !!---------------------------------------------------------------------- 
    26    !!   trc_nxt     : time stepping on passive tracers 
    27    !!---------------------------------------------------------------------- 
    28    USE oce_trc         ! ocean dynamics and tracers variables 
    29    USE trc             ! ocean passive tracers variables 
    30    USE trd_oce 
    31    USE trdtra 
    32    USE tranxt 
    33    USE bdy_oce   , ONLY: ln_bdy 
    34    USE trcbdy          ! BDY open boundaries 
     26 
     27   !!---------------------------------------------------------------------- 
     28   !!   trc_nxt       : time stepping on passive tracers 
     29   !!---------------------------------------------------------------------- 
     30   USE oce_trc        ! ocean dynamics and tracers variables 
     31   USE trc            ! ocean passive tracers variables 
     32   USE trd_oce        !  
     33   USE trdtra         ! 
     34   USE tranxt         ! 
     35   USE bdy_oce , ONLY : ln_bdy 
     36   USE trcbdy         ! BDY open boundaries 
    3537# if defined key_agrif 
    3638   USE agrif_top_interp 
    3739# endif 
    3840   ! 
    39    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    40    USE prtctl_trc      ! Print control for debbuging 
     41   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     42   USE prtctl_trc     ! Print control for debbuging 
    4143 
    4244   IMPLICIT NONE 
    … …  
    7274      !!      the divergence of two consecutive time-steps and tr arrays 
    7375      !!      to prepare the next time_step: 
    74       !!         (trb) = (trn) + atfp [ (trb) + (tra) - 2 (trn) ] 
     76      !!         (trb) = (trn) + rn_atfp [ (trb) + (tra) - 2 (trn) ] 
    7577      !!         (trn) = (tra) ; (tra) = (0,0) 
    7678      !! 
    … …  
    8183      ! 
    8284      INTEGER  ::   jk, jn   ! dummy loop indices 
    83       REAL(wp) ::   zfact            ! temporary scalar 
     85      REAL(wp) ::   zfact    ! local scalar 
    8486      CHARACTER (len=22) :: charout 
    8587      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrdt    ! 4D workspace 
    … …  
    99101      CALL lbc_lnk( tra(:,:,:,:), 'T', 1. )    
    100102 
    101       IF( ln_bdy )  CALL trc_bdy( kt ) 
     103      IF( ln_bdy )   CALL trc_bdy( kt ) 
    102104 
    103105      IF( l_trdtrc )  THEN             ! trends: store now fields before the Asselin filter application 
    104106         ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) ) 
    105          ztrdt(:,:,:,:)  = trn(:,:,:,:) 
     107         ztrdt(:,:,:,:) = trn(:,:,:,:) 
    106108      ENDIF 
    107109      !                                ! Leap-Frog + Asselin filter time stepping 
    108       IF( (neuler == 0 .AND. kt == nittrc000) .OR. ln_top_euler ) THEN    ! Euler time-stepping (only swap) 
     110      IF( l_1st_euler .OR. ln_top_euler ) THEN    ! Euler time-stepping (only swap) 
    109111         DO jn = 1, jptra 
    110112            DO jk = 1, jpkm1 
    … …  
    115117      ELSE      
    116118         IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping 
    117             IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )  !     linear ssh 
    118             ELSE                   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      & 
    119               &                                                                   sbc_trc, sbc_trc_b, jptra )  ! non-linear ssh 
     119            IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nittrc000,            'TRC', trb, trn, tra, jptra )  !     linear ssh 
     120            ELSE                   ;   CALL tra_nxt_vvl( kt, nittrc000, rn_Dt_trc, 'TRC', trb, trn, tra,       & 
     121              &                                                                      sbc_trc, sbc_trc_b, jptra )  ! non-linear ssh 
    120122            ENDIF 
    121123         ELSE 
    … …  
    129131         DO jn = 1, jptra 
    130132            DO jk = 1, jpkm1 
    131                zfact = 1._wp / r2dttrc   
    132                ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact  
     133               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * r1_Dt_trc  
    133134               CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 
    134135            END DO 
    … …  
    164165      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )    
    165166      !!             ztm = 0                                                       otherwise 
    166       !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 
    167       !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] ) 
     167      !!             tb  = ( e3t_n*tn + rn_atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 
     168      !!                  /( e3t_n    + rn_atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] ) 
    168169      !!             tn  = ta  
    169170      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call) 
    … …  
    184185         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    185186         IF( .NOT. ln_linssh ) THEN 
    186             rfact1 = atfp * rdttrc 
    187             rfact2 = rfact1 / rau0 
     187            rfact1 = rn_atfp * rn_Dt_trc 
     188            rfact2 = rfact1 * r1_rho0 
    188189         ENDIF 
    189190        !   
    … …  
    205206                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b 
    206207                  ! 
    207                   ze3t_f = ze3t_n + atfp * ze3t_d 
    208                   ztc_f  = ztc_n  + atfp * ztc_d 
    209                   ! 
    210                   IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN           ! first level  
     208                  ze3t_f = ze3t_n + rn_atfp * ze3t_d 
     209                  ztc_f  = ztc_n  + rn_atfp * ztc_d 
     210                  ! 
     211                  IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN           ! top ocean level  
    211212                     ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj)      - emp(ji,jj)   )  
    212213                     ztc_f  = ztc_f  - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 
    213214                  ENDIF 
    214  
    215                   ze3t_f = 1.e0 / ze3t_f 
    216                   trb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered 
     215                  ! 
     216                  trb(ji,jj,jk,jn) = ztc_f / ze3t_f       ! ptb <-- ptn filtered 
    217217                  trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)     ! ptn <-- pta 
    218                   ! 
    219218               END DO 
    220219            END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/TRP/trcrad.F90

    r9788 r9939  
    174174            IF( l_trdtrc ) THEN 
    175175               ! 
    176                zs2rdt = 1. / ( 2. * rdt ) 
     176!!gm Question: Is this correct with an Euler first time-step ?? 
     177               zs2rdt = 1. / ( 2. * rn_Dt ) 
    177178               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    178179               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
    … …  
    204205            IF( l_trdtrc ) THEN 
    205206               ! 
    206                zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 
     207               zs2rdt = 1. / ( 2. * rn_Dt * REAL( nn_dttrc, wp ) ) 
    207208               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    208209               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/TRP/trcsbc.F90

    r9598 r9939  
    120120            DO jj = 2, jpj 
    121121               DO ji = fs_2, fs_jpim1   ! vector opt. 
    122                   sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn) 
     122                  sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rho0 * trn(ji,jj,1,jn) 
    123123               END DO 
    124124            END DO 
    … …  
    126126            DO jj = 2, jpj 
    127127               DO ji = fs_2, fs_jpim1   ! vector opt. 
    128                   zse3t = 1. / e3t_n(ji,jj,1) 
     128                  zse3t = 1._wp / e3t_n(ji,jj,1) 
    129129                  ! tracer flux at the ice/ocean interface (tracer/m2/s) 
    130130                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
    … …  
    135135                  ztfx  = zftra                             ! net tracer flux 
    136136                  ! 
    137                   zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) )  
     137                  zdtra = r1_rho0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) )  
    138138                  IF ( zdtra < 0. ) THEN 
    139                      zratio = -zdtra * zse3t * r2dttrc / ( trn(ji,jj,1,jn) + zrtrn ) 
     139                     zratio = -zdtra * zse3t * rDt_trc / ( trn(ji,jj,1,jn) + zrtrn ) 
    140140                     zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 
    141141                  ENDIF 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/TRP/trczdf.F90

    r9598 r9939  
    5454      IF( l_trdtrc )   ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    5555      ! 
    56       CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dttrc, trb, tra, jptra )    !   implicit scheme           
     56      CALL tra_zdf_imp( kt, nittrc000, 'TRC', rDt_trc, trb, tra, jptra )    !   implicit scheme           
    5757      ! 
    5858      IF( l_trdtrc )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    5959         DO jn = 1, jptra 
    6060            DO jk = 1, jpkm1 
    61                ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dttrc ) - ztrtrd(:,:,jk,jn) 
     61               ztrtrd(:,:,jk,jn) = ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) * r1_Dt_trc - ztrtrd(:,:,jk,jn) 
    6262            END DO 
    6363            CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/TRP/trdmxl_trc.F90

    r9598 r9939  
    1616   !!   trd_mxl_trc_init : initialization step 
    1717   !!---------------------------------------------------------------------- 
    18    USE trc               ! tracer definitions (trn, trb, tra, etc.) 
    19    USE trc_oce, ONLY :  nn_dttrc  ! frequency of step on passive tracers 
    20    USE dom_oce           ! domain definition 
     18   USE trc            ! tracer definitions (trn, trb, tra, etc.) 
     19   USE trc_oce , ONLY : nn_dttrc  ! frequency of step on passive tracers 
     20   USE dom_oce        ! domain definition 
    2121   USE zdfmxl  , ONLY : nmln ! number of level in the mixed layer 
    2222   USE zdf_oce , ONLY : avs  ! vert. diffusivity coef. at w-point for temp   
    23    USE trdtrc_oce    ! definition of main arrays used for trends computations 
    24    USE in_out_manager    ! I/O manager 
    25    USE dianam            ! build the name of file (routine) 
    26    USE ldfslp            ! iso-neutral slopes  
    27    USE ioipsl            ! NetCDF library 
    28    USE lbclnk            ! ocean lateral boundary conditions (or mpp link) 
    29    USE lib_mpp           ! MPP library 
    30    USE trdmxl_trc_rst    ! restart for diagnosing the ML trends 
    31    USE prtctl            ! print control 
    32    USE sms_pisces        ! PISCES bio-model 
     23   USE trdtrc_oce     ! definition of main arrays used for trends computations 
     24   USE ldfslp         ! iso-neutral slopes  
     25   USE trdmxl_trc_rst ! restart for diagnosing the ML trends 
     26   USE sms_pisces     ! PISCES bio-model 
     27   ! 
     28   USE in_out_manager ! I/O manager 
     29   USE ioipsl         ! NetCDF library 
     30   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     31   USE lib_mpp        ! MPP library 
     32   USE prtctl         ! print control 
     33   USE dianam         ! build the name of file (routine) 
    3334 
    3435   IMPLICIT NONE 
    3536   PRIVATE 
    3637 
    37    PUBLIC trd_mxl_trc 
    38    PUBLIC trd_mxl_trc_alloc 
    39    PUBLIC trd_mxl_trc_init 
    40    PUBLIC trd_mxl_trc_zint 
     38   PUBLIC   trd_mxl_trc 
     39   PUBLIC   trd_mxl_trc_alloc 
     40   PUBLIC   trd_mxl_trc_init 
     41   PUBLIC   trd_mxl_trc_zint 
    4142 
    4243   CHARACTER (LEN=40) ::  clhstnam                                ! name of the trends NetCDF file 
    … …  
    408409         DO jn = 1, jptra 
    409410            IF( ln_trdtrc(jn) ) THEN 
    410                !-- Compute total trends    (use rdttrc instead of rdt ???) 
     411               !-- Compute total trends    (use rdt_trc instead of rn_Dt ???) 
    411412               IF ( ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) THEN  ! EULER-FORWARD schemes 
    412                   ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) )/rdt 
     413                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) ) / rn_Dt 
    413414               ELSE                                                                     ! LEAP-FROG schemes 
    414                   ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) + tmlb_trc(:,:,jn) - tmlbb_trc(:,:,jn))/(2.*rdt) 
     415                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) + tmlb_trc(:,:,jn) - tmlbb_trc(:,:,jn)) * r1_Dt 
    415416               ENDIF 
    416417                
    … …  
    446447            IF( ln_trdtrc(jn) ) THEN 
    447448               tml_sum_trc(:,:,jn) = tmlbn_trc(:,:,jn) + 2 * ( tml_sum_trc(:,:,jn) - tml_trc(:,:,jn) ) + tml_trc(:,:,jn) 
    448                ztmltot2   (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) /  ( 2.*rdt )    ! now tracer unit is /sec 
     449               ztmltot2   (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) * r1_Dt    ! now tracer unit is /sec 
    449450            ENDIF 
    450451         END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/oce_trc.F90

    r9490 r9939  
    4040   USE oce , ONLY :   tsa     =>    tsa     !: 4D array contaning ( ta, sa ) 
    4141   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3)  
    42    USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
     42   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rho0)/rho0 (no units) 
    4343   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
    4444   USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]    

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/trc.F90

    r9598 r9939  
    44   !! Passive tracers   :  module for tracers defined 
    55   !!====================================================================== 
    6    !! History :   OPA  !  1996-01  (M. Levy)  Original code 
    7    !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
    8    !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module 
     6   !! History :  OPA  !  1996-01  (M. Levy)  Original code 
     7   !!             -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
     8   !!   NEMO     1.0  !  2004-03  (C. Ethe)  Free form and module 
    99   !!---------------------------------------------------------------------- 
    1010   USE par_oce 
    1111   USE par_trc 
    12    USE bdy_oce, only: jp_bdy, ln_bdy, nb_bdy, OBC_DATA 
     12   USE bdy_oce , ONLY : jp_bdy, ln_bdy, nb_bdy, OBC_DATA 
    1313    
    1414   IMPLICIT NONE 
    … …  
    6363   CHARACTER(len = 80) , PUBLIC ::   cn_trcrst_out      !: suffix of pass. tracer restart name (output) 
    6464   CHARACTER(len = 256), PUBLIC ::   cn_trcrst_outdir   !: restart output directory 
    65    REAL(wp)            , PUBLIC ::   rdttrc             !: passive tracer time step 
    66    REAL(wp)            , PUBLIC ::   r2dttrc            !: = 2*rdttrc except at nit000 (=rdttrc) if neuler=0 
     65   REAL(wp)            , PUBLIC ::   rn_Dt_trc          !: = nn_dttrc * rn_Dt  (passive tracer time step) 
     66   REAL(wp)            , PUBLIC ::   rDt_trc            !: = 2*rn_Dt_trc except at nit000 (=rn_Dt_trc) if l_top_euler=T 
     67   REAL(wp)            , PUBLIC ::   r1_Dt_trc          !: = 1/rDt_trc 
    6768   LOGICAL             , PUBLIC ::   ln_top_euler       !: boolean term for euler integration  
     69   LOGICAL             , PUBLIC ::   l_top_euler        !: boolean term for euler integration  
    6870   LOGICAL             , PUBLIC ::   ln_trcdta          !: Read inputs data from files 
    6971   LOGICAL             , PUBLIC ::   ln_trcdmp          !: internal damping flag 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/trcbc.F90

    r9800 r9939  
    411411               DO ji = fs_2, fs_jpim1 
    412412                  DO jk = 1, nk_rnf(ji,jj) 
    413                      zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 
     413                     zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rho0 / h_rnf(ji,jj) 
    414414                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + (trn(ji,jj,jk,jn) * zrnf) 
    415415                  END DO 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/trcnam.F90

    r9598 r9939  
    5252      !!--------------------------------------------------------------------- 
    5353      ! 
    54       IF( .NOT.l_offline )   CALL trc_nam_run     ! Parameters of the run                                   
     54      IF( .NOT.l_offline )   CALL trc_nam_run   ! Parameters of the run                                   
    5555      !                
    56       CALL trc_nam_trc                            ! passive tracer informations 
     56      CALL trc_nam_trc                          ! passive tracer informations 
    5757      !                                         
    5858      IF( ln_rsttr                     )   ln_trcdta = .FALSE.   ! restart : no need of clim data 
    … …  
    6161      ! 
    6262      ! 
    63       IF(lwp) THEN                   ! control print 
     63      IF(lwp) THEN                              ! control print 
    6464         IF( ln_rsttr ) THEN 
    6565            WRITE(numout,*) 
    … …  
    7676      ENDIF 
    7777      ! 
    78       rdttrc = rdt * FLOAT( nn_dttrc )          ! passive tracer time-step 
     78      rn_Dt_trc = REAL( nn_dttrc ) * rn_Dt      ! passive tracer time-step 
    7979      !  
    8080      IF(lwp) THEN                              ! control print 
    8181        WRITE(numout,*)  
    82         WRITE(numout,*) '   ==>>>   Passive Tracer  time step    rdttrc = nn_dttrc*rdt = ', rdttrc 
     82        WRITE(numout,*) '   ==>>>   Passive Tracer  time step    rn_Dt_trc = nn_dttrc*rn_Dt = ', rn_Dt_trc 
    8383      ENDIF 
    8484      ! 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/trcrst.F90

    r9598 r9939  
    44   !! TOP :   Manage the passive tracer restart 
    55   !!====================================================================== 
    6    !! History :    -   !  1991-03  ()  original code 
    7    !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
    8    !!              -   !  2005-10 (C. Ethe) print control 
    9    !!             2.0  !  2005-10 (C. Ethe, G. Madec) revised architecture 
     6   !! History :   -   !  1991-03  ()  original code 
     7   !!            1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
     8   !!             -   !  2005-10 (C. Ethe) print control 
     9   !!            2.0  !  2005-10 (C. Ethe, G. Madec) revised architecture 
    1010   !!---------------------------------------------------------------------- 
    1111#if defined key_top 
    … …  
    1313   !!   'key_top'                                                TOP models 
    1414   !!---------------------------------------------------------------------- 
    15    !!---------------------------------------------------------------------- 
    16    !!   trc_rst        : Restart for passive tracer 
    17    !!   trc_rst_opn    : open  restart file 
    18    !!   trc_rst_read   : read  restart file 
    19    !!   trc_rst_wri    : write restart file 
    20    !!---------------------------------------------------------------------- 
    21    USE oce_trc 
    22    USE trc 
    23    USE iom 
    24    USE daymod 
     15    
     16   !!---------------------------------------------------------------------- 
     17   !!   trc_rst       : Restart for passive tracer 
     18   !!   trc_rst_opn   : open  restart file 
     19   !!   trc_rst_read  : read  restart file 
     20   !!   trc_rst_wri   : write restart file 
     21   !!---------------------------------------------------------------------- 
     22   USE oce_trc        !  
     23   USE trc            ! 
     24   USE daymod         ! 
     25   USE iom            ! 
    2526    
    2627   IMPLICIT NONE 
    2728   PRIVATE 
    2829 
    29    PUBLIC   trc_rst_opn       ! called by ??? 
    30    PUBLIC   trc_rst_read      ! called by ??? 
    31    PUBLIC   trc_rst_wri       ! called by ??? 
    32    PUBLIC   trc_rst_cal 
    33  
    34    !!---------------------------------------------------------------------- 
    35    !! NEMO/TOP 3.7 , NEMO Consortium (2018) 
     30   PUBLIC   trc_rst_opn    ! called by trcstp 
     31   PUBLIC   trc_rst_read   ! called by trcini 
     32   PUBLIC   trc_rst_wri    ! called by trcstp 
     33   PUBLIC   trc_rst_cal    ! called by trcstp & trcini (and OFF/nemogcm) 
     34 
     35   !!---------------------------------------------------------------------- 
     36   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    3637   !! $Id$ 
    3738   !! Software governed by the CeCILL licence (./LICENSE) 
    … …  
    9394   END SUBROUTINE trc_rst_opn 
    9495 
     96 
    9597   SUBROUTINE trc_rst_read 
    9698      !!---------------------------------------------------------------------- 
    … …  
    130132      !!---------------------------------------------------------------------- 
    131133      ! 
    132       CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc )   ! passive tracer time step 
     134      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rn_Dt_trc )   ! passive tracer time step 
     135 
    133136      ! prognostic variables  
    134137      ! --------------------  
    … …  
    175178      !!       In both those options, the  exact duration of the experiment 
    176179      !!       since the beginning (cumulated duration of all previous restart runs) 
    177       !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt. 
     180      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt. 
    178181      !!       This is valid is the time step has remained constant. 
    179182      !! 
    … …  
    186189      INTEGER  ::  jlibalt = jprstlib 
    187190      LOGICAL  ::  llok 
    188       REAL(wp) ::  zrdttrc1, zkt, zndastp, zdayfrac, ksecs, ktime 
     191      REAL(wp) ::  zkt, zndastp, zdayfrac, ksecs, ktime 
    189192      INTEGER  ::   ihour, iminute 
    190193 
    … …  
    256259               nminute = ( nn_time0 - nhour * 100 ) 
    257260               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0) 
    258                adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 
     261               adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 
    259262               ! note this is wrong if time step has changed during run 
    260263            ENDIF 
    … …  
    269272            ENDIF 
    270273            ! 
    271             IF( ln_rsttr )  THEN   ;    neuler = 1 
    272             ELSE                   ;    neuler = 0 
     274            IF( ln_rsttr )  THEN   ;    l_1st_euler = .FALSE.     ! OFF restart: no Euler 1st time-step 
     275            ELSE                   ;    l_1st_euler = .TRUE.      ! OFF cold start: Euler 1st time-step is used 
    273276            ENDIF 
    274277            ! 
    … …  
    346349#endif 
    347350 
    348    !!---------------------------------------------------------------------- 
    349    !! NEMO/TOP 3.3 , NEMO Consortium (2018) 
    350    !! $Id$ 
    351    !! Software governed by the CeCILL licence (./LICENSE) 
    352351   !!====================================================================== 
    353352END MODULE trcrst 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/trcstp.F90

    r9598 r9939  
    6161      IF( ln_timing )   CALL timing_start('trc_stp') 
    6262      ! 
    63       IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    64          r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping) 
     63      IF( l_1st_euler .OR. ln_top_euler ) THEN     ! at nittrc000 
     64         rDt_trc =  rn_Dt_trc           ! use or restarting with Euler time stepping) 
    6565      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    66          r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
     66         rDt_trc = 2. * rn_Dt_trc       ! leapfrog time stepping 
    6767      ENDIF 
    6868      ! 
    … …  
    144144            nb_rec_per_day = ncpl_qsr_freq 
    145145         ELSE   
    146             rdt_sampl = MAX( 3600., rdttrc ) 
     146            rdt_sampl = MAX( 3600., rn_Dt_trc ) 
    147147            nb_rec_per_day = INT( rday / rdt_sampl ) 
    148148         ENDIF 
    … …  
    163163 
    164164            CALL iom_get( numrtr, 'ktdcy', zkt )   
    165             rsecfst = INT( zkt ) * rdttrc 
     165            rsecfst = INT( zkt ) * rn_Dt_trc 
    166166            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s ' 
    167167            CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr 
    … …  
    184184         ELSE                                         !* no restart: set from nit000 values 
    185185            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values' 
    186             rsecfst  = kt * rdttrc 
     186            rsecfst  = kt * rn_Dt_trc 
    187187            ! 
    188188            qsr_mean(:,:) = qsr(:,:) 
    … …  
    194194      ENDIF 
    195195      ! 
    196       rseclast = kt * rdttrc 
     196      rseclast = kt * rn_Dt_trc 
    197197      ! 
    198198      llnew   = ( rseclast - rsecfst ) .ge.  rdt_sampl    !   new shortwave to store 

  • NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/trcsub.F90

    r9598 r9939  
    466466      ! 
    467467      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    468       REAL(wp) ::   zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0   ! local scalars 
     468      REAL(wp) ::   zcoefu, zcoefv, zcoeff, z1_2rho0   ! local scalars 
    469469      REAL(wp), DIMENSION(jpi,jpj) :: zhdiv 
    470470      !!--------------------------------------------------------------------- 
    … …  
    486486      CALL div_hor( kt )                              ! Horizontal divergence & Relative vorticity 
    487487      ! 
    488       z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog) 
    489       IF( neuler == 0 .AND. kt == nittrc000 )   z2dt = rdt 
    490  
    491488      !                                           !------------------------------! 
    492489      !                                           !   After Sea Surface Height   ! 
    … …  
    499496      ! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used 
    500497      ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp 
    501       z1_rau0 = 0.5 / rau0 
    502       ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1) 
     498      z1_2rho0 = 0.5 * r1_rho0 
     499      ssha(:,:) = (  sshb(:,:) - rDt * ( z1_2rho0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1) 
    503500 
    504501      IF( .NOT.ln_dynspg_ts ) THEN 
    … …  
    517514      !                                           !     Now Vertical Velocity    ! 
    518515      !                                           !------------------------------! 
    519       z1_2dt = 1.e0 / z2dt 
    520516      DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence 
    521517         ! - ML - need 3 lines here because replacement of e3t by its expression yields too long lines otherwise 
    522          wn(:,:,jk) = wn(:,:,jk+1) -   e3t_n(:,:,jk) * hdivn(:,:,jk)        & 
    523             &                      - ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )    & 
    524             &                         * tmask(:,:,jk) * z1_2dt 
    525          IF( ln_bdy ) wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 
     518         wn(:,:,jk) = wn(:,:,jk+1) -   e3t_n(:,:,jk) * hdivn(:,:,jk)   & 
     519            &                      - ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) * r1_Dt * tmask(:,:,jk) 
     520         IF( ln_bdy )   wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 
    526521      END DO 
    527522      ! 
Note: See TracChangeset for help on using the changeset viewer.