- Timestamp:
- 2018-07-13T09:28:50+02:00 (6 years ago)
- 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 30 30 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 31 31 ! 32 rn_ rdt= 5760. ! time step for the dynamics and tracer32 rn_Dt = 5760. ! time step for the dynamics and tracer 33 33 / 34 34 !----------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg
r9773 r9939 31 31 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 32 32 ! 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) 34 34 / 35 35 !----------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg
r9773 r9939 31 31 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 32 32 ! 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) 34 34 / 35 35 !----------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg
r9771 r9939 30 30 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 31 31 ! 32 rn_ rdt= 5760. ! time step for the dynamics and tracer32 rn_Dt = 5760. ! time step for the dynamics and tracer 33 33 / 34 34 !----------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/AMM12/EXPREF/namelist_cfg
r9742 r9939 33 33 &namdom ! time and space domain 34 34 !----------------------------------------------------------------------- 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) 36 36 / 37 37 !----------------------------------------------------------------------- … … 301 301 ln_dynspg_ts = .true. ! split-explicit free surface 302 302 ln_bt_auto = .false. ! Number of sub-step defined from: 303 nn_ baro = 30 ! =F : the number of sub-step in rn_rdt seconds303 nn_e = 30 ! =F : the number of sub-step in rn_Dt seconds 304 304 / 305 305 !----------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/C1D_PAPA/EXPREF/namelist_cfg
r9799 r9939 49 49 &namdom ! time and space domain 50 50 !----------------------------------------------------------------------- 51 rn_ rdt= 360. ! time step for the dynamics and tracer51 rn_Dt = 360. ! time step for the dynamics and tracer 52 52 / 53 53 !----------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/GYRE_BFM/EXPREF/namelist_cfg
r9560 r9939 45 45 ln_linssh = .true. ! =T linear free surface ==>> model level are fixed in time 46 46 ! 47 rn_ rdt= 7200. ! time step for the dynamics47 rn_Dt = 7200. ! time step for the dynamics 48 48 / 49 49 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/GYRE_PISCES/EXPREF/namelist_cfg
r9742 r9939 45 45 ln_linssh = .true. ! =T linear free surface ==>> model level are fixed in time 46 46 ! 47 rn_ rdt= 7200. ! time step for the dynamics47 rn_Dt = 7200. ! time step for the dynamics 48 48 / 49 49 !!====================================================================== -
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_iomput1 bld::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 28 28 &namdom ! time and space domain 29 29 !----------------------------------------------------------------------- 30 rn_ rdt = 5760. ! time step for the dynamics and tracer30 rn_Dt = 5760. ! time step for the dynamics and tracer 31 31 / 32 32 !----------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/ORCA2_OFF_PISCES/EXPREF/namelist_cfg
r9751 r9939 34 34 ln_linssh = .true. ! =T linear free surface ==>> model level are fixed in time 35 35 ! 36 rn_ rdt= 21600. ! time step for the dynamics and tracer36 rn_Dt = 21600. ! time step for the dynamics and tracer 37 37 / 38 38 !----------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/ORCA2_OFF_TRC/EXPREF/namelist_cfg
r9742 r9939 34 34 ln_linssh = .true. ! =T linear free surface ==>> model level are fixed in time 35 35 ! 36 rn_ rdt= 21600. ! time step for the dynamics and tracer36 rn_Dt = 21600. ! time step for the dynamics and tracer 37 37 / 38 38 !----------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/SHARED/namelist_ref
r9838 r9939 42 42 nn_leapy = 0 ! Leap year calendar (1) or not (0) 43 43 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=T45 nn_rstctl = 0! restart control ==> activated only if ln_rstart=T44 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 46 46 ! ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist 47 47 ! ! = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart … … 70 70 rn_isfhmin = 1.00 ! treshold [m] to discriminate grounding ice from floating ice 71 71 ! 72 rn_ rdt= 5760. ! time step for the dynamics and tracer72 rn_Dt = 5760. ! time step for the dynamics and tracer 73 73 rn_atfp = 0.1 ! asselin time filter parameter 74 74 ! … … 562 562 !----------------------------------------------------------------------- 563 563 ln_tide = .false. ! Activate tides 564 ln_tide_pot = .true. 565 ln_scal_load = .false. 566 rn_ scal_load = 0.094! load potential567 ln_read_load = .false. ! Orread load potential from file568 cn_tide_load = 'tide_LOAD_grid_T.nc' ! filename for load potential564 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 569 569 ! 570 570 ln_tide_ramp = .false. ! Use linear ramp for tides at startup 571 r dttideramp= 0. ! ramp duration in days571 rn_ramp = 0. ! ramp duration in days 572 572 clname(1) = 'DUMMY' ! name of constituent - all tidal components must be set in namelist_cfg 573 573 / … … 888 888 ln_dynspg_exp = .false. ! explicit free surface 889 889 ln_dynspg_ts = .false. ! split-explicit free surface 890 ln_bt_fw = .true. ! Forward integration of barotropicEqs.890 ln_bt_fw = .true. ! Forward integration of external mode Eqs. 891 891 ln_bt_av = .true. ! Time filtering of barotropic variables 892 892 nn_bt_flt = 1 ! Time filter choice = 0 None … … 894 894 ! ! = 2 Boxcar over 2*nn_baro " " 895 895 ln_bt_auto = .true. ! Number of sub-step defined from: 896 rn_bt_cmax = 0.8! =T : the Maximum Courant Number allowed897 nn_ baro = 30 ! =F : the number of sub-step in rn_rdt seconds896 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 898 898 rn_bt_alpha = 0. ! Temporal diffusion parameter (if ln_bt_av=F) 899 899 / -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/cfgs/SPITZ12/EXPREF/namelist_cfg
r9793 r9939 27 27 &namdom ! time and space domain 28 28 !----------------------------------------------------------------------- 29 rn_ rdt= 720. ! time step for the dynamics and tracer29 rn_Dt = 720. ! time step for the dynamics and tracer 30 30 ! 31 31 / -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/ice.F90
r9604 r9939 188 188 ! !!** some other parameters 189 189 INTEGER , PUBLIC :: kt_ice !: iteration number 190 REAL(wp), PUBLIC :: r dt_ice !: ice time step191 REAL(wp), PUBLIC :: r1_ rdtice !: = 1. / rdt_ice190 REAL(wp), PUBLIC :: rDt_ice !: ice time step 191 REAL(wp), PUBLIC :: r1_Dt_ice !: = 1. / rdt_ice 192 192 REAL(wp), PUBLIC :: r1_nlay_i !: 1 / nlay_i 193 193 REAL(wp), PUBLIC :: r1_nlay_s !: 1 / nlay_s -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icealb.F90
r9604 r9939 148 148 ! 149 149 ! !--- Snow-covered ice albedo (freezing, melting cases) 150 IF( pt_su(ji,jj,jl) < rt0 _snow) THEN150 IF( pt_su(ji,jj,jl) < rt0 ) THEN 151 151 zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 ) 152 152 ELSE -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icecor.F90
r9604 r9939 86 86 IF ( nn_icesal == 2 ) THEN ! salinity must stay in bounds [Simin,Simax] ! 87 87 ! !----------------------------------------------------- 88 zzc = rhoi c * r1_rdtice88 zzc = rhoi * r1_Dt_ice 89 89 DO jl = 1, jpl 90 90 DO jj = 1, jpj … … 137 137 ! ! heat content variation (W.m-2) 138 138 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_ rdtice139 & + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) ) * r1_Dt_ice 140 140 ! ! salt, volume 141 diag_sice(ji,jj) = SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi c * r1_rdtice142 diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi c * r1_rdtice143 diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos n * r1_rdtice141 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 144 144 END DO 145 145 END DO 146 146 ! ! concentration tendency (dynamics) 147 zafx (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_ rdtice147 zafx (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice 148 148 afx_tot(:,:) = zafx(:,:) 149 149 IF( iom_use('afxdyn') ) CALL iom_put( 'afxdyn' , zafx(:,:) ) … … 158 158 ! ! heat content variation (W.m-2) 159 159 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_ rdtice160 & + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) ) * r1_Dt_ice 161 161 ! ! salt, volume 162 diag_sice(ji,jj) = diag_sice(ji,jj) + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi c * r1_rdtice163 diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi c * r1_rdtice164 diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos n * r1_rdtice162 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 165 165 END DO 166 166 END DO 167 167 ! ! concentration tendency (total + thermo) 168 zafx (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_ rdtice168 zafx (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice 169 169 afx_tot(:,:) = afx_tot(:,:) + zafx(:,:) 170 170 IF( iom_use('afxthd') ) CALL iom_put( 'afxthd' , zafx(:,:) ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icectl.F90
r9604 r9939 93 93 & ) * e1e2t(:,:) ) * zconv 94 94 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 * rhoi c, 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 ) 98 98 99 99 pdiag_t = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) & … … 120 120 121 121 ! outputs 122 zv = ( ( glob_sum( SUM( v_i * rhoi c + v_s * rhosn, dim=3 ) * e1e2t ) * zconv &123 & - pdiag_v ) * r1_ rdtice - zfv ) * rday124 125 zs = ( ( glob_sum( SUM( sv_i * rhoi c, dim=3 ) * e1e2t ) * zconv &126 & - pdiag_s ) * r1_ rdtice + zfs ) * rday122 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 127 127 128 128 zt = ( glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) & 129 129 & + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv & 130 & - pdiag_t ) * r1_ rdtice + zft130 & - pdiag_t ) * r1_Dt_ice + zft 131 131 132 132 ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 133 zvtrp = glob_sum( ( diag_trp_vi * rhoi c + diag_trp_vs * rhosn) * e1e2t ) * zconv * rday134 zetrp = glob_sum( ( diag_trp_ei + diag_trp_es) * e1e2t ) * zconv133 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 135 135 136 136 zvmin = glob_min( v_i ) … … 580 580 WRITE(numout,*) ' hfx_res : ', hfx_res(ji,jj) 581 581 WRITE(numout,*) ' fhtur : ', fhtur(ji,jj) 582 WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_ rdtice582 WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_Dt_ice 583 583 WRITE(numout,*) 584 584 WRITE(numout,*) ' - Salt fluxes at bottom interface ***' -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icedia.F90
r9604 r9939 95 95 ! 2 - Trends due to forcing ! 96 96 ! ---------------------------! 97 z_frc_volbot = r1_r au0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater flux ice/snow-ocean98 z_frc_voltop = r1_r au0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater flux ice/snow-atm99 z_frc_sal = r1_r au0 * glob_sum( - sfx(:,:) * e1e2t(:,:) ) * 1.e-9 ! salt fluxes ice/snow-ocean97 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 100 100 z_frc_tembot = glob_sum( hfx_out(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat on top of ocean (and below ice) 101 101 z_frc_temtop = glob_sum( hfx_in (:,:) * e1e2t(:,:) ) * 1.e-20 ! heat on top of ice-coean … … 110 110 ! 3 - Content variations ! 111 111 ! ----------------------- ! 112 zdiff_vol = r1_r au0 * glob_sum( ( rhoic*vt_i(:,:) + rhosn*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9! freshwater trend (km3)113 zdiff_sal = r1_r au0 * 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(:,:) 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) 115 115 ! + SUM( qevap_ice * a_i_b, dim=3 ) !! clem: I think this term should not be there (but needs a check) 116 116 … … 125 125 ! 5 - Diagnostics writing ! 126 126 ! ----------------------- ! 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 !!gm132 127 ! 133 128 IF( iom_use('ibgvolume') ) CALL iom_put( 'ibgvolume' , zdiff_vol ) ! ice/snow volume drift (km3 equivalent ocean water) … … 135 130 IF( iom_use('ibgheatco') ) CALL iom_put( 'ibgheatco' , zdiff_tem ) ! ice/snow heat content drift (1.e20 J) 136 131 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*r dt ) )132 & zdiff_tem /glob_sum( e1e2t(:,:) * 1.e-20 * kt*rn_Dt ) ) 138 133 139 134 IF( iom_use('ibgfrcvoltop') ) CALL iom_put( 'ibgfrcvoltop' , frc_voltop ) ! vol forcing ice/snw-atm (km3 equivalent ocean water) … … 143 138 IF( iom_use('ibgfrctembot') ) CALL iom_put( 'ibgfrctembot' , frc_tembot ) ! heat on top of ocean(below ice) (1.e20 J) 144 139 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*r dt )140 & frc_temtop / glob_sum( e1e2t(:,:) ) * 1.e-20 * kt*rn_Dt ) 146 141 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*r dt )142 & frc_tembot / glob_sum( e1e2t(:,:) ) * 1.e-20 * kt*rn_Dt ) 148 143 149 144 IF( iom_use('ibgvol_tot' ) ) CALL iom_put( 'ibgvol_tot' , zbg_ivol ) ! ice volume (km3) … … 246 241 frc_sal = 0._wp 247 242 ! record initial ice volume, salt and temp 248 vol_loc_ini(:,:) = rhoi c * vt_i(:,:) + rhosn * vt_s(:,:)! ice/snow volume (kg/m2)249 tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:) 250 sal_loc_ini(:,:) = rhoi c* 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) 251 246 ENDIF 252 247 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icedyn_adv.F90
r9604 r9939 98 98 ! diagnostics 99 99 !------------ 100 diag_trp_ei(:,:) = SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_ rdtice101 diag_trp_es(:,:) = SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_ rdtice102 diag_trp_sv(:,:) = SUM( sv_i(:,:,:) - sv_i_b(:,:,:) , dim=3 ) * r1_ rdtice103 diag_trp_vi(:,:) = SUM( v_i (:,:,:) - v_i_b (:,:,:) , dim=3 ) * r1_ rdtice104 diag_trp_vs(:,:) = SUM( v_s (:,:,:) - v_s_b (:,:,:) , dim=3 ) * r1_ rdtice105 IF( iom_use('icemtrp') ) CALL iom_put( "icemtrp" , diag_trp_vi * rhoi c) ! ice mass transport106 IF( iom_use('snwmtrp') ) CALL iom_put( "snwmtrp" , diag_trp_vs * rhos n) ! snw mass transport107 IF( iom_use('salmtrp') ) CALL iom_put( "salmtrp" , diag_trp_sv * rhoi c * 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) 108 108 IF( iom_use('dihctrp') ) CALL iom_put( "dihctrp" , -diag_trp_ei ) ! advected ice heat content (W/m2) 109 109 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 189 189 ! divergence given by the advection scheme 190 190 ! (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_ rdtice191 zdivu_adv(ji) = ( 1._wp - ato_i_1d(ji) - SUM( a_i_2d(ji,:) ) ) * r1_Dt_ice 192 192 ! 193 193 IF( zdivu_adv(ji) < 0._wp ) closing_net(ji) = MAX( closing_net(ji), -zdivu_adv(ji) ) ! make sure the closing rate is large enough … … 255 255 ELSE 256 256 iterate_ridging = 1 257 zdivu_adv (ji) = zfac * r1_ rdtice257 zdivu_adv (ji) = zfac * r1_Dt_ice 258 258 closing_net(ji) = MAX( 0._wp, -zdivu_adv(ji) ) 259 259 opning (ji) = MAX( 0._wp, zdivu_adv(ji) ) … … 460 460 zfac = apartf(ji,jl) * closing_gross(ji) * rdt_ice 461 461 IF( zfac > pa_i(ji,jl) ) THEN 462 closing_gross(ji) = pa_i(ji,jl) / apartf(ji,jl) * r1_ rdtice462 closing_gross(ji) = pa_i(ji,jl) / apartf(ji,jl) * r1_Dt_ice 463 463 ENDIF 464 464 END DO … … 472 472 zfac = pato_i(ji) + ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rdt_ice 473 473 IF( zfac < 0._wp ) THEN ! would lead to negative ato_i 474 opning(ji) = apartf(ji,0) * closing_gross(ji) - pato_i(ji) * r1_ rdtice474 opning(ji) = apartf(ji,0) * closing_gross(ji) - pato_i(ji) * r1_Dt_ice 475 475 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_ rdtice476 opning(ji) = apartf(ji,0) * closing_gross(ji) + ( zasum(ji) - pato_i(ji) ) * r1_Dt_ice 477 477 ENDIF 478 478 END DO … … 543 543 ! volume and enthalpy (J/m2, >0) of seawater trapped into ridges 544 544 vsw = v_i_2d(ji,jl1) * afrdg * rn_porordg 545 ersw(ji) = -rhoi c* 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?) 546 546 547 547 ! volume etc of ridging / rafting ice and new ridges (vi, vs, sm, oi, es, ei) … … 570 570 571 571 ! 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 voids573 sfx_dyn_1d(ji) = sfx_dyn_1d(ji) - vsw * sss_1d(ji) * rhoi c * r1_rdtice574 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] 575 575 576 576 ! Put the snow lost by ridging into the ocean 577 577 ! 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) + ( rhos n* vsrdg(ji) * ( 1._wp - rn_fsnwrdg ) & ! fresh water source for ocean579 & + rhos n * vsrft(ji) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice578 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 580 580 581 581 ! Put the melt pond water into the ocean … … 583 583 ! is no net mass flux between melt ponds and the ocean (see icethd_pnd.F90 for ex.) 584 584 !IF ( ln_pnd_fwb ) THEN 585 ! wfx_pnd_1d(ji) = wfx_pnd_1d(ji) + ( rho fw * vprdg(ji) * ( 1._wp - rn_fpndrdg ) & ! fresh water source for ocean586 ! & + rho fw * vprft(ji) * ( 1._wp - rn_fpndrft ) ) * r1_rdtice585 ! 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 587 587 !ENDIF 588 588 … … 590 590 IF( nn_icesal /= 2 ) THEN 591 591 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 * rhoi c * r1_rdtice & ! put back sss_m into the ocean593 & - s_i_1d(ji) * vsw * rhoi c * r1_rdtice ! and get s_i from the ocean592 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 594 594 ENDIF 595 595 … … 621 621 ! Put the snow lost by ridging into the ocean 622 622 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_ rdtice623 & - esrft(ji,jk) * ( 1._wp - rn_fsnwrft ) ) * r1_Dt_ice 624 624 ! 625 625 ! Remove energy of new ridge to each category jl1 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icedyn_rhg_evp.F90
r9660 r9939 114 114 INTEGER :: jter ! local integers 115 115 ! 116 REAL(wp) :: zrhoco ! r au0 * rn_cio116 REAL(wp) :: zrhoco ! rho0 * rn_cio 117 117 REAL(wp) :: zdtevp, z1_dtevp ! time step for subcycling 118 118 REAL(wp) :: ecc2, z1_ecc2 ! square of yield ellipse eccenticity … … 221 221 ! 1) define some variables and initialize arrays 222 222 !------------------------------------------------------------------------------! 223 zrhoco = r au0 * rn_cio223 zrhoco = rho0 * rn_cio 224 224 225 225 ! ecc2: square of yield ellipse eccenticrity … … 271 271 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 272 272 ! 273 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_r au0273 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rho0 274 274 ! 275 275 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! … … 285 285 286 286 ! Ice/snow mass at U-V points 287 zm1 = ( rhos n * vt_s(ji ,jj ) + rhoic* vt_i(ji ,jj ) )288 zm2 = ( rhos n * vt_s(ji+1,jj ) + rhoic* vt_i(ji+1,jj ) )289 zm3 = ( rhos n * 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) ) 290 290 zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 291 291 zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) … … 799 799 zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * rswitch 800 800 801 zdiag_xmtrp_ice(ji,jj) = rhoi c * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) )! ice mass transport, X-component802 zdiag_ymtrp_ice(ji,jj) = rhoi c * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) )! '' Y- ''803 804 zdiag_xmtrp_snw(ji,jj) = rhos n * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) )! snow mass transport, X-component805 zdiag_ymtrp_snw(ji,jj) = rhos n * 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-component808 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- '' 809 809 810 810 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/iceistate.F90
r9656 r9939 295 295 ! In case snow load is in excess that would lead to transformation from snow to ice 296 296 ! Then, transfer the snow excess into the ice (different from icethd_dh) 297 zdh = MAX( 0._wp, ( rhos n * 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 ) 298 298 ! recompute h_i, h_s avoiding out of bounds values 299 299 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 * rhoi c * r1_rhosn)300 h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoi * r1_rhos ) 301 301 ! 302 302 ! ice volume, salt content, age content … … 321 321 t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 322 322 ! Snow energy of melting 323 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhos n * ( 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 ) 324 324 ! 325 325 ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 … … 340 340 ! 341 341 ! heat content per unit volume 342 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoi c * ( 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 ) ) 345 345 ! 346 346 ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 … … 410 410 ! 5) Snow-ice mass (case ice is fully embedded) 411 411 !---------------------------------------------- 412 snwice_mass (:,:) = tmask(:,:,1) * SUM( rhos n * v_s(:,:,:) + rhoic* v_i(:,:,:), dim=3 ) ! snow+ice mass412 snwice_mass (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3 ) ! snow+ice mass 413 413 snwice_mass_b(:,:) = snwice_mass(:,:) 414 414 ! 415 415 IF( ln_ice_embd ) THEN ! embedded sea-ice: deplete the initial ssh below sea-ice area 416 416 ! 417 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_r au0418 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_r au0417 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rho0 418 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rho0 419 419 ! 420 420 IF( .NOT.ln_linssh ) THEN -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icestp.F90
r9725 r9939 341 341 IF( ln_bdy .AND. ln_icediachk ) CALL ctl_warn('par_init: online conservation check does not work with BDY') 342 342 ! 343 rdt_ice = REAL(nn_fsbc) * r dt!--- sea-ice timestep and its inverse344 r1_ rdtice = 1._wp / rdt_ice343 rdt_ice = REAL(nn_fsbc) * rn_Dt !--- sea-ice timestep and its inverse 344 r1_Dt_ice = 1._wp / rdt_ice 345 345 IF(lwp) WRITE(numout,*) 346 IF(lwp) WRITE(numout,*) ' ice timestep rdt_ice = nn_fsbc*r dt = ', rdt_ice346 IF(lwp) WRITE(numout,*) ' ice timestep rdt_ice = nn_fsbc*rn_Dt = ', rdt_ice, ' [s]' 347 347 ! 348 348 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 120 120 DO jj = 2, jpjm1 121 121 DO ji = fs_2, fs_jpim1 122 zfric(ji,jj) = r1_r au0 * SQRT( 0.5_wp * &122 zfric(ji,jj) = r1_rho0 * SQRT( 0.5_wp * & 123 123 & ( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & 124 124 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) … … 150 150 ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 151 151 ! includes supercooling potential energy (>0) or "above-freezing" energy (<0) 152 zqfr = tmask(ji,jj,1) * r au0 *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 ) ) 153 153 154 154 ! --- Above-freezing sensible heat content (J/m2 grid) 155 zqfr_neg = tmask(ji,jj,1) * r au0 *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 ) 156 156 157 157 ! --- Sensible ocean-to-ice heat flux (W/m2) 158 158 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 159 fhtur(ji,jj) = rswitch * r au0 *rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2160 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 ) ) 162 162 ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach 163 163 ! the freezing point, so that we do not have SST < T_freeze … … 169 169 ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 170 170 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.F90171 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 172 172 qlead(ji,jj) = 0._wp 173 173 ELSE … … 197 197 ! Third step in iceupdate.F90 : heat from ice-ocean mass exchange (zf_mass) + solar 198 198 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 formation199 & - qlead(:,:) * r1_Dt_ice & ! heat flux taken from the ocean where there is open water ice formation 200 200 & - at_i (:,:) * fhtur(:,:) & ! heat flux taken by turbulence 201 201 & - at_i (:,:) * fhld(:,:) ! heat flux taken during bottom growth/melt … … 295 295 ztmelts = -tmut * sz_i_1d(ji,jk) 296 296 ! Conversion q(S,T) -> T (second order equation) 297 zbbb = ( rcp - cpic ) * ztmelts + e_i_1d(ji,jk) * r1_rhoic - lfus298 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_cpi c297 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 300 300 301 301 ! mask temperature -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_da.F90
r9604 r9939 137 137 138 138 ! Contribution to salt flux 139 sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoi c * h_i_1d(ji) * zda * s_i_1d(ji) * r1_rdtice139 sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoi * h_i_1d(ji) * zda * s_i_1d(ji) * r1_Dt_ice 140 140 141 141 ! 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) ) & 143 143 + h_s_1d(ji) * r1_nlay_s * SUM( e_s_1d(ji,1:nlay_s) ) ) 144 144 145 145 ! 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) ) 147 147 148 148 ! new concentration -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_dh.F90
r9767 r9939 76 76 REAL(wp) :: zgrr ! bottom growth rate 77 77 REAL(wp) :: zt_i_new ! bottom formation temperature 78 REAL(wp) :: z1_rho ! 1/(rhos n+rau0-rhoic)78 REAL(wp) :: z1_rho ! 1/(rhos+rho0-rhoi) 79 79 80 80 REAL(wp) :: zQm ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean … … 181 181 DO ji = 1, npti 182 182 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], < 0184 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos n * zh_s(ji,jk) * a_i_1d(ji) * r1_rdtice ! mass flux183 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 185 185 ! updates 186 186 dh_s_mlt(ji) = dh_s_mlt(ji) - zh_s(ji,jk) … … 202 202 ! 203 203 ! --- precipitation --- 204 zdh_s_pre (ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhos n / at_i_1d(ji)! thickness change204 zdh_s_pre (ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhos / at_i_1d(ji) ! thickness change 205 205 zqprec (ji) = - qprec_ice_1d(ji) ! enthalpy of the precip (>0, J.m-3) 206 206 ! 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) - rhos n * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice ! mass flux, <0207 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 209 209 210 210 ! --- melt of falling snow --- … … 212 212 zdeltah (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 ) ! thickness change 213 213 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) - rhos n * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice ! snow melting only = water into the ocean (then without snow precip), >0214 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 216 216 217 217 ! updates available heat + precipitations after melting … … 252 252 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,jk) 253 253 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) - rhos n * 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) 256 256 257 257 ! updates available heat + thickness … … 273 273 IF( evap_ice_1d(ji) > 0._wp ) THEN 274 274 ! 275 zdh_s_sub (ji) = MAX( - h_s_1d(ji) , - evap_ice_1d(ji) * r1_rhos n* rdt_ice )276 zevap_rema(ji) = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhos n! 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) 277 277 zdeltah (ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 278 278 279 279 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) 280 280 & ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * e_s_1d(ji,1) ) & 281 & * a_i_1d(ji) * r1_ rdtice282 wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos n * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice ! Mass flux by sublimation281 & * 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 283 283 284 284 ! new snow thickness … … 309 309 e_s_1d(ji,jk) = rswitch / MAX( h_s_1d(ji), epsi20 ) * & 310 310 & ( ( zdh_s_pre(ji) ) * zqprec(ji) + & 311 & ( h_s_1d(ji) - zdh_s_pre(ji) ) * rhos n * ( 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 ) ) 312 312 END DO 313 313 END DO … … 326 326 IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN !-- Internal melting 327 327 328 zEi = - e_i_1d(ji,jk) * r1_rhoi c! 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] 329 329 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) 330 330 ! set up at 0 since no energy is needed to melt water...(it is already melted) 331 331 zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing 332 332 ! this should normally not happen, but sometimes, heat diffusion leads to this 333 zfmdt = - zdeltah(ji,jk) * rhoi c! Mass flux x time step > 0333 zfmdt = - zdeltah(ji,jk) * rhoi ! Mass flux x time step > 0 334 334 335 335 dh_i_itm(ji) = dh_i_itm(ji) + zdeltah(ji,jk) ! Cumulate internal melting 336 336 337 zfmdt = - rhoi c * 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], <0337 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 340 340 ! ice enthalpy zEi is "sent" to the ocean 341 sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi c * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice ! Salt flux341 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 342 342 ! using s_i_1d and not sz_i_1d(jk) is ok 343 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi c * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice ! Mass flux343 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice ! Mass flux 344 344 345 345 ELSE !-- Surface melting 346 346 347 zEi = - e_i_1d(ji,jk) * r1_rhoi c! 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] 348 348 zEw = rcp * ztmelts ! Specific enthalpy of resulting meltwater [J/kg, <0] 349 349 zdE = zEi - zEw ! Specific enthalpy difference < 0 … … 351 351 zfmdt = - zq_su(ji) / zdE ! Mass flux to the ocean [kg/m2, >0] 352 352 353 zdeltah(ji,jk) = - zfmdt * r1_rhoi c! Melt of layer jk [m, <0]353 zdeltah(ji,jk) = - zfmdt * r1_rhoi ! Melt of layer jk [m, <0] 354 354 355 355 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] 356 356 357 zq_su(ji) = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoi c* zdE ) ! update available heat357 zq_su(ji) = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoi * zdE ) ! update available heat 358 358 359 359 dh_i_sum(ji) = dh_i_sum(ji) + zdeltah(ji,jk) ! Cumulate surface melt 360 360 361 zfmdt = - rhoi c * zdeltah(ji,jk)! Recompute mass flux [kg/m2, >0]361 zfmdt = - rhoi * zdeltah(ji,jk) ! Recompute mass flux [kg/m2, >0] 362 362 363 363 zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0] 364 364 365 sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi c * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice ! Salt flux >0365 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 366 366 ! 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], < 0368 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], > 0367 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 369 369 ! 370 wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi c * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice ! Mass flux370 wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice ! Mass flux 371 371 372 372 END IF … … 374 374 ! Ice sublimation 375 375 ! --------------- 376 zdum = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoi c)376 zdum = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoi ) 377 377 zdeltah (ji,jk) = zdeltah (ji,jk) + zdum 378 378 dh_i_sub(ji) = dh_i_sub(ji) + zdum 379 379 380 sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoi c * a_i_1d(ji) * zdum * s_i_1d(ji) * r1_rdtice ! Salt flux >0380 sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * s_i_1d(ji) * r1_Dt_ice ! Salt flux >0 381 381 ! clem: flux is sent to the ocean for simplicity 382 382 ! but salt should remain in the ice except 383 383 ! 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], < 0385 386 wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi c * a_i_1d(ji) * zdum * r1_rdtice ! Mass flux > 0384 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 387 387 388 388 ! update remaining mass flux 389 zevap_rema(ji) = zevap_rema(ji) + zdum * rhoi c389 zevap_rema(ji) = zevap_rema(ji) + zdum * rhoi 390 390 391 391 ! record which layers have disappeared (for bottom melting) … … 409 409 ! remaining "potential" evap is sent to ocean 410 410 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) 412 412 END DO 413 413 … … 437 437 !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 438 438 !--- 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 ) ) 440 440 zswi2 = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) ) 441 441 zswi12 = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) … … 450 450 zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 451 451 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* ztmelts452 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 454 454 455 455 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) … … 457 457 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 458 458 459 dh_i_bog(ji) = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi c) )459 dh_i_bog(ji) = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) ) 460 460 461 461 END DO 462 462 ! Contribution to Energy and Salt Fluxes 463 zfmdt = - rhoi c* 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], >0466 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], <0467 468 sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi c * a_i_1d(ji) * dh_i_bog(ji) * s_i_new(ji) * r1_rdtice ! Salt flux, <0469 470 wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi c * a_i_1d(ji) * dh_i_bog(ji) * r1_rdtice ! Mass flux, <0463 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 471 471 472 472 ! 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 * rhoi c)473 eh_i_old(ji,nlay_i+1) = eh_i_old(ji,nlay_i+1) + dh_i_bog(ji) * (-zEi * rhoi) 474 474 h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bog(ji) 475 475 … … 489 489 IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN !-- Internal melting 490 490 491 zEi = - e_i_1d(ji,jk) * r1_rhoi c! 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) 492 492 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) 493 493 ! set up at 0 since no energy is needed to melt water...(it is already melted) … … 497 497 dh_i_itm (ji) = dh_i_itm(ji) + zdeltah(ji,jk) 498 498 499 zfmdt = - zdeltah(ji,jk) * rhoi c! Mass flux x time step > 0500 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], <0499 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 502 502 ! ice enthalpy zEi is "sent" to the ocean 503 sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi c * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice ! Salt flux503 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 504 504 ! using s_i_1d and not sz_i_1d(jk) is ok 505 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi c * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice ! Mass flux505 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice ! Mass flux 506 506 507 507 ! update heat content (J.m-2) and layer thickness … … 511 511 ELSE !-- Basal melting 512 512 513 zEi = - e_i_1d(ji,jk) * r1_rhoi c! 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) 514 514 zEw = rcp * ztmelts ! Specific enthalpy of meltwater (J/kg, <0) 515 515 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) … … 517 517 zfmdt = - zq_bo(ji) / zdE ! Mass flux x time step (kg/m2, >0) 518 518 519 zdeltah(ji,jk) = - zfmdt * r1_rhoi c! Gross thickness change519 zdeltah(ji,jk) = - zfmdt * r1_rhoi ! Gross thickness change 520 520 521 521 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 522 522 523 zq_bo(ji) = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoi c * zdE )! update available heat. MAX is necessary for roundup errors524 525 dh_i_bom(ji) = dh_i_bom(ji) + zdeltah(ji,jk) ! Update basal melt526 527 zfmdt = - zdeltah(ji,jk) * rhoi c! Mass flux x time step > 0523 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 528 528 529 529 zQm = zfmdt * zEw ! Heat exchanged with ocean 530 530 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], <0532 hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_ rdtice ! Heat used in this process [W.m-2], >0533 534 sfx_bom_1d(ji) = sfx_bom_1d(ji) - rhoi c * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_rdtice ! Salt flux531 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 535 535 ! using s_i_1d and not sz_i_1d(jk) is ok 536 536 537 wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoi c * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice ! Mass flux537 wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice ! Mass flux 538 538 539 539 ! update heat content (J.m-2) and layer thickness … … 565 565 566 566 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) - rhos n * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice ! Mass flux567 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 569 569 dh_s_mlt(ji) = dh_s_mlt(ji) + zdeltah(ji,1) 570 570 ! 571 571 ! 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_ rdtice572 hfx_out_1d(ji) = hfx_out_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_Dt_ice 573 573 574 574 IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) … … 580 580 ! When snow load excesses Archimede's limit, snow-ice interface goes down under sea-level, 581 581 ! flooding of seawater transforms snow into ice dh_snowice is positive for the ice 582 z1_rho = 1._wp / ( rhos n+rau0-rhoic)582 z1_rho = 1._wp / ( rhos + rho0 - rhoi ) 583 583 DO ji = 1, npti 584 584 ! 585 dh_snowice(ji) = MAX( 0._wp , ( rhos n * 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 ) 586 586 587 587 h_i_1d(ji) = h_i_1d(ji) + dh_snowice(ji) … … 589 589 590 590 ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 591 zfmdt = ( rhos n - rhoic) * dh_snowice(ji) ! <0591 zfmdt = ( rhos - rhoi ) * dh_snowice(ji) ! <0 592 592 zEw = rcp * sst_1d(ji) 593 593 zQm = zfmdt * zEw 594 594 595 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_ rdtice ! Heat flux596 597 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * a_i_1d(ji) * zfmdt * r1_ rdtice ! Salt flux595 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 598 598 599 599 ! Case constant salinity in time: virtual salt flux to keep salinity constant 600 600 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 ocean602 & - s_i_1d(ji) * a_i_1d(ji) * dh_snowice(ji) * rhoi c * r1_rdtice ! and get rn_icesal from the ocean601 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 603 603 ENDIF 604 604 605 605 ! 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) * rhoi c * r1_rdtice607 wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhos n * r1_rdtice606 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 608 608 609 609 ! update heat content (J.m-2) and layer thickness … … 627 627 e_s_1d(ji,jk) = rswitch * e_s_1d(ji,jk) 628 628 ! recalculate t_s_1d from e_s_1d 629 t_s_1d(ji,jk) = rt0 + rswitch * ( - e_s_1d(ji,jk) * r1_rhos n * 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 ) 630 630 END DO 631 631 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_do.F90
r9604 r9939 140 140 ! Physical constants 141 141 zhicrit = 0.04 ! frazil ice thickness 142 ztwogp = 2. * r au0 / ( grav * 0.3 * ( rau0 - rhoic ) )! reduced grav142 ztwogp = 2. * rho0 / ( grav * 0.3 * ( rho0 - rhoi ) ) ! reduced grav 143 143 zsqcd = 1.0 / SQRT( 1.3 * zcai ) ! 1/SQRT(airdensity*drag) 144 144 zgamafr = 0.03 … … 264 264 DO ji = 1, npti 265 265 ztmelts = - tmut * zs_newice(ji) ! Melting point (C) 266 ze_newice(ji) = rhoi c * ( 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 ) 269 269 END DO 270 270 … … 275 275 DO ji = 1, npti 276 276 277 zEi = - ze_newice(ji) * r1_rhoi c! specific enthalpy of forming ice [J/kg]277 zEi = - ze_newice(ji) * r1_rhoi ! specific enthalpy of forming ice [J/kg] 278 278 279 279 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! specific enthalpy of seawater at t_bo_1d [J/kg] … … 284 284 zfmdt = - qlead_1d(ji) / zdE ! Fm.dt [kg/m2] (<0) 285 285 ! clem: we use qlead instead of zqld (icethd) because we suppose we are at the freezing point 286 zv_newice(ji) = - zfmdt * r1_rhoi c286 zv_newice(ji) = - zfmdt * r1_rhoi 287 287 288 288 zQm = zfmdt * zEw ! heat to the ocean >0 associated with mass flux 289 289 290 290 ! Contribution to heat flux to the ocean [W.m-2], >0 291 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_ rdtice291 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_Dt_ice 292 292 ! Total heat flux used in this process [W.m-2] 293 hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_ rdtice293 hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_Dt_ice 294 294 ! mass flux 295 wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoi c * r1_rdtice295 wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoi * r1_Dt_ice 296 296 ! salt flux 297 sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoi c * zs_newice(ji) * r1_rdtice297 sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoi * zs_newice(ji) * r1_Dt_ice 298 298 END DO 299 299 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_ent.F90
r9604 r9939 129 129 ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 130 130 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 * & 132 132 & ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) ) 133 133 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_pnd.F90
r9750 r9939 133 133 REAL(wp) :: zdv_mlt ! available meltwater for melt ponding 134 134 REAL(wp) :: z1_Tp ! inverse reference temperature 135 REAL(wp) :: z1_rhofw ! inverse freshwater density136 135 REAL(wp) :: z1_zpnd_aspect ! inverse pond aspect ratio 137 136 REAL(wp) :: zfac, zdum … … 139 138 INTEGER :: ji ! loop indices 140 139 !!------------------------------------------------------------------- 141 z1_rhofw = 1._wp / rhofw142 140 z1_zpnd_aspect = 1._wp / zpnd_aspect 143 141 z1_Tp = 1._wp / zTp … … 157 155 ! 158 156 ! available meltwater for melt ponding [m, >0] and fraction 159 zdv_mlt = -( dh_i_sum(ji)*rhoi c + 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) 160 158 zfr_mlt = zrmin + ( zrmax - zrmin ) * a_i_1d(ji) ! from CICE doc 161 159 !zfr_mlt = zrmin + zrmax * a_i_1d(ji) ! from Holland paper … … 168 166 ! melt pond mass flux (<0) 169 167 IF( ln_pnd_fwb .AND. zdv_mlt > 0._wp ) THEN 170 zfac = zfr_mlt * zdv_mlt * rho fw * r1_rdtice168 zfac = zfr_mlt * zdv_mlt * rhow * r1_Dt_ice 171 169 wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 172 170 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_sal.F90
r9750 r9939 77 77 !--------------------------------------------------------- 78 78 IF( h_i_1d(ji) > 0._wp ) THEN 79 zs_sni = sss_1d(ji) * ( rhoi c - rhosn ) * r1_rhoic! Salinity of snow ice79 zs_sni = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi ! Salinity of snow ice 80 80 zs_i_si = ( zs_sni - s_i_1d(ji) ) * dh_snowice(ji) / h_i_1d(ji) ! snow-ice 81 81 zs_i_bg = ( s_i_new(ji) - s_i_1d(ji) ) * dh_i_bog (ji) / h_i_1d(ji) ! bottom growth … … 98 98 99 99 ! Salt flux 100 sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi c * a_i_1d(ji) * h_i_1d(ji) * ( zs_i_fl + zs_i_gd ) * r1_rdtice100 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 101 101 ENDIF 102 102 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icethd_zdf_bl99.F90
r9656 r9939 217 217 ! 218 218 DO ji = 1, npti 219 ztcond_i(ji,0) = rc dic+ zbeta * sz_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )220 ztcond_i(ji,nlay_i) = rc dic+ 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 ) 221 221 END DO 222 222 DO jk = 1, nlay_i-1 223 223 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 226 231 END DO 227 232 END DO … … 230 235 ! 231 236 DO ji = 1, npti 232 ztcond_i(ji,0) = rc dic+ 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) = rc dic+ 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 ) 236 241 END DO 237 242 DO jk = 1, nlay_i-1 238 243 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 242 253 END DO 243 254 END DO … … 299 310 DO jk = 1, nlay_i 300 311 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_rhoi c* 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 ) 303 314 END DO 304 315 END DO … … 306 317 DO jk = 1, nlay_s 307 318 DO ji = 1, npti 308 zeta_s(ji,jk) = rdt_ice * r1_rhos n * r1_cpic* z1_h_s(ji)319 zeta_s(ji,jk) = rdt_ice * r1_rhos * r1_cpi * z1_h_s(ji) 309 320 END DO 310 321 END DO … … 770 781 771 782 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) 773 784 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) 775 786 ENDIF 776 787 777 788 ELSEIF( k_jules == np_jules_ACTIVE ) THEN 778 789 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) 780 791 781 792 ENDIF … … 785 796 ! 786 797 ! 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) 788 799 ! 789 800 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/iceupdate.F90
r9784 r9939 172 172 snwice_mass_b(ji,jj) = snwice_mass(ji,jj) ! save mass from the previous ice time step 173 173 ! ! new mass per unit area 174 snwice_mass (ji,jj) = tmask(ji,jj,1) * ( rhos n * 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) ) 175 175 ! ! time evolution of snow+ice mass 176 snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_ rdtice176 snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_Dt_ice 177 177 178 178 END DO … … 336 336 ENDIF 337 337 338 zrhoco = r au0 * rn_cio338 zrhoco = rho0 * rn_cio 339 339 ! 340 340 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) … … 432 432 ELSE ! start from rest 433 433 IF(lwp) WRITE(numout,*) ' ==>> previous run without snow-ice mass output then set it' 434 snwice_mass (:,:) = tmask(:,:,1) * ( rhos n * vt_s(:,:) + rhoic* vt_i(:,:) )434 snwice_mass (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) ) 435 435 snwice_mass_b(:,:) = snwice_mass(:,:) 436 436 ENDIF 437 437 ELSE !* Start from rest 438 438 IF(lwp) WRITE(numout,*) ' ==>> start from rest: set the snow-ice mass' 439 snwice_mass (:,:) = tmask(:,:,1) * ( rhos n * vt_s(:,:) + rhoic* vt_i(:,:) )439 snwice_mass (:,:) = tmask(:,:,1) * ( rhos * vt_s(:,:) + rhoi * vt_i(:,:) ) 440 440 snwice_mass_b(:,:) = snwice_mass(:,:) 441 441 ENDIF -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icevar.F90
r9725 r9939 228 228 ztmelts = - sz_i(ji,jj,jk,jl) * tmut ! Ice layer melt temperature [C] 229 229 ! Conversion q(S,T) -> T (second order equation) 230 zbbb = ( rcp - cpic ) * ztmelts + ze_i * r1_rhoic - lfus231 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_cpi c, ztmelts ) ) + rt0 ! [K] with bounds: -100 < t_i < ztmelts230 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 233 233 ! 234 234 ELSE !--- no ice … … 247 247 WHERE( v_s(:,:,:) > epsi20 ) !--- icy area 248 248 t_s(:,:,jk,:) = rt0 + MAX( -100._wp , & 249 & MIN( r1_cpi c * ( -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 ) ) 250 250 ELSEWHERE !--- no ice 251 251 t_s(:,:,jk,:) = rt0 … … 477 477 DO ji = 1 , jpi 478 478 ! 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 <0479 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 480 480 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj) 481 481 t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) … … 488 488 DO ji = 1 , jpi 489 489 ! 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 <0490 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 491 491 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj) 492 492 t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) … … 498 498 DO ji = 1 , jpi 499 499 ! update exchanges with ocean 500 sfx_res(ji,jj) = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl) * rhoi c * r1_rdtice501 wfx_res(ji,jj) = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl) * rhoi c * r1_rdtice502 wfx_res(ji,jj) = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl) * rhos n * r1_rdtice500 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 503 503 ! 504 504 !----------------------------------------------------------------- … … 669 669 ! In case snow load is in excess that would lead to transformation from snow to ice 670 670 ! Then, transfer the snow excess into the ice (different from icethd_dh) 671 zdh = MAX( 0._wp, ( rhos n * 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 ) 672 672 ! recompute h_i, h_s avoiding out of bounds values 673 673 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 * rhoi c * r1_rhosn)674 zh_s(ji,jl) = MAX( 0._wp, zh_s(ji,jl) - zdh * rhoi * r1_rhos ) 675 675 ENDIF 676 676 END DO … … 854 854 ztmelts = - tmut * sz_i_1d(ji,jk) 855 855 t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts + rt0 ) ! Force t_i_1d to be lower than melting point 856 857 e_i_1d(ji,jk) = rhoi c * ( 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 ) 860 860 END DO 861 861 END DO 862 862 DO jk = 1, nlay_s ! Snow energy of melting 863 863 DO ji = 1, npti 864 e_s_1d(ji,jk) = rhos n * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus )864 e_s_1d(ji,jk) = rhos * ( rcpi * ( rt0 - t_s_1d(ji,jk) ) + rLfus ) 865 865 END DO 866 866 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icewri.F90
r9604 r9939 85 85 ! Standard outputs 86 86 !----------------- 87 zrho1 = ( r au0 - rhoic ) * r1_rau0; zrho2 = rhosn * r1_rau087 zrho1 = ( rho0 - rhoi ) * r1_rho0 ; zrho2 = rhos * r1_rho0 88 88 ! masks 89 89 IF( iom_use('icemask' ) ) CALL iom_put( "icemask" , zmsk00 ) ! ice mask 0% … … 92 92 ! 93 93 ! general fields 94 IF( iom_use('icemass' ) ) CALL iom_put( "icemass", rhoi c * vt_i * zmsk00) ! Ice mass per cell area95 IF( iom_use('snwmass' ) ) CALL iom_put( "snwmass", rhos n * vt_s * zmsksn) ! Snow mass per cell area94 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 96 96 IF( iom_use('icepres' ) ) CALL iom_put( "icepres", zmsk00 ) ! Ice presence (1 or 0) 97 97 IF( iom_use('iceconc' ) ) CALL iom_put( "iceconc", at_i * zmsk00 ) ! ice concentration … … 104 104 IF( iom_use('snwvolu' ) ) CALL iom_put( "snwvolu", vt_s * zmsksn ) ! snow volume 105 105 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 106 109 z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) ) 107 110 WHERE( z2d < 0._wp ) z2d = 0._wp … … 115 118 ! salt 116 119 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 ) * rhoi c* 1.0e-3 * zmsk00 ) ! Mass of salt in sea ice per cell area120 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 118 121 119 122 ! heat … … 164 167 ! trends 165 168 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 + rhoi c * 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) 167 170 IF( iom_use('dmiopw') ) CALL iom_put( "dmiopw", - wfx_opw ) ! Sea-ice mass change through growth in open water 168 171 IF( iom_use('dmibog') ) CALL iom_put( "dmibog", - wfx_bog ) ! Sea-ice mass change through basal growth … … 174 177 IF( iom_use('dmisub') ) CALL iom_put( "dmisub", - wfx_ice_sub ) ! Sea-ice mass change through sublimation 175 178 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*rhos n*r1_rhoic) ! Snow mass change through snow-to-ice conversion179 IF( iom_use('dmsssi') ) CALL iom_put( "dmsssi", wfx_sni*rhos*r1_rhoi ) ! Snow mass change through snow-to-ice conversion 177 180 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 + rhos n * 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) 179 182 180 183 ! Global ice diagnostics … … 250 253 CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up") 251 254 252 CALL histdef( kid, "sithic", "Ice thickness" , "m" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )253 CALL histdef( kid, "siconc", "Ice concentration" , "%" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )254 CALL histdef( kid, "sitemp", "Ice temperature" , "C" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )255 CALL histdef( kid, "sivelu", "i-Ice speed " , "m/s" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )256 CALL histdef( kid, "sivelv", "j-Ice speed " , "m/s" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )257 CALL histdef( kid, "sistru", "i-Wind stress over ice" , "Pa" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )258 CALL histdef( kid, "sistrv", "j-Wind stress over ice" , "Pa" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )259 CALL histdef( kid, "sisflx", "Solar flx over ocean" , "W/m2" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )260 CALL histdef( kid, "sinflx", "NonSolar flx over ocean", "W/m2" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )261 CALL histdef( kid, "snwpre", "Snow precipitation" , "kg/m2/s", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )262 CALL histdef( kid, "sisali", "Ice salinity" , "PSU" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )263 CALL histdef( kid, "sivolu", "Ice volume" , "m" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )264 CALL histdef( kid, "sidive", "Ice divergence" , "10-8s-1", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )265 CALL histdef( kid, "si_amp", "Melt pond fraction" , "%" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, rdt )266 CALL histdef( kid, "si_vmp", "Melt pond volume" , "m" , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", r dt, 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 ) 272 275 273 276 CALL histend( kid, snc4set ) ! end of the file definition -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/NST/agrif_oce_update.F90
r9780 r9939 12 12 !! 3.6 ! 2014-09 (R. Benshila) 13 13 !!---------------------------------------------------------------------- 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 14 41 #if defined key_agrif 15 42 !!---------------------------------------------------------------------- 16 43 !! 'key_agrif' AGRIF zoom 17 44 !!---------------------------------------------------------------------- 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 21 48 USE zdf_oce ! vertical physics: ocean variables 22 USE agrif_oce 49 USE agrif_oce ! 23 50 ! 24 51 USE in_out_manager ! I/O manager … … 67 94 ! 68 95 END SUBROUTINE Agrif_Update_Tra 96 69 97 70 98 SUBROUTINE Agrif_Update_Dyn( ) … … 125 153 END SUBROUTINE Agrif_Update_Dyn 126 154 155 127 156 SUBROUTINE Agrif_Update_ssh( ) 128 !!--------------------------------------------- 129 !! *** ROUTINE Agrif_Update_ssh ***130 !!--------------------------------------------- 157 !!---------------------------------------------------------------------- 158 !! *** ROUTINE Agrif_Update_ssh *** 159 !!---------------------------------------------------------------------- 131 160 ! 132 161 IF (Agrif_Root()) RETURN … … 163 192 164 193 SUBROUTINE Agrif_Update_Tke( ) 165 !!--------------------------------------------- 166 !! *** ROUTINE Agrif_Update_Tke *** 167 !!--------------------------------------------- 168 !! 194 !!---------------------------------------------------------------------- 195 !! *** ROUTINE Agrif_Update_Tke *** 196 !!---------------------------------------------------------------------- 169 197 ! 170 198 IF (Agrif_Root()) RETURN 171 199 ! 172 200 # if defined TWO_WAY 173 201 ! 174 202 Agrif_UseSpecialValueInUpdate = .TRUE. 175 203 Agrif_SpecialValueFineGrid = 0. 176 204 ! 177 205 CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN ) 178 206 CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT ) 179 207 CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM ) 180 208 ! 181 209 Agrif_UseSpecialValueInUpdate = .FALSE. 182 210 ! 183 211 # endif 184 212 ! 185 213 END SUBROUTINE Agrif_Update_Tke 186 214 187 215 188 216 SUBROUTINE Agrif_Update_vvl( ) 189 !!--------------------------------------------- 190 !! *** ROUTINE Agrif_Update_vvl ***191 !!--------------------------------------------- 192 ! 193 IF ( Agrif_Root())RETURN217 !!---------------------------------------------------------------------- 218 !! *** ROUTINE Agrif_Update_vvl *** 219 !!---------------------------------------------------------------------- 220 ! 221 IF ( Agrif_Root() ) RETURN 194 222 ! 195 223 #if defined TWO_WAY … … 214 242 END SUBROUTINE Agrif_Update_vvl 215 243 244 216 245 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 230 257 ! ----------------------- 231 !232 258 e3u_a(:,:,:) = e3u_n(:,:,:) 233 259 e3v_a(:,:,:) = e3v_n(:,:,:) … … 239 265 ! 1) NOW fields 240 266 !-------------- 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' ) 248 271 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 249 272 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 250 251 ! Update total depths: 252 ! -------------------- 273 ! 274 ! ! Update total depths 253 275 hu_n(:,:) = 0._wp ! Ocean depth at U-points 254 276 hv_n(:,:) = 0._wp ! Ocean depth at V-points … … 264 286 ! 2) BEFORE fields: 265 287 !------------------ 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' ) 273 293 CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 274 294 CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 275 276 ! Update total depths: 277 ! -------------------- 295 ! 296 ! ! Update total depths: 278 297 hu_b(:,:) = 0._wp ! Ocean depth at U-points 279 298 hv_b(:,:) = 0._wp ! Ocean depth at V-points … … 289 308 END SUBROUTINE dom_vvl_update_UVF 290 309 291 # if defined key_vertical310 # if defined key_vertical 292 311 293 312 SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 294 313 !!---------------------------------------------------------------------- 295 !! *** ROUTINE updateT ***296 !!--------------------------------------------- 314 !! *** ROUTINE updateT *** 315 !!---------------------------------------------------------------------- 297 316 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 298 317 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 306 325 REAL(wp) :: zrho_xy, h_diff 307 326 REAL(wp) :: tabin(k1:k2,n1:n2) 308 !!--------------------------------------------- 327 !!---------------------------------------------------------------------- 309 328 ! 310 329 IF (before) THEN 311 330 AGRIF_SpecialValue = -999._wp 312 331 zrho_xy = Agrif_rhox() * Agrif_rhoy() 313 DO jn = n1, n2-1314 DO jk =k1,k2315 DO jj =j1,j2316 DO ji =i1,i2332 DO jn = n1, n2-1 333 DO jk = k1, k2 334 DO jj = j1, j2 335 DO ji = i1, i2 317 336 tabres(ji,jj,jk,jn) = (tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) & 318 337 * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp … … 321 340 END DO 322 341 END DO 323 DO jk =k1,k2324 DO jj =j1,j2325 DO ji =i1,i2342 DO jk = k1, k2 343 DO jj = j1, j2 344 DO ji = i1, i2 326 345 tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) & 327 346 + (tmask(ji,jj,jk)-1)*999._wp … … 332 351 tabres_child(:,:,:,:) = 0. 333 352 AGRIF_SpecialValue = 0._wp 334 DO jj =j1,j2335 DO ji =i1,i2353 DO jj = j1 , j2 354 DO ji = i1, i2 336 355 N_in = 0 337 DO jk =k1,k2 !k2 = jpk of child grid338 IF ( tabres(ji,jj,jk,n2) == 0 )EXIT356 DO jk = k1, k2 !k2 = jpk of child grid 357 IF ( tabres(ji,jj,jk,n2) == 0 ) EXIT 339 358 N_in = N_in + 1 340 359 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 END DO360 h_in (N_in) = tabres(ji,jj,jk,n2) 361 END DO 343 362 N_out = 0 344 DO jk =1,jpk ! jpk of parent grid345 IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF363 DO jk = 1, jpk ! jpk of parent grid 364 IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF 346 365 N_out = N_out + 1 347 366 h_out(N_out) = e3t_n(ji,jj,jk) 348 END DO367 END DO 349 368 IF (N_in > 0) THEN !Remove this? 350 369 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) … … 355 374 STOP 356 375 ENDIF 357 DO jn =n1,n2-1376 DO jn = n1, n2-1 358 377 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 END DO378 END DO 360 379 ENDIF 361 END DO362 END DO363 364 IF ( .NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN365 ! Add asselin part 366 DO jn = n1,n2-1 367 DO jk=1,jpk368 DO jj=j1,j2369 DO ji=i1,i2370 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN371 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) 374 393 ENDIF 375 END DO376 END DO377 END DO378 END DO379 ENDIF 380 DO jn = n1, n2-1381 DO jk =1,jpk382 DO jj =j1,j2383 DO ji =i1,i2384 IF( tabres_child(ji,jj,jk,jn) .NE.0. ) THEN394 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 385 404 tsn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk) 386 405 END IF … … 396 415 397 416 SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 398 !!--------------------------------------------- 399 !! ***ROUTINE updateT ***400 !!--------------------------------------------- 417 !!---------------------------------------------------------------------- 418 !! *** ROUTINE ROUTINE updateT *** 419 !!---------------------------------------------------------------------- 401 420 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 402 421 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 403 422 LOGICAL, INTENT(in) :: before 404 ! !423 ! 405 424 INTEGER :: ji,jj,jk,jn 406 425 REAL(wp) :: ztb, ztnu, ztno 407 !!--------------------------------------------- 426 !!---------------------------------------------------------------------- 408 427 ! 409 428 IF (before) THEN … … 425 444 tabres(i1:i2,j1:j2,k1:k2,jn) = tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & 426 445 & * tmask(i1:i2,j1:j2,k1:k2) 427 END DO446 END DO 428 447 !< 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 430 450 ! Add asselin part 431 451 DO jn = 1,jpts … … 437 457 ztnu = tabres(ji,jj,jk,jn) 438 458 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) 441 460 ENDIF 442 461 END DO … … 457 476 END DO 458 477 ! 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 460 480 tsb(i1:i2,j1:j2,k1:k2,1:jpts) = tsn(i1:i2,j1:j2,k1:k2,1:jpts) 461 481 ENDIF … … 470 490 471 491 SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 472 !!--------------------------------------------- 473 !! *** ROUTINE updateu ***474 !!--------------------------------------------- 492 !!---------------------------------------------------------------------- 493 !! *** ROUTINE updateu *** 494 !!---------------------------------------------------------------------- 475 495 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 476 496 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 487 507 REAL(wp) :: tabin(k1:k2) 488 508 ! VERTICAL REFINEMENT END 489 !!--------------------------------------------- 509 !!---------------------------------------------------------------------- 490 510 ! 491 511 IF( before ) THEN … … 515 535 tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 516 536 h_in(N_in) = tabres(ji,jj,jk,2)/e2u(ji,jj) 517 END DO537 END DO 518 538 N_out = 0 519 539 DO jk=1,jpk … … 521 541 N_out = N_out + 1 522 542 h_out(N_out) = e3u_n(ji,jj,jk) 523 END DO543 END DO 524 544 IF (N_in * N_out > 0) THEN 525 545 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) … … 538 558 EXIT 539 559 ENDIF 540 END DO560 END DO 541 561 ENDIF 542 562 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) 543 563 tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e2u(ji,jj)*h_out(N_out)) 544 564 ENDIF 545 END DO546 END DO547 548 DO jk =1,jpk549 DO jj =j1,j2550 DO ji =i1,i2551 IF ( .NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN! Add asselin part552 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) 554 574 ENDIF 555 !556 575 un(ji,jj,jk) = tabres_child(ji,jj,jk) * umask(ji,jj,jk) 557 576 END DO … … 565 584 566 585 SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 567 !!--------------------------------------------- 568 !! *** ROUTINE updateu ***569 !!--------------------------------------------- 586 !!---------------------------------------------------------------------- 587 !! *** ROUTINE updateu *** 588 !!---------------------------------------------------------------------- 570 589 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 571 590 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 574 593 INTEGER :: ji, jj, jk 575 594 REAL(wp) :: zrhoy, zub, zunu, zuno 576 !!--------------------------------------------- 595 !!---------------------------------------------------------------------- 577 596 ! 578 597 IF( before ) THEN … … 587 606 tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e2u(ji,jj) 588 607 ! 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 590 610 zub = ub(ji,jj,jk) * e3u_b(ji,jj,jk) ! fse3t_b prior update should be used 591 611 zuno = un(ji,jj,jk) * e3u_a(ji,jj,jk) 592 612 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) 595 614 ENDIF 596 615 ! 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 603 623 ub(i1:i2,j1:j2,k1:k2) = un(i1:i2,j1:j2,k1:k2) 604 624 ENDIF … … 611 631 612 632 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 !!---------------------------------------------------------------------- 616 636 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 617 637 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 618 638 LOGICAL , INTENT(in ) :: before 619 INTEGER , INTENT(in ):: nb, ndir639 INTEGER , INTENT(in ) :: nb, ndir 620 640 !! 621 641 LOGICAL :: western_side, eastern_side 622 ! 623 INTEGER :: jj, jk 624 REAL(wp) :: zcor 625 !!--------------------------------------------- 642 INTEGER :: jj, jk 643 REAL(wp):: zcor 644 !!---------------------------------------------------------------------- 626 645 ! 627 646 IF( .NOT.before ) THEN … … 657 676 658 677 SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 659 !!--------------------------------------------- 660 !! *** ROUTINE updatev ***661 !!--------------------------------------------- 678 !!---------------------------------------------------------------------- 679 !! *** ROUTINE updatev *** 680 !!---------------------------------------------------------------------- 662 681 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 663 682 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 674 693 REAL(wp) :: tabin(k1:k2) 675 694 ! VERTICAL REFINEMENT END 676 !!--------------------------------------------- 695 !!---------------------------------------------------------------------- 677 696 ! 678 697 IF( before ) THEN … … 700 719 tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 701 720 h_in(N_in) = tabres(ji,jj,jk,2)/e1v(ji,jj) 702 END DO721 END DO 703 722 N_out = 0 704 723 DO jk=1,jpk … … 706 725 N_out = N_out + 1 707 726 h_out(N_out) = e3v_n(ji,jj,jk) 708 END DO727 END DO 709 728 IF (N_in * N_out > 0) THEN 710 729 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) … … 723 742 EXIT 724 743 ENDIF 725 END DO744 END DO 726 745 ENDIF 727 746 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) 728 747 tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e1v(ji,jj)*h_out(N_out)) 729 748 ENDIF 730 END DO731 END DO749 END DO 750 END DO 732 751 733 752 DO jk=1,jpk … … 735 754 DO ji=i1,i2 736 755 ! 737 IF( .NOT.( lk_agrif_fstep.AND.(neuler==0)) ) THEN! Add asselin part738 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) 740 759 ENDIF 741 760 ! … … 751 770 752 771 SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before) 753 !!--------------------------------------------- 754 !! *** ROUTINE updatev ***755 !!--------------------------------------------- 772 !!---------------------------------------------------------------------- 773 !! *** ROUTINE updatev *** 774 !!---------------------------------------------------------------------- 756 775 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 757 776 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 760 779 INTEGER :: ji, jj, jk 761 780 REAL(wp) :: zrhox, zvb, zvnu, zvno 762 !!--------------------------------------------- 781 !!---------------------------------------------------------------------- 763 782 ! 764 783 IF (before) THEN … … 777 796 tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e1v(ji,jj) 778 797 ! 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 780 800 zvb = vb(ji,jj,jk) * e3v_b(ji,jj,jk) ! fse3t_b prior update should be used 781 801 zvno = vn(ji,jj,jk) * e3v_a(ji,jj,jk) 782 802 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) 785 804 ENDIF 786 805 ! 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 793 813 vb(i1:i2,j1:j2,k1:k2) = vn(i1:i2,j1:j2,k1:k2) 794 814 ENDIF … … 801 821 802 822 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 !!---------------------------------------------------------------------- 806 826 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 807 827 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 813 833 INTEGER :: ji, jk 814 834 REAL(wp) :: zcor 815 !!--------------------------------------------- 835 !!---------------------------------------------------------------------- 816 836 ! 817 837 IF( .NOT.before ) THEN … … 847 867 SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before ) 848 868 !!---------------------------------------------------------------------- 849 !! 869 !! *** ROUTINE updateu2d *** 850 870 !!---------------------------------------------------------------------- 851 871 INTEGER , INTENT(in ) :: i1, i2, j1, j2 852 872 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 853 873 LOGICAL , INTENT(in ) :: before 854 ! !874 ! 855 875 INTEGER :: ji, jj, jk 856 876 REAL(wp) :: zrhoy 857 877 REAL(wp) :: zcorr 858 !!--------------------------------------------- 878 !!---------------------------------------------------------------------- 859 879 ! 860 880 IF( before ) THEN … … 883 903 ! Update barotropic velocities: 884 904 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 886 907 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) 888 909 END IF 889 910 ENDIF … … 904 925 END DO 905 926 ! 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 907 929 ub_b(i1:i2,j1:j2) = un_b(i1:i2,j1:j2) 908 930 ENDIF … … 948 970 ! 949 971 ! 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 952 975 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) 954 977 END IF 955 978 ENDIF … … 970 993 END DO 971 994 ! 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 973 997 vb_b(i1:i2,j1:j2) = vn_b(i1:i2,j1:j2) 974 998 ENDIF … … 986 1010 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 987 1011 LOGICAL , INTENT(in ) :: before 988 ! !1012 ! 989 1013 INTEGER :: ji, jj 990 1014 !!---------------------------------------------------------------------- … … 997 1021 END DO 998 1022 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 1000 1025 DO jj=j1,j2 1001 1026 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) 1004 1028 END DO 1005 1029 END DO … … 1012 1036 END DO 1013 1037 ! 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 1015 1040 sshb(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 1016 1041 ENDIF 1017 1042 ! 1018 1019 1043 ENDIF 1020 1044 ! … … 1062 1086 END SUBROUTINE updateub2b 1063 1087 1088 1064 1089 SUBROUTINE reflux_sshu( tabres, i1, i2, j1, j2, before, nb, ndir ) 1065 !!--------------------------------------------- 1066 !! *** ROUTINE reflux_sshu ***1067 !!--------------------------------------------- 1068 INTEGER , INTENT(in) ::i1, i2, j1, j21069 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres1070 LOGICAL , INTENT(in) ::before1071 INTEGER , INTENT(in) ::nb, ndir1072 ! !1073 LOGICAL :: western_side, eastern_side1074 INTEGER :: ji, jj1075 REAL(wp) ::zrhoy, za1, zcor1076 !!--------------------------------------------- 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 !!---------------------------------------------------------------------- 1077 1102 ! 1078 1103 IF (before) THEN … … 1091 1116 eastern_side = (nb == 1).AND.(ndir == 2) 1092 1117 ! 1093 IF ( western_side) THEN1118 IF ( western_side ) THEN 1094 1119 DO jj=j1,j2 1095 zcor = r dt * 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)) 1096 1121 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 1101 1127 DO jj=j1,j2 1102 zcor = - r dt * 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)) 1103 1129 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 1105 1132 END DO 1106 1133 ENDIF … … 1110 1137 END SUBROUTINE reflux_sshu 1111 1138 1139 1112 1140 SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 1113 1141 !!---------------------------------------------------------------------- 1114 !! 1142 !! *** ROUTINE updatevb2b *** 1115 1143 !!---------------------------------------------------------------------- 1116 1144 INTEGER , INTENT(in ) :: i1, i2, j1, j2 1117 1145 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 1118 1146 LOGICAL , INTENT(in ) :: before 1119 ! !1147 ! 1120 1148 INTEGER :: ji, jj 1121 1149 REAL(wp) :: zrhox, za1, zcor 1122 !!--------------------------------------------- 1150 !!--------------------------------------------------------------------- 1123 1151 ! 1124 1152 IF( before ) THEN … … 1150 1178 END SUBROUTINE updatevb2b 1151 1179 1180 1152 1181 SUBROUTINE reflux_sshv( tabres, i1, i2, j1, j2, before, nb, ndir ) 1153 !!--------------------------------------------- 1154 !! *** ROUTINE reflux_sshv ***1155 !!--------------------------------------------- 1156 INTEGER , INTENT(in) ::i1, i2, j1, j21157 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres1158 LOGICAL , INTENT(in) ::before1159 INTEGER , INTENT(in) ::nb, ndir1182 !!---------------------------------------------------------------------- 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 1160 1189 !! 1161 1190 LOGICAL :: southern_side, northern_side 1162 1191 INTEGER :: ji, jj 1163 1192 REAL(wp) :: zrhox, za1, zcor 1164 !!--------------------------------------------- 1193 !!---------------------------------------------------------------------- 1165 1194 ! 1166 1195 IF (before) THEN … … 1181 1210 IF (southern_side) THEN 1182 1211 DO ji=i1,i2 1183 zcor = r dt * 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)) 1184 1213 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 1186 1216 END DO 1187 1217 ENDIF 1188 1218 IF (northern_side) THEN 1189 1219 DO ji=i1,i2 1190 zcor = - r dt * 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)) 1191 1221 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 1193 1224 END DO 1194 1225 ENDIF … … 1198 1229 END SUBROUTINE reflux_sshv 1199 1230 1231 1200 1232 SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before ) 1233 !!---------------------------------------------------------------------- 1234 !! *** ROUTINE updateT *** 1201 1235 ! 1202 1236 ! ====>>>>>>>>>> currently not used 1203 1237 ! 1204 !!----------------------------------------------------------------------1205 !! *** ROUTINE updateT ***1206 1238 !!---------------------------------------------------------------------- 1207 1239 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 … … 1284 1316 1285 1317 SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before ) 1286 !!--------------------------------------------- 1287 !! *** ROUTINE updateavm ***1318 !!---------------------------------------------------------------------- 1319 !! *** ROUTINE updateavm *** 1288 1320 !!---------------------------------------------------------------------- 1289 1321 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 … … 1298 1330 END SUBROUTINE updateAVM 1299 1331 1332 1300 1333 SUBROUTINE updatee3t(ptab_dum, i1, i2, j1, j2, k1, k2, before ) 1301 !!--------------------------------------------- 1302 !! *** ROUTINE updatee3t ***1303 !!--------------------------------------------- 1334 !!---------------------------------------------------------------------- 1335 !! *** ROUTINE updatee3t *** 1336 !!---------------------------------------------------------------------- 1304 1337 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ptab_dum 1305 1338 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 … … 1313 1346 IF (.NOT.before) THEN 1314 1347 ! 1315 ALLOCATE( ptab(i1:i2,j1:j2,1:jpk))1348 ALLOCATE( ptab(i1:i2,j1:j2,1:jpk) ) 1316 1349 ! 1317 1350 ! Update e3t from ssh (z* case only) … … 1335 1368 ! hdivn(i1:i2,j1:j2,1:jpkm1) = e3t_b(i1:i2,j1:j2,1:jpkm1) 1336 1369 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 1338 1372 DO jk = 1, jpkm1 1339 1373 DO jj=j1,j2 1340 1374 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) ) 1343 1376 END DO 1344 1377 END DO … … 1398 1431 END DO 1399 1432 ! 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 1401 1435 e3t_b (i1:i2,j1:j2,1:jpk) = e3t_n (i1:i2,j1:j2,1:jpk) 1402 1436 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 109 109 tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2) 110 110 h_in(N_in) = tabres(ji,jj,jk,n2) 111 END DO111 END DO 112 112 N_out = 0 113 113 DO jk=1,jpk ! jpk of parent grid … … 115 115 N_out = N_out + 1 116 116 h_out(N_out) = e3t_n(ji,jj,jk) !Parent grid scale factors. Could multiply by e1e2t here instead of division above 117 END DO117 END DO 118 118 IF (N_in > 0) THEN !Remove this? 119 119 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) … … 126 126 DO jn=1,jptra 127 127 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 END DO128 END DO 129 129 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 134 135 ! Add asselin part 135 136 DO jn = 1,jptra … … 139 140 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 140 141 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) 143 143 ENDIF 144 END DO145 END DO146 END DO147 END DO144 END DO 145 END DO 146 END DO 147 END DO 148 148 ENDIF 149 149 DO jn = 1,jptra … … 195 195 tabres(i1:i2,j1:j2,k1:k2,jn) = tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & 196 196 & * tmask(i1:i2,j1:j2,k1:k2) 197 END DO197 END DO 198 198 !< 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 200 201 ! Add asselin part 201 202 DO jn = n1,n2 … … 207 208 ztnu = tabres(ji,jj,jk,jn) 208 209 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) 211 211 ENDIF 212 END DO213 END DO214 END DO215 END DO212 END DO 213 END DO 214 END DO 215 END DO 216 216 ENDIF 217 217 DO jn = n1,n2 … … 227 227 END DO 228 228 ! 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 230 231 trb(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 231 232 ENDIF -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/NST/agrif_user.F90
r9788 r9939 217 217 218 218 ! Check time steps 219 IF( NINT(Agrif_Rhot()) * NINT(r dt) .NE. Agrif_Parent(rdt) ) THEN220 WRITE(cl_check1,*) NINT(Agrif_Parent(r dt))221 WRITE(cl_check2,*) NINT(r dt)222 WRITE(cl_check3,*) NINT(Agrif_Parent(r dt)/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()) 223 223 CALL ctl_stop( 'Incompatible time step between ocean grids', & 224 224 & 'parent grid value : '//cl_check1 , & … … 229 229 ! Check run length 230 230 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 231 Agrif_Parent(nit000)+1) .NE.(nitend-nit000+1) ) THEN231 Agrif_Parent(nit000)+1) /= (nitend-nit000+1) ) THEN 232 232 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 233 233 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot() … … 601 601 IF( check_namelist ) THEN 602 602 ! Check time steps 603 IF( NINT(Agrif_Rhot()) * NINT(r dt) .NE. Agrif_Parent(rdt) ) THEN604 WRITE(cl_check1,*) Agrif_Parent(r dt)605 WRITE(cl_check2,*) r dt606 WRITE(cl_check3,*) r dt*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() 607 607 CALL ctl_stop( 'incompatible time step between grids', & 608 608 & 'parent grid value : '//cl_check1 , & -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ASM/asminc.F90
r9656 r9939 491 491 ENDIF 492 492 ! 493 IF(lwp) WRITE(numout,*) ' ==>>> Euler time step switch is ', neuler493 IF(lwp) WRITE(numout,*) ' ==>>> Euler time step switch is ', ln_1st_euler 494 494 ! 495 495 IF( lk_asminc ) THEN !== data assimilation ==! … … 536 536 ! 537 537 it = kt - nit000 + 1 538 zincwgt = wgtiau(it) / r dt ! IAU weight for the current time step538 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 539 539 ! 540 540 IF(lwp) THEN … … 579 579 IF ( kt == nitdin_r ) THEN 580 580 ! 581 neuler = 0! Force Euler forward step581 l_1st_euler = .TRUE. ! Force Euler forward step 582 582 ! 583 583 ! Initialize the now fields with the background + increment … … 651 651 ! 652 652 it = kt - nit000 + 1 653 zincwgt = wgtiau(it) / r dt ! IAU weight for the current time step653 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 654 654 ! 655 655 IF(lwp) THEN … … 677 677 IF ( kt == nitdin_r ) THEN 678 678 ! 679 neuler = 0! Force Euler forward step679 l_1st_euler = .TRUE. ! Force Euler forward step 680 680 ! 681 681 ! Initialize the now fields with the background + increment … … 721 721 ! 722 722 it = kt - nit000 + 1 723 zincwgt = wgtiau(it) / r dt ! IAU weight for the current time step723 zincwgt = wgtiau(it) / rn_Dt ! IAU weight for the current time step 724 724 ! 725 725 IF(lwp) THEN … … 752 752 IF ( kt == nitdin_r ) THEN 753 753 ! 754 neuler = 0! Force Euler forward step754 l_1st_euler = .TRUE. ! Force Euler forward step 755 755 ! 756 756 sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:) ! Initialize the now fields the background + increment … … 758 758 sshb(:,:) = sshn(:,:) ! Update before fields 759 759 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 761 763 ! 762 764 DEALLOCATE( ssh_bkg ) … … 839 841 it = kt - nit000 + 1 840 842 zincwgt = wgtiau(it) ! IAU weight for the current time step 841 ! note this is not a tendency so should not be divided by r dt (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) 842 844 ! 843 845 IF(lwp) THEN … … 874 876 #if defined key_cice && defined key_asminc 875 877 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 876 ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / r dt878 ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rn_Dt 877 879 #endif 878 880 ! … … 894 896 IF ( kt == nitdin_r ) THEN 895 897 ! 896 neuler = 0! Force Euler forward step898 l_1st_euler = .TRUE. ! Force Euler forward step 897 899 ! 898 900 ! Sea-ice : SI3 case … … 924 926 #if defined key_cice && defined key_asminc 925 927 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 926 ndaice_da(:,:) = seaice_bkginc(:,:) / r dt928 ndaice_da(:,:) = seaice_bkginc(:,:) / rn_Dt 927 929 #endif 928 930 IF ( .NOT. PRESENT(kindic) ) THEN … … 957 959 ! ! fwf : ice formation and melting 958 960 ! 959 ! zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) ) *rdt961 ! zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) ) * rn_Dt 960 962 ! 961 963 ! ! change salinity down to mixed layer depth … … 1006 1008 ! !! ! E-P (kg m-2 s-2) 1007 1009 ! ! emp(ji,jj) = emp(ji,jj) + zpmess ! E-P (kg m-2 s-2) 1008 ! END DO !ji1009 ! END DO !jj!1010 ! END DO !ji 1011 ! END DO !jj! 1010 1012 ! 1011 1013 ! ENDIF !ln_seaicebal -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/BDY/bdyice.F90
r9657 r9939 124 124 125 125 ! Then, a) transfer the snow excess into the ice (different from icethd_dh) 126 zdh = MAX( 0._wp, ( rhos n * 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 ) 127 127 ! 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) * rhos n / rhoic)128 !zdh = MAX( 0._wp, h_s(ji,jj,jl) * rhos / rhoi ) 129 129 130 130 ! recompute h_i, h_s 131 131 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 * rhoi c / rhosn)133 134 END DO132 h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoi / rhos ) 133 134 END DO 135 135 CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy ) 136 136 CALL lbc_bdy_lnk( h_i(:,:,jl), 'T', 1., ib_bdy ) 137 137 CALL lbc_bdy_lnk( h_s(:,:,jl), 'T', 1., ib_bdy ) 138 END DO138 END DO 139 139 ! retrieve at_i 140 140 at_i(:,:) = 0._wp … … 212 212 DO jk = 1, nlay_s 213 213 ! Snow energy of melting 214 e_s(ji,jj,jk,jl) = rswitch * rhos n * ( 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 ) 215 215 ! Multiply by volume, so that heat content in J/m2 216 216 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s … … 219 219 ztmelts = - tmut * sz_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 220 220 ! heat content per unit volume 221 e_i(ji,jj,jk,jl) = rswitch * rhoi c* &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 ) ) 225 225 ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 226 226 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 4 4 !! Unstructured Open Boundary Cond. : Library module of generic boundary algorithms. 5 5 !!====================================================================== 6 !! History : 3.6 ! 2013 (D. Storkey) original code7 !! 4.0 ! 2014 (T. Lovato) Generalize OBC structure6 !! History : 3.6 ! 2013 (D. Storkey) original code 7 !! 4.0 ! 2014 (T. Lovato) Generalize OBC structure 8 8 !!---------------------------------------------------------------------- 9 9 10 !!---------------------------------------------------------------------- 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) 12 17 !!---------------------------------------------------------------------- 13 18 USE oce ! ocean dynamics and tracers … … 22 27 PRIVATE 23 28 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 27 31 28 32 !!---------------------------------------------------------------------- … … 230 234 ! Note no rdt factor in expression for zdt because it cancels in the expressions for 231 235 ! zrx and zry. 232 zdt = phia(iibm1,ijbm1) - phib(iibm1,ijbm1)236 zdt = phia(iibm1,ijbm1) - phib(iibm1,ijbm1) 233 237 zdx = ( ( phia(iibm1,ijbm1) - phia(iibm2,ijbm2) ) / zex2 ) * zmask_x 234 238 zdy_1 = ( ( phib(iibm1 ,ijbm1 ) - phib(iibm1jm1,ijbm1jm1) ) / zey1 ) * zmask_y1 … … 247 251 zout = sign( 1., zrx ) 248 252 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) ) 250 254 ! only apply radiation on outflow points 251 255 if( ll_npo ) then !! NPO version !! … … 385 389 ! Centred derivative is calculated as average of "left" and "right" derivatives for 386 390 ! this reason. 387 zdt = phia(iibm1,ijbm1,jk) - phib(iibm1,ijbm1,jk)391 zdt = phia(iibm1,ijbm1,jk) - phib(iibm1,ijbm1,jk) 388 392 zdx = ( ( phia(iibm1,ijbm1,jk) - phia(iibm2,ijbm2,jk) ) / zex2 ) * zmask_x 389 393 zdy_1 = ( ( phib(iibm1 ,ijbm1 ,jk) - phib(iibm1jm1,ijbm1jm1,jk) ) / zey1 ) * zmask_y1 … … 402 406 !!$ zrx = min(zrx,2.0_wp) 403 407 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) ) 406 410 ! only apply radiation on outflow points 407 411 if( ll_npo ) then !! NPO version !! … … 426 430 ! 427 431 END SUBROUTINE bdy_orlanski_3d 432 428 433 429 434 SUBROUTINE bdy_nmn( idx, igrd, phia ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/BDY/bdytides.F90
r9598 r9939 295 295 !!---------------------------------------------------------------------- 296 296 ! 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) ) 300 300 301 301 zflag=1 302 302 IF ( PRESENT(jit) ) THEN 303 IF ( jit /= 1 ) zflag=0303 IF ( jit /= 1 ) zflag=0 304 304 ENDIF 305 305 306 IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000) .AND. zflag==1 ) THEN306 IF ( ( nsec_day == NINT( 0.5_wp * rn_Dt ) .OR. kt == nit000 ) .AND. zflag==1 ) THEN 307 307 ! 308 kt_tide = kt - (nsec_day - 0.5_wp * r dt)/rdt308 kt_tide = kt - (nsec_day - 0.5_wp * rn_Dt) / rn_Dt 309 309 ! 310 310 IF(lwp) THEN 311 311 WRITE(numout,*) 312 WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=', kt312 WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=', kt 313 313 WRITE(numout,*) '~~~~~~~~~~~~~~ ' 314 314 ENDIF … … 325 325 326 326 IF( PRESENT(jit) ) THEN 327 z_arg = ((kt-kt_tide) * r dt + (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) ) 328 328 ELSE 329 z_arg = ((kt-kt_tide)+time_add) * r dt329 z_arg = ((kt-kt_tide)+time_add) * rn_Dt 330 330 ENDIF 331 331 332 332 ! Linear ramp on tidal component at open boundaries 333 333 zramp = 1._wp 334 IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*r dt)/(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) 335 335 336 336 DO itide = 1, nb_harmo … … 392 392 ! Absolute time from model initialization: 393 393 IF( PRESENT(kit) ) THEN 394 z_arg = ( kt + (kit+time_add-1) / REAL(nn_ baro,wp) ) * rdt394 z_arg = ( kt + (kit+time_add-1) / REAL(nn_e,wp) ) * rn_Dt 395 395 ELSE 396 z_arg = ( kt + time_add ) * r dt396 z_arg = ( kt + time_add ) * rn_Dt 397 397 ENDIF 398 398 399 399 ! Linear ramp on tidal component at open boundaries 400 400 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. ) 402 402 403 403 DO ib_bdy = 1,nb_bdy … … 414 414 ! We refresh nodal factors every day below 415 415 ! This should be done somewhere else 416 IF ( ( nsec_day == NINT(0.5_wp * r dt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN417 ! 418 kt_tide = kt - (nsec_day - 0.5_wp * r dt)/rdt416 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 419 419 ! 420 420 IF(lwp) THEN … … 428 428 ! 429 429 ENDIF 430 zoff = -kt_tide * r dt! time offset relative to nodal factor computation time430 zoff = -kt_tide * rn_Dt ! time offset relative to nodal factor computation time 431 431 ! 432 432 ! 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 84 84 ! ----------------------------------------------------------------------- 85 85 !!gm replace these lines : 86 z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / r au086 z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rho0 87 87 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 88 88 !!gm by : 89 !!gm z_cflxemp = glob_sum( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / r au090 !!gm 89 !!gm z_cflxemp = glob_sum( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rho0 90 !!gm ??? 91 91 92 92 ! Transport through the unstructured open boundary -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/dia25h.F90
r9598 r9939 139 139 ! ----------------- 140 140 ! Define frequency of summing to create 25 h mean 141 IF( MOD( 3600 ,INT(rdt) ) == 0 ) THEN142 i_steps = 3600 /INT(rdt)141 IF( MOD( 3600 , INT(rn_Dt) ) == 0 ) THEN 142 i_steps = 3600 / INT( rn_Dt ) 143 143 ELSE 144 CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,r dt) = 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') 145 145 ENDIF 146 146 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diaar5.F90
r9598 r9939 161 161 162 162 ! ! ocean bottom pressure 163 zztmp = r au0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa163 zztmp = rho0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 164 164 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 165 165 CALL iom_put( 'botpres', zbotpres ) … … 198 198 END IF 199 199 ! 200 zmass = r au0 * ( zarho + zvol ) ! total mass of liquid seawater200 zmass = rho0 * ( zarho + zvol ) ! total mass of liquid seawater 201 201 ztemp = ztemp / zvol ! potential temperature in liquid seawater 202 202 zsal = zsal / zvol ! Salinity of liquid seawater … … 239 239 DO ji = 1, jpi 240 240 DO jj = 1, jpj 241 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * r au0 * 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) 242 242 END DO 243 243 END DO … … 287 287 CALL lbc_lnk( z2d, 'U', -1. ) 288 288 IF( cptr == 'adv' ) THEN 289 IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , r au0_rcp * z2d ) ! advective heat transport in i-direction290 IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr" , r au0 * z2d ) ! advective salt transport in i-direction289 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 291 291 ENDIF 292 292 IF( cptr == 'ldf' ) THEN 293 IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr" , r au0_rcp * z2d ) ! diffusive heat transport in i-direction294 IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr" , r au0 * z2d ) ! diffusive salt transport in i-direction293 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 295 295 ENDIF 296 296 ! … … 305 305 CALL lbc_lnk( z2d, 'V', -1. ) 306 306 IF( cptr == 'adv' ) THEN 307 IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , r au0_rcp * z2d ) ! advective heat transport in j-direction308 IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr" , r au0 * z2d ) ! advective salt transport in j-direction307 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 309 309 ENDIF 310 310 IF( cptr == 'ldf' ) THEN 311 IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr" , r au0_rcp * z2d ) ! diffusive heat transport in j-direction312 IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr" , r au0 * z2d ) ! diffusive salt transport in j-direction311 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 313 313 ENDIF 314 314 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diacfl.F90
r9598 r9939 55 55 ! 56 56 INTEGER :: ji, jj, jk ! dummy loop indices 57 REAL(wp):: z 2dt, zCu_max, zCv_max, zCw_max ! local scalars57 REAL(wp):: zCu_max, zCv_max, zCw_max ! local scalars 58 58 INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc ! workspace 59 59 !!gm this does not work REAL(wp), DIMENSION(jpi,jpj,jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace … … 62 62 IF( ln_timing ) CALL timing_start('dia_cfl') 63 63 ! 64 ! ! setup timestep multiplier to account for initial Eulerian timestep65 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2dt = rdt66 ELSE ; z2dt = rdt * 2._wp67 ENDIF68 !69 64 ! 70 65 DO jk = 1, jpk ! calculate Courant numbers 71 66 DO jj = 1, jpj 72 67 DO ji = 1, fs_jpim1 ! vector opt. 73 zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u (ji,jj) ! for i-direction74 zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v (ji,jj) ! for j-direction75 zCw_cfl(ji,jj,jk) = ABS( wn(ji,jj,jk) ) * z2dt / e3w_n(ji,jj,jk) ! for k-direction68 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 76 71 END DO 77 72 END DO … … 120 115 WRITE(numcfl,*) '******************************************' 121 116 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_max117 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCu_max 123 118 WRITE(numcfl,*) '******************************************' 124 119 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_max120 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCv_max 126 121 WRITE(numcfl,*) '******************************************' 127 122 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_max123 WRITE(numcfl,FMT='(3x,a8,11x,f15.1)') ' => dt/C', rDt/rCw_max 129 124 CLOSE( numcfl ) 130 125 ! … … 133 128 WRITE(numout,*) 'dia_cfl : Maximum Courant number information for the run ' 134 129 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_max136 WRITE(numout,*) ' Max Cv = ', rCv_max, ' at (i,j,k) = (',nCv_loc(1),nCv_loc(2),nCv_loc(3),') => dt/C = ', z2dt/rCv_max137 WRITE(numout,*) ' Max Cw = ', rCw_max, ' at (i,j,k) = (',nCw_loc(1),nCw_loc(2),nCw_loc(3),') => dt/C = ', z2dt/rCw_max130 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 138 133 ENDIF 139 134 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diadct.F90
r9598 r9939 679 679 zsn = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 680 680 zrhop = interp(k%I,k%J,jk,'V',rhop) 681 zrhoi = interp(k%I,k%J,jk,'V',rhd*r au0+rau0)681 zrhoi = interp(k%I,k%J,jk,'V',rhd*rho0+rho0) 682 682 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1) 683 683 CASE(2,3) … … 685 685 zsn = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 686 686 zrhop = interp(k%I,k%J,jk,'U',rhop) 687 zrhoi = interp(k%I,k%J,jk,'U',rhd*r au0+rau0)687 zrhoi = interp(k%I,k%J,jk,'U',rhd*rho0+rho0) 688 688 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 689 689 END SELECT … … 851 851 zsn = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 852 852 zrhop = interp(k%I,k%J,jk,'V',rhop) 853 zrhoi = interp(k%I,k%J,jk,'V',rhd*r au0+rau0)853 zrhoi = interp(k%I,k%J,jk,'V',rhd*rho0+rho0) 854 854 855 855 CASE(2,3) … … 857 857 zsn = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 858 858 zrhop = interp(k%I,k%J,jk,'U',rhop) 859 zrhoi = interp(k%I,k%J,jk,'U',rhd*r au0+rau0)859 zrhoi = interp(k%I,k%J,jk,'U',rhd*rho0+rho0) 860 860 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 861 861 END SELECT -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diaharm.F90
r9598 r9939 181 181 IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN 182 182 ! 183 ztime = ( kt-nit000+1) * rdt183 ztime = ( kt - nit000+1 ) * rn_Dt 184 184 ! 185 185 nhc = 0 … … 231 231 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 232 232 233 ztime_ini = nit000_han*r dt ! Initial time in seconds at the beginning of analysis234 ztime_end = nitend_han*r dt ! Final time in seconds at the end of analysis233 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 235 235 nhan = (nitend_han-nit000_han+1)/nstep_han ! Number of dumps used for analysis 236 236 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diahsb.F90
r9598 r9939 91 91 ! 1 - Trends due to forcing ! 92 92 ! ------------------------- ! 93 z_frc_trd_v = r1_r au0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes93 z_frc_trd_v = r1_rho0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes 94 94 z_frc_trd_t = glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes 95 95 z_frc_trd_s = glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes … … 100 100 IF( ln_isf ) z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) ) 101 101 ! ! Add penetrative solar radiation 102 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_r au0_rcp * glob_sum( qsr (:,:) * surf(:,:) )102 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rho0_rcp * glob_sum( qsr (:,:) * surf(:,:) ) 103 103 ! ! Add geothermal heat flux 104 104 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + glob_sum( qgh_trd0(:,:) * surf(:,:) ) … … 120 120 ENDIF 121 121 122 frc_v = frc_v + z_frc_trd_v * r dt123 frc_t = frc_t + z_frc_trd_t * r dt124 frc_s = frc_s + z_frc_trd_s * r dt122 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 125 125 ! ! Advection flux through fixed surface (z=0) 126 126 IF( ln_linssh ) THEN 127 frc_wn_t = frc_wn_t + z_wn_trd_t * r dt128 frc_wn_s = frc_wn_s + z_wn_trd_s * r dt127 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 129 129 ENDIF 130 130 … … 196 196 197 197 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 198 CALL iom_put( 'bgfrctem' , frc_t * r au0 * rcp * 1.e-20 )! hc - surface forcing (1.e20 J)199 CALL iom_put( 'bgfrchfx' , frc_t * r au0 * 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 ) ) 201 201 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3) 202 202 … … 204 204 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C) 205 205 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity drift (PSU) 206 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * r au0 * rcp )! Heat content drift (1.e20 J)207 CALL iom_put( 'bgheatfx' , zdiff_hc * r au0 * rcp / &! Heat flux drift (W/m2)208 & ( surf_tot * kt * r dt ))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 ) ) 209 209 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content drift (psu*km3) 210 210 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) … … 224 224 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C) 225 225 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content drift (PSU) 226 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * r au0 * rcp )! Heat content drift (1.e20 J)227 CALL iom_put( 'bgheatfx' , zdiff_hc1 * r au0 * rcp / &! Heat flux drift (W/m2)228 & ( surf_tot * kt * r dt ))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 ) ) 229 229 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content drift (psu*km3) 230 230 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 89 89 REAL(wp) :: zrho1 = 0.01_wp ! density criterion for mixed layer depth 90 90 REAL(wp) :: ztem2 = 0.2_wp ! temperature criterion for mixed layer depth 91 REAL(wp) :: zthick_0 , zcoef ! temporaryscalars92 REAL(wp) :: zztmp, zzdep ! temporaryscalars inside do loop93 REAL(wp) :: zu, zv, zw, zut, zvt ! temporaryworkspace91 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 94 94 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zabs2 ! MLD: abs( tn - tn(10m) ) = ztem2 95 95 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ztm2 ! Top of thermocline: tn = tn(10m) - ztem2 … … 328 328 END DO 329 329 ! from temperature to heat contain 330 zcoef = rau0 * rcp 331 htc3(:,:) = zcoef * htc3(:,:) 330 htc3(:,:) = rho0_rcp * htc3(:,:) 332 331 CALL iom_put( "hc300", htc3 ) ! first 300m heat content 333 332 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/dianam.F90
r9598 r9939 71 71 ENDIF 72 72 73 IF( llfsec .OR. kfreq < 0 ) THEN ; inbsec = kfreq 74 ELSE ; inbsec = kfreq * NINT( r dt )! from time-step to seconds73 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 75 75 ENDIF 76 76 iddss = NINT( rday ) ! number of seconds in 1 day … … 116 116 ! date of the beginning and the end of the run 117 117 118 zdrun = r dt / rday * REAL( nitend - nit000, wp )! length of the run in days119 zjul = fjulday - r dt / rday118 zdrun = rn_Dt / rday * REAL( nitend - nit000, wp ) ! length of the run in days 119 zjul = fjulday - rn_Dt / rday 120 120 CALL ju2ymds( zjul , iyear1, imonth1, iday1, zsec1 ) ! year/month/day of the beginning of run 121 121 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 52 52 53 53 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 r au0 x Cp)54 REAL(wp) :: rc_pwatt = 1.e-15_wp ! conversion from W to PW (further x rho0 x Cp) 55 55 REAL(wp) :: rc_ggram = 1.e-6_wp ! conversion from g to Pg 56 56 … … 424 424 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 425 425 426 rc_pwatt = rc_pwatt * r au0_rcp ! conversion from K.s-1 to PetaWatt426 rc_pwatt = rc_pwatt * rho0_rcp ! conversion from K.s-1 to PetaWatt 427 427 428 428 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum … … 448 448 ! Initialise arrays to zero because diatpr is called before they are first calculated 449 449 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 450 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp451 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp452 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp450 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 453 453 htr_ove(:,:) = 0._wp ; str_ove(:,:) = 0._wp 454 454 htr_btr(:,:) = 0._wp ; str_btr(:,:) = 0._wp -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIA/diawri.F90
r9652 r9939 169 169 170 170 IF ( iom_use("taubot") ) THEN ! bottom stress 171 zztmp = r au0 * 0.25171 zztmp = rho0 * 0.25 172 172 z2d(:,:) = 0._wp 173 173 DO jj = 2, jpjm1 … … 212 212 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 213 213 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 214 z2d(:,:) = r au0 * e1e2t(:,:)214 z2d(:,:) = rho0 * e1e2t(:,:) 215 215 DO jk = 1, jpk 216 216 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) … … 253 253 END DO 254 254 END DO 255 CALL iom_put( "heatc", r au0_rcp * z2d ) ! vertically integrated heat content (J/m2)255 CALL iom_put( "heatc", rho0_rcp * z2d ) ! vertically integrated heat content (J/m2) 256 256 ENDIF 257 257 … … 265 265 END DO 266 266 END DO 267 CALL iom_put( "saltc", r au0 * z2d ) ! vertically integrated salt content (PSU*kg/m2)267 CALL iom_put( "saltc", rho0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 268 268 ENDIF 269 269 ! … … 291 291 z2d(:,:) = 0.e0 292 292 DO jk = 1, jpkm1 293 z3d(:,:,jk) = r au0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk)293 z3d(:,:,jk) = rho0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 294 294 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 295 295 END DO … … 328 328 z3d(:,:,jpk) = 0.e0 329 329 DO jk = 1, jpkm1 330 z3d(:,:,jk) = r au0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk)330 z3d(:,:,jk) = rho0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 331 331 END DO 332 332 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction … … 369 369 END DO 370 370 CALL lbc_lnk( z2d, 'T', -1. ) 371 CALL iom_put( "tosmint", r au0 * z2d ) ! Vertical integral of temperature371 CALL iom_put( "tosmint", rho0 * z2d ) ! Vertical integral of temperature 372 372 ENDIF 373 373 IF( iom_use("somint") ) THEN … … 381 381 END DO 382 382 CALL lbc_lnk( z2d, 'T', -1. ) 383 CALL iom_put( "somint", r au0 * z2d ) ! Vertical integral of salinity383 CALL iom_put( "somint", rho0 * z2d ) ! Vertical integral of salinity 384 384 ENDIF 385 385 … … 458 458 clop = "x" ! no use of the mask value (require less cpu time and otherwise the model crashes) 459 459 #if defined key_diainstant 460 zsto = nwrite * r dt460 zsto = nwrite * rn_Dt 461 461 clop = "inst("//TRIM(clop)//")" 462 462 #else 463 zsto =rdt463 zsto = rn_Dt 464 464 clop = "ave("//TRIM(clop)//")" 465 465 #endif 466 zout = nwrite * r dt467 zmax = ( nitend - nit000 + 1 ) * r dt466 zout = nwrite * rn_Dt 467 zmax = ( nitend - nit000 + 1 ) * rn_Dt 468 468 469 469 ! Define indices of the horizontal output zoom and vertical limit storage … … 485 485 486 486 ! Compute julian date from starting date of the run 487 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian )487 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 488 488 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 489 489 IF(lwp)WRITE(numout,*) … … 507 507 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 508 508 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 509 & nit000-1, zjulian, r dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )509 & nit000-1, zjulian, rn_Dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 510 510 CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept 511 511 & "m", ipk, gdept_1d, nz_T, "down" ) … … 543 543 CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu 544 544 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 545 & nit000-1, zjulian, r dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )545 & nit000-1, zjulian, rn_Dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 546 546 CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept 547 547 & "m", ipk, gdept_1d, nz_U, "down" ) … … 556 556 CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv 557 557 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 558 & nit000-1, zjulian, r dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )558 & nit000-1, zjulian, rn_Dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 559 559 CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept 560 560 & "m", ipk, gdept_1d, nz_V, "down" ) … … 569 569 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 570 570 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 571 & nit000-1, zjulian, r dt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )571 & nit000-1, zjulian, rn_Dt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set ) 572 572 CALL histvert( nid_W, "depthw", "Vertical W levels", & ! Vertical grid: gdepw 573 573 & "m", ipk, gdepw_1d, nz_W, "down" ) … … 897 897 clname = cdfile_name 898 898 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 899 zsto = r dt899 zsto = rn_Dt 900 900 clop = "inst(x)" ! no use of the mask value (require less cpu time) 901 zout = r dt902 zmax = ( nitend - nit000 + 1 ) * r dt901 zout = rn_Dt 902 zmax = ( nitend - nit000 + 1 ) * rn_Dt 903 903 904 904 IF(lwp) WRITE(numout,*) … … 912 912 913 913 ! Compute julian date from starting date of the run 914 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian ) ! time axis914 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) ! time axis 915 915 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 916 916 CALL histbeg( clname, jpi, glamt, jpj, gphit, & 917 1, jpi, 1, jpj, nit000-1, zjulian, r dt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit917 1, jpi, 1, jpj, nit000-1, zjulian, rn_Dt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 918 918 CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept 919 919 "m", jpk, gdept_1d, nz_i, "down") -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIU/cool_skin.F90
r9598 r9939 68 68 69 69 70 SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, rdt)70 SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, pdt) 71 71 !!---------------------------------------------------------------------- 72 72 !! *** ROUTINE diurnal_sst_takaya_step *** … … 82 82 REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux ! Wind stress (kg/ m s^2) 83 83 REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho ! Water density (kg/m^3) 84 REAL(wp), INTENT(IN) :: rdt ! Time-step84 REAL(wp), INTENT(IN) :: pdt ! Time-step (s) 85 85 86 86 ! Local variables -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIU/diurnal_bulk.F90
r9168 r9939 78 78 79 79 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, & 81 81 & pla, pthick, pcoolthick, pmu, & 82 82 & p_fvel_bkginc, p_hflux_bkginc) … … 98 98 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: ptauflux ! wind stress (kg/ m s^2) 99 99 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: prho ! water density (kg/m^3) 100 REAL(wp) , INTENT(in) :: p _rdt ! time-step100 REAL(wp) , INTENT(in) :: pdt ! time-step (s) 101 101 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pLa ! Langmuir number 102 102 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pthick ! warm layer thickness (m) … … 167 167 168 168 ! 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(:,:), & 170 170 & z_fla(:,:), zmu(:,:), zthick(:,:), prho(:,:) ) 171 171 ! … … 173 173 174 174 175 FUNCTION t_imp(p_dsst, p _rdt, p_abflux, p_fvel, &175 FUNCTION t_imp(p_dsst, pdt, p_abflux, p_fvel, & 176 176 p_fla, pmu, pthick, prho ) 177 177 … … 182 182 ! Dummy variables 183 183 REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_dsst ! Delta SST 184 REAL(wp), INTENT(IN) :: p _rdt ! Time-step184 REAL(wp), INTENT(IN) :: pdt ! Time-step (s) 185 185 REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_abflux ! Heat forcing 186 186 REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fvel ! Friction velocity … … 257 257 & ( pthick(ji,jj) * z_stabfunc ) ) 258 258 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 ) 261 261 262 262 END DO 263 263 END DO 264 264 265 END FUNCTION t_imp 266 265 END FUNCTION t_imp 266 267 !!====================================================================== 267 268 END MODULE diurnal_bulk -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DIU/step_diu.F90
r9598 r9939 5 5 !!====================================================================== 6 6 !! History : 3.7 ! 2015-11 (J. While) Original code 7 !!---------------------------------------------------------------------- 7 8 8 9 USE diurnal_bulk ! diurnal SST bulk routines (diurnal_sst_takaya routine) … … 27 28 !! Software governed by the CeCILL licence (./LICENSE) 28 29 !!---------------------------------------------------------------------- 29 30 30 CONTAINS 31 31 32 32 SUBROUTINE stp_diurnal( kstp ) 33 INTEGER, INTENT(in) :: kstp ! ocean time-step index34 33 !!---------------------------------------------------------------------- 35 34 !! *** ROUTINE stp_diurnal *** … … 46 45 !! -8- Outputs and diagnostics 47 46 !!---------------------------------------------------------------------- 47 INTEGER, INTENT(in) :: kstp ! ocean time-step index 48 ! 48 49 INTEGER :: jk ! dummy loop indices 49 50 INTEGER :: indic ! error indicator if < 0 … … 51 52 !! --------------------------------------------------------------------- 52 53 53 IF( ln_diurnal_only) THEN54 IF( ln_diurnal_only ) THEN 54 55 indic = 0 ! reset to no error condition 55 56 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) … … 60 61 ENDIF 61 62 62 CALL sbc ( kstp ) ! SeaBoundary Conditions63 CALL sbc( kstp ) ! Sea Surface Boundary Conditions 63 64 ENDIF 64 65 65 ! Cool skin66 66 IF( .NOT.ln_diurnal ) CALL ctl_stop( "stp_diurnal: ln_diurnal not set" ) 67 67 68 68 IF( .NOT. ln_blk ) CALL ctl_stop( "stp_diurnal: diurnal flux processing only implemented for bulk forcing" ) 69 69 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 ) 71 72 72 CALL iom_put( "sst_wl" , x_dsst )! warm layer (write out before update below).73 CALL iom_put( "sst_cs" , x_csdsst )! cool skin73 CALL iom_put( "sst_wl", x_dsst ) ! warm layer (write out before update below). 74 CALL iom_put( "sst_cs", x_csdsst ) ! cool skin 74 75 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 ) 78 78 79 79 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) 81 81 82 82 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 84 84 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 85 85 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 86 IF( lrst_oce ) CALL rst_write ( kstp )! write output ocean restart file86 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 87 87 88 88 IF( ln_timing .AND. kstp == nit000 ) CALL timing_reset … … 91 91 END SUBROUTINE stp_diurnal 92 92 93 !!====================================================================== 93 94 END MODULE step_diu -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/daymod.F90
r9598 r9939 20 20 !! ------------------------------- 21 21 !! sbcmod assume that the time step is dividing the number of second of 22 !! in a day, i.e. ===> MOD( rday, r dt ) == 022 !! in a day, i.e. ===> MOD( rday, rn_Dt ) == 0 23 23 !! except when user defined forcing is used (see sbcmod.F90) 24 24 !!---------------------------------------------------------------------- … … 72 72 ! 73 73 ! max number of seconds between each restart 74 IF( REAL( nitend - nit000 + 1 ) * r dt > REAL( HUGE( nsec1jan000 ) ) ) THEN74 IF( REAL( nitend - nit000 + 1 ) * rn_Dt > REAL( HUGE( nsec1jan000 ) ) ) THEN 75 75 CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ', & 76 76 & 'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 77 77 ENDIF 78 nsecd = NINT( rday )79 nsecd05 = NINT( 0.5 * rday )80 ndt = NINT( r dt)81 ndt05 = NINT( 0.5 * r dt)78 nsecd = NINT( rday ) 79 nsecd05 = NINT( 0.5 * rday ) 80 ndt = NINT( rn_Dt ) 81 ndt05 = NINT( 0.5 * rn_Dt ) 82 82 83 83 IF( .NOT. l_offline ) CALL day_rst( nit000, 'READ' ) … … 239 239 nsec_week = nsec_week + ndt 240 240 nsec_day = nsec_day + ndt 241 adatrj = adatrj + r dt / rday242 fjulday = fjulday + r dt / rday241 adatrj = adatrj + rn_Dt / rday 242 fjulday = fjulday + rn_Dt / rday 243 243 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 244 244 IF( ABS(adatrj - REAL(NINT(adatrj ),wp)) < zprec ) adatrj = REAL(NINT(adatrj ),wp) ! avoid truncation error … … 309 309 !! In both those options, the exact duration of the experiment 310 310 !! since the beginning (cumulated duration of all previous restart runs) 311 !! is not stored in the restart and is assumed to be (nit000-1)*r dt.311 !! is not stored in the restart and is assumed to be (nit000-1)*rn_Dt. 312 312 !! This is valid is the time step has remained constant. 313 313 !! … … 378 378 nminute = ( nn_time0 - nhour * 100 ) 379 379 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 ) * r dt ) / rday380 adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 381 381 ! note this is wrong if time step has changed during run 382 382 ENDIF … … 387 387 nminute = ( nn_time0 - nhour * 100 ) 388 388 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 ) * r dt ) / rday389 adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 390 390 ENDIF 391 391 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 33 33 LOGICAL , PUBLIC :: ln_meshmask !: =T create a mesh-mask file (mesh_mask.nc) 34 34 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 tracer35 REAL(wp), PUBLIC :: rn_dt !: time step for the dynamics and tracer 36 36 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) 38 38 LOGICAL , PUBLIC :: ln_iscpl !: coupling with ice sheet 39 39 LOGICAL , PUBLIC :: ln_crs !: Apply grid coarsening to dynamical model output or online passive tracers … … 50 50 LOGICAL, PUBLIC :: ln_bt_auto !: Set number of barotropic iterations automatically 51 51 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 53 53 REAL(wp), PUBLIC :: rn_bt_cmax !: Maximum allowed courant number (used if ln_bt_auto=T) 54 54 REAL(wp), PUBLIC :: rn_bt_alpha !: Time stepping diffusion parameter 55 55 56 57 ! !! old non-DOCTOR names still used in the model58 REAL(wp), PUBLIC :: atfp !: asselin time filter parameter59 REAL(wp), PUBLIC :: rdt !: time step for the dynamics and tracer60 61 56 ! !!! 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 64 60 65 61 !!---------------------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domain.F90
r9598 r9939 288 288 INTEGER :: ios ! Local integer 289 289 ! 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, & 294 294 & ln_cfmeta, ln_iscpl, ln_xios_read, nn_wxios 295 NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_ rdt, rn_atfp, ln_crs, ln_meshmask295 NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_Dt, rn_atfp, ln_crs, ln_meshmask 296 296 #if defined key_netcdf4 297 297 NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip … … 323 323 WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir ) 324 324 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 325 WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler325 WRITE(numout,*) ' start with forward time step ln_1st_euler = ', ln_1st_euler 326 326 WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl 327 327 WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000 … … 361 361 nstocklist = nn_stocklist 362 362 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 365 366 IF(lwp) WRITE(numout,*) 366 367 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 = 0368 IF(lwp) WRITE(numout,*)' an Euler initial time step is used ' 369 l_1st_euler = .TRUE. 369 370 ENDIF 370 371 ! ! control of output frequency … … 374 375 nstock = nitend 375 376 ENDIF 376 IF 377 IF( nwrite == 0 ) THEN 377 378 WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend 378 379 CALL ctl_warn( ctmp1 ) … … 413 414 WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask 414 415 WRITE(numout,*) ' treshold to open the isf cavity rn_isfhmin = ', rn_isfhmin, ' [m]' 415 WRITE(numout,*) ' ocean time step rn_ rdt = ', rn_rdt416 WRITE(numout,*) ' ocean time step rn_dt = ', rn_dt 416 417 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 417 418 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs 418 419 ENDIF 419 420 ! 420 ! ! conversion DOCTOR names into model names (this should disappear soon)421 atfp = rn_atfp422 rdt = rn_rdt423 424 421 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 425 422 lrxios = ln_xios_read.AND.ln_rstart -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domvvl.F90
r9598 r9939 54 54 LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE. ! debug control prints 55 55 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td 57 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf 58 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n ! baroclinic scale factors59 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a ! baroclinic scale factors60 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_e3t 61 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv 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 62 62 63 63 !! * Substitutions … … 76 76 IF( ln_vvl_zstar ) dom_vvl_alloc = 0 77 77 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 78 ALLOCATE( t ilde_e3t_b(jpi,jpj,jpk) , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) , &79 & dt ilde_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) , & 80 80 & STAT = dom_vvl_alloc ) 81 81 IF( lk_mpp ) CALL mpp_sum ( dom_vvl_alloc ) … … 103 103 !! - interpolate scale factors 104 104 !! 105 !! ** Action : - e3t_(n/b) and t ilde_e3t_(n/b)105 !! ** Action : - e3t_(n/b) and te3t_(n/b) 106 106 !! - Regrid: e3(u/v)_n 107 107 !! e3(u/v)_b … … 117 117 INTEGER :: ji, jj, jk 118 118 INTEGER :: ii0, ii1, ij0, ij1 119 REAL(wp):: zcoef 119 REAL(wp):: zcoef, z1_Dt 120 120 !!---------------------------------------------------------------------- 121 121 ! … … 129 129 IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' ) 130 130 ! 131 ! ! Read or initialize e3t_(b/n), t ilde_e3t_(b/n) and hdiv_lf131 ! ! Read or initialize e3t_(b/n), te3t_(b/n) and hdiv_lf 132 132 CALL dom_vvl_rst( nit000, 'READ' ) 133 133 e3t_a(:,:,jpk) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all … … 208 208 IF( ln_vvl_ztilde_as_zstar ) THEN ! z-star emulation using z-tile 209 209 frq_rst_e3t(:,:) = 0._wp !Ignore namelist settings 210 frq_rst_hdv(:,:) = 1._wp / r dt210 frq_rst_hdv(:,:) = 1._wp / rn_Dt 211 211 ENDIF 212 212 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 213 z1_Dt = 1._wp / rn_Dt 213 214 DO jj = 1, jpj 214 215 DO ji = 1, jpi … … 216 217 IF( ABS(gphit(ji,jj)) >= 6.) THEN 217 218 ! 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 ) 220 221 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN ! Equator strip ==> z-star 221 222 ! values inside the equatorial band (ztilde as zstar) 222 frq_rst_e3t(ji,jj) = 0. 0_wp223 frq_rst_hdv(ji,jj) = 1.0_wp / rdt223 frq_rst_e3t(ji,jj) = 0._wp 224 frq_rst_hdv(ji,jj) = z1_Dt 224 225 ELSE ! transition band (2.5 to 6 degrees N/S) 225 226 ! ! (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 ) ) 233 231 ENDIF 234 232 END DO … … 237 235 ii0 = 103 ; ii1 = 111 238 236 ij0 = 128 ; ij1 = 135 ; 239 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0. 0_wp240 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rdt237 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 241 239 ENDIF 242 240 ENDIF … … 280 278 !! 281 279 !! ** Action : - hdiv_lf : restoring towards full baroclinic divergence in z_tilde case 282 !! - t ilde_e3t_a: after increment of vertical scale factor280 !! - te3t_a: after increment of vertical scale factor 283 281 !! in z_tilde case 284 282 !! - e3(t/u/v)_a … … 345 343 IF( kt > nit000 ) THEN 346 344 DO jk = 1, jpkm1 347 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - r dt * frq_rst_hdv(:,:) &345 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rn_Dt * frq_rst_hdv(:,:) & 348 346 & * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) ) 349 347 END DO … … 353 351 ! II - after z_tilde increments of vertical scale factors 354 352 ! ======================================================= 355 t ilde_e3t_a(:,:,:) = 0._wp ! tilde_e3t_a used to store tendency terms353 te3t_a(:,:,:) = 0._wp ! te3t_a used to store tendency terms 356 354 357 355 ! 1 - High frequency divergence term … … 359 357 IF( ln_vvl_ztilde ) THEN ! z_tilde case 360 358 DO jk = 1, jpkm1 361 t ilde_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) ) 362 360 END DO 363 361 ELSE ! layer case 364 362 DO jk = 1, jpkm1 365 t ilde_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) 366 364 END DO 367 365 ENDIF … … 371 369 IF( ln_vvl_ztilde ) THEN 372 370 DO jk = 1, jpk 373 t ilde_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) 374 372 END DO 375 373 ENDIF … … 383 381 DO ji = 1, fs_jpim1 ! vector opt. 384 382 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 385 & * ( t ilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) )383 & * ( te3t_b(ji,jj,jk) - te3t_b(ji+1,jj ,jk) ) 386 384 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 387 & * ( t ilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) )385 & * ( te3t_b(ji,jj,jk) - te3t_b(ji ,jj+1,jk) ) 388 386 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 389 387 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) … … 400 398 DO jj = 2, jpjm1 401 399 DO ji = fs_2, fs_jpim1 ! vector opt. 402 t ilde_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) & 403 401 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 404 402 & ) * r1_e1e2t(ji,jj) … … 414 412 ! Leapfrog time stepping 415 413 ! ~~~~~~~~~~~~~~~~~~~~~~ 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(:,:,:) 423 416 424 417 ! Maximum deformation control … … 426 419 ze3t(:,:,jpk) = 0._wp 427 420 DO jk = 1, jpkm1 428 ze3t(:,:,jk) = t ilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)421 ze3t(:,:,jk) = te3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 429 422 END DO 430 423 z_tmax = MAXVAL( ze3t(:,:,:) ) … … 446 439 ENDIF 447 440 IF (lwp) THEN 448 WRITE(numout, *) 'MAX( t ilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax441 WRITE(numout, *) 'MAX( te3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 449 442 WRITE(numout, *) 'at i, j, k=', ijk_max 450 WRITE(numout, *) 'MIN( t ilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin443 WRITE(numout, *) 'MIN( te3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 451 444 WRITE(numout, *) 'at i, j, k=', ijk_min 452 CALL ctl_warn('MAX( ABS( t ilde_e3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high')445 CALL ctl_warn('MAX( ABS( te3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high') 453 446 ENDIF 454 447 ENDIF 455 448 ! - ML - end test 456 449 ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 457 t ilde_e3t_a(:,:,:) = MIN( tilde_e3t_a(:,:,:), rn_zdef_max * e3t_0(:,:,:) )458 t ilde_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(:,:,:) ) 459 452 460 453 ! … … 462 455 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 463 456 DO jk = 1, jpkm1 464 dt ilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - tilde_e3t_b(:,:,jk)457 dte3t_a(:,:,jk) = te3t_a(:,:,jk) - te3t_b(:,:,jk) 465 458 END DO 466 459 ! III - Barotropic repartition of the sea surface height over the baroclinic profile … … 470 463 ! i.e. locally and not spread over the water column. 471 464 ! (keep in mind that the idea is to reduce Eulerian velocity as much as possible) 472 zht(:,:) = 0. 465 zht(:,:) = 0._wp 473 466 DO jk = 1, jpkm1 474 zht(:,:) = zht(:,:) + t ilde_e3t_a(:,:,jk) * tmask(:,:,jk)467 zht(:,:) = zht(:,:) + te3t_a(:,:,jk) * tmask(:,:,jk) 475 468 END DO 476 469 z_scale(:,:) = - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 477 470 DO jk = 1, jpkm1 478 dt ilde_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) 479 472 END DO 480 473 … … 484 477 ! ! ---baroclinic part--------- ! 485 478 DO jk = 1, jpkm1 486 e3t_a(:,:,jk) = e3t_a(:,:,jk) + dt ilde_e3t_a(:,:,jk) * tmask(:,:,jk)479 e3t_a(:,:,jk) = e3t_a(:,:,jk) + dte3t_a(:,:,jk) * tmask(:,:,jk) 487 480 END DO 488 481 ENDIF … … 494 487 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) ) 495 488 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 496 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(t ilde_e3t_a))) =', z_tmax489 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(te3t_a))) =', z_tmax 497 490 END IF 498 491 ! … … 573 566 !! - recompute depths and water height fields 574 567 !! 575 !! ** Action : - e3t_(b/n), t ilde_e3t_(b/n) and e3(u/v)_n ready for next time step568 !! ** Action : - e3t_(b/n), te3t_(b/n) and e3(u/v)_n ready for next time step 576 569 !! - Recompute: 577 570 !! e3(u/v)_b … … 587 580 INTEGER, INTENT( in ) :: kt ! time step 588 581 ! 589 INTEGER :: ji, jj, jk ! dummy loop indices590 REAL(wp) :: zcoef 582 INTEGER :: ji, jj, jk ! dummy loop indices 583 REAL(wp) :: zcoef, ze3f ! local scalar 591 584 !!---------------------------------------------------------------------- 592 585 ! … … 605 598 ! - ML - e3(t/u/v)_b are allready computed in dynnxt. 606 599 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 607 IF( neuler == 0 .AND. kt == nit000) THEN608 t ilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:)600 IF( l_1st_euler ) THEN 601 te3t_n(:,:,:) = te3t_a(:,:,:) 609 602 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 612 613 ENDIF 613 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:)614 614 ENDIF 615 615 gdept_b(:,:,:) = gdept_n(:,:,:) … … 806 806 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn, ldxios = lrxios ) 807 807 ! 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. ) 810 810 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 811 811 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. ) 813 813 ! ! --------- ! 814 814 ! ! all cases ! … … 823 823 e3t_b(:,:,:) = e3t_0(:,:,:) 824 824 END WHERE 825 IF( neuler == 0) THEN825 IF( l_1st_euler ) THEN 826 826 e3t_b(:,:,:) = e3t_n(:,:,:) 827 827 ENDIF … … 829 829 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart files' 830 830 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' 832 832 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), ldxios = lrxios ) 833 833 e3t_n(:,:,:) = e3t_b(:,:,:) 834 neuler = 0834 l_1st_euler = .TRUE. 835 835 ELSE IF( id2 > 0 ) THEN 836 836 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_b not found in restart files' 837 837 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' 839 839 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), ldxios = lrxios ) 840 840 e3t_b(:,:,:) = e3t_n(:,:,:) 841 neuler = 0841 l_1st_euler = .TRUE. 842 842 ELSE 843 843 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t_n not found in restart file' 844 844 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' 846 846 DO jk = 1, jpk 847 847 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) & … … 850 850 END DO 851 851 e3t_b(:,:,:) = e3t_n(:,:,:) 852 neuler = 0852 l_1st_euler = .TRUE. 853 853 ENDIF 854 854 ! ! ----------- ! … … 862 862 ! ! ----------------------- ! 863 863 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 864 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', t ilde_e3t_b(:,:,:), ldxios = lrxios )865 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', t ilde_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 ) 866 866 ELSE ! one at least array is missing 867 t ilde_e3t_b(:,:,:) = 0.0_wp868 t ilde_e3t_n(:,:,:) = 0.0_wp867 te3t_b(:,:,:) = 0.0_wp 868 te3t_n(:,:,:) = 0.0_wp 869 869 ENDIF 870 870 ! ! ------------ ! … … 942 942 943 943 IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 944 t ilde_e3t_b(:,:,:) = 0._wp945 t ilde_e3t_n(:,:,:) = 0._wp944 te3t_b(:,:,:) = 0._wp 945 te3t_n(:,:,:) = 0._wp 946 946 IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0._wp 947 947 END IF … … 960 960 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 961 961 ! ! ----------------------- ! 962 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', t ilde_e3t_b(:,:,:), ldxios = lwxios)963 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', t ilde_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) 964 964 END IF 965 965 ! ! -------------! … … 1016 1016 WRITE(numout,*) ' rn_rst_e3t = 0.e0' 1017 1017 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' 1019 1019 ELSE 1020 1020 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 71 71 ! 72 72 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_ rdt73 rdt_iscpl = nstp_iscpl * rn_Dt 74 74 ! 75 75 IF (lwp) THEN … … 79 79 WRITE(numout,*) ' conservation flag (ln_hsb ) = ', ln_hsb 80 80 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 & 82 82 & (larger than run length)' 83 83 WRITE(numout,*) ' coupling time step = ', rdt_iscpl -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/iscplrst.F90
r9598 r9939 89 89 END IF 90 90 ! 91 neuler = 0! next step is an euler time step91 l_1st_euler = .TRUE. ! next step is an euler time step 92 92 ! 93 93 ! ! set _b and _n variables equal -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/istate.F90
r9598 r9939 92 92 ! ! --------------- 93 93 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 95 95 CALL day_init ! model calendar (using both namelist and restart infos) 96 96 ! ! Initialization of ocean to zero -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/phycst.F90
r9656 r9939 34 34 REAL(wp), PUBLIC :: rhhmm = 60._wp !: number of minutes in one hour 35 35 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] 39 39 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 ) 54 47 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 57 56 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] 62 59 REAL(wp), PUBLIC :: vkarmn = 0.4_wp !: von Karman constant 63 60 REAL(wp), PUBLIC :: stefan = 5.67e-8_wp !: Stefan-Boltzmann constant 64 61 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 93 69 !!---------------------------------------------------------------------- 94 70 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 105 81 !! ** Purpose : set and print the constants 106 82 !!---------------------------------------------------------------------- 107 83 ! 108 84 IF(lwp) WRITE(numout,*) 109 85 IF(lwp) WRITE(numout,*) 'phy_cst : initialization of ocean parameters and constants' 110 86 IF(lwp) WRITE(numout,*) '~~~~~~~' 111 87 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 ==! 119 89 120 90 rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp … … 125 95 omega = 2._wp * rpi / rsiday 126 96 #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 ==! 160 105 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' 186 107 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 188 110 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 190 141 ENDIF 191 142 ! 192 143 END SUBROUTINE phy_cst 193 144 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/restart.F90
r9838 r9939 8 8 !! 2.0 ! 2006-07 (S. Masson) use IOM for restart 9 9 !! 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 ! 26 29 ! 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 30 32 31 33 IMPLICIT NONE … … 34 36 PUBLIC rst_opn ! routine called by step module 35 37 PUBLIC rst_write ! routine called by step module 38 PUBLIC rst_read_open ! routine called in rst_read and (possibly) in dom_vvl_init 36 39 PUBLIC rst_read ! routine called by istate module 37 PUBLIC rst_read_open ! routine called in rst_read and (possibly) in dom_vvl_init38 40 39 41 !! * Substitutions … … 144 146 INTEGER, INTENT(in) :: kt ! ocean time-step 145 147 !!---------------------------------------------------------------------- 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 ) 177 180 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) 182 183 ENDIF 183 184 !!gm IF( .NOT. lk_trdmld ) lrst_oce = .FALSE. 184 185 !!gm not sure what to do here ===>>> ask to Sebastian 185 186 lrst_oce = .FALSE. 186 187 188 189 187 IF( ln_rst_list ) THEN 188 nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 189 nitrst = nstocklist( nrst_lst ) 190 ENDIF 190 191 ENDIF 191 192 ! … … 202 203 !! the file has already been opened 203 204 !!---------------------------------------------------------------------- 204 INTEGER 205 LOGICAL 206 CHARACTER(lc) 205 INTEGER :: jlibalt = jprstlib 206 LOGICAL :: llok 207 CHARACTER(lc) :: clpath ! full path to ocean output restart file 207 208 !!---------------------------------------------------------------------- 208 209 ! … … 238 239 ENDIF 239 240 ENDIF 240 241 ! 241 242 END SUBROUTINE rst_read_open 242 243 … … 254 255 REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d 255 256 !!---------------------------------------------------------------------- 256 257 ! 257 258 CALL rst_read_open ! open restart for reading (if not already opened) 258 259 … … 260 261 IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN 261 262 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 263 270 ENDIF 264 271 … … 266 273 IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios ) 267 274 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 271 277 CALL iom_get( numror, jpdom_autoglo, 'tn' , w3d, ldxios = lrxios ) 272 278 tsn(:,:,1,jp_tem) = w3d(:,:,1) … … 274 280 ENDIF 275 281 276 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN282 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 .AND. .NOT.l_1st_euler ) THEN 277 283 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub, ldxios = lrxios ) ! before fields 278 284 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb, ldxios = lrxios ) … … 281 287 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb, ldxios = lrxios ) 282 288 ELSE 283 neuler = 0289 l_1st_euler = .TRUE. ! before field not found, forced euler 1st time-step 284 290 ENDIF 285 291 ! … … 295 301 ENDIF 296 302 ! 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(:,:,:) 309 309 ENDIF 310 310 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/divhor.F90
r9598 r9939 63 63 ! 64 64 INTEGER :: ji, jj, jk ! dummy loop indices 65 REAL(wp) :: z raur, zdep! local scalars65 REAL(wp) :: zdep ! local scalars 66 66 !!---------------------------------------------------------------------- 67 67 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynnxt.F90
r9598 r9939 64 64 CONTAINS 65 65 66 SUBROUTINE dyn_nxt 66 SUBROUTINE dyn_nxt( kt ) 67 67 !!---------------------------------------------------------------------- 68 68 !! *** ROUTINE dyn_nxt *** … … 83 83 !! * Apply the time filter applied and swap of the dynamics 84 84 !! 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) ] 86 86 !! (un,vn) = (ua,va). 87 87 !! Note that with flux form advection and non linear free surface, … … 92 92 !! un,vn now horizontal velocity of next time-step 93 93 !!---------------------------------------------------------------------- 94 INTEGER, INTENT( in ) :: kt 94 INTEGER, INTENT( in ) :: kt ! ocean time-step index 95 95 ! 96 96 INTEGER :: ji, jj, jk ! dummy loop indices 97 97 INTEGER :: ikt ! local integers 98 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zcoef 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 ! - - 100 100 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve 101 101 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze3u_f, ze3v_f, zua, zva … … 132 132 ! so that asselin contribution is removed at the same time 133 133 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) 136 136 END DO 137 137 ENDIF … … 152 152 !!$ Do we need a call to bdy_vol here?? 153 153 ! 154 IF( l_trddyn ) THEN ! prepare the atf trend computation + some diagnostics155 z1_2dt = 1._wp / (2. * rdt) ! Euler or leap-frog time step156 IF( neuler == 0 .AND. kt == nit000 ) z1_2dt = 1._wp / rdt157 !158 ! ! Kinetic energy and Conversion159 IF( ln_KE_trd ) CALL trd_dyn( ua, va, jpdyn_ken, kt )160 !161 IF( ln_dyn_trd ) THEN ! 3D output: total momentum trends162 zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt163 zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt164 CALL iom_put( "utrd_tot", zua ) ! total momentum trends, except the asselin timefilter154 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 165 165 CALL iom_put( "vtrd_tot", zva ) 166 166 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) 171 169 ENDIF 172 170 173 171 ! Time filter and swap of dynamics arrays 174 ! --------------------------------------- ---175 IF( neuler == 0 .AND. kt == nit000 ) THEN !* Euler at first time-step: only swap172 ! --------------------------------------- 173 IF( l_1st_euler ) THEN !== Euler at 1st time-step ==! (swap only) 176 174 DO jk = 1, jpkm1 177 175 un(:,:,jk) = ua(:,:,jk) ! un <-- ua 178 176 vn(:,:,jk) = va(:,:,jk) 179 177 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 182 179 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 !187 180 e3t_n(:,:,jk) = e3t_a(:,:,jk) 188 181 e3u_n(:,:,jk) = e3u_a(:,:,jk) 189 182 e3v_n(:,:,jk) = e3v_a(:,:,jk) 190 183 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 ! 196 188 ! ! =============! 197 189 IF( ln_linssh ) THEN ! Fixed volume ! … … 200 192 DO jj = 1, jpj 201 193 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) ) 204 196 ! 205 197 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity … … 213 205 ELSE ! Variable volume ! 214 206 ! ! ================! 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) 218 208 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) ) 220 210 END DO 221 211 ! Add volume filter correction: compatibility with tracer advection scheme 222 ! => time filter + conservation correction (only at the first level)223 zcoef = atfp * rdt * r1_rau0212 ! => time filter + conservation correction (only at the first level) 213 zcoef = rn_atfp * rn_Dt * r1_rho0 224 214 225 215 e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) … … 232 222 IF( jk <= nk_rnf(ji,jj) ) THEN 233 223 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) 235 225 ENDIF 236 END DO237 END DO238 END DO226 END DO 227 END DO 228 END DO 239 229 ELSE 240 230 e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( -rnf_b(:,:) + rnf(:,:))*tmask(:,:,1) 241 231 ENDIF 242 END 232 ENDIF 243 233 244 234 IF ( ln_isf ) THEN ! if ice shelf melting … … 253 243 END DO 254 244 END DO 255 END 245 ENDIF 256 246 ! 257 247 IF( ln_dynadv_vec ) THEN ! Asselin filter applied on velocity … … 262 252 DO jj = 1, jpj 263 253 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) ) 266 256 ! 267 257 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity … … 289 279 zve3b = e3v_b(ji,jj,jk) * vb(ji,jj,jk) 290 280 ! 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) 293 283 ! 294 284 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity … … 322 312 ENDIF 323 313 ! 324 ENDIF ! neuler =/0314 ENDIF ! end Leap-Frog time stepping 325 315 ! 326 316 ! 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 329 318 ! 330 319 ! … … 360 349 ENDIF 361 350 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 362 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt363 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt351 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * r1_Dt 352 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * r1_Dt 364 353 CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 365 354 ENDIF -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynspg.F90
r9598 r9939 66 66 !! ln_apr_dyn=T : the atmospheric pressure forcing is applied 67 67 !! as the gradient of the inverse barometer ssh: 68 !! apgu = - 1/r au0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb]69 !! apgv = - 1/r au0 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] 70 70 !! Note that as all external forcing a time averaging over a two rdt 71 71 !! period is used to prevent the divergence of odd and even time step. … … 74 74 ! 75 75 INTEGER :: ji, jj, jk ! dummy loop indices 76 REAL(wp) :: z 2dt, zg_2, zintp, zgrau0r, zld ! local scalars76 REAL(wp) :: zg_2, zintp, zg_rho0, zld ! local scalars 77 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpice 78 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv … … 110 110 ENDIF 111 111 ! 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 132 136 ENDIF 133 137 ENDIF … … 136 140 ALLOCATE( zpice(jpi,jpj) ) 137 141 zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 138 zg rau0r = - grav * r1_rau0139 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zg rau0r142 zg_rho0 = - grav * r1_rho0 143 zpice(:,:) = ( zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:) ) * zg_rho0 140 144 DO jj = 2, jpjm1 141 145 DO ji = fs_2, fs_jpim1 ! vector opt. … … 191 195 NAMELIST/namdyn_spg/ ln_dynspg_exp , ln_dynspg_ts, & 192 196 & ln_bt_fw, ln_bt_av , ln_bt_auto , & 193 & nn_ baro, rn_bt_cmax, nn_bt_flt, rn_bt_alpha197 & nn_e , rn_bt_cmax, nn_bt_flt, rn_bt_alpha 194 198 !!---------------------------------------------------------------------- 195 199 ! … … 227 231 WRITE(numout,*) 228 232 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' 230 234 IF( nspg == np_NO ) WRITE(numout,*) ' ==>>> No surface surface pressure gradient trend in momentum Eqs.' 231 235 ENDIF 232 236 ! 233 237 IF( nspg == np_TS ) THEN ! split-explicit scheme initialisation 234 CALL dyn_spg_ts_init ! do it first: set nn_ baroused to allocate some arrays later on238 CALL dyn_spg_ts_init ! do it first: set nn_e used to allocate some arrays later on 235 239 ENDIF 236 240 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynspg_exp.F90
r9598 r9939 49 49 !! momentum trend the surface pressure gradient : 50 50 !! (ua,va) = (ua,va) + (spgu,spgv) 51 !! where spgu = -1/r au0 d/dx(ps) = -g/e1u di( sshn )52 !! spgv = -1/r au0 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 ) 53 53 !! 54 54 !! ** Action : (ua,va) trend of horizontal velocity increased by -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynspg_ts.F90
r9598 r9939 1 1 MODULE dynspg_ts 2 3 !! Includes ROMS wd scheme with diagnostic outputs ; un and ua updates are commented out !4 5 2 !!====================================================================== 6 3 !! *** MODULE dynspg_ts *** … … 35 32 USE sbcisf ! ice shelf variable (fwfisf) 36 33 USE sbcapr ! surface boundary condition: atmospheric pressure 37 USE dynadv , ONLY: ln_dynadv_vec34 USE dynadv , ONLY : ln_dynadv_vec 38 35 USE dynvor ! vortivity scheme indicators 39 36 USE phycst ! physical constants … … 72 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv , vn_adv !: Advection vel. at "now" barocl. step 73 70 ! 74 INTEGER, SAVE :: icycle ! Number of barotropic sub-steps for each internal step nn_ baro <= 2.5 nn_baro75 REAL(wp),SAVE :: r dtbt ! Barotropic timestep71 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 76 73 ! 77 74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: wgtbtp1, wgtbtp2 ! 1st & 2nd weights used in time filtering of barotropic fields … … 84 81 REAL(wp) :: r1_4 = 0.25_wp ! 85 82 REAL(wp) :: r1_2 = 0.5_wp ! 86 83 87 84 !! * Substitutions 88 85 # include "vectopt_loop_substitute.h90" … … 102 99 ierr(:) = 0 103 100 ! 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) ) 105 102 ! 106 103 IF( ln_dynvor_een .OR. ln_dynvor_eeT ) & … … 151 148 INTEGER :: ikbu, iktu, noffset ! local integers 152 149 INTEGER :: ikbv, iktv ! - - 153 REAL(wp) :: r1_2dt_b, z2dt_bf ! local scalars150 INTEGER :: iwdg, jwdg, kwdg ! short-hand values for the indices of the output point 154 151 REAL(wp) :: zx1, zx2, zu_spg, zhura, z1_hu ! - - 155 152 REAL(wp) :: zy1, zy2, zv_spg, zhvra, z1_hv ! - - 156 153 REAL(wp) :: za0, za1, za2, za3 ! - - 157 154 REAL(wp) :: zmdi, zztmp , z1_ht ! - - 155 REAL(wp) :: zwdramp ! local scalar - only used if ln_wd_dl = .True. 156 REAL(wp) :: zload 158 157 REAL(wp), DIMENSION(jpi,jpj) :: zsshp2_e, zhf 159 158 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zu_trd, zu_frc, zssh_frc … … 163 162 REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v ! top/bottom stress at u- & v-points 164 163 ! 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 168 165 169 166 REAL(wp) :: zepsilon, zgamma ! - - … … 181 178 zwdramp = r_rn_wdmin1 ! simplest ramp 182 179 ! zwdramp = 1._wp / (rn_wdmin2 - rn_wdmin1) ! more general ramp 183 ! ! reciprocal of baroclinic time step184 IF( kt == nit000 .AND. neuler == 0 ) THEN ; z2dt_bf = rdt185 ELSE ; z2dt_bf = 2.0_wp * rdt186 ENDIF187 r1_2dt_b = 1.0_wp / z2dt_bf188 180 ! 189 181 ll_init = ln_bt_av ! if no time averaging, then no specific restart 190 182 ll_fw_start = .FALSE. 191 183 ! ! time offset in steps for bdy data update 192 IF( .NOT.ln_bt_fw ) THEN ; noffset = - nn_ baro184 IF( .NOT.ln_bt_fw ) THEN ; noffset = - nn_e 193 185 ELSE ; noffset = 0 194 186 ENDIF 195 187 ! 196 IF( kt == nit000 ) THEN !* initialisation 188 IF( kt == nit000 ) THEN !* initialisation 1st time-step 197 189 ! 198 190 IF(lwp) WRITE(numout,*) … … 201 193 IF(lwp) WRITE(numout,*) 202 194 ! 203 IF( neuler == 0 ) ll_init=.TRUE.204 ! 205 IF( ln_bt_fw .OR. neuler == 0) THEN195 IF( l_1st_euler ) ll_init = .TRUE. 196 ! 197 IF( ln_bt_fw .OR. l_1st_euler ) THEN 206 198 ll_fw_start =.TRUE. 207 199 noffset = 0 … … 212 204 ! Set averaging weights and cycle length: 213 205 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 214 213 ! 215 214 ENDIF … … 340 339 END SELECT 341 340 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 ! 350 342 ! ----------------------------------------------------------------------------- 351 343 ! Phase 1 : Coupling between general trend and barotropic estimates (1st step) … … 461 453 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) & 462 454 & / (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 ) ) 464 456 ELSE 465 457 zcpx(ji,jj) = 0._wp … … 538 530 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 539 531 IF( ln_wd_il ) THEN 540 zztmp = -1._wp / r dtbt532 zztmp = -1._wp / rDt_e 541 533 DO jj = 2, jpjm1 542 534 DO ji = fs_2, fs_jpim1 ! vector opt. … … 589 581 DO jj = 2, jpjm1 590 582 DO ji = fs_2, fs_jpim1 ! vector opt. 591 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_r au0 * utau(ji,jj) * r1_hu_n(ji,jj)592 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_r au0 * 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) 593 585 END DO 594 586 END DO 595 587 ELSE 596 zztmp = r1_r au0 * r1_2588 zztmp = r1_rho0 * r1_2 597 589 DO jj = 2, jpjm1 598 590 DO ji = fs_2, fs_jpim1 ! vector opt. … … 631 623 ! ! Surface net water flux and rivers 632 624 IF (ln_bt_fw) THEN 633 zssh_frc(:,:) = r1_r au0 * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )625 zssh_frc(:,:) = r1_rho0 * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 634 626 ELSE 635 zztmp = r1_r au0 * r1_2627 zztmp = r1_rho0 * r1_2 636 628 zssh_frc(:,:) = zztmp * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 637 629 & + fwfisf(:,:) + fwfisf_b(:,:) ) … … 820 812 ENDIF 821 813 #endif 822 IF( ln_wd_il ) CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, r dtbt)814 IF( ln_wd_il ) CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rDt_e) 823 815 824 816 IF ( ln_wd_dl ) THEN … … 866 858 END DO 867 859 END DO 868 ssha_e(:,:) = ( sshn_e(:,:) - r dtbt* ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:)860 ssha_e(:,:) = ( sshn_e(:,:) - rDt_e * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 869 861 870 862 CALL lbc_lnk( ssha_e, 'T', 1._wp ) … … 1070 1062 ENDIF 1071 1063 ! 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 1073 1068 IF( ln_wd_il ) THEN 1074 1069 DO jj = 2, jpjm1 … … 1077 1072 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 1078 1073 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) 1081 1076 END DO 1082 1077 END DO … … 1087 1082 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 1088 1083 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_spg1090 zwy(ji,jj) = (1._wp - rn_scal_load)* zv_spg1084 zwx(ji,jj) = zload * zu_spg 1085 zwy(ji,jj) = zload * zv_spg 1091 1086 END DO 1092 1087 END DO … … 1099 1094 DO ji = fs_2, fs_jpim1 ! vector opt. 1100 1095 ua_e(ji,jj) = ( un_e(ji,jj) & 1101 & + r dtbt* ( zwx(ji,jj) &1096 & + rDt_e * ( zwx(ji,jj) & 1102 1097 & + zu_trd(ji,jj) & 1103 1098 & + zu_frc(ji,jj) ) & … … 1105 1100 1106 1101 va_e(ji,jj) = ( vn_e(ji,jj) & 1107 & + r dtbt* ( zwy(ji,jj) &1102 & + rDt_e * ( zwy(ji,jj) & 1108 1103 & + zv_trd(ji,jj) & 1109 1104 & + zv_frc(ji,jj) ) & … … 1112 1107 !jth implicit bottom friction: 1113 1108 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 - r dtbt* zCdU_u(ji,jj) * hur_e(ji,jj))1115 va_e(ji,jj) = va_e(ji,jj) /(1.0 - r dtbt* 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)) 1116 1111 ENDIF 1117 1112 … … 1130 1125 1131 1126 ua_e(ji,jj) = ( hu_e(ji,jj) * un_e(ji,jj) & 1132 & + r dtbt* ( zhust_e(ji,jj) * zwx(ji,jj) &1127 & + rDt_e * ( zhust_e(ji,jj) * zwx(ji,jj) & 1133 1128 & + zhup2_e(ji,jj) * zu_trd(ji,jj) & 1134 1129 & + hu_n(ji,jj) * zu_frc(ji,jj) ) & … … 1136 1131 1137 1132 va_e(ji,jj) = ( hv_e(ji,jj) * vn_e(ji,jj) & 1138 & + r dtbt* ( zhvst_e(ji,jj) * zwy(ji,jj) &1133 & + rDt_e * ( zhvst_e(ji,jj) * zwy(ji,jj) & 1139 1134 & + zhvp2_e(ji,jj) * zv_trd(ji,jj) & 1140 1135 & + hv_n(ji,jj) * zv_frc(ji,jj) ) & … … 1203 1198 zwx(:,:) = un_adv(:,:) 1204 1199 zwy(:,:) = vn_adv(:,:) 1205 IF( .NOT. ( kt == nit000 .AND. neuler==0 )) THEN1206 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(:,:) ) 1208 1203 ! 1209 1204 ! 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(:,:)) 1212 1207 ELSE 1213 1208 un_bf(:,:) = 0._wp … … 1224 1219 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 1225 1220 DO jk=1,jpkm1 1226 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * r1_ 2dt_b1227 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * r1_ 2dt_b1221 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * r1_Dt 1222 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * r1_Dt 1228 1223 END DO 1229 1224 ELSE … … 1231 1226 DO jj = 1, jpjm1 1232 1227 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) ) 1239 1232 END DO 1240 1233 END DO … … 1242 1235 ! 1243 1236 DO jk=1,jpkm1 1244 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * r1_ 2dt_b1245 va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * r1_ 2dt_b1237 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 1246 1239 END DO 1247 1240 ! Save barotropic velocities not transport: … … 1305 1298 !! ** Purpose : Set time-splitting weights for temporal averaging (or not) 1306 1299 !!---------------------------------------------------------------------- 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 ! 1313 1305 INTEGER :: jic, jn, ji ! temporary integers 1314 1306 REAL(wp) :: za1, za2 1315 1307 !!---------------------------------------------------------------------- 1316 1308 ! 1317 1309 zwgt1(:) = 0._wp 1318 1310 zwgt2(:) = 0._wp 1319 1311 ! 1320 1312 ! 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) 1331 1321 SELECT CASE ( nn_bt_flt ) 1332 1333 1334 1335 1336 CASE( 1 ) ! Boxcar, width = nn_baro1337 DO jn = 1, 3*nn_baro1338 za1 = ABS(float(jn-jic))/float(nn_baro)1339 IF (za1 < 0.5_wp) THEN1340 1341 1342 1343 ENDDO1344 1345 CASE( 2 ) ! Boxcar, width = 2 * nn_baro1346 DO jn = 1, 3*nn_baro1347 za1 = ABS(float(jn-jic))/float(nn_baro)1348 IF (za1 < 1._wp) THEN1349 1350 1351 1352 ENDDO1353 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' ) 1354 1344 END SELECT 1355 1356 ELSE !No time averaging1345 ! 1346 ELSE !* No time averaging 1357 1347 zwgt1(jic) = 1._wp 1358 1348 jpit = jic 1359 1349 ENDIF 1360 1350 1361 ! Set secondary weights 1351 ! !== Set secondary weights ==! 1352 ! 1362 1353 DO jn = 1, jpit 1363 DO ji = jn, jpit1364 1365 END DO1354 DO ji = jn, jpit 1355 zwgt2(jn) = zwgt2(jn) + zwgt1(ji) 1356 END DO 1366 1357 END DO 1367 1358 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) ) 1371 1363 DO jn = 1, jpit 1372 zwgt1(jn) = zwgt1(jn) * za11373 zwgt2(jn) = zwgt2(jn) * za21364 zwgt1(jn) = zwgt1(jn) * za1 1365 zwgt2(jn) = zwgt2(jn) * za2 1374 1366 END DO 1375 1367 ! … … 1477 1469 1478 1470 ! 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) 1480 1472 1481 r dtbt = rdt / REAL( nn_baro, wp )1482 zcmax = zcmax * r dtbt1473 rDt_e = rn_Dt / REAL( nn_e , wp ) 1474 zcmax = zcmax * rDt_e 1483 1475 ! Print results 1484 1476 IF(lwp) WRITE(numout,*) … … 1486 1478 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 1487 1479 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 ' 1489 1481 IF(lwp) WRITE(numout,*) ' Max. courant number allowed: ', rn_bt_cmax 1490 1482 ELSE 1491 IF(lwp) WRITE(numout,*) ' ln_ts_auto=.false.: Use nn_ baro in namelist nn_baro = ', nn_baro1483 IF(lwp) WRITE(numout,*) ' ln_ts_auto=.false.: Use nn_e in namelist nn_e = ', nn_e 1492 1484 ENDIF 1493 1485 1494 1486 IF(ln_bt_av) THEN 1495 IF(lwp) WRITE(numout,*) ' ln_bt_av =.true. ==> Time averaging over nn_ barotime steps is on '1487 IF(lwp) WRITE(numout,*) ' ln_bt_av =.true. ==> Time averaging over nn_e time steps is on ' 1496 1488 ELSE 1497 1489 IF(lwp) WRITE(numout,*) ' ln_bt_av =.false. => No time averaging of barotropic variables ' … … 1513 1505 SELECT CASE ( nn_bt_flt ) 1514 1506 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' 1517 1509 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1, or 2' ) 1518 1510 END SELECT 1519 1511 ! 1520 1512 IF(lwp) WRITE(numout,*) ' ' 1521 IF(lwp) WRITE(numout,*) ' nn_ baro = ', nn_baro1522 IF(lwp) WRITE(numout,*) ' Barotropic time step [s] is :', rdtbt1523 IF(lwp) WRITE(numout,*) ' Maximum Courant number is :', zcmax1513 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 1524 1516 ! 1525 1517 IF(lwp) WRITE(numout,*) ' Time diffusion parameter rn_bt_alpha: ', rn_bt_alpha … … 1532 1524 ENDIF 1533 1525 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 !' ) 1535 1527 ENDIF 1536 1528 ! … … 1539 1531 ! 1540 1532 ! ! 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... 1541 1535 CALL ts_rst( nit000, 'READ' ) 1542 1536 ! … … 1548 1542 CALL iom_set_rstw_var_active('vn_bf') 1549 1543 ! 1550 IF ( .NOT.ln_bt_av) THEN1544 IF ( .NOT.ln_bt_av ) THEN 1551 1545 CALL iom_set_rstw_var_active('sshbb_e') 1552 1546 CALL iom_set_rstw_var_active('ubb_e') -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynzdf.F90
r9598 r9939 11 11 !!---------------------------------------------------------------------- 12 12 !! 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 13 15 !!---------------------------------------------------------------------- 14 16 USE oce ! ocean dynamics and tracers variables … … 26 28 USE in_out_manager ! I/O manager 27 29 USE lib_mpp ! MPP library 30 USE iom ! IOM library 28 31 USE prtctl ! Print control 29 32 USE timing ! Timing … … 67 70 INTEGER, INTENT(in) :: kt ! ocean time-step index 68 71 ! 69 INTEGER :: ji, jj, jk ! dummy loop indices70 INTEGER :: iku, ikv ! local integers71 REAL(wp) :: zzwi, ze3ua, z dt! local scalars72 REAL(wp) :: zzws, ze3va ! - -73 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwd, zws ! 3D workspace74 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 ! - - 75 78 !!--------------------------------------------------------------------- 76 79 ! … … 86 89 ENDIF 87 90 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 ! 92 94 ! 93 95 ! !* explicit top/bottom drag case … … 106 108 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity 107 109 DO jk = 1, jpkm1 108 ua(:,:,jk) = ( ub(:,:,jk) + r 2dt * ua(:,:,jk) ) * umask(:,:,jk)109 va(:,:,jk) = ( vb(:,:,jk) + r 2dt * va(:,:,jk) ) * vmask(:,:,jk)110 ua(:,:,jk) = ( ub(:,:,jk) + rDt * ua(:,:,jk) ) * umask(:,:,jk) 111 va(:,:,jk) = ( vb(:,:,jk) + rDt * va(:,:,jk) ) * vmask(:,:,jk) 110 112 END DO 111 113 ELSE ! applied on thickness weighted velocity 112 114 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) 117 117 END DO 118 118 ENDIF … … 133 133 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 134 134 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) / ze3ua136 va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va135 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 137 137 END DO 138 138 END DO … … 144 144 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 145 145 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) / ze3ua147 va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va146 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 148 148 END DO 149 149 END DO … … 153 153 ! !== Vertical diffusion on u ==! 154 154 ! 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) 159 158 DO jk = 1, jpkm1 160 159 DO jj = 2, jpjm1 161 160 DO ji = fs_2, fs_jpim1 ! vector opt. 162 161 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) 167 166 zwi(ji,jj,jk) = zzwi 168 167 zws(ji,jj,jk) = zzws … … 171 170 END DO 172 171 END DO 173 CASE DEFAULT ! iso-level lateral mixing172 CASE DEFAULT ! iso-level lateral mixing 174 173 DO jk = 1, jpkm1 175 174 DO jj = 2, jpjm1 176 175 DO ji = fs_2, fs_jpim1 ! vector opt. 177 176 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 = - z dt* ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) / ( ze3ua * e3uw_n(ji,jj,jk ) ) * wumask(ji,jj,jk )179 zzws = - z dt* ( 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) 180 179 zwi(ji,jj,jk) = zzwi 181 180 zws(ji,jj,jk) = zzws … … 186 185 END SELECT 187 186 ! 188 DO jj = 2, jpjm1 !* Surface boundary conditions189 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. 190 189 zwi(ji,jj,1) = 0._wp 191 190 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) … … 204 203 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 205 204 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) ) / ze3ua205 zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 207 206 END DO 208 207 END DO … … 213 212 iku = miku(ji,jj) ! ocean top level at u- and v-points 214 213 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) ) / ze3ua214 zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua 216 215 END DO 217 216 END DO … … 245 244 DO ji = fs_2, fs_jpim1 ! vector opt. 246 245 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) 249 247 END DO 250 248 END DO … … 272 270 ! !== Vertical diffusion on v ==! 273 271 ! 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) 278 275 DO jk = 1, jpkm1 279 276 DO jj = 2, jpjm1 280 277 DO ji = fs_2, fs_jpim1 ! vector opt. 281 278 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) 286 283 zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk ) 287 284 zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) … … 290 287 END DO 291 288 END DO 292 CASE DEFAULT ! iso-level lateral mixing289 CASE DEFAULT ! iso-level lateral mixing 293 290 DO jk = 1, jpkm1 294 291 DO jj = 2, jpjm1 295 292 DO ji = fs_2, fs_jpim1 ! vector opt. 296 293 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 = - z dt* ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) / ( ze3va * e3vw_n(ji,jj,jk ) ) * wvmask(ji,jj,jk )298 zzws = - z dt* ( 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) 299 296 zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk ) 300 297 zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) … … 305 302 END SELECT 306 303 ! 307 DO jj = 2, jpjm1 !* Surface boundary conditions308 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. 309 306 zwi(ji,jj,1) = 0._wp 310 307 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) … … 322 319 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 323 320 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) ) / ze3va321 zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - z2dt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va 325 322 END DO 326 323 END DO … … 330 327 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) 331 328 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) ) / ze3va329 zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va 333 330 END DO 334 331 END DO … … 362 359 DO ji = fs_2, fs_jpim1 ! vector opt. 363 360 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) 366 362 END DO 367 363 END DO … … 387 383 END DO 388 384 ! 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 392 393 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 393 394 DEALLOCATE( ztrdu, ztrdv ) … … 401 402 END SUBROUTINE dyn_zdf 402 403 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 403 506 !!============================================================================== 404 507 END MODULE dynzdf -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/sshwzv.F90
r9598 r9939 68 68 INTEGER, INTENT(in) :: kt ! time step 69 69 ! 70 INTEGER :: jk 71 REAL(wp) :: z 2dt, zcoef! local scalars70 INTEGER :: jk ! dummy loop indice 71 REAL(wp) :: z1_2rho0 ! local scalars 72 72 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv ! 2D workspace 73 73 !!---------------------------------------------------------------------- … … 81 81 ENDIF 82 82 ! 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 86 84 87 85 ! !------------------------------! 88 86 ! ! After Sea Surface Height ! 89 87 ! !------------------------------! 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 ) 93 90 94 91 CALL div_hor( kt ) ! Horizontal divergence … … 102 99 ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 103 100 ! 104 ssha(:,:) = ( sshb(:,:) - z2dt * ( zcoef* ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:)101 ssha(:,:) = ( sshb(:,:) - rDt * ( z1_2rho0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:) 105 102 ! 106 103 #if defined key_agrif … … 143 140 ! 144 141 INTEGER :: ji, jj, jk ! dummy loop indices 145 REAL(wp) :: z1_2dt ! local scalars146 142 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zhdiv 147 143 !!---------------------------------------------------------------------- … … 159 155 ! ! Now Vertical Velocity ! 160 156 ! !------------------------------! 161 z1_2dt = 1. / ( 2. * rdt ) ! set time step size (Euler/Leapfrog)162 IF( neuler == 0 .AND. kt == nit000 ) z1_2dt = 1. / rdt163 157 ! 164 158 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases … … 180 174 ! computation of w 181 175 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) 183 177 END DO 184 178 ! IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 … … 188 182 ! computation of w 189 183 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) 191 185 END DO 192 186 ENDIF … … 200 194 #if defined key_agrif 201 195 IF( .NOT. AGRIF_Root() ) THEN 202 IF ( (nbondi == 1).OR.(nbondi == 2)) wn(nlci-1 , : ,:) = 0.e0! east203 IF ( (nbondi == -1).OR.(nbondi == 2)) wn(2 , : ,:) = 0.e0! west204 IF ( (nbondj == 1).OR.(nbondj == 2)) wn(: ,nlcj-1 ,:) = 0.e0! north205 IF ( (nbondj == -1).OR.(nbondj == 2)) wn(: ,2 ,:) = 0.e0! south196 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 206 200 ENDIF 207 201 #endif … … 222 216 !! ** Method : - apply Asselin time fiter to now ssh (excluding the forcing 223 217 !! from the filter, see Leclair and Madec 2010) and swap : 224 !! sshn = ssha + atfp * ( sshb -2 sshn + ssha )225 !! - atfp * rdt * ( emp_b - emp ) / rau0218 !! sshn = ssha + rn_atfp * ( sshb -2 sshn + ssha ) 219 !! - rn_atfp * rn_Dt * ( emp_b - emp ) / rho0 226 220 !! sshn = ssha 227 221 !! … … 243 237 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 244 238 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 254 250 sshb(:,:) = sshb(:,:) - zcoef * ( emp_b(:,:) - emp (:,:) & 255 251 & - rnf_b(:,:) + rnf (:,:) & 256 252 & + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:) 257 253 ENDIF 258 sshn(:,:) = ssha(:,:) 254 sshn(:,:) = ssha(:,:) ! now <-- after 259 255 ENDIF 260 256 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/wet_dry.F90
r9168 r9939 117 117 118 118 119 SUBROUTINE wad_lmt( sshb1, sshemp, z2dt )119 SUBROUTINE wad_lmt( sshb1, sshemp, p2dt ) 120 120 !!---------------------------------------------------------------------- 121 121 !! *** ROUTINE wad_lmt *** … … 129 129 REAL(wp), DIMENSION(:,:), INTENT(inout) :: sshb1 !!gm DOCTOR names: should start with p ! 130 130 REAL(wp), DIMENSION(:,:), INTENT(in ) :: sshemp 131 REAL(wp) , INTENT(in ) :: z2dt131 REAL(wp) , INTENT(in ) :: p2dt 132 132 ! 133 133 INTEGER :: ji, jj, jk, jk1 ! dummy loop indices … … 220 220 & + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji, jj-1) , 0._wp) 221 221 ! 222 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp223 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) 224 224 ! 225 225 IF( zdep1 > zdep2 ) THEN 226 226 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 ) 229 229 ! flag if the limiter has been used but stop flagging if the only 230 230 ! changes have zeroed the coefficient since further iterations will … … 270 270 271 271 272 SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt )272 SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, pdt ) 273 273 !!---------------------------------------------------------------------- 274 274 !! *** ROUTINE wad_lmt *** … … 280 280 !! ** Action : - calculate flux limiter and W/D flag 281 281 !!---------------------------------------------------------------------- 282 REAL(wp) , INTENT(in ) :: rdtbt ! ocean time-step index282 REAL(wp) , INTENT(in ) :: pdt ! external mode time-step [s] 283 283 REAL(wp), DIMENSION(:,:), INTENT(inout) :: zflxu, zflxv, sshn_e, zssh_frc 284 284 ! 285 285 INTEGER :: ji, jj, jk, jk1 ! dummy loop indices 286 286 INTEGER :: jflag ! local integer 287 REAL(wp) :: z2dt288 287 REAL(wp) :: zcoef, zdep1, zdep2 ! local scalars 289 288 REAL(wp) :: zzflxp, zzflxn ! local scalars … … 298 297 jflag = 0 299 298 zdepwd = 50._wp ! maximum depth that ocean cells can have W/D processes 300 !301 z2dt = rdtbt302 299 ! 303 300 zflxp(:,:) = 0._wp … … 347 344 & + min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji, jj-1), 0._wp) 348 345 349 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp350 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) 351 348 352 349 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 ) 355 352 ! flag if the limiter has been used but stop flagging if the only 356 353 ! changes have zeroed the coefficient since further iterations will -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/FLO/flo4rk.F90
r9598 r9939 131 131 ! computation of Runge-Kutta factor 132 132 DO jfl = 1, jpnfl 133 zrkxfl(jfl,jind) = r dt*zufl(jfl)134 zrkyfl(jfl,jind) = r dt*zvfl(jfl)135 zrkzfl(jfl,jind) = r dt*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) 136 136 END DO 137 137 IF( jind /= 4 ) THEN -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/FLO/floblk.F90
r9598 r9939 234 234 ! test to know if the "age" of the float is not bigger than the 235 235 ! time step 236 IF( zagenewfl(jfl) > r dt ) THEN237 zttfl(jfl) = (r dt-zagefl(jfl)) / zvol238 zagenewfl(jfl) = r dt236 IF( zagenewfl(jfl) > rn_Dt ) THEN 237 zttfl(jfl) = (rn_Dt-zagefl(jfl)) / zvol 238 zagenewfl(jfl) = rn_Dt 239 239 ENDIF 240 240 … … 341 341 ifin = 1 342 342 DO jfl = 1, jpnfl 343 IF( zagefl(jfl) < r dt ) ifin = 0343 IF( zagefl(jfl) < rn_Dt ) ifin = 0 344 344 tpifl(jfl) = zgifl(jfl) + 0.5 345 345 tpjfl(jfl) = zgjfl(jfl) + 0.5 … … 348 348 ifin = 1 349 349 DO jfl = 1, jpnfl 350 IF( zagefl(jfl) < r dt ) ifin = 0350 IF( zagefl(jfl) < rn_Dt ) ifin = 0 351 351 tpifl(jfl) = zgifl(jfl) + 0.5 352 352 tpjfl(jfl) = zgjfl(jfl) + 0.5 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/FLO/flowri.F90
r9598 r9939 125 125 ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) 126 126 zsal (jfl) = tsn(iafloc,ibfloc,icfl,jp_sal) 127 zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*r au0127 zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0 128 128 129 129 ENDIF … … 145 145 ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) 146 146 zsal(jfl) = tsn(iafloc,ibfloc,icfl,jp_sal) 147 zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*r au0147 zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0 148 148 149 149 ENDIF … … 248 248 !------------------------------- 249 249 irec = INT( (kt-nn_it000+1)/nn_writefl ) +1 250 ztime = ( kt-nn_it000 + 1 ) * r dt250 ztime = ( kt-nn_it000 + 1 ) * rn_Dt 251 251 252 252 CALL flioputv( numflo , 'time_counter', ztime , start=(/irec/) ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ICB/icbini.F90
r9598 r9939 58 58 !! - setup either test icebergs or calving file 59 59 !!---------------------------------------------------------------------- 60 REAL(wp), INTENT(in) :: pdt ! iceberg time-step (r dt*nn_fsbc)60 REAL(wp), INTENT(in) :: pdt ! iceberg time-step (rn_Dt*nn_fsbc) 61 61 INTEGER , INTENT(in) :: kt ! time step number 62 62 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ICB/icbtrj.F90
r9598 r9939 69 69 !!---------------------------------------------------------------------- 70 70 71 !!gm we could probably use the daymod calculation here.... 72 !! ===>>> TO BE checked by someone 73 71 74 ! compute initial time step date 72 75 CALL ju2ymds( fjulday, iyear, imonth, iday, zsec ) … … 74 77 75 78 ! compute end time step date 76 zfjulday = fjulday + r dt / rday * REAL( nitend - nit000 + 1 , wp)79 zfjulday = fjulday + rn_Dt / rday * REAL( nitend - nit000 + 1 , wp) 77 80 IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday ) zfjulday = REAL(NINT(zfjulday),wp) ! avoid truncation error 78 81 CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/IOM/iom.F90
r9802 r9939 239 239 ! 240 240 ! end file definition 241 dtime%second = r dt241 dtime%second = rn_Dt 242 242 CALL xios_set_timestep( dtime ) 243 243 CALL xios_close_context_definition() … … 2358 2358 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 2359 2359 DO WHILE ( idx /= 0 ) 2360 cldate = iom_sdate( fjulday - r dt / rday )2360 cldate = iom_sdate( fjulday - rn_Dt / rday ) 2361 2361 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 2362 2362 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') … … 2365 2365 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 2366 2366 DO WHILE ( idx /= 0 ) 2367 cldate = iom_sdate( fjulday - r dt / rday, ldfull = .TRUE. )2367 cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. ) 2368 2368 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 2369 2369 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') … … 2372 2372 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 2373 2373 DO WHILE ( idx /= 0 ) 2374 cldate = iom_sdate( fjulday + r dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )2374 cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 2375 2375 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 2376 2376 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') … … 2379 2379 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 2380 2380 DO WHILE ( idx /= 0 ) 2381 cldate = iom_sdate( fjulday + r dt / 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. ) 2382 2382 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 2383 2383 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/LDF/ldfdyn.F90
r9598 r9939 408 408 zcmsmag = (rn_csmc/rpi)**2 ! (C_smag/pi)^2 409 409 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 * r dt )! upper limit stability factor scaling410 zstabf_up = rn_maxfac / ( 4._wp * zcmsmag * 2._wp * rn_Dt ) ! upper limit stability factor scaling 411 411 IF( ln_dynldf_blp ) zstabf_lo = ( 16._wp / 9._wp ) * zstabf_lo ! provide |U|L^3/12 lower limit instead 412 412 ! ! of |U|L^3/16 in blp case -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/LDF/ldftra.F90
r9737 r9939 852 852 ! 853 853 ! 854 zztmp = 0.5_wp * r au0 * rcp854 zztmp = 0.5_wp * rho0_rcp 855 855 IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 856 856 zw2d(:,:) = 0._wp -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/OBS/diaobs.F90
r9656 r9939 539 539 ENDIF 540 540 541 idaystp = NINT( rday / r dt )541 idaystp = NINT( rday / rn_Dt ) 542 542 543 543 !----------------------------------------------------------------------- … … 630 630 631 631 ENDIF 632 632 ! 633 633 END SUBROUTINE dia_obs 634 634 635 635 636 SUBROUTINE dia_obs_wri … … 651 652 !! ! 15-08 (M. Martin) Combined writing for prof and surf types 652 653 !!---------------------------------------------------------------------- 653 !! * Modules used654 654 USE obs_rot_vel ! Rotation of velocities 655 655 656 656 IMPLICIT NONE 657 657 658 !! * Local declarations659 658 INTEGER :: jtype ! Data set loop variable 660 659 INTEGER :: jo, jvar, jk 661 REAL(wp), DIMENSION(:), ALLOCATABLE :: & 662 & zu, & 663 & zv 660 REAL(wp), DIMENSION(:), ALLOCATABLE :: zu, zv 664 661 665 662 !----------------------------------------------------------------------- … … 771 768 !! ! 2014-09 (D. Lea) New generic routine now deals with arbitrary initial time of day 772 769 !!---------------------------------------------------------------------- 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 777 772 778 773 IMPLICIT NONE 779 774 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 785 778 INTEGER :: iyea ! date - (year, month, day, hour, minute) 786 779 INTEGER :: imon … … 805 798 !! Compute number of days + number of hours + min since initial time 806 799 !!---------------------------------------------------------------------- 807 zdayfrc = kstp * r dt / rday800 zdayfrc = kstp * rn_Dt / rday 808 801 zdayfrc = zdayfrc - aint(zdayfrc) 809 802 imin = imin + int( zdayfrc * 24 * 60 ) … … 816 809 iday=iday+1 817 810 END DO 818 iday = iday + kstp * r dt / rday811 iday = iday + kstp * rn_Dt / rday 819 812 820 813 !----------------------------------------------------------------------- … … 842 835 END SUBROUTINE calc_date 843 836 837 844 838 SUBROUTINE ini_date( ddobsini ) 845 839 !!---------------------------------------------------------------------- … … 859 853 !! ! 2014-09 (D. Lea) Change to call generic routine calc_date 860 854 !!---------------------------------------------------------------------- 861 862 855 IMPLICIT NONE 863 864 !! * Arguments865 REAL(KIND=dp), INTENT(OUT) :: ddobsini ! Initial date in YYYYMMDD.HHMMSS866 856 ! 857 REAL(KIND=dp), INTENT(out) :: ddobsini ! Initial date in YYYYMMDD.HHMMSS 858 !!---------------------------------------------------------------------- 859 ! 867 860 CALL calc_date( nit000 - 1, ddobsini ) 868 861 ! 869 862 END SUBROUTINE ini_date 863 870 864 871 865 SUBROUTINE fin_date( ddobsfin ) … … 1011 1005 END SUBROUTINE obs_setinterpopts 1012 1006 1007 !!====================================================================== 1013 1008 END MODULE diaobs -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/OBS/obs_prep.F90
r9598 r9939 610 610 !! ! 2010-05 (D. Lea) Fix in leap year calculation for NEMO vn3.2 611 611 !!---------------------------------------------------------------------- 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 620 615 INTEGER, INTENT(IN) :: kcycle ! Current cycle 621 616 INTEGER, INTENT(IN) :: kyea0 ! Initial date coordinates … … 632 627 & kobshou, & 633 628 & 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 ! 641 632 INTEGER :: jyea 642 633 INTEGER :: jmon … … 661 652 662 653 ! Intialize the number of time steps per day 663 idaystp = NINT( rday / r dt )654 idaystp = NINT( rday / rn_Dt ) 664 655 665 656 !--------------------------------------------------------------------- … … 731 722 732 723 ! Add in the number of time steps to the observation minute 733 zminstp = rmmss / r dt724 zminstp = rmmss / rn_Dt 734 725 zhoustp = rhhmm * zminstp 735 726 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/fldread.F90
r9807 r9939 180 180 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 181 181 IF( present(kit) ) THEN ! ignore kn_fsbc in this case 182 isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( r dt/REAL(nn_baro,wp) )182 isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rn_Dt/REAL(nn_e,wp) ) 183 183 ELSE ! middle of sbc time step 184 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * r dt) + it_offset * NINT(rdt)184 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rn_Dt) + it_offset * NINT(rn_Dt) 185 185 ENDIF 186 186 imf = SIZE( sd ) … … 213 213 CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit ) ! update after record informations 214 214 215 ! if kn_fsbc*r dt is larger than nfreqh (which is kind of odd),215 ! if kn_fsbc*rn_Dt is larger than nfreqh (which is kind of odd), 216 216 ! it is possible that the before value is no more the good one... we have to re-read it 217 217 ! if before is not the last record of the file currently opened and after is the first record to be read … … 234 234 IF( sd(jf)%ln_tint ) THEN 235 235 236 ! if kn_fsbc*r dt is larger than nfreqh (which is kind of odd),236 ! if kn_fsbc*rn_Dt is larger than nfreqh (which is kind of odd), 237 237 ! it is possible that the before value is no more the good one... we have to re-read it 238 238 ! if before record is not just just before the after record... … … 267 267 ! year/month/week/day file to be not present. If the run continue further than the current 268 268 ! year/month/week/day, next year/month/week/day file must exist 269 isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(r dt) ! second at the end of the run270 llstop = isecend > sd(jf)%nrec_a(2) 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 271 271 ! we suppose that the date of next file is next day (should be ok even for weekly files...) 272 272 CALL fld_clopn( sd(jf), nyear + COUNT((/llnxtyr /)) , & … … 485 485 ENDIF 486 486 IF( PRESENT(kt_offset) ) it_offset = kt_offset 487 IF( PRESENT(kit) ) THEN ; it_offset = ( kit + it_offset ) * NINT( r dt/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 ) 489 489 ENDIF 490 490 ! … … 563 563 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 564 564 ENDIF 565 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * r dt + REAL( it_offset, wp )! centrered in the middle of sbc time step566 ztmp = ztmp + 0.01 * r dt! avoid truncation error565 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 567 567 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 568 568 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcapr.F90
r9598 r9939 36 36 37 37 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) 39 39 40 40 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_apr ! structure of input fields (file informations, fields read) … … 100 100 ENDIF 101 101 ! 102 r1_ grau = 1.e0 / (grav * rau0)!* constant for optimization102 r1_rhog = 1._wp / (rho0*grav) !* constant for optimization 103 103 ! 104 104 ! !* control check … … 144 144 ! 145 145 ! !* 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) 147 147 apr (:,:) = sf_apr(1)%fnow(:,:,1) ! atmospheric pressure 148 148 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcblk.F90
r9767 r9939 225 225 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 226 226 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) * r dt) /= 0. ) &228 & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep r dt*nn_fsbc is NOT a submultiple of atmosphericforcing frequency.', &229 & ' This is not ideal. You should consider changing either r dt 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...' ) 230 230 231 231 END DO … … 323 323 ! 324 324 ! ! 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 ) 326 326 327 327 #if defined key_cice 328 IF( MOD( kt -1, nn_fsbc ) == 0 ) THEN328 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 329 329 qlw_ice(:,:,1) = sf(jp_qlw )%fnow(:,:,1) 330 330 IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) … … 504 504 ENDIF 505 505 506 zqla(:,:) = L_vap( zst(:,:)) * zevap(:,:) ! Latent Heat flux506 zqla(:,:) = L_vap( zst(:,:) ) * zevap(:,:) ! Latent Heat flux 507 507 508 508 … … 526 526 ! 527 527 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar 528 & - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus& ! remove latent melting heat for solid precip528 & - sf(jp_snow)%fnow(:,:,1) * rn_pfac * rLfus & ! remove latent melting heat for solid precip 529 529 & - zevap(:,:) * pst(:,:) * rcp & ! remove evap heat content at SST 530 530 & + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac & ! add liquid precip heat content at Tair 531 531 & * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & 532 532 & + 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 ) * cpic533 & * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi 534 534 qns(:,:) = qns(:,:) * tmask(:,:,1) 535 535 ! … … 643 643 !! ** Purpose : Compute the moist adiabatic lapse-rate. 644 644 !! => 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.html646 645 !! 647 646 !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) … … 652 651 ! 653 652 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 655 655 !!---------------------------------------------------------------------------------- 656 656 ! … … 659 659 zrv = pqa(ji,jj) / (1. - pqa(ji,jj)) 660 660 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) ) 662 662 END DO 663 663 END DO … … 792 792 REAL(wp) :: zst3 ! local variable 793 793 REAL(wp) :: zcoef_dqlw, zcoef_dqla ! - - 794 REAL(wp) :: zztmp , z1_lsub! - -794 REAL(wp) :: zztmp ! - - 795 795 REAL(wp) :: zfr1, zfr2 ! local variables 796 796 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_st ! inverse of surface temperature … … 868 868 869 869 ! --- 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 873 872 zevap (:,:) = rn_efac * ( emp(:,:) + tprecip(:,:) ) ! evaporation over ocean 874 873 … … 884 883 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip at Tair 885 884 & + 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 ) 887 886 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 ) 889 888 890 889 ! --- total solar and non solar fluxes --- ! … … 894 893 895 894 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 896 qprec_ice(:,:) = rhos n * ( ( 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 ) 897 896 898 897 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 899 898 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) ) 901 900 ! ! But we do not have Tice => consider it at 0degC => evap=0 902 901 END DO … … 971 970 CASE ( 1 , 2 ) 972 971 ! 973 zfac = 1._wp / ( rn_cnd_s + rc dic)972 zfac = 1._wp / ( rn_cnd_s + rcnd_i ) 974 973 zfac2 = EXP(1._wp) * 0.5_wp * zepsilon 975 974 zfac3 = 2._wp / zepsilon … … 978 977 DO jj = 1 , jpj 979 978 DO ji = 1, jpi 980 zhe = ( rn_cnd_s * phi(ji,jj,jl) + rc dic* phs(ji,jj,jl) ) * zfac ! Effective thickness981 IF( zhe >= zfac2 ) zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor979 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 982 981 END DO 983 982 END DO … … 990 989 ! -------------------------------------------------------------! 991 990 ! 992 zfac = rc dic* rn_cnd_s991 zfac = rcnd_i * rn_cnd_s 993 992 ! 994 993 DO jl = 1, jpl 995 994 DO jj = 1 , jpj 996 995 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) ) ) 1000 998 ztsu = ptsu(ji,jj,jl) ! Store current iteration temperature 1001 999 ztsu0 = ptsu(ji,jj,jl) ! Store initial surface temperature -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbccpl.F90
r9767 r9939 193 193 194 194 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) 196 196 197 197 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: nrcvinfo ! OASIS info argument … … 1100 1100 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 1101 1101 INTEGER :: ji, jj, jn ! dummy loop indices 1102 INTEGER :: isec ! number of seconds since nit000 (assuming r dt did not change since nit000)1102 INTEGER :: isec ! number of seconds since nit000 (assuming rn_Dt did not change since nit000) 1103 1103 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1104 1104 REAL(wp) :: zcoef ! temporary scalar … … 1114 1114 ! ! Receive all the atmos. fields (including ice information) 1115 1115 ! ! ======================================================= ! 1116 isec = ( kt - nit000 ) * NINT( r dt )! date of exchanges1116 isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges 1117 1117 DO jn = 1, jprcv ! received fields sent by the atmosphere 1118 1118 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) … … 1259 1259 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 1260 1260 1261 r1_ grau = 1.e0 / (grav * rau0) !* constant for optimization1262 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) 1263 1263 apr (:,:) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure 1264 1264 … … 1418 1418 zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 1419 1419 IF( srcv(jpr_snow )%laction ) THEN 1420 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus! energy for melting solid precipitation over the free ocean1420 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * rLfus ! energy for melting solid precipitation over the free ocean 1421 1421 ENDIF 1422 1422 ENDIF 1423 1423 ! 1424 IF( srcv(jpr_icb)%laction ) zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting1424 IF( srcv(jpr_icb)%laction ) zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove heat content associated to iceberg melting 1425 1425 ! 1426 1426 IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) … … 1811 1811 ! 1812 1812 ! --- 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 calving1814 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean1813 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 1815 1815 ! --- 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 melting1816 IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting 1817 1817 1818 1818 #if defined key_si3 … … 1823 1823 1824 1824 ! 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 ) 1826 1826 ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:) 1827 END WHERE1827 END WHERE 1828 1828 ! Heat content per unit mass of rain (J/kg) 1829 1829 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 1830 1830 1831 1831 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1832 zqprec_ice(:,:) = rhos n * ( zcptsnw(:,:) - lfus )1832 zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus ) 1833 1833 1834 1834 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1835 1835 DO jl = 1, jpl 1836 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic) but atm. does not take it into account1836 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * rcpi ) but atm. does not take it into account 1837 1837 END DO 1838 1838 … … 1840 1840 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn (:,:) & ! evap 1841 1841 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptrain(:,:) & ! liquid precip 1842 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus ) ! solid precip over ocean + snow melting1843 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) 1844 1844 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap 1845 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhos n! solid precip over ice1845 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhos ! solid precip over ice 1846 1846 1847 1847 ! --- total non solar flux (including evap/precip) --- ! … … 1875 1875 ! clem: this formulation is certainly wrong... but better than it was... 1876 1876 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1877 & - ( ziceld(:,:) * zsprecip(:,:) * lfus ) &! remove the latent heat flux of solid precip. melting1877 & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 1878 1878 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1879 1879 & - zemp_ice(:,:) ) * zcptn(:,:) … … 1892 1892 #endif 1893 1893 ! outputs 1894 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * lfus )! latent heat from calving1895 IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * lfus )! latent heat from icebergs melting1894 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 1896 1896 IF ( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1897 1897 IF ( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 1898 1898 & * 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 ) & 1901 1901 & * ( 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 ) & 1903 1903 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1904 1904 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. … … 2047 2047 !!---------------------------------------------------------------------- 2048 2048 ! 2049 isec = ( kt - nit000 ) * NINT( r dt ) ! date of exchanges2049 isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges 2050 2050 2051 2051 zfr_l(:,:) = 1.- fr_i(:,:) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcdcy.F90
r9598 r9939 88 88 89 89 ! When are we during the day (from 0 to 1) 90 zlo = ( REAL(nsec_day, wp) - 0.5_wp * r dt ) / rday91 zup = zlo + ( REAL(nn_fsbc, wp) * r dt ) / rday90 zlo = ( REAL(nsec_day, wp) - 0.5_wp * rn_Dt ) / rday 91 zup = zlo + ( REAL(nn_fsbc, wp) * rn_Dt ) / rday 92 92 ! 93 93 IF( nday_qsr == -1 ) THEN ! first time step only … … 187 187 END DO 188 188 ! 189 ztmp = rday / ( r dt * REAL(nn_fsbc, wp) )189 ztmp = rday / ( rn_Dt * REAL(nn_fsbc, wp) ) 190 190 rscal(:,:) = rscal(:,:) * ztmp 191 191 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcfwb.F90
r9598 r9939 123 123 ENDIF 124 124 ! ! Update fwfold if new year start 125 ikty = 365 * 86400 / r dt!!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 !!!!!!! 126 126 IF( MOD( kt, ikty ) == 0 ) THEN 127 127 a_fwb_b = a_fwb ! mean sea level taking into account the ice+snow 128 128 ! sum over the global domain 129 a_fwb = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_r au0 ) )129 a_fwb = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rho0 ) ) 130 130 a_fwb = a_fwb * 1.e+3 / ( area * rday * 365. ) ! convert in Kg/m3/s = mm/s 131 131 !!gm ! !!bug 365d year -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcice_cice.F90
r9598 r9939 13 13 USE dom_oce ! ocean space and time domain 14 14 USE domvvl 15 USE phycst , only : rcp, rau0, r1_rau0, rhosn, rhoic15 USE phycst , ONLY : rcp, rho0, r1_rho0, rhos, rhoi 16 16 USE in_out_manager ! I/O manager 17 17 USE iom, ONLY : iom_put,iom_use ! I/O manager library !!Joakim edit … … 222 222 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 223 223 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 224 snwice_mass (:,:) = ( rhos n * ztmp1(:,:) + rhoic* ztmp2(:,:) )224 snwice_mass (:,:) = ( rhos * ztmp1(:,:) + rhoi * ztmp2(:,:) ) 225 225 snwice_mass_b(:,:) = snwice_mass(:,:) 226 226 227 227 IF( .NOT.ln_rstart ) THEN 228 228 IF( ln_ice_embd ) THEN ! embedded sea-ice: deplete the initial ssh below sea-ice area 229 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_r au0230 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_r au0229 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rho0 230 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rho0 231 231 232 232 !!gm This should be put elsewhere.... (same remark for limsbc) … … 422 422 ! Freezing/melting potential 423 423 ! Calculated over NEMO leapfrog timestep (hence 2*dt) 424 nfrzmlt(:,:) = r au0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt )424 nfrzmlt(:,:) = rho0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt ) 425 425 426 426 ztmp(:,:) = nfrzmlt(:,:) … … 459 459 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 460 460 ! 461 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_r au0461 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rho0 462 462 ! 463 463 ! … … 644 644 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 645 645 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 646 snwice_mass (:,:) = ( rhos n * ztmp1(:,:) + rhoic* ztmp2(:,:) )646 snwice_mass (:,:) = ( rhos * ztmp1(:,:) + rhoi * ztmp2(:,:) ) 647 647 snwice_mass_b(:,:) = snwice_mass(:,:) 648 648 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcisf.F90
r9728 r9939 52 52 LOGICAL, PUBLIC :: l_isfcpl = .false. !: isf recieved from oasis 53 53 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] 55 55 REAL(wp), PUBLIC, SAVE :: rkappa = 1.54e-6_wp !: heat diffusivity through the ice-shelf [m2/s] 56 REAL(wp), PUBLIC, SAVE :: rho isf= 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] 57 57 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]59 58 60 59 !: Variable used in fldread to read the forcing file (nn_isf == 4 .OR. nn_isf == 3) … … 114 113 ! compute fwf and heat flux 115 114 IF( .NOT.l_isfcpl ) THEN ; CALL sbc_isf_cav (kt) 116 ELSE ; qisf(:,:) = fwfisf(:,:) * r lfusisf ! heatflux115 ELSE ; qisf(:,:) = fwfisf(:,:) * rLfus ! heat flux 117 116 ENDIF 118 117 ! … … 127 126 fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) 128 127 ENDIF 129 qisf(:,:) = fwfisf(:,:) * r lfusisf! heat flux128 qisf(:,:) = fwfisf(:,:) * rLfus ! heat flux 130 129 stbl(:,:) = soce 131 130 ! … … 137 136 fwfisf(:,:) = -sf_fwfisf(1)%fnow(:,:,1) ! fwf 138 137 ENDIF 139 qisf(:,:) = fwfisf(:,:) * r lfusisf! heat flux138 qisf(:,:) = fwfisf(:,:) * rLfus ! heat flux 140 139 stbl(:,:) = soce 141 140 ! … … 144 143 ! compute tsc due to isf 145 144 ! 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 / r au0).145 ! WARNING water add at temp = 0C, need to add a correction term (fwfisf * tfreez / rho0). 147 146 ! compute freezing point beneath ice shelf (or top cell if nn_isf = 3) 148 147 DO jj = 1,jpj … … 153 152 CALL eos_fzp( stbl(:,:), zt_frz(:,:), zdep(:,:) ) 154 153 155 risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_r au0_rcp - fwfisf(:,:) * zt_frz(:,:) * r1_rau0 !154 risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rho0_rcp - fwfisf(:,:) * zt_frz(:,:) * r1_rho0 ! 156 155 risf_tsc(:,:,jp_sal) = 0.0_wp 157 156 … … 160 159 ! output 161 160 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) * r au0 * 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) 163 162 IF( iom_use('qlatisf' ) ) CALL iom_put( 'qlatisf' , qisf(:,:) ) ! isf latent heat 164 163 IF( iom_use('fwfisf' ) ) CALL iom_put( 'fwfisf' , fwfisf(:,:) ) ! isf mass flux (opposite sign) … … 308 307 qisf (:,:) = 0._wp ; fwfisf (:,:) = 0._wp 309 308 risf_tsc(:,:,:) = 0._wp ; fwfisf_b(:,:) = 0._wp 310 ! 311 ! define isf tbl tickness, top and bottom indice312 SELECT CASE ( nn_isf )309 310 SELECT CASE ( nn_isf ) ! define isf tbl tickness, top and bottom indice 311 ! 313 312 CASE ( 1 ) 314 313 IF(lwp) WRITE(numout,*) … … 452 451 ! 2. ------------Net heat flux and fresh water flux due to the ice shelf 453 452 ! For those corresponding to zonal boundary 454 qisf(ji,jj) = - r au0 * 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 & 455 454 & * r1_e1e2t(ji,jj) * tmask(ji,jj,jk) 456 455 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) 458 457 fwfisf(ji,jj) = fwfisf(ji,jj) * ( soce / stbl(ji,jj) ) 459 458 !add to salinity trend … … 500 499 zlamb1 =-0.0564_wp 501 500 zlamb2 = 0.0773_wp 502 zlamb3 =-7.8633e-8 * grav * r au0501 zlamb3 =-7.8633e-8 * grav * rho0 503 502 ELSE ! linearisation from table 4 (Asay-Davis et al., 2015) 504 503 zlamb1 =-0.0573_wp 505 504 zlamb2 = 0.0832_wp 506 zlamb3 =-7.53e-8 * grav * r au0505 zlamb3 =-7.53e-8 * grav * rho0 507 506 ENDIF 508 507 ! … … 526 525 DO jj = 1, jpj 527 526 DO ji = 1, jpi 528 zhtflx(ji,jj) = zgammat(ji,jj)*rcp*r au0*(ttbl(ji,jj)-zfrz(ji,jj))529 zfwflx(ji,jj) = - zhtflx(ji,jj) /rlfusisf527 zhtflx(ji,jj) = zgammat(ji,jj)*rcp*rho0*(ttbl(ji,jj)-zfrz(ji,jj)) 528 zfwflx(ji,jj) = - zhtflx(ji,jj) * r1_Lfus 530 529 END DO 531 530 END DO … … 544 543 DO ji = 1, jpi 545 544 ! compute coeficient to solve the 2nd order equation 546 zeps1 = rcp*r au0*zgammat(ji,jj)547 zeps2 = r lfusisf*rau0*zgammas(ji,jj)548 zeps3 = rho isf*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) 549 548 zeps4 = zlamb2+zlamb3*risfdep(ji,jj) 550 549 zeps6 = zeps4-ttbl(ji,jj) … … 567 566 ! zhtflx is upward heat flux (out of ocean) 568 567 ! compute the upward water and heat flux (eq. 28 and eq. 29) 569 zfwflx(ji,jj) = r au0 * zgammas(ji,jj) * (zsfrz-stbl(ji,jj)) / MAX(zsfrz,zeps)570 zhtflx(ji,jj) = zgammat(ji,jj) * r au0 * 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) ) 571 570 END DO 572 571 END DO … … 890 889 DO jk = ikt, ikb - 1 891 890 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) + ( fwfisf(ji,jj) + fwfisf_b(ji,jj) ) & 892 & * r1_hisf_tbl(ji,jj) * r1_r au0 * zfact891 & * r1_hisf_tbl(ji,jj) * r1_rho0 * zfact 893 892 END DO 894 893 ! level partially include in ice shelf boundary layer 895 894 phdivn(ji,jj,ikb) = phdivn(ji,jj,ikb) + ( fwfisf(ji,jj) & 896 & + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_r au0 * zfact * ralpha(ji,jj)895 & + fwfisf_b(ji,jj) ) * r1_hisf_tbl(ji,jj) * r1_rho0 * zfact * ralpha(ji,jj) 897 896 END DO 898 897 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcmod.F90
r9656 r9939 177 177 ! 178 178 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( r dt , 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' ) 182 182 ENDIF 183 183 ! !** check option consistency … … 288 288 ! SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 289 289 IF( nn_components /= jp_iam_nemo ) THEN 290 IF( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(r dt)291 IF( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(r dt)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) 292 292 ! 293 293 IF(lwp)THEN … … 306 306 ENDIF 307 307 ! 308 IF( MOD( rday, REAL(nn_fsbc, wp) * r dt ) /= 0 ) &308 IF( MOD( rday, REAL(nn_fsbc, wp) * rn_Dt ) /= 0 ) & 309 309 & CALL ctl_warn( 'sbc_init : nn_fsbc is NOT a multiple of the number of time steps in a day' ) 310 310 ! 311 IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(r dt) ) < 8 ) &311 IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(rn_Dt) ) < 8 ) & 312 312 & CALL ctl_warn( 'sbc_init : diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 313 313 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcrnf.F90
r9727 r9939 116 116 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required 117 117 ! 118 IF( MOD( kt -1, nn_fsbc ) == 0 ) THEN118 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 119 119 ! 120 120 IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt … … 122 122 ! ! set temperature & salinity content of runoffs 123 123 IF( ln_rnf_tem ) THEN ! use runoffs temperature data 124 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_r au0124 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rho0 125 125 CALL eos_fzp( sss_m(:,:), ztfrz(:,:) ) 126 126 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_r au0127 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rho0 128 128 END WHERE 129 129 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_r au0 - rnf(:,:) * rlfusisf * r1_rau0_rcp130 rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rho0 - rnf(:,:) * rLfus * r1_rho0_rcp 131 131 END WHERE 132 132 ELSE ! use SST as runoffs temperature 133 133 !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_r au0134 rnf_tsc(:,:,jp_tem) = MAX(sst_m(:,:),0.0_wp) * rnf(:,:) * r1_rho0 135 135 ENDIF 136 136 ! ! use runoffs salinity data 137 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_r au0137 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rho0 138 138 ! ! else use S=0 for runoffs (done one for all in the init) 139 139 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) * r au0 * 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) 141 141 ENDIF 142 142 ! … … 198 198 DO ji = 1, jpi 199 199 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_r au0 / 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) 201 201 END DO 202 202 END DO … … 211 211 ! ! apply the runoff input flow 212 212 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_r au0 / 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) 214 214 END DO 215 215 END DO … … 218 218 ELSE !== runoff put only at the surface ==! 219 219 h_rnf (:,:) = e3t_n (:,:,1) ! update h_rnf to be depth of top box 220 phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_r au0 / e3t_n(:,:,1)220 phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rho0 / e3t_n(:,:,1) 221 221 ENDIF 222 222 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcssm.F90
r9598 r9939 106 106 frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 107 107 ! ! ---------------------------------------- ! 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 ! 109 109 ! ! ---------------------------------------- ! 110 110 ssu_m(:,:) = 0._wp ! reset to zero ocean mean sbc fields … … 135 135 136 136 ! ! ---------------------------------------- ! 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 ! 138 138 ! ! ---------------------------------------- ! 139 139 zcoef = 1. / REAL( nn_fsbc, wp ) … … 263 263 CALL iom_set_rstw_var_active('frq_m') 264 264 ENDIF 265 265 ! 266 266 END SUBROUTINE sbc_ssm_init 267 267 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbctide.F90
r9598 r9939 48 48 !!---------------------------------------------------------------------- 49 49 50 IF( nsec_day == NINT(0.5_wp * r dt) .OR. kt == nit000 ) THEN ! start a new day50 IF( nsec_day == NINT(0.5_wp * rn_Dt) .OR. kt == nit000 ) THEN ! start a new day 51 51 ! 52 52 IF( kt == nit000 )THEN … … 72 72 ! Temporarily set nsec_day to beginning of day. 73 73 nsec_day_orig = nsec_day 74 IF ( nsec_day /= NINT(0.5_wp * r dt) ) THEN75 kt_tide = kt - (nsec_day - 0.5_wp * r dt)/rdt76 nsec_day = NINT(0.5_wp * r dt)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) 77 77 ELSE 78 78 kt_tide = kt -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/tideini.F90
r9598 r9939 20 20 PUBLIC 21 21 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 !: 26 26 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 !: ??? 37 38 38 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntide !: 39 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntide !: ??? 39 40 40 41 !!---------------------------------------------------------------------- … … 52 53 CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname 53 54 INTEGER :: ios ! Local integer output status for namelist read 54 ! 55 !! 55 56 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, clname57 & ln_tide_ramp, rn_load, rn_ramp, clname 57 58 !!---------------------------------------------------------------------- 58 59 ! … … 76 77 WRITE(numout,*) ' Apply astronomical potential ln_tide_pot = ', ln_tide_pot 77 78 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 78 80 WRITE(numout,*) ' Read load potential from file ln_read_load = ', ln_read_load 79 81 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]' 82 83 ENDIF 83 84 ELSE 84 rn_ scal_load = 0._wp85 85 rn_load = 0._wp 86 ! 86 87 IF(lwp) WRITE(numout,*) 87 88 IF(lwp) WRITE(numout,*) 'tide_init : tidal components not used (ln_tide = F)' … … 92 93 CALL tide_init_Wave 93 94 ! 94 nb_harmo =095 nb_harmo = 0 95 96 DO jk = 1, jpmax_harmo 96 97 DO ji = 1,jpmax_harmo … … 108 109 IF( ln_scal_load.AND.ln_read_load ) & 109 110 & CALL ctl_stop('Choose between ln_scal_load and ln_read_load') 110 IF( ln_tide_ramp.AND.((nitend-nit000+1)*r dt/rday < rdttideramp) ) &111 & CALL ctl_stop('r dttideramp must be lower than run duration')112 IF( ln_tide_ramp.AND.(r dttideramp<0.) ) &113 & CALL ctl_stop('r dttideramp 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') 114 115 ! 115 116 ALLOCATE( ntide(nb_harmo) ) … … 123 124 END DO 124 125 ! 125 ALLOCATE( omega_tide(nb_harmo), v0tide 126 & utide (nb_harmo), ftide 126 ALLOCATE( omega_tide(nb_harmo), v0tide(nb_harmo), & 127 & utide (nb_harmo), ftide (nb_harmo) ) 127 128 kt_tide = nit000 128 129 ! 129 IF (.NOT.ln_scal_load ) rn_scal_load = 0._wp130 IF (.NOT.ln_scal_load ) rn_load = 0._wp 130 131 ! 131 132 END SUBROUTINE tide_init -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/updtide.F90
r9598 r9939 6 6 !! History : 9.0 ! 07 (O. Le Galloudec) Original code 7 7 !!---------------------------------------------------------------------- 8 !! upd_tide : update tidal potential 8 9 9 !!---------------------------------------------------------------------- 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 16 18 17 19 IMPLICIT NONE … … 37 39 !! ** Action : pot_astro actronomical potential 38 40 !!---------------------------------------------------------------------- 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) 44 45 ! 46 INTEGER :: ji, jj, jk ! dummy loop indices 45 47 INTEGER :: joffset ! local integer 46 INTEGER :: ji, jj, jk ! dummy loop indices47 48 REAL(wp) :: zt, zramp ! local scalar 48 49 REAL(wp), DIMENSION(nb_harmo) :: zwt … … 50 51 ! 51 52 ! ! tide pulsation at model time step (or sub-time-step) 52 zt = ( kt - kt_tide ) * r dt53 zt = ( kt - kt_tide ) * rn_Dt 53 54 ! 54 55 joffset = 0 … … 56 57 ! 57 58 IF( PRESENT( kit ) ) THEN 58 zt = zt + ( kit + joffset - 1 ) * r dt / REAL( nn_baro, wp )59 zt = zt + ( kit + joffset - 1 ) * rn_Dt / REAL( nn_e, wp ) 59 60 ELSE 60 zt = zt + joffset * r dt61 zt = zt + joffset * rn_Dt 61 62 ENDIF 62 63 ! … … 69 70 ! 70 71 IF( ln_tide_ramp ) THEN ! linear increase if asked 71 zt = ( kt - nit000 ) * r dt72 IF( PRESENT( kit ) ) zt = zt + ( kit + joffset -1) * r dt / 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 ) 74 75 pot_astro(:,:) = zramp * pot_astro(:,:) 75 76 ENDIF -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/eosbn2.F90
r9757 r9939 190 190 !! *** ROUTINE eos_insitu *** 191 191 !! 192 !! ** Purpose : Compute the in situ density (ratio rho/r au0) from192 !! ** Purpose : Compute the in situ density (ratio rho/rho0) from 193 193 !! potential temperature and salinity using an equation of state 194 194 !! selected in the nameos namelist 195 195 !! 196 !! ** Method : prd(t,s,z) = ( rho(t,s,z) - r au0 ) / rau0196 !! ** Method : prd(t,s,z) = ( rho(t,s,z) - rho0 ) / rho0 197 197 !! with prd in situ density anomaly no units 198 198 !! t TEOS10: CT or EOS80: PT Celsius … … 200 200 !! z depth meters 201 201 !! rho in situ density kg/m^3 202 !! r au0 reference density kg/m^3202 !! rho0 reference density kg/m^3 203 203 !! 204 204 !! ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z). … … 209 209 !! 210 210 !! 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) ) / r au0211 !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rho0 212 212 !! linear case function of T only: rn_alpha<>0, other coefficients = 0 213 213 !! linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0 … … 268 268 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 269 269 ! 270 prd(ji,jj,jk) = ( zn * r1_r au0 - 1._wp ) * ztm ! density anomaly (masked)270 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 271 271 ! 272 272 END DO … … 288 288 & - rn_nu * zt * zs 289 289 ! 290 prd(ji,jj,jk) = zn * r1_r au0 * ztm ! density anomaly (masked)290 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 291 291 END DO 292 292 END DO … … 306 306 !! *** ROUTINE eos_insitu_pot *** 307 307 !! 308 !! ** Purpose : Compute the in situ density (ratio rho/r au0) and the308 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 309 309 !! potential volumic mass (Kg/m3) from potential temperature and 310 310 !! salinity fields using an equation of state selected in the … … 388 388 prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface 389 389 ! 390 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_r au0 - 1._wp ) ! density anomaly (masked)390 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rho0 - 1._wp ) ! density anomaly (masked) 391 391 END DO 392 392 prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos … … 432 432 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 433 433 ! 434 prd(ji,jj,jk) = ( zn * r1_r au0 - 1._wp ) * ztm ! density anomaly (masked)434 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 435 435 END DO 436 436 END DO … … 451 451 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 452 452 & - rn_nu * zt * zs 453 prhop(ji,jj,jk) = ( r au0 + zn ) * ztm453 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 454 454 ! ! density anomaly (masked) 455 455 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 456 prd(ji,jj,jk) = zn * r1_r au0 * ztm456 prd(ji,jj,jk) = zn * r1_rho0 * ztm 457 457 ! 458 458 END DO … … 473 473 !! *** ROUTINE eos_insitu_2d *** 474 474 !! 475 !! ** Purpose : Compute the in situ density (ratio rho/r au0) from475 !! ** Purpose : Compute the in situ density (ratio rho/rho0) from 476 476 !! potential temperature and salinity using an equation of state 477 477 !! selected in the nameos namelist. * 2D field case … … 528 528 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 529 529 ! 530 prd(ji,jj) = zn * r1_r au0 - 1._wp ! unmasked in situ density anomaly530 prd(ji,jj) = zn * r1_rho0 - 1._wp ! unmasked in situ density anomaly 531 531 ! 532 532 END DO … … 548 548 & - rn_nu * zt * zs 549 549 ! 550 prd(ji,jj) = zn * r1_r au0 ! unmasked in situ density anomaly550 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 551 551 ! 552 552 END DO … … 616 616 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 617 617 ! 618 pab(ji,jj,jk,jp_tem) = zn * r1_r au0 * ztm618 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 619 619 ! 620 620 ! beta … … 637 637 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 638 638 ! 639 pab(ji,jj,jk,jp_sal) = zn / zs * r1_r au0 * ztm639 pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 640 640 ! 641 641 END DO … … 654 654 ! 655 655 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 656 pab(ji,jj,jk,jp_tem) = zn * r1_r au0 * ztm ! alpha656 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 657 657 ! 658 658 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 659 pab(ji,jj,jk,jp_sal) = zn * r1_r au0 * ztm ! beta659 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 660 660 ! 661 661 END DO … … 729 729 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 730 730 ! 731 pab(ji,jj,jp_tem) = zn * r1_r au0731 pab(ji,jj,jp_tem) = zn * r1_rho0 732 732 ! 733 733 ! beta … … 750 750 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 751 751 ! 752 pab(ji,jj,jp_sal) = zn / zs * r1_r au0752 pab(ji,jj,jp_sal) = zn / zs * r1_rho0 753 753 ! 754 754 ! … … 768 768 ! 769 769 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 770 pab(ji,jj,jp_tem) = zn * r1_r au0 ! alpha770 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 771 771 ! 772 772 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 773 pab(ji,jj,jp_sal) = zn * r1_r au0 ! beta773 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 774 774 ! 775 775 END DO … … 841 841 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 842 842 ! 843 pab(jp_tem) = zn * r1_r au0843 pab(jp_tem) = zn * r1_rho0 844 844 ! 845 845 ! beta … … 862 862 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 863 863 ! 864 pab(jp_sal) = zn / zs * r1_r au0864 pab(jp_sal) = zn / zs * r1_rho0 865 865 ! 866 866 ! … … 873 873 ! 874 874 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 875 pab(jp_tem) = zn * r1_r au0 ! alpha875 pab(jp_tem) = zn * r1_rho0 ! alpha 876 876 ! 877 877 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 878 pab(jp_sal) = zn * r1_r au0 ! beta878 pab(jp_sal) = zn * r1_rho0 ! beta 879 879 ! 880 880 CASE DEFAULT … … 1104 1104 !! ** Method : PE is defined analytically as the vertical 1105 1105 !! primitive of EOS times -g integrated between 0 and z>0. 1106 !! pen is the nonlinear bsq-PE anomaly: pen = ( PE - r au0 gz ) / rau0 gz - rd1106 !! pen is the nonlinear bsq-PE anomaly: pen = ( PE - rho0 gz ) / rho0 gz - rd 1107 1107 !! = 1/z * /int_0^z rd dz - rd 1108 1108 !! where rd is the density anomaly (see eos_rhd function) 1109 1109 !! ab_pe are partial derivatives of PE anomaly with respect to T and S: 1110 !! ab_pe(1) = - 1/(r au0 gz) * dPE/dT + drd/dT = - d(pen)/dT1111 !! ab_pe(2) = 1/(r au0 gz) * dPE/dS + drd/dS = d(pen)/dS1110 !! 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 1112 1112 !! 1113 1113 !! ** Action : - pen : PE anomaly given at T-points … … 1156 1156 zn = ( zn2 * zh + zn1 ) * zh + zn0 1157 1157 ! 1158 ppen(ji,jj,jk) = zn * zh * r1_r au0 * ztm1158 ppen(ji,jj,jk) = zn * zh * r1_rho0 * ztm 1159 1159 ! 1160 1160 ! alphaPE non-linear anomaly … … 1171 1171 zn = ( zn2 * zh + zn1 ) * zh + zn0 1172 1172 ! 1173 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_r au0 * ztm1173 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 1174 1174 ! 1175 1175 ! betaPE non-linear anomaly … … 1186 1186 zn = ( zn2 * zh + zn1 ) * zh + zn0 1187 1187 ! 1188 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_r au0 * ztm1188 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 1189 1189 ! 1190 1190 END DO … … 1201 1201 zh = gdept_n(ji,jj,jk) ! depth in meters at t-point 1202 1202 ztm = tmask(ji,jj,jk) ! tmask 1203 zn = 0.5_wp * zh * r1_r au0 * ztm1203 zn = 0.5_wp * zh * r1_rho0 * ztm 1204 1204 ! ! Potential Energy 1205 1205 ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn … … 1248 1248 IF(lwm) WRITE( numond, nameos ) 1249 1249 ! 1250 r au0 = 1026._wp !: volumic mass of reference [kg/m3]1250 rho0 = 1026._wp !: volumic mass of reference [kg/m3] 1251 1251 rcp = 3991.86795711963_wp !: heat capacity [J/K] 1252 1252 ! … … 1657 1657 WRITE(numout,*) ' ==>>> use of simplified eos: ' 1658 1658 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] / r au0'1659 WRITE(numout,*) ' + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS] / rho0' 1660 1660 WRITE(numout,*) ' with the following coefficients :' 1661 1661 WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a0 … … 1676 1676 END SELECT 1677 1677 ! 1678 r au0_rcp = rau0 * rcp1679 r1_r au0 = 1._wp / rau01678 rho0_rcp = rho0 * rcp 1679 r1_rho0 = 1._wp / rho0 1680 1680 r1_rcp = 1._wp / rcp 1681 r1_r au0_rcp = 1._wp / rau0_rcp1681 r1_rho0_rcp = 1._wp / rho0_rcp 1682 1682 ! 1683 1683 IF(lwp) THEN … … 1694 1694 IF(lwp) WRITE(numout,*) 1695 1695 IF(lwp) WRITE(numout,*) ' Associated physical constant' 1696 IF(lwp) WRITE(numout,*) ' volumic mass of reference r au0 = ', rau0 , ' kg/m^3'1697 IF(lwp) WRITE(numout,*) ' 1. / r au0 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' 1698 1698 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin' 1699 IF(lwp) WRITE(numout,*) ' r au0 * rcp rau0_rcp = ', rau0_rcp1700 IF(lwp) WRITE(numout,*) ' 1. / ( r au0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp1699 IF(lwp) WRITE(numout,*) ' rho0 * rcp rho0_rcp = ', rho0_rcp 1700 IF(lwp) WRITE(numout,*) ' 1. / ( rho0 * rcp ) r1_rho0_rcp = ', r1_rho0_rcp 1701 1701 ! 1702 1702 END SUBROUTINE eos_init -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traadv.F90
r9598 r9939 87 87 INTEGER :: jk ! dummy loop index 88 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! 3D workspace 89 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: ztrdt, ztrds89 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd 90 90 !!---------------------------------------------------------------------- 91 91 ! 92 92 IF( ln_timing ) CALL timing_start('tra_adv') 93 !94 ! ! set time step95 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 ENDIF98 93 ! 99 94 ! !== effective transport ==! … … 138 133 ! 139 134 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(:,:,:,:) 143 137 ENDIF 144 138 ! … … 146 140 ! 147 141 CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order 148 CALL tra_adv_cen ( kt, nit000, 'TRA', 142 CALL tra_adv_cen ( kt, nit000, 'TRA', zun, zvn, zwn , tsn, tsa, jpts, nn_cen_h, nn_cen_v ) 149 143 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 150 CALL tra_adv_fct ( kt, nit000, 'TRA', r 2dt, 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 ) 151 145 CASE ( np_MUS ) ! MUSCL 152 CALL tra_adv_mus ( kt, nit000, 'TRA', r 2dt, 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 ) 153 147 CASE ( np_UBS ) ! UBS 154 CALL tra_adv_ubs ( kt, nit000, 'TRA', r 2dt, 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 ) 155 149 CASE ( np_QCK ) ! QUICKEST 156 CALL tra_adv_qck ( kt, nit000, 'TRA', r 2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )150 CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 157 151 ! 158 152 END SELECT … … 160 154 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 161 155 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,:) 164 157 END DO 165 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrd t)166 CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrd s)167 DEALLOCATE( ztrd t, 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 ) 168 161 ENDIF 169 162 ! ! print mean trends (used for debugging) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traadv_fct.F90
r9598 r9939 20 20 USE diaptr ! poleward transport diagnostics 21 21 USE diaar5 ! AR5 diagnostics 22 USE phycst , ONLY : rau0_rcp23 22 ! 24 23 USE in_out_manager ! I/O manager … … 131 130 zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj ,jk,jn) ) 132 131 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 133 139 END DO 134 140 END DO … … 141 147 zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 142 148 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 143 153 END DO 144 154 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trabbc.F90
r9598 r9939 64 64 !! ocean bottom can be computed once and is added to the temperature 65 65 !! trend juste above the bottom at each time step: 66 !! ta = ta + Qsf / (r au0 rcp e3T) for k= mbkt66 !! ta = ta + Qsf / (rho0 rcp e3T) for k= mbkt 67 67 !! Where Qsf is the geothermal heat flux. 68 68 !! … … 76 76 ! 77 77 INTEGER :: ji, jj ! dummy loop indices 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrd t! 3D workspace78 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrd ! 3D workspace 79 79 !!---------------------------------------------------------------------- 80 80 ! … … 82 82 ! 83 83 IF( l_trdtra ) THEN ! Save the input temperature trend 84 ALLOCATE( ztrd t(jpi,jpj,jpk) )85 ztrd t(:,:,:) = tsa(:,:,:,jp_tem)84 ALLOCATE( ztrd(jpi,jpj,jpk) ) 85 ztrd(:,:,:) = tsa(:,:,:,jp_tem) 86 86 ENDIF 87 87 ! ! Add the geothermal trend on temperature … … 95 95 ! 96 96 IF( l_trdtra ) THEN ! Send the trend for diagnostics 97 ztrd t(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)98 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrd t)99 DEALLOCATE( ztrd t)97 ztrd(:,:,:) = tsa(:,:,:,jp_tem) - ztrd(:,:,:) 98 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrd ) 99 DEALLOCATE( ztrd ) 100 100 ENDIF 101 101 ! … … 157 157 ALLOCATE( qgh_trd0(jpi,jpj) ) ! allocation 158 158 ! 159 SELECT CASE ( nn_geoflx ) ! geothermal heat flux / (r auO * Cp)159 SELECT CASE ( nn_geoflx ) ! geothermal heat flux / (rhoO * Cp) 160 160 ! 161 161 CASE ( 1 ) !* constant flux 162 162 IF(lwp) WRITE(numout,*) ' ==>>> constant heat flux = ', rn_geoflx_cst 163 qgh_trd0(:,:) = r1_r au0_rcp * rn_geoflx_cst163 qgh_trd0(:,:) = r1_rho0_rcp * rn_geoflx_cst 164 164 ! 165 165 CASE ( 2 ) !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 … … 178 178 179 179 CALL fld_read( nit000, 1, sf_qgh ) ! Read qgh data 180 qgh_trd0(:,:) = r1_r au0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2180 qgh_trd0(:,:) = r1_rho0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2 181 181 ! 182 182 CASE DEFAULT -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trabbl.F90
r9598 r9939 103 103 INTEGER, INTENT( in ) :: kt ! ocean time-step 104 104 ! 105 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: ztrdt, ztrds105 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrd 106 106 !!---------------------------------------------------------------------- 107 107 ! … … 109 109 ! 110 110 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(:,:,:,:) 114 113 ENDIF 115 114 … … 143 142 144 143 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 ) 150 148 ENDIF 151 149 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tradmp.F90
r9598 r9939 94 94 INTEGER :: ji, jj, jk, jn ! dummy loop indices 95 95 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts_dta 96 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd ts96 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd 97 97 !!---------------------------------------------------------------------- 98 98 ! … … 100 100 ! 101 101 IF( l_trdtra ) THEN !* Save ta and sa trends 102 ALLOCATE( ztrd ts(jpi,jpj,jpk,jpts) )103 ztrd ts(:,:,:,:) = tsa(:,:,:,:)102 ALLOCATE( ztrd(jpi,jpj,jpk,jpts) ) 103 ztrd(:,:,:,:) = tsa(:,:,:,:) 104 104 ENDIF 105 105 ! !== input T-S data at kt ==! … … 150 150 ! 151 151 IF( l_trdtra ) THEN ! trend diagnostic 152 ztrd ts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:)153 CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrd ts(:,:,:,jp_tem) )154 CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrd ts(:,:,:,jp_sal) )155 DEALLOCATE( ztrd ts)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 ) 156 156 ENDIF 157 157 ! ! Control print -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traldf.F90
r9598 r9939 55 55 INTEGER, INTENT( in ) :: kt ! ocean time-step index 56 56 !! 57 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: ztrdt, ztrds57 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrd ! 4D workspace 58 58 !!---------------------------------------------------------------------- 59 59 ! … … 61 61 ! 62 62 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(:,:,:,:) 66 65 ENDIF 67 66 ! … … 78 77 ! 79 78 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 ) 85 83 ENDIF 86 84 ! !* print mean trends (used for debugging) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traldf_iso.F90
r9779 r9939 108 108 REAL(wp) :: zmsku, zahu_w, zabe1, zcof1, zcoef3 ! local scalars 109 109 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 ! - - 111 111 REAL(wp), DIMENSION(jpi,jpj) :: zdkt, zdk1t, z2d 112 112 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdit, zdjt, zftu, zftv, ztfw … … 127 127 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 128 128 & 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 ENDIF134 z1_2dt = 1._wp / z2dt135 129 ! 136 130 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) … … 191 185 DO ji = 1, fs_jpim1 192 186 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_2dt187 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 195 189 END DO 196 190 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traldf_triad.F90
r9598 r9939 85 85 INTEGER :: ip,jp,kp ! dummy loop indices 86 86 INTEGER :: ierr ! local integer 87 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 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 ! - - 90 90 ! 91 91 REAL(wp) :: zslope_skew, zslope_iso, zslope2, zbu, zbv … … 110 110 l_hst = .FALSE. 111 111 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. 119 116 ENDIF 120 z1_2dt = 1._wp / z2dt121 117 ! 122 118 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) … … 202 198 DO ji = 1, fs_jpim1 203 199 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_2dt200 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 206 202 END DO 207 203 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tramle.F90
r9598 r9939 41 41 42 42 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 /r au0 where rho_c is defined in zdfmld43 REAL(wp) :: rb_c ! ML buoyancy criteria = g rho_c /rho0 where rho_c is defined in zdfmld 44 44 REAL(wp) :: rc_f ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_mle=1 case 45 45 … … 115 115 zc = e3t_n(ji,jj,jk) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 116 116 zmld(ji,jj) = zmld(ji,jj) + zc 117 zbm (ji,jj) = zbm (ji,jj) + zc * (r au0 - rhop(ji,jj,jk) ) * r1_rau0117 zbm (ji,jj) = zbm (ji,jj) + zc * (rho0 - rhop(ji,jj,jk) ) * r1_rho0 118 118 zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp 119 119 END DO … … 302 302 IF( ln_mle ) THEN ! MLE initialisation 303 303 ! 304 rb_c = grav * rn_rho_c_mle / rau0! Mixed Layer buoyancy criteria304 rb_c = grav * rn_rho_c_mle / rho0 ! Mixed Layer buoyancy criteria 305 305 IF(lwp) WRITE(numout,*) 306 306 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 65 65 LOGICAL :: l_bottom_reached, l_column_treated 66 66 REAL(wp) :: zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 67 REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw , z1_r2dt67 REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw 68 68 REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp ! acceptance criteria for neutrality (N2==0) 69 69 REAL(wp), DIMENSION( jpk ) :: zvn2 ! vertical profile of N2 at 1 given point... … … 71 71 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zn2 ! N^2 72 72 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zab ! alpha and beta 73 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: ztrdt, ztrds ! 3D workspace73 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrd ! 4D workspace 74 74 ! 75 75 LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is … … 82 82 IF( MOD( kt, nn_npc ) == 0 ) THEN 83 83 ! 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(:,:,:,:) 88 87 ENDIF 89 88 ! … … 301 300 ! 302 301 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 ) 309 306 ENDIF 310 307 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tranxt.F90
r9598 r9939 90 90 INTEGER :: ji, jj, jk, jn ! dummy loop indices 91 91 REAL(wp) :: zfact ! local scalars 92 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds92 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd ! 4D workspace 93 93 !!---------------------------------------------------------------------- 94 94 ! … … 111 111 IF( ln_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 112 112 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 123 116 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 124 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrd t)125 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrd s)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) ) 126 119 ENDIF 127 120 ! total trend for the non-time-filtered variables. 128 zfact = 1.0 / r dt121 zfact = 1.0 / rn_Dt 129 122 ! 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) 145 137 DO jn = 1, jpts 146 138 DO jk = 1, jpkm1 … … 150 142 IF (l_trdtra .AND. .NOT. ln_linssh ) THEN ! Zero Asselin filter contribution must be explicitly written out since for vvl 151 143 ! ! 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) ) 156 147 END IF 157 148 ! 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. ) 168 157 ! 169 158 ENDIF 170 159 ! 171 160 IF( l_trdtra .AND. ln_linssh ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 172 zfact = 1._wp / r2dt173 161 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) ) 179 166 END IF 180 IF( l_trdtra ) DEALLOCATE( ztrd t , ztrds)167 IF( l_trdtra ) DEALLOCATE( ztrd ) 181 168 ! 182 169 ! ! control print … … 227 214 ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn) ! time laplacian on tracers 228 215 ! 229 ptb(ji,jj,jk,jn) = ztn + atfp * ztd! ptb <-- filtered ptn216 ptb(ji,jj,jk,jn) = ztn + rn_atfp * ztd ! ptb <-- filtered ptn 230 217 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 231 218 END DO … … 238 225 239 226 240 SUBROUTINE tra_nxt_vvl( kt, kit000, p 2dt, 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 ) 241 228 !!---------------------------------------------------------------------- 242 229 !! *** ROUTINE tra_nxt_vvl *** … … 247 234 !! ** Method : - Apply a thickness weighted Asselin time filter on now fields. 248 235 !! - 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 ] ) 251 238 !! tn = ta 252 239 !! … … 255 242 INTEGER , INTENT(in ) :: kt ! ocean time-step index 256 243 INTEGER , INTENT(in ) :: kit000 ! first time step index 257 REAL(wp) , INTENT(in ) :: p 2dt! time-step244 REAL(wp) , INTENT(in ) :: pdt ! time-step 258 245 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 259 246 INTEGER , INTENT(in ) :: kjpt ! number of tracers … … 289 276 IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) ) THEN 290 277 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 297 285 DO jk = 1, jpkm1 298 286 DO jj = 2, jpjm1 … … 309 297 ztc_d = ztc_a - 2. * ztc_n + ztc_b 310 298 ! 311 ze3t_f = ze3t_n + atfp * ze3t_d312 ztc_f = ztc_n + atfp * ztc_d299 ze3t_f = ze3t_n + rn_atfp * ze3t_d 300 ztc_f = ztc_n + rn_atfp * ztc_d 313 301 ! 314 302 IF( jk == mikt(ji,jj) ) THEN ! first level -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/traqsr.F90
r9598 r9939 87 87 !! I(k) = Qsr*( rn_abs*EXP(z(k)/rn_si0) + (1.-rn_abs)*EXP(z(k)/rn_si1) ) 88 88 !! The temperature trend associated with the solar radiation penetration 89 !! is given by : zta = 1/e3t dk[ I ] / (r au0*Cp)89 !! is given by : zta = 1/e3t dk[ I ] / (rho0*Cp) 90 90 !! At the bottom, boudary condition for the radiation is no flux : 91 91 !! all heat which has not been absorbed in the above levels is put … … 112 112 REAL(wp) :: zlogc, zlogc2, zlogc3 113 113 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zekb, zekg, zekr 114 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrd t114 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrd 115 115 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d 116 116 !!---------------------------------------------------------------------- … … 125 125 ! 126 126 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 127 ALLOCATE( ztrd t(jpi,jpj,jpk) )128 ztrd t(:,:,:) = tsa(:,:,:,jp_tem)127 ALLOCATE( ztrd(jpi,jpj,jpk) ) 128 ztrd(:,:,:) = tsa(:,:,:,jp_tem) 129 129 ENDIF 130 130 ! … … 133 133 ! !-----------------------------------! 134 134 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 137 136 IF(lwp) WRITE(numout,*) ' nit000-1 qsr tracer content forcing field read in the restart file' 138 137 z1_2 = 0.5_wp … … 154 153 ! 155 154 DO jk = 1, nksr 156 qsr_hc(:,:,jk) = r1_r au0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )155 qsr_hc(:,:,jk) = r1_rho0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 157 156 END DO 158 157 ! … … 234 233 DO jj = 2, jpjm1 235 234 DO ji = fs_2, fs_jpim1 236 qsr_hc(ji,jj,jk) = r1_r au0_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) ) 237 236 END DO 238 237 END DO … … 243 242 CASE( np_2BD ) !== 2-bands fluxes ==! 244 243 ! 245 zz0 = rn_abs * r1_r au0_rcp ! surface equi-partition in 2-bands246 zz1 = ( 1. - rn_abs ) * r1_r au0_rcp244 zz0 = rn_abs * r1_rho0_rcp ! surface equi-partition in 2-bands 245 zz1 = ( 1. - rn_abs ) * r1_rho0_rcp 247 246 DO jk = 1, nksr ! solar heat absorbed at T-point in the top 400m 248 247 DO jj = 2, jpjm1 … … 270 269 DO jj = 2, jpjm1 271 270 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_r au0_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) ) 273 272 ELSE ; fraqsr_1lev(ji,jj) = 1._wp 274 273 ENDIF … … 281 280 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 282 281 DO jk = nksr, 1, -1 283 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * r au0_rcp282 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp 284 283 END DO 285 284 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation … … 295 294 ! 296 295 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 297 ztrd t(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)298 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrd t)299 DEALLOCATE( ztrd t)296 ztrd(:,:,:) = tsa(:,:,:,jp_tem) - ztrd(:,:,:) 297 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrd ) 298 DEALLOCATE( ztrd ) 300 299 ENDIF 301 300 ! ! print mean trends (used for debugging) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trasbc.F90
r9598 r9939 78 78 INTEGER :: ikt, ikb ! local integers 79 79 REAL(wp) :: zfact, z1_e3t, zdep, ztim ! local scalar 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds80 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd ! 4D workspace 81 81 !!---------------------------------------------------------------------- 82 82 ! … … 89 89 ENDIF 90 90 ! 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(:,:,:,:) 95 94 ENDIF 96 95 ! … … 98 97 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 99 98 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 100 qsr(:,:) = 0._wp 99 qsr(:,:) = 0._wp ! qsr set to zero 101 100 ENDIF 102 101 … … 127 126 IF ( ll_wd ) THEN ! If near WAD point limit the flux for now 128 127 IF ( sshn(ji,jj) + ht_0(ji,jj) > 2._wp * rn_wdmin1 ) THEN 129 sbc_tsc(ji,jj,jp_tem) = r1_r au0_rcp * qns(ji,jj) ! non solar heat flux128 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 130 129 ELSE IF ( sshn(ji,jj) + ht_0(ji,jj) > rn_wdmin1 ) THEN 131 sbc_tsc(ji,jj,jp_tem) = r1_r au0_rcp * qns(ji,jj) &130 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) & 132 131 & * tanh ( 5._wp * ( ( sshn(ji,jj) + ht_0(ji,jj) - rn_wdmin1 ) * r_rn_wdmin1 ) ) 133 132 ELSE … … 135 134 ENDIF 136 135 ELSE 137 sbc_tsc(ji,jj,jp_tem) = r1_r au0_rcp * qns(ji,jj) ! non solar heat flux136 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 138 137 ENDIF 139 138 140 sbc_tsc(ji,jj,jp_sal) = r1_r au0 * sfx(ji,jj) ! salt flux due to freezing/melting139 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 141 140 END DO 142 141 END DO … … 144 143 DO jj = 2, jpj !==>> add concentration/dilution effect due to constant volume cell 145 144 DO ji = fs_2, fs_jpim1 ! vector opt. 146 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_r au0 * emp(ji,jj) * tsn(ji,jj,1,jp_tem)147 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_r au0 * 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) 148 147 END DO 149 148 END DO !==>> output c./d. term … … 272 271 273 272 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 ) 279 277 ENDIF 280 278 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trazdf.F90
r9598 r9939 52 52 INTEGER, INTENT(in) :: kt ! ocean time-step index 53 53 ! 54 INTEGER :: jk ! Dummy loop indices55 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace54 INTEGER :: jk, jts ! Dummy loop indices 55 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrd ! 4D workspace 56 56 !!--------------------------------------------------------------------- 57 57 ! … … 64 64 ENDIF 65 65 ! 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(:,:,:,:) 68 69 ENDIF 69 70 ! 70 IF( l_trdtra ) THEN !* Save ta and sa trends71 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )72 ztrdt(:,:,:) = tsa(:,:,:,jp_tem)73 ztrds(:,:,:) = tsa(:,:,:,jp_sal)74 ENDIF75 !76 71 ! !* compute lateral mixing trend and add it to the general trend 77 CALL tra_zdf_imp( kt, nit000, 'TRA', r 2dt, tsb, tsa, jpts )72 CALL tra_zdf_imp( kt, nit000, 'TRA', rDt, tsb, tsa, jpts ) 78 73 79 74 !!gm WHY here ! and I don't like that ! … … 85 80 86 81 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 87 DO j k = 1, jpkm188 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 92 87 END DO 93 88 !!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. ) 95 90 !!gm 96 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrd t)97 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrd s)98 DEALLOCATE( ztrd t , 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 ) 99 94 ENDIF 100 95 ! ! print mean trends (used for debugging) … … 180 175 DO jj = 2, jpjm1 181 176 DO ji = fs_2, fs_jpim1 ! vector opt. 182 !!gm BUG I think, use e3w_a instead of e3w_n, not sure of that183 177 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w_n(ji,jj,jk ) 184 178 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 142 142 ! ! wind stress trends 143 143 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) ) 144 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * r au0 )145 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * r au0 )144 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rho0 ) 145 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rho0 ) 146 146 CALL iom_put( "utrd_tau", z2dx ) 147 147 CALL iom_put( "vtrd_tau", z2dy ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdglo.F90
r9598 r9939 75 75 INTEGER :: ji, jj, jk ! dummy loop indices 76 76 INTEGER :: ikbu, ikbv ! local integers 77 REAL(wp):: zvm, zvt, zvs, z1_2r au0 ! local scalars77 REAL(wp):: zvm, zvt, zvs, z1_2rho0 ! local scalars 78 78 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 79 79 !!---------------------------------------------------------------------- … … 132 132 ! 133 133 IF( ktrd == jpdyn_zdf ) THEN ! zdf trend: compute separately the surface forcing trend 134 z1_2r au0 = 0.5_wp / rau0134 z1_2rho0 = 0.5_wp / rho0 135 135 DO jj = 1, jpjm1 136 136 DO ji = 1, jpim1 137 137 zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 138 & * z1_2r au0 * e1e2u(ji,jj)138 & * z1_2rho0 * e1e2u(ji,jj) 139 139 zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 140 & * z1_2r au0 * e1e2v(ji,jj)140 & * z1_2rho0 * e1e2v(ji,jj) 141 141 umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 142 142 vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs … … 150 150 ! ! 151 151 ! IF( ln_drgimp ) THEN ! implicit drag case: compute separately the bottom friction 152 ! z1_2r au0 = 0.5_wp / rau0152 ! z1_2rho0 = 0.5_wp / rho0 153 153 ! DO jj = 1, jpjm1 154 154 ! DO ji = 1, jpim1 … … 211 211 CALL eos( tsn, rhd, rhop ) ! now potential density 212 212 213 zcof = 0.5_wp / r au0 ! Density flux at w-point213 zcof = 0.5_wp / rho0 ! Density flux at w-point 214 214 zkz(:,:,1) = 0._wp 215 215 DO jk = 2, jpk … … 217 217 END DO 218 218 219 zcof = 0.5_wp / r au0 ! Density flux at u and v-points219 zcof = 0.5_wp / rho0 ! Density flux at u and v-points 220 220 DO jk = 1, jpkm1 221 221 DO jj = 1, jpjm1 … … 363 363 9546 FORMAT(' 0 < horizontal diffusion : ', e20.13) 364 364 9547 FORMAT(' 0 < vertical diffusion : ', e20.13) 365 9548 FORMAT(' pressure gradient u2 = - 1/r au0 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) 366 366 ! 367 367 ! Save potential to kinetic energy conversion for next time step -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdken.F90
r9598 r9939 103 103 DO jj = 2, jpj 104 104 DO ji = 2, jpi 105 zke(ji,jj,jk) = 0.5_wp * r au0 *( 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) & 106 106 & + un(ji-1,jj,jk) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk) & 107 107 & + vn(ji,jj ,jk) * pvtrd(ji,jj ,jk) * bv(ji,jj ,jk) & … … 127 127 DO jj = 2, jpj 128 128 DO ji = 2, jpi 129 zke2d(ji,jj) = r1_r au0 * 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) & 130 130 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1) 131 131 END DO … … 184 184 ! 185 185 CALL ken_p2k( kt , zke ) 186 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -r au*g*w186 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rho*g*w 187 187 ! 188 188 END SELECT … … 197 197 !! ** Purpose : compute rate of conversion from potential to kinetic energy 198 198 !! 199 !! ** Method : - compute conv defined as -r au*g*w on T-grid points199 !! ** Method : - compute conv defined as -rho*g*w on T-grid points 200 200 !! 201 201 !! ** Work only for full steps and partial steps (ln_hpg_zco or ln_hpg_zps) … … 211 211 ! 212 212 ! Local constant initialization 213 zcoef = - r au0 * grav * 0.5_wp213 zcoef = - rho0 * grav * 0.5_wp 214 214 215 215 ! Surface value (also valid in partial step case) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdtra.F90
r9598 r9939 238 238 !!---------------------------------------------------------------------- 239 239 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 ENDIF243 244 240 ! ! 3D output of tracers trends using IOM interface 245 241 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt ) … … 249 245 250 246 ! ! Potential ENergy trends 251 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r 2dt )247 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, rDt ) 252 248 253 249 ! ! Mixed layer trends for active tracers … … 282 278 CASE ( jptra_atf ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_atf, '3D' ) ! asselin time filter (last trend) 283 279 ! 284 CALL trd_mxl( kt, r 2dt )! trends: Mixed-layer (output)280 CALL trd_mxl( kt, rDt ) ! trends: Mixed-layer (output) 285 281 END SELECT 286 282 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRD/trdvor.F90
r9598 r9939 105 105 DO jj = 2, jpjm1 ! wind stress trends 106 106 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) * r au0 )108 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * r au0 )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 ) 109 109 END DO 110 110 END DO … … 385 385 ! III.1 compute total trend 386 386 ! ------------------------ 387 zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * r dt )387 zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * rn_Dt ) 388 388 vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean 389 389 … … 504 504 ENDIF 505 505 #if defined key_diainstant 506 zsto = nwrite *rdt506 zsto = nwrite * rn_Dt 507 507 clop = "inst("//TRIM(clop)//")" 508 508 #else 509 zsto = r dt509 zsto = rn_Dt 510 510 clop = "ave("//TRIM(clop)//")" 511 511 #endif 512 zout = nn_trd *rdt512 zout = nn_trd * rn_Dt 513 513 514 514 IF(lwp) WRITE(numout,*) ' netCDF initialization' … … 516 516 ! II.2 Compute julian date from starting date of the run 517 517 ! ------------------------ 518 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian )518 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 519 519 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 520 520 IF(lwp) WRITE(numout,*)' ' … … 528 528 IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam 529 529 CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi, & ! Horizontal grid : glamt and gphit 530 & 1, jpj, nit000-1, zjulian, r dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )530 & 1, jpj, nit000-1, zjulian, rn_Dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set ) 531 531 CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 ) ! surface 532 532 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/USR/usrdef_sbc.F90
r9598 r9939 88 88 89 89 ! current day (in hours) since january the 1st of the current year 90 ztime = REAL( kt ) * r dt / (rmmss * rhhmm) &! total incrementation (in hours)90 ztime = REAL( kt ) * rn_Dt / (rmmss * rhhmm) & ! total incrementation (in hours) 91 91 & - (nyear - 1) * rjjhh * zyydd ! minus years since beginning of experiment (in hours) 92 92 … … 155 155 !accumulates days of previous months of this year 156 156 ! day (in hours) since january the 1st 157 ztime = FLOAT( kt ) * rdt / (rmmss * rhhmm) &! incrementation in hour158 & - (nyear - 1) * rjjhh * zyydd ! - nber of hours the precedent years157 ztime = REAL( kt ) * rn_Dt / (rmmss * rhhmm) & ! incrementation in hour 158 & - (nyear - 1) * rjjhh * zyydd ! - nber of hours the precedent years 159 159 ztimemax = ((5.*30.)+21.)* 24. ! 21th june in hours 160 160 ztimemin = ztimemax + rjjhh * zyydd / 2 ! 21th december in hours -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfddm.F90
r9598 r9939 7 7 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 8 8 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 9 !! 3.6 ! 2013-04 (G. Madec, F. Roquet) zr aucompute locally using interpolation of alpha & beta9 !! 3.6 ! 2013-04 (G. Madec, F. Roquet) zrho compute locally using interpolation of alpha & beta 10 10 !! 4.0 ! 2017-04 (G. Madec) remove CPP ddm key & avm at t-point only 11 11 !!---------------------------------------------------------------------- … … 79 79 REAL(wp) :: zavft, zavfs ! - - 80 80 REAL(wp) :: zavdt, zavds ! - - 81 REAL(wp), DIMENSION(jpi,jpj) :: zr au, zmsks, zmskf, zmskd1, zmskd2, zmskd381 REAL(wp), DIMENSION(jpi,jpj) :: zrho, zmsks, zmskf, zmskd1, zmskd2, zmskd3 82 82 !!---------------------------------------------------------------------- 83 83 ! … … 91 91 !!gm and many acces in memory 92 92 93 DO jj = 1, jpj !== R=zr au= (alpha / beta) (dk[t] / dk[s]) ==!93 DO jj = 1, jpj !== R=zrho = (alpha / beta) (dk[t] / dk[s]) ==! 94 94 DO ji = 1, jpi 95 95 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & … … 105 105 zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 106 106 IF( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 107 zr au(ji,jj) = MAX( 1.e-20, zdt / zds ) ! only retains positive value of zrau107 zrho(ji,jj) = MAX( 1.e-20, zdt / zds ) ! only retains positive value of zrho 108 108 END DO 109 109 END DO … … 116 116 ENDIF 117 117 ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere 118 IF( zr au(ji,jj) <= 1. ) THEN ; zmskf(ji,jj) = 0._wp118 IF( zrho(ji,jj) <= 1. ) THEN ; zmskf(ji,jj) = 0._wp 119 119 ELSE ; zmskf(ji,jj) = 1._wp 120 120 ENDIF 121 121 ! diffusive layering indicators: 122 122 ! ! mskdl1=1 if 0< R <1; 0 elsewhere 123 IF( zr au(ji,jj) >= 1. ) THEN ; zmskd1(ji,jj) = 0._wp123 IF( zrho(ji,jj) >= 1. ) THEN ; zmskd1(ji,jj) = 0._wp 124 124 ELSE ; zmskd1(ji,jj) = 1._wp 125 125 ENDIF 126 126 ! ! mskdl2=1 if 0< R <0.5; 0 elsewhere 127 IF( zr au(ji,jj) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0._wp127 IF( zrho(ji,jj) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0._wp 128 128 ELSE ; zmskd2(ji,jj) = 1._wp 129 129 ENDIF 130 130 ! mskdl3=1 if 0.5< R <1; 0 elsewhere 131 IF( zr au(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN ; zmskd3(ji,jj) = 0._wp131 IF( zrho(ji,jj) <= 0.5 .OR. zrho(ji,jj) >= 1. ) THEN ; zmskd3(ji,jj) = 0._wp 132 132 ELSE ; zmskd3(ji,jj) = 1._wp 133 133 ENDIF … … 143 143 DO jj = 1, jpj 144 144 DO ji = 1, jpi 145 zinr = 1._wp / zr au(ji,jj)145 zinr = 1._wp / zrho(ji,jj) 146 146 ! salt fingering 147 zrr = zr au(ji,jj) / rn_hsbfr147 zrr = zrho(ji,jj) / rn_hsbfr 148 148 zrr = zrr * zrr 149 149 zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) … … 151 151 ! diffusive layering 152 152 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 * zr au(ji,jj) - 0.85 ) * zmskd3(ji,jj) &154 & + 0.15 * zr au(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) ) 155 155 ! add to the eddy viscosity coef. previously computed 156 156 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 162 162 INTEGER :: ji, jj ! dummy loop indexes 163 163 INTEGER :: ikbu, ikbv ! local integers 164 REAL(wp) :: zm1_2dt ! local scalar165 164 REAL(wp) :: zCdu, zCdv ! - - 166 165 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv 167 166 !!--------------------------------------------------------------------- 168 167 ! 169 !!gm bug : time step is only rdt (not 2 rdt if euler start !)170 zm1_2dt = - 1._wp / ( 2._wp * rdt )171 172 168 IF( l_trddyn ) THEN ! trends: store the input trends 173 169 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) … … 185 181 zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv) 186 182 ! 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) 189 185 END DO 190 186 END DO … … 200 196 zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 201 197 ! 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) 204 200 END DO 205 201 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfgls.F90
r9598 r9939 170 170 ! 171 171 ! surface friction 172 ustar2_surf(ji,jj) = r1_r au0 * taum(ji,jj) * tmask(ji,jj,1)172 ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1) 173 173 ! 174 174 !!gm Rq we may add here r_ke0(_top/_bot) ? ==>> think about that... … … 280 280 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) ) 281 281 ! ! diagonal 282 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + r dt * 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) 283 283 ! ! right hand side in en 284 en(ji,jj,jk) = en(ji,jj,jk) + r dt * zesh2 * wmask(ji,jj,jk)284 en(ji,jj,jk) = en(ji,jj,jk) + rn_Dt * zesh2 * wmask(ji,jj,jk) 285 285 END DO 286 286 END DO … … 530 530 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) ) 531 531 ! ! diagonal 532 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + r dt * 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) 533 533 ! ! right hand side in psi 534 psi(ji,jj,jk) = psi(ji,jj,jk) + r dt * zesh2 * wmask(ji,jj,jk)534 psi(ji,jj,jk) = psi(ji,jj,jk) + rn_Dt * zesh2 * wmask(ji,jj,jk) 535 535 END DO 536 536 END DO … … 1105 1105 rc04 = rc03 * rc0 1106 1106 rsbc_tke1 = -3._wp/2._wp*rn_crban*ra_sf*rl_sf ! Dirichlet + Wave breaking 1107 rsbc_tke2 = r dt * rn_crban / rl_sf! Neumann + Wave breaking1107 rsbc_tke2 = rn_Dt * rn_crban / rl_sf ! Neumann + Wave breaking 1108 1108 zcr = MAX(rsmall, rsbc_tke1**(1./(-ra_sf*3._wp/2._wp))-1._wp ) 1109 1109 rtrans = 0.2_wp / zcr ! Ad. inverse transition length between log and wave layer 1110 1110 rsbc_zs1 = rn_charn/grav ! Charnock formula for surface roughness 1111 1111 rsbc_zs2 = rn_frac_hs / 0.85_wp / grav * 665._wp ! Rascle formula for surface roughness 1112 rsbc_psi1 = -0.5_wp * r dt * rc0**(rpp-2._wp*rmm) / rsc_psi1113 rsbc_psi2 = -0.5_wp * r dt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi ! Neumann + NO Wave breaking1114 ! 1115 rfact_tke = -0.5_wp / rsc_tke * r dt! Cst used for the Diffusion term of tke1116 rfact_psi = -0.5_wp / rsc_psi * r dt! Cst used for the Diffusion term of tke1112 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 1117 1117 ! 1118 1118 ! !* Wall proximity function -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfiwm.F90
r9598 r9939 87 87 !! This is divided into three components: 88 88 !! 1. Bottom-intensified low-mode dissipation at critical slopes 89 !! zemx_iwm(z) = ( ecri_iwm / r au0 ) * EXP( -(H-z)/hcri_iwm )89 !! zemx_iwm(z) = ( ecri_iwm / rho0 ) * EXP( -(H-z)/hcri_iwm ) 90 90 !! / ( 1. - EXP( - H/hcri_iwm ) ) * hcri_iwm 91 91 !! where hcri_iwm is the characteristic length scale of the bottom 92 92 !! intensification, ecri_iwm a map of available power, and H the ocean depth. 93 93 !! 2. Pycnocline-intensified low-mode dissipation 94 !! zemx_iwm(z) = ( epyc_iwm / r au0 ) * ( sqrt(rn2(z))^nn_zpyc )94 !! zemx_iwm(z) = ( epyc_iwm / rho0 ) * ( sqrt(rn2(z))^nn_zpyc ) 95 95 !! / SUM( sqrt(rn2(z))^nn_zpyc * e3w(z) ) 96 96 !! where epyc_iwm is a map of available power, and nn_zpyc … … 98 98 !! energy dissipation. 99 99 !! 3. WKB-height dependent high mode dissipation 100 !! zemx_iwm(z) = ( ebot_iwm / r au0 ) * rn2(z) * EXP(-z_wkb(z)/hbot_iwm)100 !! zemx_iwm(z) = ( ebot_iwm / rho0 ) * rn2(z) * EXP(-z_wkb(z)/hbot_iwm) 101 101 !! / SUM( rn2(z) * EXP(-z_wkb(z)/hbot_iwm) * e3w(z) ) 102 102 !! where hbot_iwm is the characteristic length scale of the WKB bottom … … 151 151 DO ji = 1, jpi 152 152 zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) ! depth of the ocean 153 zfact(ji,jj) = r au0 * ( 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) ) ) 154 154 IF( zfact(ji,jj) /= 0._wp ) zfact(ji,jj) = ecri_iwm(ji,jj) / zfact(ji,jj) 155 155 END DO … … 180 180 DO jj = 1, jpj 181 181 DO ji = 1, jpi 182 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( r au0 * zfact(ji,jj) )182 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 183 183 END DO 184 184 END DO … … 197 197 DO jj= 1, jpj 198 198 DO ji = 1, jpi 199 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( r au0 * zfact(ji,jj) )199 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 200 200 END DO 201 201 END DO … … 247 247 DO jj = 1, jpj 248 248 DO ji = 1, jpi 249 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = ebot_iwm(ji,jj) / ( r au0 * zfact(ji,jj) )249 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 250 250 END DO 251 251 END DO … … 260 260 ! Calculate molecular kinematic viscosity 261 261 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_r au0262 & + 0.02305_wp * tsn(:,:,:,jp_sal) ) * tmask(:,:,:) * r1_rho0 263 263 DO jk = 2, jpkm1 264 264 znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) … … 306 306 END DO 307 307 IF( lk_mpp ) CALL mpp_sum( zztmp ) 308 zztmp = r au0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing308 zztmp = rho0 * zztmp ! Global integral of rhoo * Kz * N^2 = power contributing to mixing 309 309 ! 310 310 IF(lwp) THEN … … 350 350 !* output useful diagnostics: Kz*N^2 , 351 351 !!gm Kz*N2 should take into account the ratio avs/avt if it is used.... (see diaar5) 352 ! vertical integral of r au0 * Kz * N^2 , energy density (zemx_iwm)352 ! vertical integral of rho0 * Kz * N^2 , energy density (zemx_iwm) 353 353 IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN 354 354 ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) ) … … 358 358 z2d(:,:) = z2d(:,:) + e3w_n(:,:,jk) * z3d(:,:,jk) * wmask(:,:,jk) 359 359 END DO 360 z2d(:,:) = r au0 * z2d(:,:)360 z2d(:,:) = rho0 * z2d(:,:) 361 361 CALL iom_put( "bflx_iwm", z3d ) 362 362 CALL iom_put( "pcmap_iwm", z2d ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfmxl.F90
r9598 r9939 93 93 nmln(:,:) = nlb10 ! Initialization to the number of w ocean point 94 94 hmlp(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 95 zN2_c = grav * rho_c * r1_r au0 ! convert density criteria into N^2 criteria95 zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 96 96 DO jk = nlb10, jpkm1 97 97 DO jj = 1, jpj ! Mixed layer level: w-level -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfosm.F90
r9598 r9939 298 298 DO ji = 2, jpim1 299 299 ! Surface downward irradiance (so always +ve) 300 zrad0(ji,jj) = qsr(ji,jj) * r1_r au0_rcp300 zrad0(ji,jj) = qsr(ji,jj) * r1_rho0_rcp 301 301 ! Downwards irradiance at base of boundary layer 302 302 zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) ) … … 312 312 zbeta = rab_n(ji,jj,1,jp_sal) 313 313 ! Upwards surface Temperature flux for non-local term 314 zwth0(ji,jj) = - qns(ji,jj) * r1_r au0_rcp * tmask(ji,jj,1)314 zwth0(ji,jj) = - qns(ji,jj) * r1_rho0_rcp * tmask(ji,jj,1) 315 315 ! 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_r au0 * 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) 317 317 ! Non radiative upwards surface buoyancy flux 318 318 zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) - grav * zbeta * zws0(ji,jj) … … 324 324 zwbav(ji,jj) = grav * zthermal * zwthav(ji,jj) - grav * zbeta * zwsav(ji,jj) 325 325 ! Surface upward velocity fluxes 326 zuw0(ji,jj) = -utau(ji,jj) * r1_r au0 * tmask(ji,jj,1)327 zvw0(ji,jj) = -vtau(ji,jj) * r1_r au0 * 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) 328 328 ! Friction velocity (zustar), at T-point : LMD94 eq. 2 329 329 zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) … … 455 455 & + 0.135 * zla(ji,jj) * zwstrl(ji,jj)**3/hbl(ji,jj) ) 456 456 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) ) & 458 458 & * zwb_ent(ji,jj) / ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 459 459 ! Entrainment including component due to shear turbulence. Modified Langmuir component, but gives same result for La=0.3 For testing uncomment. … … 461 461 ! & + ( 0.15 * ( 1.0 - EXP( -0.5 * zla(ji,jj) ) ) + 0.03 / zla(ji,jj)**2 ) * zustar(ji,jj)**3/hbl(ji,jj) ) 462 462 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) / & 464 464 ! & ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 465 465 zzdhdt = - zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj),0.0) ) … … 472 472 IF ( zzdhdt < 0._wp ) THEN 473 473 ! 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) 475 475 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) & 477 477 & + MAX( zdb_bl(ji,jj), 0.0 ) 478 478 ENDIF … … 487 487 ibld(:,:) = 3 488 488 489 zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - wn(ji,jj,ibld(ji,jj)))* rn_ rdt ! certainly need wb here, so subtract it489 zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - wn(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need wb here, so subtract it 490 490 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 bottom491 zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_Dt + wn(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 492 492 493 493 DO jk = 4, jpkm1 … … 516 516 IF ( lconv(ji,jj) ) THEN 517 517 !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) ) & 519 519 & * zwb_ent(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 520 520 … … 523 523 & - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ), 0.0 ) + zvel_max 524 524 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) ) 526 526 zhbl_s = MIN(zhbl_s, ht_n(ji,jj)) 527 527 … … 1327 1327 IF ( iom_use("us_x") ) CALL iom_put( "us_x", tmask(:,:,1)*zustke*zcos_wind ) ! x surface Stokes drift 1328 1328 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.*r au0*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 ) 1330 1330 ! Stokes drift read in from sbcwave (=2). 1331 1331 CASE(2) 1332 1332 IF ( iom_use("us_x") ) CALL iom_put( "us_x", ut0sd ) ! x surface Stokes drift 1333 1333 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.*r au0*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* & 1335 1335 & SQRT(ut0sd**2 + vt0sd**2 ) ) 1336 1336 END SELECT … … 1348 1348 IF ( iom_use("zwstrl") ) CALL iom_put( "zwstrl", tmask(:,:,1)*zwstrl ) ! Langmuir velocity scale 1349 1349 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.*r au0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine1351 IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*r au0*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 ) 1352 1352 IF ( iom_use("zhbl") ) CALL iom_put( "zhbl", tmask(:,:,1)*zhbl ) ! BL depth internal to zdf_osm routine 1353 1353 IF ( iom_use("zhml") ) CALL iom_put( "zhml", tmask(:,:,1)*zhml ) ! ML depth internal to zdf_osm routine … … 1584 1584 imld_rst(:,:) = nlb10 ! Initialization to the number of w ocean point 1585 1585 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 1586 zN2_c = grav * rho_c * r1_r au0 ! convert density criteria into N^2 criteria1586 zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 1587 1587 ! 1588 1588 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 181 181 DO jj = 2, jpjm1 !* Ekman depth 182 182 DO ji = 2, jpim1 183 zustar = SQRT( taum(ji,jj) * r1_r au0 )183 zustar = SQRT( taum(ji,jj) * r1_rho0 ) 184 184 zhek = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall ) ! Ekman depth 185 185 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 195 195 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 196 196 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 197 REAL(wp) :: zbbr au, zri ! local scalars197 REAL(wp) :: zbbrho, zri ! local scalars 198 198 REAL(wp) :: zfact1, zfact2, zfact3 ! - - 199 199 REAL(wp) :: ztx2 , zty2 , zcof ! - - … … 206 206 !!-------------------------------------------------------------------- 207 207 ! 208 zbbr au = rn_ebb / rau0 ! Local constant initialisation209 zfact1 = -.5_wp * r dt210 zfact2 = 1.5_wp * r dt * rn_ediss211 zfact3 = 0.5_wp * rn_ediss208 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 212 212 ! 213 213 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 215 215 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 216 216 217 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / r au0 (min value rn_emin0)217 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rho0 (min value rn_emin0) 218 218 DO ji = fs_2, fs_jpim1 ! vector opt. 219 en(ji,jj,1) = MAX( rn_emin0, zbbr au* taum(ji,jj) ) * tmask(ji,jj,1)219 en(ji,jj,1) = MAX( rn_emin0, zbbrho * taum(ji,jj) ) * tmask(ji,jj,1) 220 220 END DO 221 221 END DO … … 232 232 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 233 233 ! 234 ! en(bot) = (ebb0/r au0)*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) 235 235 ! where ebb0 does not includes surface wave enhancement (i.e. ebb0=3.75) 236 236 ! Note that stress averaged is done using an wet-only calculation of u and v at t-point like in zdfsh2 … … 242 242 zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 243 243 zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 244 ! ! where 0.001875 = (rn_ebb0/r au0) * 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) 245 245 zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 & 246 246 & + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 ) … … 253 253 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 254 254 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 255 ! ! where 0.001875 = (rn_ebb0/r au0) * 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) 256 256 zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 & 257 257 & + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 ) … … 298 298 zwlc = zind * rn_lc * zus * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) 299 299 ! ! TKE Langmuir circulation source term 300 en(ji,jj,jk) = en(ji,jj,jk) + r 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)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) 302 302 END DO 303 303 END DO … … 342 342 ! 343 343 ! ! right hand side in en 344 en(ji,jj,jk) = en(ji,jj,jk) + r dt * ( p_sh2(ji,jj,jk) & ! shear345 & - p_avt(ji,jj,jk) * rn2(ji,jj,jk) & ! stratification346 & + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk) & ! dissipation347 & ) * 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) 348 348 END DO 349 349 END DO … … 422 422 zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean 423 423 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... 424 en(ji,jj,jk) = en(ji,jj,jk) + zbbr au* 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) ) & 425 425 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 426 426 END DO … … 473 473 ! 474 474 INTEGER :: ji, jj, jk ! dummy loop indices 475 REAL(wp) :: zrn2, zr aug, zcoef, zav ! local scalars475 REAL(wp) :: zrn2, zrhog, zcoef, zav ! local scalars 476 476 REAL(wp) :: zdku, zdkv, zsqen ! - - 477 477 REAL(wp) :: zemxl, zemlm, zemlp ! - - … … 489 489 zmxld(:,:,:) = rmxl_min 490 490 ! 491 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(r au0*g)492 zr aug = 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 ) 493 493 DO jj = 2, jpjm1 494 494 DO ji = fs_2, fs_jpim1 495 zmxlm(ji,jj,1) = MAX( rn_mxl0, zr aug * taum(ji,jj) * tmask(ji,jj,1) )495 zmxlm(ji,jj,1) = MAX( rn_mxl0, zrhog * taum(ji,jj) * tmask(ji,jj,1) ) 496 496 END DO 497 497 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/module_example
r9598 r9939 93 93 INTEGER :: ji, jj, jk ! dummy loop arguments (DOCTOR : start with j, but not jp) 94 94 INTEGER :: itoto, itata ! temporary integers (DOCTOR : start with i 95 REAL(wp) :: zmlmin, zbbr au! temporary scalars (DOCTOR : start with z)95 REAL(wp) :: zmlmin, zbbrho ! temporary scalars (DOCTOR : start with z) 96 96 REAL(wp) :: zfact1, zfact2 ! do not use continuation lines in declaration 97 97 REAL(wp), DIMENSION(jpi,jpj) :: zwrk_2d ! 2D workspace … … 101 101 102 102 zmlmin = 1.e-8 ! Local constant initialization 103 zbbr au = .5 * ebb / rau0104 zfact1 = -.5 * r dt * efave105 zfact2 = 1.5 * r dt * ediss103 zbbrho = .5 * ebb / rho0 104 zfact1 = -.5 * rn_Dt * efave 105 zfact2 = 1.5 * rn_Dt * ediss 106 106 107 107 SELECT CASE ( npdl ) ! short description of the action -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/nemogcm.F90
r9780 r9939 151 151 ! !== time stepping ==! 152 152 ! !-----------------------! 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 ! 153 164 istp = nit000 154 165 ! … … 429 440 430 441 ! ! Icebergs 431 CALL icb_init( r dt, nit000) ! initialise icebergs instance442 CALL icb_init( rn_Dt, nit000 ) ! initialise icebergs instance 432 443 433 444 ! ! Misc. options -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/oce.F90
r9598 r9939 27 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rn2b , rn2 !: brunt-vaisala frequency**2 [s-2] 28 28 ! 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhd !: in situ density anomalie rhd=(rho-r au0)/rau0 [no units]29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhd !: in situ density anomalie rhd=(rho-rho0)/rho0 [no units] 30 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhop !: potential volumic mass [kg/m3] 31 31 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/step.F90
r9780 r9939 34 34 35 35 !!---------------------------------------------------------------------- 36 !! stp : OPAsystem time-stepping37 !!---------------------------------------------------------------------- 38 USE step_oce 36 !! stp : NEMO system time-stepping 37 !!---------------------------------------------------------------------- 38 USE step_oce ! time stepping definition modules 39 39 ! 40 USE iom 40 USE iom ! xIOs server 41 41 42 42 IMPLICIT NONE … … 323 323 #endif 324 324 ! 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 ! 325 331 IF( ln_timing ) CALL timing_stop('stp') 326 332 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OFF/dtadyn.F90
r9598 r9939 438 438 ENDIF 439 439 440 sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:))! before <-- now filtered440 sshb(:,:) = sshn(:,:) + rn_atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) ! before <-- now filtered 441 441 sshn(:,:) = ssha(:,:) 442 442 … … 511 511 INTEGER :: jk 512 512 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv 513 REAL(wp) :: z2dt 514 !!---------------------------------------------------------------------- 515 ! 516 z2dt = 2._wp * rdt 513 !!---------------------------------------------------------------------- 517 514 ! 518 515 zhdiv(:,:) = 0._wp … … 521 518 END DO 522 519 ! ! Sea surface elevation time-stepping 523 pssha(:,:) = ( psshb(:,:) - z2dt * ( r1_rau0 * pemp(:,:) + zhdiv(:,:) ) ) * ssmask(:,:)520 pssha(:,:) = ( psshb(:,:) - rDt * ( r1_rho0 * pemp(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 524 521 ! ! 525 522 ! ! After acale factors at t-points ( z_star coordinate ) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OFF/nemogcm.F90
r9751 r9939 100 100 ! !== time stepping ==! 101 101 ! !-----------------------! 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 ! 102 111 istp = nit000 103 112 ! … … 115 124 CALL trc_stp ( istp ) ! time-stepping 116 125 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 ! 117 132 istp = istp + 1 118 133 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/SAS/daymod.F90
r9598 r9939 20 20 !! ------------------------------- 21 21 !! sbcmod assume that the time step is dividing the number of second of 22 !! in a day, i.e. ===> MOD( rday, r dt ) == 022 !! in a day, i.e. ===> MOD( rday, rn_Dt ) == 0 23 23 !! except when user defined forcing is used (see sbcmod.F90) 24 24 !!---------------------------------------------------------------------- … … 72 72 ! 73 73 ! max number of seconds between each restart 74 IF( REAL( nitend - nit000 + 1 ) * r dt > REAL( HUGE( nsec1jan000 ) ) ) THEN74 IF( REAL( nitend - nit000 + 1 ) * rn_Dt > REAL( HUGE( nsec1jan000 ) ) ) THEN 75 75 CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ', & 76 76 & 'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 77 77 ENDIF 78 nsecd = NINT( rday )79 nsecd05 = NINT( 0.5 * rday )80 ndt = NINT( r dt)81 ndt05 = NINT( 0.5 * r dt)78 nsecd = NINT( rday ) 79 nsecd05 = NINT( 0.5 * rday ) 80 ndt = NINT( rn_Dt ) 81 ndt05 = NINT( 0.5 * rn_Dt ) 82 82 83 83 IF( .NOT. l_offline ) CALL day_rst( nit000, 'READ' ) … … 237 237 nsec_week = nsec_week + ndt 238 238 nsec_day = nsec_day + ndt 239 adatrj = adatrj + r dt / rday240 fjulday = fjulday + r dt / rday239 adatrj = adatrj + rn_Dt / rday 240 fjulday = fjulday + rn_Dt / rday 241 241 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 242 242 IF( ABS(adatrj - REAL(NINT(adatrj ),wp)) < zprec ) adatrj = REAL(NINT(adatrj ),wp) ! avoid truncation error … … 307 307 !! In both those options, the exact duration of the experiment 308 308 !! since the beginning (cumulated duration of all previous restart runs) 309 !! is not stored in the restart and is assumed to be (nit000-1)*r dt.309 !! is not stored in the restart and is assumed to be (nit000-1)*rn_Dt. 310 310 !! This is valid is the time step has remained constant. 311 311 !! … … 376 376 nminute = ( nn_time0 - nhour * 100 ) 377 377 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 ) * r dt ) / rday378 adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 379 379 ! note this is wrong if time step has changed during run 380 380 ENDIF … … 385 385 nminute = ( nn_time0 - nhour * 100 ) 386 386 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 ) * r dt ) / rday387 adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 388 388 ENDIF 389 389 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 158 158 ENDIF 159 159 #if defined key_diainstant 160 zsto = nwrite * r dt160 zsto = nwrite * rn_Dt 161 161 clop = "inst("//TRIM(clop)//")" 162 162 #else 163 zsto =rdt163 zsto = rn_Dt 164 164 clop = "ave("//TRIM(clop)//")" 165 165 #endif 166 zout = nwrite * r dt167 zmax = ( nitend - nit000 + 1 ) * r dt166 zout = nwrite * rn_Dt 167 zmax = ( nitend - nit000 + 1 ) * rn_Dt 168 168 169 169 ! Define indices of the horizontal output zoom and vertical limit storage … … 185 185 186 186 ! Compute julian date from starting date of the run 187 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian )187 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 188 188 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 189 189 IF(lwp)WRITE(numout,*) … … 207 207 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 208 208 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 209 & nit000-1, zjulian, r dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )209 & nit000-1, zjulian, rn_Dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 210 210 CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept 211 211 & "m", ipk, gdept_1d, nz_T, "down" ) … … 219 219 CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu 220 220 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 221 & nit000-1, zjulian, r dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )221 & nit000-1, zjulian, rn_Dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 222 222 CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept 223 223 & "m", ipk, gdept_1d, nz_U, "down" ) … … 231 231 CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv 232 232 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 233 & nit000-1, zjulian, r dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )233 & nit000-1, zjulian, rn_Dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 234 234 CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept 235 235 & "m", ipk, gdept_1d, nz_V, "down" ) … … 360 360 clname = cdfile_name 361 361 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 362 zsto = r dt362 zsto = rn_Dt 363 363 clop = "inst(x)" ! no use of the mask value (require less cpu time) 364 zout = r dt365 zmax = ( nitend - nit000 + 1 ) * r dt364 zout = rn_Dt 365 zmax = ( nitend - nit000 + 1 ) * rn_Dt 366 366 367 367 IF(lwp) WRITE(numout,*) … … 375 375 376 376 ! Compute julian date from starting date of the run 377 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian ) ! time axis377 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) ! time axis 378 378 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 379 379 CALL histbeg( clname, jpi, glamt, jpj, gphit, & 380 1, jpi, 1, jpj, nit000-1, zjulian, r dt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit380 1, jpi, 1, jpj, nit000-1, zjulian, rn_Dt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 381 381 CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept 382 382 "m", jpk, gdept_1d, nz_i, "down") -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/C14/trcatm_c14.F90
r9598 r9939 223 223 IF(kc14typ >= 1) THEN ! Transient C14 & CO2 224 224 ! 225 tyrc14_now = tyrc14_now + ( r dt / ( rday * nyear_len(1)) ) ! current time step in yr relative to tyrc14_beg225 tyrc14_now = tyrc14_now + ( rn_Dt / ( rday * nyear_len(1) ) ) ! current time step in yr relative to tyrc14_beg 226 226 ! 227 227 ! CO2 -------------------------------------------------------- -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/C14/trcsms_c14.F90
r9598 r9939 123 123 124 124 ! cumulation of air-to-sea flux at each time step 125 qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * r dttrc125 qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rn_Dt_trc 126 126 ! 127 127 ! Add the surface flux to the trend of jp_c14 … … 148 148 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 149 149 ! 150 CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc ) 150 CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc ) ! These five need & 151 151 CALL iom_rstput( kt, nitrst, numrtw, 'c14sbc', c14sbc ) ! & to be written & 152 152 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 161 161 162 162 ! cumulation of surface flux at each time step 163 qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * r dt163 qint_cfc(ji,jj,jl) = qint_cfc(ji,jj,jl) + qtr_cfc(ji,jj,jl) * rn_Dt 164 164 ! !----------------! 165 165 END DO ! end i-j loop ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/P2Z/p2zexp.F90
r9788 r9939 4 4 !! TOP : LOBSTER Compute loss of organic matter in the sediments 5 5 !!====================================================================== 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 ! 23 25 24 26 IMPLICIT NONE … … 30 32 31 33 ! 32 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dminl ! :fraction of sinking POC released in sediments33 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: dmin3 ! :fraction of sinking POC released at each level34 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: sedpocb ! :mass of POC in sediments35 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: sedpocn ! :mass of POC in sediments36 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: cmask ! :Coastal mask area37 REAL(wp) :: areacot ! :surface coastal area34 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 38 40 39 41 !! * Substitutions … … 59 61 !! COLUMN BELOW THE SURFACE LAYER. 60 62 !!--------------------------------------------------------------------- 61 !! 62 INTEGER, INTENT( in ) :: kt ! ocean time-step index 63 INTEGER, INTENT( in ) :: kt ! ocean time-step index 63 64 !! 64 65 INTEGER :: ji, jj, jk, jl, ikt 65 66 REAL(wp) :: zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt 66 67 REAL(wp), DIMENSION(jpi,jpj) :: zsedpoca 67 CHARACTER (len=25) :: charout68 CHARACTER (len=25) :: charout 68 69 !!--------------------------------------------------------------------- 69 70 ! … … 72 73 IF( kt == nittrc000 ) CALL p2z_exp_init 73 74 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 79 79 ! (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT 80 80 ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90 … … 93 93 94 94 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 98 97 DO ji = fs_2, fs_jpim1 99 98 ikt = mbkt(ji,jj) … … 102 101 zwork = vsed * trn(ji,jj,ikt,jpdet) 103 102 zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj) & 104 & - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * r dt103 & - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rn_Dt 105 104 zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 106 105 END DO … … 121 120 ! Time filter and swap of arrays 122 121 ! ------------------------------ 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) 125 123 sedpocn(:,:) = zsedpoca(:,:) 126 124 ! 127 ELSE 125 ELSE ! Leap-Frog + Asselin filter 128 126 ! 129 127 DO jj = 1, jpj 130 128 DO ji = 1, jpi 131 zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj) 132 sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd! sedpocb <-- filtered sedpocn133 sedpocn(ji,jj) = zsedpoca(ji,jj) 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 134 132 END DO 135 133 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/P2Z/p2zsms.F90
r9598 r9939 4 4 !! TOP : Time loop of LOBSTER model 5 5 !!====================================================================== 6 !! History : 7 !! 6 !! History : 1.0 ! M. Levy 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 8 8 !!---------------------------------------------------------------------- 9 9 … … 11 11 !! p2zsms : Time loop of passive tracers sms 12 12 !!---------------------------------------------------------------------- 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 ! 24 24 25 25 IMPLICIT NONE -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/P4Z/p4zsms.F90
r9751 r9939 4 4 !! TOP : PISCES Source Minus Sink manager 5 5 !!====================================================================== 6 !! History : 7 !! 6 !! History : 1.0 ! 2004-03 (O. Aumont) Original code 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 8 !!---------------------------------------------------------------------- 9 !! p4z_sms : Time loop of passive tracers sms 9 10 10 !!---------------------------------------------------------------------- 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 28 35 29 36 IMPLICIT NONE … … 37 44 REAL(wp) :: xfact1, xfact2, xfact3 38 45 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr ! Array used to indicate negative tracer values 40 47 41 48 !!---------------------------------------------------------------------- … … 82 89 IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers 83 90 ! 84 rfact = r 2dttrc91 rfact = rDt_trc 85 92 ! 86 93 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN … … 90 97 xstep = rfact2 / rday ! Time step duration for biology 91 98 IF(lwp) WRITE(numout,*) 92 IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' r dt = ', rdt99 IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rn_Dt = ', rn_Dt, ' [s]' 93 100 IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2 94 101 IF(lwp) WRITE(numout,*) 95 102 ENDIF 96 103 97 IF( ( neuler == 0 .AND. kt == nittrc000 ).OR. ln_top_euler ) THEN104 IF( l_1st_euler .OR. ln_top_euler ) THEN 98 105 DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter 99 106 trb(:,:,:,jn) = trn(:,:,:,jn) … … 277 284 IF(lwp) WRITE(numout,*) 278 285 IF(lwp) WRITE(numout,*) ' p4z_rst : Read specific variables from pisces model ' 279 IF(lwp) WRITE(numout,*) ' ~~~~~~~ ~~~~~~~'286 IF(lwp) WRITE(numout,*) ' ~~~~~~~' 280 287 ! 281 288 IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN … … 407 414 !! 408 415 !!--------------------------------------------------------------------- 409 INTEGER, INTENT( in ) :: kt ! ocean time-step index 416 INTEGER, INTENT( in ) :: kt ! ocean time-step index 417 ! 410 418 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot 411 419 CHARACTER(LEN=100) :: cltxt 412 INTEGER :: jk413 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork420 INTEGER :: jk 421 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork 414 422 !!---------------------------------------------------------------------- 415 423 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/SED/sedwri.F90
r5215 r9939 1 1 MODULE sedwri 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE sedwri *** 5 4 !! Sediment diagnostics : write sediment output files 6 5 !!====================================================================== 6 !! History : ! 06-07 (C. Ethe) original 7 !!---------------------------------------------------------------------- 8 #if defined key_sed 9 !!---------------------------------------------------------------------- 10 !! 'key_sed' PISCES sediment 11 !!---------------------------------------------------------------------- 7 12 USE sed 8 13 USE sedarr … … 13 18 PRIVATE 14 19 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) 27 34 !! $Id$ 35 !! Software governed by the CeCILL licence (./LICENSE) 36 !!---------------------------------------------------------------------- 28 37 CONTAINS 29 38 30 !!----------------------------------------------------------------------31 !! NetCDF output file32 !!----------------------------------------------------------------------33 39 SUBROUTINE sed_wri( kt ) 34 40 !!---------------------------------------------------------------------- … … 37 43 !! ** Purpose : output of sediment passive tracer 38 44 !! 39 !! History :40 !! ! 06-07 (C. Ethe) original41 45 !!---------------------------------------------------------------------- 42 43 46 INTEGER, INTENT(in) :: kt 44 47 ! 45 48 CHARACTER(len = 60) :: clhstnam, clop 46 49 INTEGER :: ji, jk, js, jw, jn … … 51 54 REAL(wp) :: zrate 52 55 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta, zflx 53 54 56 !!------------------------------------------------------------------- 55 57 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/sms_pisces.F90
r9598 r9939 13 13 PUBLIC 14 14 15 INTEGER :: numnatp_ref = -1 !! Logical units for namelist pisces16 INTEGER :: numnatp_cfg = -1 !! Logical units for namelist pisces17 INTEGER :: numonp = -1 !! Logical unit for namelist pisces output15 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 18 18 19 19 ! !: PISCES : silicon dependant half saturation … … 26 26 27 27 !!* Time variables 28 INTEGER :: nrdttrc !: ???28 INTEGER :: nrdttrc !: frequency for the biology 29 29 REAL(wp) :: rfact , rfactr !: ??? 30 30 REAL(wp) :: rfact2, rfact2r !: ??? -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/TRP/trcadv.F90
r9598 r9939 125 125 CALL tra_adv_cen( kt, nittrc000,'TRC', zun, zvn, zwn , trn, tra, jptra, nn_cen_h, nn_cen_v ) 126 126 CASE ( np_FCT ) ! FCT : 2nd / 4th order 127 CALL tra_adv_fct( kt, nittrc000,'TRC', r 2dttrc, 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 ) 128 128 CASE ( np_MUS ) ! MUSCL 129 CALL tra_adv_mus( kt, nittrc000,'TRC', r 2dttrc, 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 ) 130 130 CASE ( np_UBS ) ! UBS 131 CALL tra_adv_ubs( kt, nittrc000,'TRC', r 2dttrc, 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 ) 132 132 CASE ( np_QCK ) ! QUICKEST 133 CALL tra_adv_qck( kt, nittrc000,'TRC', r 2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )133 CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zun, zvn, zwn, trb, trn, tra, jptra ) 134 134 ! 135 135 END SELECT -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/TRP/trcnxt.F90
r9598 r9939 24 24 !! 'key_top' TOP models 25 25 !!---------------------------------------------------------------------- 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 35 37 # if defined key_agrif 36 38 USE agrif_top_interp 37 39 # endif 38 40 ! 39 USE lbclnk 40 USE prtctl_trc 41 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 42 USE prtctl_trc ! Print control for debbuging 41 43 42 44 IMPLICIT NONE … … 72 74 !! the divergence of two consecutive time-steps and tr arrays 73 75 !! to prepare the next time_step: 74 !! (trb) = (trn) + atfp [ (trb) + (tra) - 2 (trn) ]76 !! (trb) = (trn) + rn_atfp [ (trb) + (tra) - 2 (trn) ] 75 77 !! (trn) = (tra) ; (tra) = (0,0) 76 78 !! … … 81 83 ! 82 84 INTEGER :: jk, jn ! dummy loop indices 83 REAL(wp) :: zfact ! temporaryscalar85 REAL(wp) :: zfact ! local scalar 84 86 CHARACTER (len=22) :: charout 85 87 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrdt ! 4D workspace … … 99 101 CALL lbc_lnk( tra(:,:,:,:), 'T', 1. ) 100 102 101 IF( ln_bdy ) CALL trc_bdy( kt )103 IF( ln_bdy ) CALL trc_bdy( kt ) 102 104 103 105 IF( l_trdtrc ) THEN ! trends: store now fields before the Asselin filter application 104 106 ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) ) 105 ztrdt(:,:,:,:) 107 ztrdt(:,:,:,:) = trn(:,:,:,:) 106 108 ENDIF 107 109 ! ! 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) 109 111 DO jn = 1, jptra 110 112 DO jk = 1, jpkm1 … … 115 117 ELSE 116 118 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 ssh118 ELSE ; CALL tra_nxt_vvl( kt, nittrc000, r dttrc, 'TRC', trb, trn, tra,&119 & sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh119 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 120 122 ENDIF 121 123 ELSE … … 129 131 DO jn = 1, jptra 130 132 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 133 134 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 134 135 END DO … … 164 165 !! /( e3t_n + rbcp*[ e3t_b - 2 e3t_n + e3t_a ] ) 165 166 !! 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 ] ) 168 169 !! tn = ta 169 170 !! ta = zt (NB: reset to 0 after eos_bn2 call) … … 184 185 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 185 186 IF( .NOT. ln_linssh ) THEN 186 rfact1 = atfp * rdttrc187 rfact2 = rfact1 / rau0187 rfact1 = rn_atfp * rn_Dt_trc 188 rfact2 = rfact1 * r1_rho0 188 189 ENDIF 189 190 ! … … 205 206 ztc_d = ztc_a - 2. * ztc_n + ztc_b 206 207 ! 207 ze3t_f = ze3t_n + atfp * ze3t_d208 ztc_f = ztc_n + atfp * ztc_d209 ! 210 IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN ! firstlevel208 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 211 212 ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj) - emp(ji,jj) ) 212 213 ztc_f = ztc_f - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 213 214 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 217 217 trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn) ! ptn <-- pta 218 !219 218 END DO 220 219 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/TRP/trcrad.F90
r9788 r9939 174 174 IF( l_trdtrc ) THEN 175 175 ! 176 zs2rdt = 1. / ( 2. * rdt ) 176 !!gm Question: Is this correct with an Euler first time-step ?? 177 zs2rdt = 1. / ( 2. * rn_Dt ) 177 178 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 178 179 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt … … 204 205 IF( l_trdtrc ) THEN 205 206 ! 206 zs2rdt = 1. / ( 2. * r dt * REAL( nn_dttrc, wp ) )207 zs2rdt = 1. / ( 2. * rn_Dt * REAL( nn_dttrc, wp ) ) 207 208 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 208 209 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/TRP/trcsbc.F90
r9598 r9939 120 120 DO jj = 2, jpj 121 121 DO ji = fs_2, fs_jpim1 ! vector opt. 122 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_r au0 * trn(ji,jj,1,jn)122 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rho0 * trn(ji,jj,1,jn) 123 123 END DO 124 124 END DO … … 126 126 DO jj = 2, jpj 127 127 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) 129 129 ! tracer flux at the ice/ocean interface (tracer/m2/s) 130 130 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice … … 135 135 ztfx = zftra ! net tracer flux 136 136 ! 137 zdtra = r1_r au0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) )137 zdtra = r1_rho0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) 138 138 IF ( zdtra < 0. ) THEN 139 zratio = -zdtra * zse3t * r 2dttrc / ( trn(ji,jj,1,jn) + zrtrn )139 zratio = -zdtra * zse3t * rDt_trc / ( trn(ji,jj,1,jn) + zrtrn ) 140 140 zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 141 141 ENDIF -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/TRP/trczdf.F90
r9598 r9939 54 54 IF( l_trdtrc ) ztrtrd(:,:,:,:) = tra(:,:,:,:) 55 55 ! 56 CALL tra_zdf_imp( kt, nittrc000, 'TRC', r 2dttrc, trb, tra, jptra ) ! implicit scheme56 CALL tra_zdf_imp( kt, nittrc000, 'TRC', rDt_trc, trb, tra, jptra ) ! implicit scheme 57 57 ! 58 58 IF( l_trdtrc ) THEN ! save the vertical diffusive trends for further diagnostics 59 59 DO jn = 1, jptra 60 60 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) 62 62 END DO 63 63 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 16 16 !! trd_mxl_trc_init : initialization step 17 17 !!---------------------------------------------------------------------- 18 USE trc 19 USE trc_oce , ONLY :nn_dttrc ! frequency of step on passive tracers20 USE dom_oce 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 21 21 USE zdfmxl , ONLY : nmln ! number of level in the mixed layer 22 22 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) 33 34 34 35 IMPLICIT NONE 35 36 PRIVATE 36 37 37 PUBLIC trd_mxl_trc38 PUBLIC trd_mxl_trc_alloc39 PUBLIC trd_mxl_trc_init40 PUBLIC trd_mxl_trc_zint38 PUBLIC trd_mxl_trc 39 PUBLIC trd_mxl_trc_alloc 40 PUBLIC trd_mxl_trc_init 41 PUBLIC trd_mxl_trc_zint 41 42 42 43 CHARACTER (LEN=40) :: clhstnam ! name of the trends NetCDF file … … 408 409 DO jn = 1, jptra 409 410 IF( ln_trdtrc(jn) ) THEN 410 !-- Compute total trends (use rdt trc instead of rdt ???)411 !-- Compute total trends (use rdt_trc instead of rn_Dt ???) 411 412 IF ( ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) THEN ! EULER-FORWARD schemes 412 ztmltot(:,:,jn) = ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) ) /rdt413 ztmltot(:,:,jn) = ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) ) / rn_Dt 413 414 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 415 416 ENDIF 416 417 … … 446 447 IF( ln_trdtrc(jn) ) THEN 447 448 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 /sec449 ztmltot2 (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) * r1_Dt ! now tracer unit is /sec 449 450 ENDIF 450 451 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/oce_trc.F90
r9490 r9939 40 40 USE oce , ONLY : tsa => tsa !: 4D array contaning ( ta, sa ) 41 41 USE oce , ONLY : rhop => rhop !: potential volumic mass (kg m-3) 42 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-r au0)/rau0 (no units)42 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rho0)/rho0 (no units) 43 43 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s) 44 44 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 4 4 !! Passive tracers : module for tracers defined 5 5 !!====================================================================== 6 !! History : 7 !! 8 !! NEMO 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 9 9 !!---------------------------------------------------------------------- 10 10 USE par_oce 11 11 USE par_trc 12 USE bdy_oce , only: jp_bdy, ln_bdy, nb_bdy, OBC_DATA12 USE bdy_oce , ONLY : jp_bdy, ln_bdy, nb_bdy, OBC_DATA 13 13 14 14 IMPLICIT NONE … … 63 63 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output) 64 64 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 67 68 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration 69 LOGICAL , PUBLIC :: l_top_euler !: boolean term for euler integration 68 70 LOGICAL , PUBLIC :: ln_trcdta !: Read inputs data from files 69 71 LOGICAL , PUBLIC :: ln_trcdmp !: internal damping flag -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/trcbc.F90
r9800 r9939 411 411 DO ji = fs_2, fs_jpim1 412 412 DO jk = 1, nk_rnf(ji,jj) 413 zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_r au0 / h_rnf(ji,jj)413 zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rho0 / h_rnf(ji,jj) 414 414 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (trn(ji,jj,jk,jn) * zrnf) 415 415 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/trcnam.F90
r9598 r9939 52 52 !!--------------------------------------------------------------------- 53 53 ! 54 IF( .NOT.l_offline ) CALL trc_nam_run 54 IF( .NOT.l_offline ) CALL trc_nam_run ! Parameters of the run 55 55 ! 56 CALL trc_nam_trc 56 CALL trc_nam_trc ! passive tracer informations 57 57 ! 58 58 IF( ln_rsttr ) ln_trcdta = .FALSE. ! restart : no need of clim data … … 61 61 ! 62 62 ! 63 IF(lwp) THEN ! control print63 IF(lwp) THEN ! control print 64 64 IF( ln_rsttr ) THEN 65 65 WRITE(numout,*) … … 76 76 ENDIF 77 77 ! 78 r dttrc = rdt * FLOAT( nn_dttrc )! passive tracer time-step78 rn_Dt_trc = REAL( nn_dttrc ) * rn_Dt ! passive tracer time-step 79 79 ! 80 80 IF(lwp) THEN ! control print 81 81 WRITE(numout,*) 82 WRITE(numout,*) ' ==>>> Passive Tracer time step r dttrc = nn_dttrc*rdt = ', rdttrc82 WRITE(numout,*) ' ==>>> Passive Tracer time step rn_Dt_trc = nn_dttrc*rn_Dt = ', rn_Dt_trc 83 83 ENDIF 84 84 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/trcrst.F90
r9598 r9939 4 4 !! TOP : Manage the passive tracer restart 5 5 !!====================================================================== 6 !! History : 7 !! 8 !! 9 !! 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 10 10 !!---------------------------------------------------------------------- 11 11 #if defined key_top … … 13 13 !! 'key_top' TOP models 14 14 !!---------------------------------------------------------------------- 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 ! 25 26 26 27 IMPLICIT NONE 27 28 PRIVATE 28 29 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) 36 37 !! $Id$ 37 38 !! Software governed by the CeCILL licence (./LICENSE) … … 93 94 END SUBROUTINE trc_rst_opn 94 95 96 95 97 SUBROUTINE trc_rst_read 96 98 !!---------------------------------------------------------------------- … … 130 132 !!---------------------------------------------------------------------- 131 133 ! 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 133 136 ! prognostic variables 134 137 ! -------------------- … … 175 178 !! In both those options, the exact duration of the experiment 176 179 !! since the beginning (cumulated duration of all previous restart runs) 177 !! is not stored in the restart and is assumed to be (nittrc000-1)*r dt.180 !! is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt. 178 181 !! This is valid is the time step has remained constant. 179 182 !! … … 186 189 INTEGER :: jlibalt = jprstlib 187 190 LOGICAL :: llok 188 REAL(wp) :: z rdttrc1, zkt, zndastp, zdayfrac, ksecs, ktime191 REAL(wp) :: zkt, zndastp, zdayfrac, ksecs, ktime 189 192 INTEGER :: ihour, iminute 190 193 … … 256 259 nminute = ( nn_time0 - nhour * 100 ) 257 260 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 ) * r dt ) / rday261 adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 259 262 ! note this is wrong if time step has changed during run 260 263 ENDIF … … 269 272 ENDIF 270 273 ! 271 IF( ln_rsttr ) THEN ; neuler = 1272 ELSE ; neuler = 0274 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 273 276 ENDIF 274 277 ! … … 346 349 #endif 347 350 348 !!----------------------------------------------------------------------349 !! NEMO/TOP 3.3 , NEMO Consortium (2018)350 !! $Id$351 !! Software governed by the CeCILL licence (./LICENSE)352 351 !!====================================================================== 353 352 END MODULE trcrst -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/trcstp.F90
r9598 r9939 61 61 IF( ln_timing ) CALL timing_start('trc_stp') 62 62 ! 63 IF( ( neuler == 0 .AND. kt == nittrc000 ).OR. ln_top_euler ) THEN ! at nittrc00064 r 2dttrc = 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) 65 65 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 66 r 2dttrc = 2. * rdttrc ! = 2 rdttrc (leapfrog)66 rDt_trc = 2. * rn_Dt_trc ! leapfrog time stepping 67 67 ENDIF 68 68 ! … … 144 144 nb_rec_per_day = ncpl_qsr_freq 145 145 ELSE 146 rdt_sampl = MAX( 3600., r dttrc )146 rdt_sampl = MAX( 3600., rn_Dt_trc ) 147 147 nb_rec_per_day = INT( rday / rdt_sampl ) 148 148 ENDIF … … 163 163 164 164 CALL iom_get( numrtr, 'ktdcy', zkt ) 165 rsecfst = INT( zkt ) * r dttrc165 rsecfst = INT( zkt ) * rn_Dt_trc 166 166 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s ' 167 167 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean ) ! A mean of qsr … … 184 184 ELSE !* no restart: set from nit000 values 185 185 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean set to nit000 values' 186 rsecfst = kt * r dttrc186 rsecfst = kt * rn_Dt_trc 187 187 ! 188 188 qsr_mean(:,:) = qsr(:,:) … … 194 194 ENDIF 195 195 ! 196 rseclast = kt * r dttrc196 rseclast = kt * rn_Dt_trc 197 197 ! 198 198 llnew = ( rseclast - rsecfst ) .ge. rdt_sampl ! new shortwave to store -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/trcsub.F90
r9598 r9939 466 466 ! 467 467 INTEGER :: ji, jj, jk ! dummy loop indices 468 REAL(wp) :: zcoefu, zcoefv, zcoeff, z 2dt, z1_2dt, z1_rau0 ! local scalars468 REAL(wp) :: zcoefu, zcoefv, zcoeff, z1_2rho0 ! local scalars 469 469 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv 470 470 !!--------------------------------------------------------------------- … … 486 486 CALL div_hor( kt ) ! Horizontal divergence & Relative vorticity 487 487 ! 488 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog)489 IF( neuler == 0 .AND. kt == nittrc000 ) z2dt = rdt490 491 488 ! !------------------------------! 492 489 ! ! After Sea Surface Height ! … … 499 496 ! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used 500 497 ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp 501 z1_ rau0 = 0.5 / rau0502 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) 503 500 504 501 IF( .NOT.ln_dynspg_ts ) THEN … … 517 514 ! ! Now Vertical Velocity ! 518 515 ! !------------------------------! 519 z1_2dt = 1.e0 / z2dt520 516 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 521 517 ! - 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(:,:) 526 521 END DO 527 522 !
Note: See TracChangeset
for help on using the changeset viewer.