Changeset 8143
- Timestamp:
- 2017-06-06T15:55:44+02:00 (7 years ago)
- Location:
- branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM
- Files:
-
- 1 deleted
- 44 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
r7990 r8143 174 174 filtide = 'bdydta/amm12_bdytide_' ! file name root of tidal forcing files 175 175 / 176 !----------------------------------------------------------------------- 177 &nambfr ! bottom friction 178 !----------------------------------------------------------------------- 179 nn_bfr = 2 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 180 ! = 2 : nonlinear friction 181 rn_bfri2 = 2.5e-3 ! bottom drag coefficient (non linear case) 182 rn_bfeb2 = 0.0e0 ! bottom turbulent kinetic energy background (m2/s2) 183 ln_loglayer = .true. ! loglayer bottom friction (only effect when nn_bfr = 2) 184 rn_bfrz0 = 0.003 ! bottom roughness (only effect when ln_loglayer = .true.) 176 177 !----------------------------------------------------------------------- 178 &namdrg ! top/bottom drag coefficient (default: NO selection) 179 !----------------------------------------------------------------------- 180 ln_NONE = .false. ! free-slip : Cd = 0 (F => fill namdrg_bot 181 ln_lin = .false. ! linear drag: Cd = Cd0 Uc0 & namdrg_top) 182 ln_non_lin = .false. ! non-linear drag: Cd = Cd0 |U| 183 ln_loglayer= .true. ! logarithmic drag: Cd = vkarmn/log(z/z0) |U| 184 ! 185 ln_drgimp = .true. ! implicit top/bottom friction flag 186 / 187 !----------------------------------------------------------------------- 188 &namdrg_bot ! BOTTOM friction 189 !----------------------------------------------------------------------- 190 rn_Cd0 = 2.5e-3 ! drag coefficient [-] 191 rn_Uc0 = 0.4 ! ref. velocity [m/s] (linear drag=Cd0*Uc0) 192 rn_Cdmax = 0.1 ! drag value maximum [-] (logarithmic drag) 193 rn_ke0 = 0.0e0 ! background kinetic energy [m2/s2] (non-linear cases) 194 rn_z0 = 0.003 ! roughness [m] (ln_loglayer=T) 195 ln_boost = .false. ! =T regional boost of Cd0 ; =F constant 196 rn_boost= 50. ! local boost factor [-] 185 197 / 186 198 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
r7990 r8143 183 183 / 184 184 !----------------------------------------------------------------------- 185 &nam bfr ! bottom friction186 !----------------------------------------------------------------------- 187 nn_bfr = 2 ! type of bottom friction : = 0 : free slip, = 1 : linear friction185 &namdrg ! top/bottom drag coefficient (default: NO selection) 186 !----------------------------------------------------------------------- 187 ln_non_lin = .true. ! non-linear drag: Cd = Cd0 |U| 188 188 / 189 189 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
r7990 r8143 124 124 / 125 125 !----------------------------------------------------------------------- 126 &nam bfr ! bottom friction127 !----------------------------------------------------------------------- 128 nn_bfr = 2 ! type of bottom friction : = 0 : free slip, = 1 : linear friction126 &namdrg ! top/bottom drag coefficient (default: NO selection) 127 !----------------------------------------------------------------------- 128 ln_non_lin = .true. ! non-linear drag: Cd = Cd0 |U| 129 129 / 130 130 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg
r7990 r8143 78 78 / 79 79 !----------------------------------------------------------------------- 80 &nam bfr !bottom friction81 !----------------------------------------------------------------------- 82 nn_bfr = 2 ! type of bottom friction : = 0 : free slip, = 1 : linear friction80 &namdrg ! top/bottom friction 81 !----------------------------------------------------------------------- 82 ln_non_lin = .true. ! non-linear drag: Cd = Cd0 |U| 83 83 / 84 84 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg
r7990 r8143 86 86 / 87 87 !----------------------------------------------------------------------- 88 &nambfr ! bottom friction 89 !----------------------------------------------------------------------- 88 &namdrg ! bottom friction 89 !----------------------------------------------------------------------- 90 ln_lin = .true. ! linear drag: Cd = Cd0 Uc0 90 91 / 91 92 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg
r7990 r8143 99 99 / 100 100 !----------------------------------------------------------------------- 101 &nambfr ! bottom friction 102 !----------------------------------------------------------------------- 101 &namdrg ! top/bottom friction 102 !----------------------------------------------------------------------- 103 ln_lin = .true. ! linear drag: Cd = Cd0 Uc0 103 104 / 104 105 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/SHARED/namelist_ref
r8093 r8143 8 8 !! namsbc_apr, namsbc_ssr, namsbc_alb, namsbc_wave) 9 9 !! 4 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide) 10 !! 5 - bottom boundary (nam bfr, nambbc, nambbl)10 !! 5 - bottom boundary (namdrg, namdrg_top, namdrg_bot, nambbc, nambbl) 11 11 !! 6 - Tracer (nameos, namtra_adv, namtra_ldf, namtra_ldfeiv, namtra_dmp) 12 12 !! 7 - dynamics (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf) … … 603 603 !! *** top/Bottom boundary condition *** !! 604 604 !!====================================================================== 605 !! nambfr bottom friction (default: NONE) 606 !! namtfr top friction (default: NONE) 605 !! namdrg top/bottom drag coefficient (default: NONE) 606 !! namdrg_top top friction (ln_isfcav=T) 607 !! namdrg_bot bottom friction 607 608 !! nambbc bottom temperature boundary condition (default: NO) 608 609 !! nambbl bottom boundary layer scheme (default: NO) … … 610 611 ! 611 612 !----------------------------------------------------------------------- 612 &nambfr ! bottom friction (default: linear) 613 !----------------------------------------------------------------------- 614 nn_bfr = 1 ! type of top/bottom drag: free slip (=0), linear drag (=1), 615 ! ! nonlinear drag (=2), nonlinear with logarithmic formulation (=3) 616 ln_bfrimp = .true. ! implicit bottom friction (requires ln_zdfexp = .false. if true) 617 ln_loglayer = .false. ! logarithmic formulation (non linear case only) 618 ! 619 rn_bfri1 = 4.e-4 ! bottom drag coefficient (linear case) 620 rn_bfri2 = 1.e-3 ! bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T 621 rn_bfri2_max= 1.e-1 ! max. bottom drag coefficient (non linear case and ln_loglayer=T) 622 rn_bfeb2 = 2.5e-3 ! bottom turbulent kinetic energy background (m2/s2) 623 rn_bfrz0 = 3.e-3 ! bottom roughness [m] if ln_loglayer=T 624 ln_bfr2d = .false. ! horizontal variation of the bottom friction coef (read a 2D mask file ) 625 rn_bfrien = 50. ! local boost factor 626 ! 627 rn_tfri1 = 4.e-4 ! top drag coefficient (linear case) 628 rn_tfri2 = 2.5e-3 ! top drag coefficient (non linear case). Minimum coeft if ln_loglayer=T 629 rn_tfri2_max= 1.e-1 ! max. top drag coefficient (non linear case and ln_loglayer=T) 630 rn_tfeb2 = 0.0 ! top turbulent kinetic energy background (m2/s2) 631 rn_tfrz0 = 3.e-3 ! top roughness [m] if ln_loglayer=T 632 ln_tfr2d = .false. ! horizontal variation of the top friction coef (read a 2D mask file ) 633 rn_tfrien = 50. ! local boost factor 634 / 635 636 !----------------------------------------------------------------------- 637 &namdrg ! top/bottom drag coeeficient (default: NO selection) 613 &namdrg ! top/bottom drag coefficient (default: NO selection) 638 614 !----------------------------------------------------------------------- 639 615 ln_NONE = .false. ! free-slip : Cd = 0 (F => fill namdrg_bot … … 644 620 ln_drgimp = .true. ! implicit top/bottom friction flag 645 621 / 646 647 622 !----------------------------------------------------------------------- 648 623 &namdrg_top ! TOP friction (ln_isfcav=T) … … 656 631 rn_boost= 50. ! local boost factor [-] 657 632 / 658 659 633 !----------------------------------------------------------------------- 660 634 &namdrg_bot ! BOTTOM friction … … 668 642 rn_boost= 50. ! local boost factor [-] 669 643 / 670 671 644 !----------------------------------------------------------------------- 672 645 &nambbc ! bottom temperature boundary condition (default: NO) … … 980 953 ln_mxl0 = .true. ! surface mixing length scale = F(wind stress) (T) or not (F) 981 954 rn_mxl0 = 0.04 ! surface buoyancy lenght scale minimum value 982 !!gmln_drg = .false. ! top/bottom friction added as boundary condition of TKE955 ln_drg = .false. ! top/bottom friction added as boundary condition of TKE 983 956 ln_lc = .true. ! Langmuir cell parameterisation (Axell 2002) 984 rn_lc = 0.15 ! coef. associated to Langmuir cells957 rn_lc = 0.15 ! coef. associated to Langmuir cells 985 958 nn_etau = 1 ! penetration of tke below the mixed layer (ML) due to NIWs 986 ! = 0 no penetration 987 ! = 1 add a tke source below the ML 988 ! = 2 add a tke source just at the base of the ML 989 ! = 3 as = 1 applied on HF part of the stress (ln_cpl=T) 990 rn_efr = 0.05 ! fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 991 nn_htau = 1 ! type of exponential decrease of tke penetration below the ML 992 ! = 0 constant 10 m length scale 993 ! = 1 0.5m at the equator to 30m poleward of 40 degrees 959 ! = 0 none ; = 1 add a tke source below the ML 960 ! = 2 add a tke source just at the base of the ML 961 ! = 3 as = 1 applied on HF part of the stress (ln_cpl=T) 962 rn_efr = 0.05 ! fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 963 nn_htau = 1 ! type of exponential decrease of tke penetration below the ML 964 ! = 0 constant 10 m length scale 965 ! = 1 0.5m at the equator to 30m poleward of 40 degrees 994 966 / 995 967 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg
r8017 r8143 5 5 &namusr_def ! ISOMIP user defined namelist 6 6 !----------------------------------------------------------------------- 7 ln_zco = .false. ! z-coordinate 7 8 ln_zps = .true. ! z-partial-step coordinate 9 ln_sco = .false. ! s-coordinate 8 10 rn_lam0 = 0.0 ! longitude of first raw and column T-point (jphgr_msh = 1) 9 11 rn_phi0 = -80.0 ! latitude of first raw and column T-point (jphgr_msh = 1) … … 179 181 / 180 182 !----------------------------------------------------------------------- 181 &nambfr ! bottom friction 182 !----------------------------------------------------------------------- 183 nn_bfr = 2 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 184 ! = 2 : nonlinear friction 185 rn_bfri1 = 4.e-4 ! bottom drag coefficient (linear case) 186 rn_bfri2 = 1.e-3 ! bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T 187 rn_bfri2_max = 1.e-1 ! max. bottom drag coefficient (non linear case and ln_loglayer=T) 188 rn_bfeb2 = 2.5e-3 ! bottom turbulent kinetic energy background (m2/s2) 189 rn_bfrz0 = 3.e-3 ! bottom roughness [m] if ln_loglayer=T 190 ln_bfr2d = .false. ! horizontal variation of the bottom friction coef (read a 2D mask file ) 191 rn_bfrien = 50. ! local multiplying factor of bfr (ln_bfr2d=T) 192 rn_tfri1 = 4.e-4 ! top drag coefficient (linear case) 193 rn_tfri2 = 2.5e-3 ! top drag coefficient (non linear case). Minimum coeft if ln_loglayer=T 194 rn_tfri2_max = 1.e-1 ! max. top drag coefficient (non linear case and ln_loglayer=T) 195 rn_tfeb2 = 0.0 ! top turbulent kinetic energy background (m2/s2) 196 rn_tfrz0 = 3.e-3 ! top roughness [m] if ln_loglayer=T 197 ln_tfr2d = .false. ! horizontal variation of the top friction coef (read a 2D mask file ) 198 rn_tfrien = 50. ! local multiplying factor of tfr (ln_tfr2d=T) 199 200 ln_bfrimp = .true. ! implicit bottom friction (requires ln_zdfexp = .false. if true) 201 ln_loglayer = .false. ! logarithmic formulation (non linear case) 183 &namdrg ! top/bottom drag coefficient (default: NO selection) 184 !----------------------------------------------------------------------- 185 ln_non_lin = .false. ! non-linear drag: Cd = Cd0 |U| 186 / 187 !----------------------------------------------------------------------- 188 &namdrg_top ! TOP friction (ln_isfcav=T) 189 !----------------------------------------------------------------------- 190 rn_Cd0 = 2.5e-3 ! drag coefficient [-] 191 rn_Uc0 = 1.6 ! ref. velocity [m/s] (linear drag=Cd0*Uc0) 192 rn_Cdmax = 0.1 ! drag value maximum [-] (logarithmic drag) 193 rn_ke0 = 0.0e-0 ! background kinetic energy [m2/s2] (non-linear cases) 194 rn_z0 = 3.0e-3 ! roughness [m] (ln_loglayer=T) 195 ln_boost = .false. ! =T regional boost of Cd0 ; =F constant 196 rn_boost= 50. ! local boost factor [-] 202 197 / 203 198 !----------------------------------------------------------------------- … … 215 210 &nameos ! ocean physical parameters 216 211 !----------------------------------------------------------------------- 217 ln_teos10 = .false. ! = Use TEOS-10 equation of state218 212 ln_eos80 = .true. ! = Use EOS80 equation of state 219 ! ! rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS220 213 / 221 214 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_cen2_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_flux_ubs_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_eenH_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_een_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ene_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT2_vect_ens_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_cen2_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_flux_ubs_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_eenH_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_een_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ene_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_FCT4_vect_ens_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/LOCK_EXCHANGE/EXP00/namelist_cfg
r7954 r8143 68 68 / 69 69 !----------------------------------------------------------------------- 70 &nambfr ! bottom friction 71 !----------------------------------------------------------------------- 72 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 73 ! = 2 : nonlinear friction 70 &namdrg ! top/bottom drag coefficient (default: NO selection) 71 !----------------------------------------------------------------------- 72 ln_NONE = .false. ! free-slip : Cd = 0 74 73 / 75 74 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/OVERFLOW/EXP00/namelist_cfg
r7954 r8143 62 62 / 63 63 !----------------------------------------------------------------------- 64 &nambfr ! bottom friction 65 !----------------------------------------------------------------------- 66 nn_bfr = 0 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 67 ! = 2 : nonlinear friction 64 &namdrg ! top/bottom drag coefficient (default: NO selection) 65 !----------------------------------------------------------------------- 66 ln_NONE = .false. ! free-slip : Cd = 0 68 67 / 69 68 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg
r7990 r8143 82 82 / 83 83 !----------------------------------------------------------------------- 84 &nambfr ! bottom friction 85 !----------------------------------------------------------------------- 84 &namdrg ! top/bottom drag coefficient (default: NO selection) 85 !----------------------------------------------------------------------- 86 ln_NONE = .false. ! free-slip : Cd = 0 86 87 / 87 88 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/CONFIG/TEST_CASES/WAD/EXP00/namelist_cfg
r7990 r8143 173 173 / 174 174 !----------------------------------------------------------------------- 175 &nambfr ! bottom friction 176 !----------------------------------------------------------------------- 177 nn_bfr = 2 ! type of bottom friction : = 0 : free slip, = 1 : linear friction 178 !rn_bfri2 = 1.e-5 ! bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T 179 !rn_bfri2_max = 1.e-4 ! max. bottom drag coefficient (non linear case and ln_loglayer=T) 180 rn_bfri2 = 1.e-5 ! bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T 181 rn_bfri2_max = 1.e-4 ! max. bottom drag coefficient (non linear case and ln_loglayer=T) 182 !rn_bfeb2 = 2.5e-3 ! bottom turbulent kinetic energy background (m2/s2) 183 !rn_bfrz0 = 3.e-3 ! bottom roughness [m] if ln_loglayer=T 184 ln_loglayer = .true. ! logarithmic formulation (non linear case) 175 &namdrg ! top/bottom drag coefficient (default: NO selection) 176 !----------------------------------------------------------------------- 177 ln_loglayer= .false. ! logarithmic drag: Cd = vkarmn/log(z/z0) |U| 178 / 179 !----------------------------------------------------------------------- 180 &namdrg_bot ! BOTTOM friction 181 !----------------------------------------------------------------------- 182 rn_Cd0 = 1.e-4 ! drag coefficient [-] 183 rn_Uc0 = 0.1 ! ref. velocity [m/s] (linear drag=Cd0*Uc0) 184 rn_Cdmax = 1.e-4 ! drag value maximum [-] (logarithmic drag) 185 rn_ke0 = 2.5e-3 ! background kinetic energy [m2/s2] (non-linear cases) 186 rn_z0 = 3.e-3 ! roughness [m] (ln_loglayer=T) 187 ln_boost = .false. ! =T regional boost of Cd0 ; =F constant 188 rn_boost= 50. ! local boost factor [-] 185 189 / 186 190 !----------------------------------------------------------------------- -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
r8093 r8143 151 151 152 152 ! Vertical diffusion 153 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avs_crs !: salinity vertical diffusivity coeff. [m2/s] at w-point 153 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avt_crs !: temperature vertical diffusivity coeff. [m2/s] at w-point 154 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avs_crs !: salinity vertical diffusivity coeff. [m2/s] at w-point 154 155 155 156 ! Mixing and Mixed Layer Depth … … 235 236 & fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs), STAT=ierr(12) ) 236 237 237 ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avs_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(13) ) 238 ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk), & 239 & avs_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(13) ) 238 240 239 241 ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , & -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r8093 r8143 210 210 ! free memory 211 211 212 ! avt, avs 213 !!gm BUG TOP always uses avs !!! 212 ! avs 214 213 SELECT CASE ( nn_crs_kz ) 215 214 CASE ( 0 ) 216 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 215 CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 216 CALL crs_dom_ope( avs, 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 217 217 CASE ( 1 ) 218 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 218 CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 219 CALL crs_dom_ope( avs, 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 219 220 CASE ( 2 ) 220 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 221 CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 222 CALL crs_dom_ope( avs, 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=ze3w, psgn=1.0 ) 221 223 END SELECT 222 224 ! 223 CALL iom_put( "avt", avs_crs ) ! Kz 225 CALL iom_put( "avt", avt_crs ) ! Kz on T 226 CALL iom_put( "avs", avs_crs ) ! Kz on S 224 227 225 228 ! sbc fields -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r8093 r8143 61 61 USE diurnal_bulk ! diurnal warm layer 62 62 USE cool_skin ! Cool skin 63 USE wrk_nemo ! working array64 63 65 64 IMPLICIT NONE … … 183 182 DO jj = 2, jpjm1 184 183 DO ji = fs_2, fs_jpim1 ! vector opt. 185 !!gm old186 !!gm BUG missing x 0.5187 zztmpx = ( bfrua(ji ,jj) * un(ji ,jj,mbku(ji ,jj)) &188 & + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj)) )189 zztmpy = ( bfrva(ji, jj) * vn(ji,jj ,mbkv(ji,jj )) &190 & + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1)) )191 z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1)192 !!gm193 184 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * un(ji ,jj,mbku(ji ,jj)) )**2 & 194 185 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * un(ji-1,jj,mbku(ji-1,jj)) )**2 & … … 196 187 & + ( ( rCdU_bot(ji,jj )+rCdU_bot(ji,jj-1) ) * vn(ji,jj-1,mbkv(ji,jj-1)) )**2 197 188 z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 198 !!gm new end199 189 ! 200 END DO201 END DO190 END DO 191 END DO 202 192 CALL lbc_lnk( z2d, 'T', 1. ) 203 193 CALL iom_put( "taubot", z2d ) … … 449 439 REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars 450 440 ! 451 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d ! 2D workspace452 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d ! 3D workspace441 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 442 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace 453 443 !!---------------------------------------------------------------------- 454 444 ! 455 445 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 456 446 ! 457 CALL wrk_alloc( jpi,jpj , zw2d ) 458 IF( .NOT.ln_linssh ) CALL wrk_alloc( jpi,jpj,jpk , zw3d ) 459 ! 460 ! Output the initial state and forcings 461 IF( ninist == 1 ) THEN 447 IF( ninist == 1 ) THEN !== Output the initial state and forcings ==! 462 448 CALL dia_wri_state( 'output.init', kt ) 463 449 ninist = 0 … … 467 453 ! ----------------- 468 454 469 ! local variable for debugging 470 ll_print = .FALSE. 455 ll_print = .FALSE. ! local variable for debugging 471 456 ll_print = ll_print .AND. lwp 472 457 … … 891 876 ENDIF 892 877 ! 893 CALL wrk_dealloc( jpi , jpj , zw2d )894 IF( .NOT.ln_linssh ) CALL wrk_dealloc( jpi , jpj , jpk , zw3d )895 !896 878 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') 897 879 ! -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r8093 r8143 5 5 !!============================================================================== 6 6 !! History : 3.2 ! 2008-11 (A. C. Coward) Original code 7 !! 3.4 ! 2011-09 (H. Liu) Make it consistent with semi-implicit 8 !! Bottom friction (ln_bfrimp = .true.)7 !! 3.4 ! 2011-09 (H. Liu) Make it consistent with semi-implicit Bottom friction (ln_drgimp =T) 8 !! 4.0 ! 2017-05 (G. Madec) drag coef. defined at t-point (zdfdrg.F90) 9 9 !!---------------------------------------------------------------------- 10 10 … … 14 14 USE oce ! ocean dynamics and tracers variables 15 15 USE dom_oce ! ocean space and time domain variables 16 USE zdf_oce ! ocean vertical physics variables 17 !!gm new 16 USE zdf_oce ! vertical physics: variables 18 17 USE zdfdrg ! vertical physics: top/bottom drag coef. 19 !!gm old20 USE zdfbfr ! ocean bottom friction variables21 !!gm22 18 USE trd_oce ! trends: ocean variables 23 19 USE trddyn ! trend manager: dynamics … … 26 22 USE prtctl ! Print control 27 23 USE timing ! Timing 28 USE wrk_nemo ! Memory Allocation29 24 30 25 IMPLICIT NONE … … 36 31 # include "vectopt_loop_substitute.h90" 37 32 !!---------------------------------------------------------------------- 38 !! NEMO/OPA 3.3 , NEMO Consortium (2010)33 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 39 34 !! $Id$ 40 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 47 42 !! 48 43 !! ** Purpose : compute the bottom friction ocean dynamics physics. 44 !! 45 !! only for explicit bottom friction form 46 !! implicit bfr is implemented in dynzdf_imp 49 47 !! 50 48 !! ** Action : (ua,va) momentum trend increased by bottom friction trend … … 61 59 IF( nn_timing == 1 ) CALL timing_start('dyn_bfr') 62 60 ! 63 !!gm issue: better to put the logical in step to control the call of zdf_bfr64 !! ==> change the logical from ln_bfrimp to ln_bfr_exp !!65 IF( .NOT.ln_bfrimp) THEN ! only for explicit bottom friction form66 ! implicit bfr is implemented in dynzdf_imp67 68 61 !!gm bug : time step is only rdt (not 2 rdt if euler start !) 69 62 zm1_2dt = - 1._wp / ( 2._wp * rdt ) 70 63 71 72 73 64 IF( l_trddyn ) THEN ! trends: store the input trends 65 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 66 ztrdu(:,:,:) = ua(:,:,:) 74 67 ztrdv(:,:,:) = va(:,:,:) 75 68 ENDIF 76 69 77 70 71 DO jj = 2, jpjm1 72 DO ji = 2, jpim1 73 ikbu = mbku(ji,jj) ! deepest wet ocean u- & v-levels 74 ikbv = mbkv(ji,jj) 75 ! 76 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 77 zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu) 78 zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv) 79 ! 80 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * ub(ji,jj,ikbu) 81 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * vb(ji,jj,ikbv) 82 END DO 83 END DO 84 ! 85 IF( ln_isfcav ) THEN ! ocean cavities 78 86 DO jj = 2, jpjm1 79 87 DO ji = 2, jpim1 80 ikbu = m bku(ji,jj) ! deepest wet ocean u- & v-levels81 ikbv = m bkv(ji,jj)88 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 89 ikbv = mikv(ji,jj) 82 90 ! 83 91 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 84 !!gm old 85 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( bfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) 86 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( bfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) 87 !!gm new 88 ! zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu) 89 ! zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv) 90 ! ! 91 ! ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * ub(ji,jj,ikbu) 92 ! va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * vb(ji,jj,ikbv) 93 !!gm 94 END DO 92 zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu) ! NB: Cdtop masked 93 zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 94 ! 95 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * ub(ji,jj,ikbu) 96 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * vb(ji,jj,ikbv) 97 END DO 95 98 END DO 96 ! 97 IF( ln_isfcav ) THEN ! ocean cavities 98 DO jj = 2, jpjm1 99 DO ji = 2, jpim1 100 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 101 ikbv = mikv(ji,jj) 102 ! 103 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 104 !!gm old 105 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( tfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) & 106 & * (1.-umask(ji,jj,1)) 107 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( tfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) & 108 & * (1.-vmask(ji,jj,1)) 109 !!gm new 110 ! zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu) ! NB: Cdtop masked 111 ! zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 112 ! ! 113 ! ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * ub(ji,jj,ikbu) 114 ! va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * vb(ji,jj,ikbv) 115 !!gm 116 END DO 117 END DO 118 END IF 119 ! 120 IF( l_trddyn ) THEN ! trends: send trends to trddyn for further diagnostics 121 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 122 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 123 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 124 DEALLOCATE( ztrdu, ztrdv ) 125 ENDIF 126 ! ! print mean trends (used for debugging) 127 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr - Ua: ', mask1=umask, & 128 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 129 ! 130 ENDIF ! end explicit bottom friction 99 ENDIF 100 ! 101 IF( l_trddyn ) THEN ! trends: send trends to trddyn for further diagnostics 102 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 103 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 104 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 105 DEALLOCATE( ztrdu, ztrdv ) 106 ENDIF 107 ! ! print mean trends (used for debugging) 108 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr - Ua: ', mask1=umask, & 109 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 131 110 ! 132 111 IF( nn_timing == 1 ) CALL timing_stop('dyn_bfr') -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r8093 r8143 16 16 !! 3.7 ! 2015-11 (J. Chanut) free surface simplification 17 17 !! - ! 2016-12 (G. Madec, E. Clementi) update for Stoke-Drift divergence 18 !! 4.0 ! 2017-05 (G. Madec) drag coef. defined at t-point (zdfdrg.F90) 18 19 !!--------------------------------------------------------------------- 19 20 … … 27 28 USE dom_oce ! ocean space and time domain 28 29 USE sbc_oce ! surface boundary condition: ocean 29 USE zdf_oce ! Bottom friction coefts 30 !!gm new 31 USE zdfdrg ! vertical physics: top/bottom drag coef. 32 !!gm 30 USE zdf_oce ! vertical physics: variables 31 USE zdfdrg ! vertical physics: top/bottom drag coef. 33 32 USE sbcisf ! ice shelf variable (fwfisf) 34 33 USE sbcapr ! surface boundary condition: atmospheric pressure … … 43 42 USE updtide ! tide potential 44 43 USE sbcwave ! surface wave 44 USE diatmb ! Top,middle,bottom output 45 #if defined key_agrif 46 USE agrif_opa_interp ! agrif 47 #endif 48 #if defined key_asminc 49 USE asminc ! Assimilation increment 50 #endif 45 51 ! 46 52 USE in_out_manager ! I/O manager … … 50 56 USE iom ! IOM library 51 57 USE restart ! only for lrst_oce 52 USE wrk_nemo ! Memory Allocation53 58 USE timing ! Timing 54 USE diatmb ! Top,middle,bottom output55 #if defined key_agrif56 USE agrif_opa_interp ! agrif57 #endif58 #if defined key_asminc59 USE asminc ! Assimilation increment60 #endif61 62 59 63 60 IMPLICIT NONE … … 69 66 PUBLIC ts_rst ! " " " " 70 67 71 INTEGER, SAVE :: icycle ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro72 REAL(wp),SAVE :: rdtbt ! Barotropic time step73 74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: wgtbtp1, wgtbtp2 !: 1st & 2nd weights used in time filtering of barotropic fields75 76 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zwz !: ff_f/h at F points77 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftnw, ftne !: triad of coriolis parameter78 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse !: (only used with een vorticity scheme)79 80 68 !! Time filtered arrays at baroclinic time step: 81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv , vn_adv !: Advection vel. at "now" barocl. step 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv , vn_adv !: Advection vel. at "now" barocl. step 70 71 INTEGER , SAVE :: icycle ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro 72 REAL(wp), SAVE :: rdtbt ! Barotropic time step 73 ! 74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: wgtbtp1, wgtbtp2 ! 1st & 2nd weights used in time filtering of barotropic fields 75 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zwz ! ff_f/h at F points 76 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftnw, ftne ! triad of coriolis parameter 77 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse ! (only used with een vorticity scheme) 78 79 REAL(wp) :: r1_12 = 1._wp / 12._wp ! local ratios 80 REAL(wp) :: r1_8 = 0.125_wp ! 81 REAL(wp) :: r1_4 = 0.25_wp ! 82 REAL(wp) :: r1_2 = 0.5_wp ! 82 83 83 84 !! * Substitutions 84 85 # include "vectopt_loop_substitute.h90" 85 86 !!---------------------------------------------------------------------- 86 !! NEMO/OPA 3.5 , NEMO Consortium (2013)87 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 87 88 !! $Id$ 88 89 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 140 141 INTEGER, INTENT(in) :: kt ! ocean time-step index 141 142 ! 142 LOGICAL :: ll_fw_start ! if true, forward integration143 LOGICAL :: ll_init ! if true, special startup of 2d equations144 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables used in W/D145 143 INTEGER :: ji, jj, jk, jn ! dummy loop indices 146 INTEGER :: ikbu, ikbv, noffset ! local integers 147 INTEGER :: iktu, iktv ! local integers 148 REAL(wp) :: zmdi 149 REAL(wp) :: zraur, z1_2dt_b, z2dt_bf ! local scalars 150 REAL(wp) :: zx1, zy1, zx2, zy2 ! - - 151 REAL(wp) :: z1_12, z1_8, z1_4, z1_2 ! - - 152 REAL(wp) :: zu_spg, zv_spg ! - - 153 REAL(wp) :: zhura, zhvra ! - - 154 REAL(wp) :: za0, za1, za2, za3 ! - - 155 REAL(wp) :: zztmp ! - - 156 REAL(wp), DIMENSION(jpi,jpj) :: zsshp2_e 157 REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 158 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zhdiv 159 REAL(wp), DIMENSION(jpi,jpj) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 160 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zsshv_a 161 REAL(wp), DIMENSION(jpi,jpj) :: zhf 144 LOGICAL :: ll_fw_start ! =T : forward integration 145 LOGICAL :: ll_init ! =T : special startup of 2d equations 146 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables used in W/D 147 INTEGER :: ikbu, iktu, noffset ! local integers 148 INTEGER :: ikbv, iktv ! - - 149 REAL(wp) :: z1_2dt_b, z2dt_bf ! local scalars 150 REAL(wp) :: zx1, zx2, zu_spg, zhura ! - - 151 REAL(wp) :: zy1, zy2, zv_spg, zhvra ! - - 152 REAL(wp) :: za0, za1, za2, za3 ! - - 153 REAL(wp) :: zmdi, zztmp ! - - 154 REAL(wp), DIMENSION(jpi,jpj) :: zsshp2_e, zhf 155 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zu_trd, zu_frc, zssh_frc 156 REAL(wp), DIMENSION(jpi,jpj) :: zwy, zv_trd, zv_frc, zhdiv 157 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhust_e 158 REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zhvst_e 162 159 REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v ! top/bottom stress at u- & v-points 163 160 ! … … 170 167 ! 171 168 zmdi=1.e+20 ! missing data indicator for masking 172 ! !* Local constant initialization 173 z1_12 = 1._wp / 12._wp 174 z1_8 = 0.125_wp 175 z1_4 = 0.25_wp 176 z1_2 = 0.5_wp 177 zraur = 1._wp / rau0 169 ! 178 170 ! ! reciprocal of baroclinic time step 179 171 IF( kt == nit000 .AND. neuler == 0 ) THEN ; z2dt_bf = rdt … … 210 202 ENDIF 211 203 ! 212 !!gm old/new213 204 IF( ln_isfcav ) THEN ! top+bottom friction (ocean cavities) 214 zCdU_u(:,:) = bfrua(:,:) + tfrua(:,:) 215 zCdU_v(:,:) = bfrva(:,:) + tfrva(:,:) 205 DO jj = 2, jpjm1 206 DO ji = fs_2, fs_jpim1 ! vector opt. 207 zCdU_u(ji,jj) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 208 zCdU_v(ji,jj) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 209 END DO 210 END DO 216 211 ELSE ! bottom friction only 217 zCdU_u(:,:) = bfrua(:,:) 218 zCdU_v(:,:) = bfrva(:,:) 219 ENDIF 220 !!gm new 221 ! IF( ln_isfcav ) THEN ! top+bottom friction (ocean cavities) 222 ! DO jj = 2, jpjm1 223 ! DO ji = fs_2, fs_jpim1 ! vector opt. 224 ! zCdU_u(ji,jj) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 225 ! zCdU_v(ji,jj) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 226 ! END DO 227 ! END DO 228 ! ELSE ! bottom friction only 229 ! DO jj = 2, jpjm1 230 ! DO ji = fs_2, fs_jpim1 ! vector opt. 231 ! zCdU_u(ji,jj) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) 232 ! zCdU_v(ji,jj) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) 233 ! END DO 234 ! END DO 235 ! ENDIF 236 !!gm 212 DO jj = 2, jpjm1 213 DO ji = fs_2, fs_jpim1 ! vector opt. 214 zCdU_u(ji,jj) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) 215 zCdU_v(ji,jj) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) 216 END DO 217 END DO 218 ENDIF 237 219 ! 238 220 ! Set arrays to remove/compute coriolis trend. … … 287 269 !!gm 288 270 !! 289 IF ( .not.ln_sco ) THEN271 IF( .NOT.ln_sco ) THEN 290 272 291 273 !!gm agree the JC comment : this should be done in a much clear way … … 338 320 IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN 339 321 ll_fw_start=.FALSE. 340 CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2)322 CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 341 323 ENDIF 342 324 … … 387 369 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 388 370 ! energy conserving formulation for planetary vorticity term 389 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )390 zv_trd(ji,jj) = -z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )371 zu_trd(ji,jj) = r1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 372 zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 391 373 END DO 392 374 END DO … … 395 377 DO jj = 2, jpjm1 396 378 DO ji = fs_2, fs_jpim1 ! vector opt. 397 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) &379 zy1 = r1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 398 380 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 399 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) &381 zx1 = - r1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 400 382 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 401 383 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) … … 407 389 DO jj = 2, jpjm1 408 390 DO ji = fs_2, fs_jpim1 ! vector opt. 409 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &391 zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 410 392 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 411 393 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 412 394 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 413 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &395 zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 414 396 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 415 397 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & … … 423 405 ! ! ---------------------------------------------------- 424 406 IF( .NOT.ln_linssh ) THEN ! Variable volume : remove surface pressure gradient 425 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters426 DO jj = 2, jpjm1427 DO ji = 2, jpim1428 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > &429 & MAX( -ht_wd(ji,jj) , -ht_wd(ji+1,jj) ) .AND. &430 & MAX( sshn(ji,jj) + ht_wd(ji,jj), sshn(ji+1,jj) + ht_wd(ji+1,jj) ) &407 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 408 DO jj = 2, jpjm1 409 DO ji = 2, jpim1 410 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > & 411 & MAX( -ht_wd(ji,jj) , -ht_wd(ji+1,jj) ) .AND. & 412 & MAX( sshn(ji,jj) + ht_wd(ji,jj), sshn(ji+1,jj) + ht_wd(ji+1,jj) ) & 431 413 & > rn_wdmin1 + rn_wdmin2 432 ll_tmp2 = ( ABS( sshn(ji+1,jj) - sshn(ji ,jj)) > 1.E-12 ).AND.( & 433 & MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 434 & MAX( -ht_wd(ji,jj) , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 435 436 IF(ll_tmp1) THEN 437 zcpx(ji,jj) = 1.0_wp 438 ELSE IF(ll_tmp2) THEN 439 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 440 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 441 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 442 ELSE 443 zcpx(ji,jj) = 0._wp 444 END IF 445 446 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji,jj+1) ) > & 414 ll_tmp2 = ( ABS( sshn(ji+1,jj) - sshn(ji ,jj)) > 1.E-12 ).AND.( & 415 & MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 416 & MAX( -ht_wd(ji,jj) , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 417 ! 418 IF(ll_tmp1) THEN 419 zcpx(ji,jj) = 1.0_wp 420 ELSE IF(ll_tmp2) THEN ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 421 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 422 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 423 ELSE 424 zcpx(ji,jj) = 0._wp 425 ENDIF 426 ! 427 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji,jj+1) ) > & 447 428 & MAX( -ht_wd(ji,jj) , -ht_wd(ji,jj+1) ) .AND. & 448 429 & MAX( sshn(ji,jj) + ht_wd(ji,jj), sshn(ji,jj+1) + ht_wd(ji,jj+1) ) & 449 430 & > rn_wdmin1 + rn_wdmin2 450 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji,jj+1)) > 1.E-12 ).AND.( &431 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji,jj+1)) > 1.E-12 ).AND.( & 451 432 & MAX( sshn(ji,jj) , sshn(ji,jj+1) ) > & 452 433 & MAX( -ht_wd(ji,jj) , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 453 454 IF(ll_tmp1) THEN455 zcpy(ji,jj) = 1.0_wp456 ELSE IF(ll_tmp2) THEN457 ! no worries about sshn(ji,jj+1) - sshn(ji,jj ) = 0, it won't happen ! here458 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &459 &/ (sshn(ji,jj+1) - sshn(ji,jj )) )460 ELSE461 zcpy(ji,jj) = 0._wp462 ENDIF463 END DO464 END DO465 466 DO jj = 2, jpjm1467 DO ji = 2, jpim1468 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) &469 &* r1_e1u(ji,jj) * zcpx(ji,jj)470 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) &471 &* r1_e2v(ji,jj) * zcpy(ji,jj)472 END DO473 END DO474 434 ! 435 IF(ll_tmp1) THEN 436 zcpy(ji,jj) = 1.0_wp 437 ELSE IF(ll_tmp2) THEN 438 ! no worries about sshn(ji,jj+1) - sshn(ji,jj ) = 0, it won't happen ! here 439 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 440 & / (sshn(ji,jj+1) - sshn(ji,jj )) ) 441 ELSE 442 zcpy(ji,jj) = 0._wp 443 ENDIF 444 END DO 445 END DO 446 ! 447 DO jj = 2, jpjm1 448 DO ji = 2, jpim1 449 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) & 450 & * r1_e1u(ji,jj) * zcpx(ji,jj) 451 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) & 452 & * r1_e2v(ji,jj) * zcpy(ji,jj) 453 END DO 454 END DO 455 ! 475 456 ELSE 476 477 DO jj = 2, jpjm1478 DO ji = fs_2, fs_jpim1 ! vector opt.479 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) * r1_e1u(ji,jj)480 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) * r1_e2v(ji,jj)481 END DO482 END DO483 ENDIF484 485 ENDIF 486 457 ! 458 DO jj = 2, jpjm1 459 DO ji = fs_2, fs_jpim1 ! vector opt. 460 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) * r1_e1u(ji,jj) 461 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) * r1_e2v(ji,jj) 462 END DO 463 END DO 464 ENDIF 465 ! 466 ENDIF 467 ! 487 468 DO jj = 2, jpjm1 ! Remove coriolis term (and possibly spg) from barotropic trend 488 469 DO ji = fs_2, fs_jpim1 … … 492 473 END DO 493 474 ! 494 ! ! Add bottomstress contribution from baroclinic velocities:495 IF (ln_bt_fw) THEN475 ! ! Add BOTTOM stress contribution from baroclinic velocities: 476 IF( ln_bt_fw ) THEN 496 477 DO jj = 2, jpjm1 497 478 DO ji = fs_2, fs_jpim1 ! vector opt. … … 518 499 DO jj = 2, jpjm1 519 500 DO ji = fs_2, fs_jpim1 ! vector opt. 520 !!gm old 521 zu_frc(ji,jj) = zu_frc(ji,jj) + MAX( r1_hu_n(ji,jj) * bfrua(ji,jj) , zztmp ) * zwx(ji,jj) 522 zv_frc(ji,jj) = zv_frc(ji,jj) + MAX( r1_hv_n(ji,jj) * bfrva(ji,jj) , zztmp ) * zwy(ji,jj) 523 !!gm new 524 ! zu_frc(ji,jj) = zu_frc(ji,jj) + MAX( r1_hu_n(ji,jj) * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp ) * zwx(ji,jj) 525 ! zv_frc(ji,jj) = zv_frc(ji,jj) + MAX( r1_hv_n(ji,jj) * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp ) * zwy(ji,jj) 526 !!gm 501 zu_frc(ji,jj) = zu_frc(ji,jj) + MAX( r1_hu_n(ji,jj) * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp ) * zwx(ji,jj) 502 zv_frc(ji,jj) = zv_frc(ji,jj) + MAX( r1_hv_n(ji,jj) * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp ) * zwy(ji,jj) 527 503 END DO 528 504 END DO … … 530 506 DO jj = 2, jpjm1 531 507 DO ji = fs_2, fs_jpim1 ! vector opt. 532 !!gm old 533 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * bfrua(ji,jj) * zwx(ji,jj) 534 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * bfrva(ji,jj) * zwy(ji,jj) 535 !!gm new 536 ! zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zwx(ji,jj) 537 ! zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zwy(ji,jj) 538 !!gm 508 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zwx(ji,jj) 509 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zwy(ji,jj) 539 510 END DO 540 511 END DO 541 512 END IF 542 513 ! 543 ! ! Add top stress contribution from baroclinic velocities: 544 IF( ln_bt_fw ) THEN 514 IF( ln_isfcav ) THEN ! Add TOP stress contribution from baroclinic velocities: 515 IF( ln_bt_fw ) THEN 516 DO jj = 2, jpjm1 517 DO ji = fs_2, fs_jpim1 ! vector opt. 518 iktu = miku(ji,jj) 519 iktv = mikv(ji,jj) 520 zwx(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj) ! NOW top baroclinic velocities 521 zwy(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj) 522 END DO 523 END DO 524 ELSE 525 DO jj = 2, jpjm1 526 DO ji = fs_2, fs_jpim1 ! vector opt. 527 iktu = miku(ji,jj) 528 iktv = mikv(ji,jj) 529 zwx(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj) ! BEFORE top baroclinic velocities 530 zwy(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj) 531 END DO 532 END DO 533 ENDIF 534 ! 535 ! Note that the "unclipped" top friction parameter is used even with explicit drag 536 DO jj = 2, jpjm1 537 DO ji = fs_2, fs_jpim1 ! vector opt. 538 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zwx(ji,jj) 539 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zwy(ji,jj) 540 END DO 541 END DO 542 ENDIF 543 ! 544 IF( ln_bt_fw ) THEN ! Add wind forcing 545 545 DO jj = 2, jpjm1 546 546 DO ji = fs_2, fs_jpim1 ! vector opt. 547 iktu = miku(ji,jj) 548 iktv = mikv(ji,jj) 549 zwx(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj) ! NOW top baroclinic velocities 550 zwy(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj) 547 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj) 548 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj) 551 549 END DO 552 550 END DO 553 551 ELSE 552 zztmp = r1_rau0 * r1_2 554 553 DO jj = 2, jpjm1 555 554 DO ji = fs_2, fs_jpim1 ! vector opt. 556 iktu = miku(ji,jj) 557 iktv = mikv(ji,jj) 558 zwx(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj) ! BEFORE top baroclinic velocities 559 zwy(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj) 560 END DO 561 END DO 562 ENDIF 563 ! 564 ! Note that the "unclipped" top friction parameter is used even with explicit drag 565 DO jj = 2, jpjm1 566 DO ji = fs_2, fs_jpim1 ! vector opt. 567 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * tfrua(ji,jj) * zwx(ji,jj) 568 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * tfrva(ji,jj) * zwy(ji,jj) 569 END DO 570 END DO 571 ! 572 IF (ln_bt_fw) THEN ! Add wind forcing 573 DO jj = 2, jpjm1 574 DO ji = fs_2, fs_jpim1 ! vector opt. 575 zu_frc(ji,jj) = zu_frc(ji,jj) + zraur * utau(ji,jj) * r1_hu_n(ji,jj) 576 zv_frc(ji,jj) = zv_frc(ji,jj) + zraur * vtau(ji,jj) * r1_hv_n(ji,jj) 577 END DO 578 END DO 579 ELSE 580 DO jj = 2, jpjm1 581 DO ji = fs_2, fs_jpim1 ! vector opt. 582 zu_frc(ji,jj) = zu_frc(ji,jj) + zraur * z1_2 * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 583 zv_frc(ji,jj) = zv_frc(ji,jj) + zraur * z1_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 555 zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 556 zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 584 557 END DO 585 558 END DO 586 559 ENDIF 587 560 ! 588 IF ( ln_apr_dyn ) THEN! Add atm pressure forcing589 IF (ln_bt_fw) THEN561 IF( ln_apr_dyn ) THEN ! Add atm pressure forcing 562 IF( ln_bt_fw ) THEN 590 563 DO jj = 2, jpjm1 591 564 DO ji = fs_2, fs_jpim1 ! vector opt. … … 597 570 END DO 598 571 ELSE 572 zztmp = grav * r1_2 599 573 DO jj = 2, jpjm1 600 574 DO ji = fs_2, fs_jpim1 ! vector opt. 601 zu_spg = grav * z1_2* ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) &602 & 603 zv_spg = grav * z1_2* ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) &604 & 575 zu_spg = zztmp * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) & 576 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) 577 zv_spg = zztmp * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) & 578 & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj) 605 579 zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 606 580 zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg … … 613 587 ! ! Surface net water flux and rivers 614 588 IF (ln_bt_fw) THEN 615 zssh_frc(:,:) = zraur* ( emp(:,:) - rnf(:,:) + fwfisf(:,:) )589 zssh_frc(:,:) = r1_rau0 * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 616 590 ELSE 617 zssh_frc(:,:) = zraur * z1_2 * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 618 & + fwfisf(:,:) + fwfisf_b(:,:) ) 591 zztmp = r1_rau0 * r1_2 592 zssh_frc(:,:) = zztmp * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 593 & + fwfisf(:,:) + fwfisf_b(:,:) ) 619 594 ENDIF 620 595 ! … … 712 687 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 713 688 DO ji = 2, fs_jpim1 ! Vector opt. 714 zwx(ji,jj) = z1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) &689 zwx(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 715 690 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 716 691 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 717 zwy(ji,jj) = z1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) &692 zwy(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) & 718 693 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & 719 694 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) … … 789 764 DO jj = 2, jpjm1 790 765 DO ji = 2, jpim1 ! NO Vector Opt. 791 zsshu_a(ji,jj) = z1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) &766 zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 792 767 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 793 768 & + e1e2t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 794 zsshv_a(ji,jj) = z1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) &769 zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) & 795 770 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 796 771 & + e1e2t(ji ,jj+1) * ssha_e(ji ,jj+1) ) … … 868 843 DO jj = 2, jpjm1 869 844 DO ji = 2, jpim1 870 zx1 = z1_2 * ssumask(ji ,jj) * r1_e1e2u(ji ,jj) &845 zx1 = r1_2 * ssumask(ji ,jj) * r1_e1e2u(ji ,jj) & 871 846 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj) & 872 847 & + e1e2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) ) 873 zy1 = z1_2 * ssvmask(ji ,jj) * r1_e1e2v(ji ,jj ) &848 zy1 = r1_2 * ssvmask(ji ,jj) * r1_e1e2v(ji ,jj ) & 874 849 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj ) & 875 850 & + e1e2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) ) … … 895 870 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 896 871 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 897 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )898 zv_trd(ji,jj) =- z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )872 zu_trd(ji,jj) = r1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 873 zv_trd(ji,jj) =-r1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 899 874 END DO 900 875 END DO … … 903 878 DO jj = 2, jpjm1 904 879 DO ji = fs_2, fs_jpim1 ! vector opt. 905 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) &880 zy1 = r1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 906 881 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 907 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) &882 zx1 = - r1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 908 883 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 909 884 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) … … 915 890 DO jj = 2, jpjm1 916 891 DO ji = fs_2, fs_jpim1 ! vector opt. 917 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &892 zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 918 893 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 919 894 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 920 895 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 921 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &896 zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 922 897 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 923 898 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & … … 1082 1057 vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 1083 1058 ELSE 1084 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:)1085 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:)1059 un_adv(:,:) = r1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 1060 vn_adv(:,:) = r1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 1086 1061 END IF 1087 1062 … … 1101 1076 DO jj = 1, jpjm1 1102 1077 DO ji = 1, jpim1 ! NO Vector Opt. 1103 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) &1078 zsshu_a(ji,jj) = r1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 1104 1079 & * ( e1e2t(ji ,jj) * ssha(ji ,jj) & 1105 1080 & + e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 1106 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) &1081 zsshv_a(ji,jj) = r1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 1107 1082 & * ( e1e2t(ji,jj ) * ssha(ji,jj ) & 1108 1083 & + e1e2t(ji,jj+1) * ssha(ji,jj+1) ) … … 1299 1274 INTEGER :: ji ,jj ! dummy loop indices 1300 1275 REAL(wp) :: zxr2, zyr2, zcmax ! local scalar 1301 REAL(wp), POINTER, DIMENSION(:,:) :: zcu1276 REAL(wp), DIMENSION(jpi,jpj) :: zcu 1302 1277 !!---------------------------------------------------------------------- 1303 1278 ! 1304 1279 ! Max courant number for ext. grav. waves 1305 !1306 CALL wrk_alloc( jpi,jpj, zcu )1307 1280 ! 1308 1281 DO jj = 1, jpj … … 1371 1344 ENDIF 1372 1345 ! 1373 CALL wrk_dealloc( jpi,jpj, zcu )1374 !1375 1346 END SUBROUTINE dyn_spg_ts_init 1376 1347 -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r8093 r8143 9 9 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) Forcing averaged over 2 time steps 10 10 !! 3.4 ! 2012-01 (H. Liu) Semi-implicit bottom friction 11 !! 4.0 ! 2017-05 (G. Madec) drag coef. defined at t-point (zdfdrg.F90) 11 12 !!---------------------------------------------------------------------- 12 13 … … 22 23 USE dynadv , ONLY: ln_dynadv_vec ! Momentum advection form 23 24 USE zdf_oce ! ocean vertical physics 24 !!gm new25 25 USE zdfdrg ! vertical physics: top/bottom drag coef. 26 !!gm old27 USE zdfbfr ! Bottom friction setup28 !!gm29 26 ! 30 27 USE in_out_manager ! I/O manager 31 28 USE lib_mpp ! MPP library 32 USE wrk_nemo ! Memory Allocation33 29 USE timing ! Timing 34 30 … … 65 61 !! with the following surface/top/bottom boundary condition: 66 62 !! surface: wind stress input (averaged over kt-1/2 & kt+1/2) 67 !! top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdf bfr.F)63 !! top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfdrg.F90) 68 64 !! 69 65 !! ** Action : (ua,va) after velocity … … 76 72 REAL(wp) :: zzwi, ze3ua ! local scalars 77 73 REAL(wp) :: zzws, ze3va ! - - 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwd, zws74 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwd, zws 79 75 !!---------------------------------------------------------------------- 80 76 ! 81 77 IF( nn_timing == 1 ) CALL timing_start('dyn_zdf_imp') 82 !83 CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws )84 78 ! 85 79 IF( kt == nit000 ) THEN … … 115 109 ! column vector of the tri-diagonal matrix equation 116 110 ! 117 IF( ln_ bfrimp ) THEN111 IF( ln_drgimp ) THEN 118 112 DO jj = 2, jpjm1 119 113 DO ji = 2, jpim1 120 114 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 121 115 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 122 !!gm old 123 avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * e3uw_n(ji,jj,ikbu+1) 124 avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * e3vw_n(ji,jj,ikbv+1) 125 !!gm new 126 ! avmu(ji,jj,ikbu+1) = -0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * e3uw_n(ji,jj,ikbu+1) 127 ! avmv(ji,jj,ikbv+1) = -0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * e3vw_n(ji,jj,ikbv+1) 128 !!gm 116 avmu(ji,jj,ikbu+1) = -0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * e3uw_n(ji,jj,ikbu+1) 117 avmv(ji,jj,ikbv+1) = -0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * e3vw_n(ji,jj,ikbv+1) 129 118 END DO 130 119 END DO … … 134 123 ikbu = miku(ji,jj) ! ocean top level at u- and v-points 135 124 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 136 !!gm old137 IF( ikbu >= 2 ) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * e3uw_n(ji,jj,ikbu)138 IF( ikbv >= 2 ) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * e3vw_n(ji,jj,ikbv)139 !!gm new140 125 ! top Cd is masked (=0 outside cavities) no need of test on mik>=2 141 ! avmu(ji,jj,ikbu) = -0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * e3uw_n(ji,jj,ikbu) 142 ! avmv(ji,jj,ikbv) = -0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * e3vw_n(ji,jj,ikbv) 143 !!gm 126 avmu(ji,jj,ikbu) = -0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * e3uw_n(ji,jj,ikbu) 127 avmv(ji,jj,ikbv) = -0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * e3vw_n(ji,jj,ikbv) 144 128 END DO 145 129 END DO … … 152 136 ! not lead to the effective stress seen over the whole barotropic loop. 153 137 ! G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a 154 IF( ln_ bfrimp .AND. ln_dynspg_ts ) THEN138 IF( ln_drgimp .AND. ln_dynspg_ts ) THEN 155 139 DO jk = 1, jpkm1 ! remove barotropic velocities 156 140 ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk) … … 163 147 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu) 164 148 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv) 165 !!gm old 166 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * bfrua(ji,jj) * ua_b(ji,jj) / ze3ua 167 va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * bfrva(ji,jj) * va_b(ji,jj) / ze3va 168 !!gm new 169 ! ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua 170 ! va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va 171 !!gm 149 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua 150 va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va 172 151 END DO 173 152 END DO … … 179 158 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu) 180 159 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv) 181 !!gm old182 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua183 va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va184 !!gm new185 160 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua 186 161 va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va 187 !!gm188 162 END DO 189 163 END DO … … 342 316 END DO 343 317 END DO 344 345 ! J. Chanut: Lines below are useless ?346 !! restore bottom layer avmu(v)347 !!gm I almost sure it is !!!!348 IF( ln_bfrimp ) THEN349 DO jj = 2, jpjm1350 DO ji = 2, jpim1351 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points352 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points)353 avmu(ji,jj,ikbu+1) = 0._wp354 avmv(ji,jj,ikbv+1) = 0._wp355 END DO356 END DO357 IF (ln_isfcav) THEN358 DO jj = 2, jpjm1359 DO ji = 2, jpim1360 ikbu = miku(ji,jj) ! ocean top level at u- and v-points361 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points)362 IF( ikbu > 1 ) avmu(ji,jj,ikbu) = 0._wp363 IF( ikbv > 1 ) avmv(ji,jj,ikbv) = 0._wp364 END DO365 END DO366 ENDIF367 ENDIF368 !369 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws)370 318 ! 371 319 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf_imp') -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r7816 r8143 5 5 !! shelf 6 6 !!====================================================================== 7 !! History : 3.2 8 !! X.X 9 !! 3.4 7 !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav 8 !! X.X ! 2006-02 (C. Wang ) Original code bg03 9 !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization 10 10 !!---------------------------------------------------------------------- 11 11 12 12 !!---------------------------------------------------------------------- 13 !! sbc_isf 13 !! sbc_isf : update sbc under ice shelf 14 14 !!---------------------------------------------------------------------- 15 USE oce 16 USE dom_oce 17 USE phycst 18 USE eosbn2 19 USE sbc_oce 20 USE zdf bfr !15 USE oce ! ocean dynamics and tracers 16 USE dom_oce ! ocean space and time domain 17 USE phycst ! physical constants 18 USE eosbn2 ! equation of state 19 USE sbc_oce ! surface boundary condition: ocean fields 20 USE zdfdrg ! vertical physics: top/bottom drag coef. 21 21 ! 22 USE in_out_manager 23 USE iom 24 USE fldread 25 USE lbclnk 26 USE wrk_nemo 27 USE timing 28 USE lib_fortran 22 USE in_out_manager ! I/O manager 23 USE iom ! I/O manager library 24 USE fldread ! read input field at current time step 25 USE lbclnk ! 26 USE wrk_nemo ! Memory allocation 27 USE timing ! Timing 28 USE lib_fortran ! glob_sum 29 29 30 30 IMPLICIT NONE … … 77 77 CONTAINS 78 78 79 SUBROUTINE sbc_isf( kt)79 SUBROUTINE sbc_isf( kt ) 80 80 !!--------------------------------------------------------------------- 81 81 !! *** ROUTINE sbc_isf *** … … 94 94 INTEGER :: ji, jj, jk ! loop index 95 95 INTEGER :: ikt, ikb ! loop index 96 REAL(wp), DIMENSION (:,:), POINTER :: zt_frz, zdep! freezing temperature (zt_frz) at depth (zdep)96 REAL(wp), DIMENSION(jpi,jpj) :: zt_frz, zdep ! freezing temperature (zt_frz) at depth (zdep) 97 97 REAL(wp), DIMENSION(:,:,:), POINTER :: zfwfisf3d, zqhcisf3d, zqlatisf3d 98 98 REAL(wp), DIMENSION(:,: ), POINTER :: zqhcisf2d … … 100 100 ! 101 101 IF( MOD( kt-1, nn_fsbc) == 0 ) THEN 102 ! allocation103 CALL wrk_alloc( jpi,jpj, zt_frz, zdep )104 102 105 103 ! compute salt and heat flux … … 204 202 CALL wrk_dealloc( jpi,jpj, zqhcisf2d ) 205 203 END IF 206 ! deallocation207 CALL wrk_dealloc( jpi,jpj, zt_frz, zdep )208 204 ! 209 205 END IF … … 254 250 END FUNCTION 255 251 252 256 253 SUBROUTINE sbc_isf_init 257 254 !!--------------------------------------------------------------------- … … 289 286 290 287 IF ( lwp ) WRITE(numout,*) 291 IF ( lwp ) WRITE(numout,*) 'sbc_isf: heat flux of the ice shelf' 292 IF ( lwp ) WRITE(numout,*) '~~~~~~~~~' 293 IF ( lwp ) WRITE(numout,*) 'sbcisf :' 294 IF ( lwp ) WRITE(numout,*) '~~~~~~~~' 288 IF ( lwp ) WRITE(numout,*) 'sbc_isf_init : heat flux of the ice shelf' 289 IF ( lwp ) WRITE(numout,*) '~~~~~~~~~~~' 295 290 IF ( lwp ) WRITE(numout,*) ' nn_isf = ', nn_isf 296 291 IF ( lwp ) WRITE(numout,*) ' nn_isfblk = ', nn_isfblk … … 299 294 IF ( lwp ) WRITE(numout,*) ' rn_gammat0 = ', rn_gammat0 300 295 IF ( lwp ) WRITE(numout,*) ' rn_gammas0 = ', rn_gammas0 301 IF ( lwp ) WRITE(numout,*) ' rn_ tfri2 = ', rn_tfri2296 IF ( lwp ) WRITE(numout,*) ' rn_Cd0 = ', r_Cdmin_top 302 297 ! 303 298 ! Allocate public variable … … 305 300 ! 306 301 ! initialisation 307 qisf (:,:) = 0._wp ;fwfisf (:,:) = 0._wp308 risf_tsc(:,:,:) = 0._wp ;fwfisf_b(:,:) = 0._wp302 qisf (:,:) = 0._wp ; fwfisf (:,:) = 0._wp 303 risf_tsc(:,:,:) = 0._wp ; fwfisf_b(:,:) = 0._wp 309 304 ! 310 305 ! define isf tbl tickness, top and bottom indice … … 312 307 CASE ( 1 ) 313 308 rhisf_tbl(:,:) = rn_hisf_tbl 314 misfkt (:,:)= mikt(:,:) ! same indice for bg03 et cav => used in isfdiv309 misfkt (:,:) = mikt(:,:) ! same indice for bg03 et cav => used in isfdiv 315 310 316 311 CASE ( 2 , 3 ) … … 346 341 DO jj = 1, jpj 347 342 ik = 2 343 !!gm potential bug: use gdepw_0 not _n 348 344 DO WHILE ( ik <= mbkt(ji,jj) .AND. gdepw_n(ji,jj,ik) < rzisf_tbl(ji,jj) ) ; ik = ik + 1 ; END DO 349 345 misfkt(ji,jj) = ik-1 … … 354 350 ! as in nn_isf == 1 355 351 rhisf_tbl(:,:) = rn_hisf_tbl 356 misfkt (:,:)= mikt(:,:) ! same indice for bg03 et cav => used in isfdiv352 misfkt (:,:) = mikt(:,:) ! same indice for bg03 et cav => used in isfdiv 357 353 358 354 ! load variable used in fldread (use for temporal interpolation of isf fwf forcing) … … 377 373 ! determine the deepest level influenced by the boundary layer 378 374 DO jk = ikt+1, mbkt(ji,jj) 379 IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) < rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) )ikb = jk375 IF( (SUM(e3t_n(ji,jj,ikt:jk-1)) < rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 380 376 END DO 381 377 rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb))) ! limit the tbl to water thickness. … … 390 386 END SUBROUTINE sbc_isf_init 391 387 388 392 389 SUBROUTINE sbc_isf_bg03(kt) 393 390 !!--------------------------------------------------------------------- … … 402 399 !! interaction for climate models", Ocean Modelling 5(2003) 157-170. 403 400 !! (hereafter BG) 404 !! History : 405 !! 06-02 (C. Wang) Original code 401 !! History : 06-02 (C. Wang) Original code 406 402 !!---------------------------------------------------------------------- 407 403 INTEGER, INTENT ( in ) :: kt … … 415 411 !!---------------------------------------------------------------------- 416 412 417 IF ( nn_timing == 1 )CALL timing_start('sbc_isf_bg03')413 IF( nn_timing == 1 ) CALL timing_start('sbc_isf_bg03') 418 414 ! 419 415 DO ji = 1, jpi … … 441 437 !add to salinity trend 442 438 ELSE 443 qisf(ji,jj) = 0._wp ;fwfisf(ji,jj) = 0._wp439 qisf(ji,jj) = 0._wp ; fwfisf(ji,jj) = 0._wp 444 440 END IF 445 441 END DO 446 442 END DO 447 443 ! 448 IF( nn_timing == 1 ) CALL timing_stop('sbc_isf_bg03')444 IF( nn_timing == 1 ) CALL timing_stop('sbc_isf_bg03') 449 445 ! 450 446 END SUBROUTINE sbc_isf_bg03 447 451 448 452 449 SUBROUTINE sbc_isf_cav( kt ) … … 463 460 !! emp, emps : update freshwater flux below ice shelf 464 461 !!--------------------------------------------------------------------- 465 INTEGER, INTENT(in) :: kt! ocean time step462 INTEGER, INTENT(in) :: kt ! ocean time step 466 463 ! 467 464 INTEGER :: ji, jj ! dummy loop indices 468 465 INTEGER :: nit 466 LOGICAL :: lit 469 467 REAL(wp) :: zlamb1, zlamb2, zlamb3 470 468 REAL(wp) :: zeps1,zeps2,zeps3,zeps4,zeps6,zeps7 … … 472 470 REAL(wp) :: zeps = 1.e-20_wp 473 471 REAL(wp) :: zerr 474 REAL(wp), DIMENSION(:,:), POINTER :: zfrz 475 REAL(wp), DIMENSION(:,:), POINTER :: zgammat, zgammas 476 REAL(wp), DIMENSION(:,:), POINTER :: zfwflx, zhtflx, zhtflx_b 477 LOGICAL :: lit 472 REAL(wp), DIMENSION(jpi,jpj) :: zfrz 473 REAL(wp), DIMENSION(jpi,jpj) :: zgammat, zgammas 474 REAL(wp), DIMENSION(jpi,jpj) :: zfwflx, zhtflx, zhtflx_b 478 475 !!--------------------------------------------------------------------- 479 476 ! coeficient for linearisation of potential tfreez … … 484 481 IF( nn_timing == 1 ) CALL timing_start('sbc_isf_cav') 485 482 ! 486 CALL wrk_alloc( jpi,jpj, zfrz , zgammat, zgammas )487 CALL wrk_alloc( jpi,jpj, zfwflx, zhtflx , zhtflx_b )488 489 483 ! initialisation 490 484 zgammat(:,:) = rn_gammat0 ; zgammas (:,:) = rn_gammas0 … … 578 572 CALL iom_put('isfgammas', zgammas) 579 573 ! 580 CALL wrk_dealloc( jpi,jpj, zfrz , zgammat, zgammas )581 CALL wrk_dealloc( jpi,jpj, zfwflx, zhtflx , zhtflx_b )582 !583 574 IF( nn_timing == 1 ) CALL timing_stop('sbc_isf_cav') 584 575 ! … … 600 591 INTEGER :: ikt 601 592 INTEGER :: ji, jj ! loop index 602 REAL(wp), DIMENSION(:,:), POINTER :: zustar ! U, V at T point and friction velocity603 593 REAL(wp) :: zdku, zdkv ! U, V shear 604 594 REAL(wp) :: zPr, zSc, zRc ! Prandtl, Scmidth and Richardson number … … 614 604 REAL(wp), PARAMETER :: znu = 1.95e-6_wp ! kinamatic viscosity of sea water (m2.s-1) 615 605 REAL(wp), DIMENSION(2) :: zts, zab 606 REAL(wp), DIMENSION(jpi,jpj) :: zustar ! U, V at T point and friction velocity 616 607 !!--------------------------------------------------------------------- 617 CALL wrk_alloc( jpi,jpj, zustar )618 608 ! 619 609 SELECT CASE ( nn_gammablk ) … … 626 616 !! Jenkins et al., 2010, JPO, p2298-2312 627 617 !! Adopted by Asay-Davis et al. (2015) 628 629 !! compute ustar (eq. 24) 630 zustar(:,:) = SQRT( rn_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + rn_tfeb2) ) 618 !!gm I don't understand the u* expression in those papers... (see for example zdfglf module) 619 !! for me ustar= Cd0 * |U| not (Cd0)^1/2 * |U| .... which is what you can find in Jenkins et al. 620 621 !! compute ustar (eq. 24) !! NB: here r_Cdmin_top = rn_Cd0 read in namdrg_top namelist) 622 zustar(:,:) = SQRT( r_Cdmin_top * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + r_ke0_top) ) 631 623 632 624 !! Compute gammats … … 638 630 !! as MOL depends of flux and flux depends of MOL, best will be iteration (TO DO) 639 631 !! compute ustar 640 zustar(:,:) = SQRT( r n_tfri2 * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + rn_tfeb2) )632 zustar(:,:) = SQRT( r_Cdmin_top * (utbl(:,:) * utbl(:,:) + vtbl(:,:) * vtbl(:,:) + r_ke0_top) ) 641 633 642 634 !! compute Pr and Sc number (can be improved) … … 649 641 650 642 !! compute gamma 651 DO ji =2,jpi652 DO jj =2,jpj643 DO ji = 2, jpi 644 DO jj = 2, jpj 653 645 ikt = mikt(ji,jj) 654 646 655 IF (zustar(ji,jj) == 0._wp) THEN ! only for kt = 1 I think647 IF( zustar(ji,jj) == 0._wp ) THEN ! only for kt = 1 I think 656 648 pgt = rn_gammat0 657 649 pgs = rn_gammas0 658 650 ELSE 659 651 !! compute Rc number (as done in zdfric.F90) 652 !!gm better to do it like in the new zdfric.F90 i.e. avm weighted Ri computation 653 !!gm moreover, use Max(rn2,0) to take care of static instabilities.... 660 654 zcoef = 0.5_wp / e3w_n(ji,jj,ikt) 661 655 ! ! shear of horizontal velocity … … 703 697 CALL lbc_lnk(pgs(:,:),'T',1.) 704 698 END SELECT 705 CALL wrk_dealloc( jpi,jpj, zustar )706 699 ! 707 700 END SUBROUTINE sbc_isf_gammats 708 701 702 709 703 SUBROUTINE sbc_isf_tbl( pvarin, pvarout, cd_ptin ) 710 704 !!---------------------------------------------------------------------- … … 714 708 !! 715 709 !!---------------------------------------------------------------------- 716 REAL(wp), DIMENSION(:,:,:), INTENT( in ) :: pvarin 717 REAL(wp), DIMENSION(:,:) , INTENT( out ) :: pvarout 718 CHARACTER(len=1), INTENT( in ) :: cd_ptin ! point of variable in/out 719 ! 720 REAL(wp) :: ze3, zhk 710 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pvarin 711 REAL(wp), DIMENSION(:,:) , INTENT( out) :: pvarout 712 CHARACTER(len=1), INTENT(in ) :: cd_ptin ! point of variable in/out 713 ! 714 INTEGER :: ji, jj, jk ! loop index 715 INTEGER :: ikt, ikb ! top and bottom index of the tbl 716 REAL(wp) :: ze3, zhk 721 717 REAL(wp), DIMENSION(:,:), POINTER :: zhisf_tbl ! thickness of the tbl 722 723 INTEGER :: ji, jj, jk ! loop index724 INTEGER :: ikt, ikb ! top and bottom index of the tbl725 718 !!---------------------------------------------------------------------- 726 719 ! allocation … … 736 729 ikt = miku(ji,jj) ; ikb = miku(ji,jj) 737 730 ! thickness of boundary layer at least the top level thickness 738 zhisf_tbl(ji,jj) = MAX( rhisf_tbl_0(ji,jj), e3u_n(ji,jj,ikt))731 zhisf_tbl(ji,jj) = MAX( rhisf_tbl_0(ji,jj) , e3u_n(ji,jj,ikt) ) 739 732 740 733 ! determine the deepest level influenced by the boundary layer … … 755 748 END DO 756 749 END DO 757 DO jj = 2,jpj 758 DO ji = 2,jpi 750 DO jj = 2, jpj 751 DO ji = 2, jpi 752 !!gm a wet-point only average should be used here !!! 759 753 pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji-1,jj)) 760 754 END DO … … 786 780 END DO 787 781 END DO 788 DO jj = 2,jpj 789 DO ji = 2,jpi 782 DO jj = 2, jpj 783 DO ji = 2, jpi 784 !!gm a wet-point only average should be used here !!! 790 785 pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji,jj-1)) 791 786 END DO … … 882 877 ! 883 878 END SUBROUTINE sbc_isf_div 879 884 880 !!====================================================================== 885 881 END MODULE sbcisf -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
r7646 r8143 72 72 INTEGER, PUBLIC, PARAMETER :: jpdyn_atf = 10 !: Asselin time filter 73 73 INTEGER, PUBLIC, PARAMETER :: jpdyn_tau = 11 !: surface stress 74 INTEGER, PUBLIC, PARAMETER :: jpdyn_bfri = 12 !: implicit bottom friction (ln_ bfrimp=.TRUE.)74 INTEGER, PUBLIC, PARAMETER :: jpdyn_bfri = 12 !: implicit bottom friction (ln_drgimp=.TRUE.) 75 75 INTEGER, PUBLIC, PARAMETER :: jpdyn_ken = 13 !: use for calculation of KE 76 76 ! -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
r6140 r8143 15 15 USE oce ! ocean dynamics and tracers variables 16 16 USE dom_oce ! ocean space and time domain variables 17 USE zdf_oce ! ocean vertical physics variables 17 USE phycst ! physical constants 18 USE sbc_oce ! surface boundary condition: ocean 19 USE zdf_oce ! ocean vertical physics: variables 20 USE zdfdrg ! ocean vertical physics: bottom friction 18 21 USE trd_oce ! trends: ocean variables 19 USE zdfbfr ! bottom friction20 USE sbc_oce ! surface boundary condition: ocean21 USE phycst ! physical constants22 22 USE trdken ! trends: Kinetic ENergy 23 23 USE trdglo ! trends: global domain averaged 24 24 USE trdvor ! trends: vertical averaged vorticity 25 25 USE trdmxl ! trends: mixed layer averaged 26 ! 26 27 USE in_out_manager ! I/O manager 27 28 USE lbclnk ! lateral boundary condition 28 29 USE iom ! I/O manager library 29 30 USE lib_mpp ! MPP library 30 USE wrk_nemo ! Memory allocation31 31 32 32 IMPLICIT NONE 33 33 PRIVATE 34 34 35 PUBLIC trd_dyn ! called by all dynXX modules35 PUBLIC trd_dyn ! called by all dynXXX modules 36 36 37 37 !! * Substitutions 38 38 # include "vectopt_loop_substitute.h90" 39 39 !!---------------------------------------------------------------------- 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010)40 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 41 41 !! $Id$ 42 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 103 103 INTEGER :: ji, jj, jk ! dummy loop indices 104 104 INTEGER :: ikbu, ikbv ! local integers 105 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace106 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace105 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace 107 107 !!---------------------------------------------------------------------- 108 108 ! … … 118 118 CASE( jpdyn_keg ) ; CALL iom_put( "utrd_keg", putrd ) ! Kinetic Energy gradient (or had) 119 119 CALL iom_put( "vtrd_keg", pvtrd ) 120 CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy)120 ALLOCATE( z3dx(jpi,jpj,jpk) , z3dy(jpi,jpj,jpk) ) 121 121 z3dx(:,:,:) = 0._wp ! U.dxU & V.dyV (approximation) 122 122 z3dy(:,:,:) = 0._wp … … 133 133 CALL iom_put( "utrd_udx", z3dx ) 134 134 CALL iom_put( "vtrd_vdy", z3dy ) 135 CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy )136 CASE( jpdyn_zad ) ; CALL iom_put( "utrd_zad", putrd ) ! vertical 135 DEALLOCATE( z3dx , z3dy ) 136 CASE( jpdyn_zad ) ; CALL iom_put( "utrd_zad", putrd ) ! vertical advection 137 137 CALL iom_put( "vtrd_zad", pvtrd ) 138 CASE( jpdyn_ldf ) ; CALL iom_put( "utrd_ldf", putrd ) ! lateral diffusion138 CASE( jpdyn_ldf ) ; CALL iom_put( "utrd_ldf", putrd ) ! lateral diffusion 139 139 CALL iom_put( "vtrd_ldf", pvtrd ) 140 140 CASE( jpdyn_zdf ) ; CALL iom_put( "utrd_zdf", putrd ) ! vertical diffusion 141 141 CALL iom_put( "vtrd_zdf", pvtrd ) 142 ! 142 143 ! ! wind stress trends 143 CALL wrk_alloc( jpi, jpj, z2dx, z2dy)144 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) ) 144 145 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 ) 145 146 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 ) 146 147 CALL iom_put( "utrd_tau", z2dx ) 147 148 CALL iom_put( "vtrd_tau", z2dy ) 148 CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 149 CASE( jpdyn_bfr ) ! called if ln_bfrimp=T 150 CALL iom_put( "utrd_bfr", putrd ) ! bottom friction (explicit case) 151 CALL iom_put( "vtrd_bfr", pvtrd ) 152 CASE( jpdyn_atf ) ; CALL iom_put( "utrd_atf", putrd ) ! asselin filter trends 153 CALL iom_put( "vtrd_atf", pvtrd ) 154 CASE( jpdyn_bfri ) ; IF( ln_bfrimp ) THEN ! bottom friction (implicit case) 155 CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy ) 149 DEALLOCATE( z2dx , z2dy ) 150 ! ! bottom stress tends (implicit case) 151 IF( ln_drgimp ) THEN 152 ALLOCATE( z3dx(jpi,jpj,jpk) , z3dy(jpi,jpj,jpk) ) 156 153 z3dx(:,:,:) = 0._wp ; z3dy(:,:,:) = 0._wp ! after velocity known (now filed at this stage) 157 154 DO jk = 1, jpkm1 … … 160 157 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 161 158 ikbv = mbkv(ji,jj) 162 z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) /e3u_n(ji,jj,ikbu)163 z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) /e3v_n(ji,jj,ikbv)159 z3dx(ji,jj,jk) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )*un(ji,jj,ikbu)/e3u_n(ji,jj,ikbu) 160 z3dy(ji,jj,jk) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )*vn(ji,jj,ikbv)/e3v_n(ji,jj,ikbv) 164 161 END DO 165 162 END DO 166 163 END DO 167 CALL lbc_lnk( z3dx, 'U', -1. ) ; CALL lbc_lnk( z3dy, 'V', -1. ) 168 CALL iom_put( "utrd_bfri", z3dx ) 169 CALL iom_put( "vtrd_bfri", z3dy ) 170 CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy ) 171 ENDIF 164 CALL lbc_lnk( z3dx, 'U', -1. ) ; CALL lbc_lnk( z3dy, 'V', -1. ) 165 CALL iom_put( "utrd_bfr", z3dx ) 166 CALL iom_put( "vtrd_bfr", z3dy ) 167 DEALLOCATE( z3dx , z3dy ) 168 ENDIF 169 CASE( jpdyn_bfr ) ! called if ln_drgimp=F 170 CALL iom_put( "utrd_bfr", putrd ) ! bottom friction (explicit case) 171 CALL iom_put( "vtrd_bfr", pvtrd ) 172 CASE( jpdyn_atf ) ; CALL iom_put( "utrd_atf", putrd ) ! asselin filter trends 173 CALL iom_put( "vtrd_atf", pvtrd ) 172 174 END SELECT 173 175 ! -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
r7931 r8143 9 9 10 10 !!---------------------------------------------------------------------- 11 !! trd_glo : domain averaged budget of trends (including kinetic energy and T^2 trends)12 !! glo_dyn_wri : print dynamic trends in ocean.output file13 !! glo_tra_wri : print global T & T^2 trends in ocean.output file14 !! trd_glo_init : initialization step11 !! trd_glo : domain averaged budget of trends (including kinetic energy and T^2 trends) 12 !! glo_dyn_wri : print dynamic trends in ocean.output file 13 !! glo_tra_wri : print global T & T^2 trends in ocean.output file 14 !! trd_glo_init : initialization step 15 15 !!---------------------------------------------------------------------- 16 USE oce 17 USE dom_oce 18 USE sbc_oce 19 USE trd_oce 20 USE phycst 21 USE ldftra 22 USE ldfdyn 23 USE zdf_oce 24 USE zdf bfr !bottom friction25 USE zdfddm 26 USE eosbn2 27 USE phycst 16 USE oce ! ocean dynamics and tracers variables 17 USE dom_oce ! ocean space and time domain variables 18 USE sbc_oce ! surface boundary condition: ocean 19 USE trd_oce ! trends: ocean variables 20 USE phycst ! physical constants 21 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 22 USE ldfdyn ! ocean dynamics: lateral physics 23 USE zdf_oce ! ocean vertical physics 24 USE zdfdrg ! ocean vertical physics: bottom friction 25 USE zdfddm ! ocean vertical physics: double diffusion 26 USE eosbn2 ! equation of state 27 USE phycst ! physical constants 28 28 ! 29 USE lib_mpp ! distibuted memory computing library 30 USE in_out_manager ! I/O manager 31 USE iom ! I/O manager library 32 USE wrk_nemo ! Memory allocation 29 USE lib_mpp ! distibuted memory computing library 30 USE in_out_manager ! I/O manager 31 USE iom ! I/O manager library 33 32 34 33 IMPLICIT NONE … … 77 76 INTEGER :: ikbu, ikbv ! local integers 78 77 REAL(wp):: zvm, zvt, zvs, z1_2rau0 ! local scalars 79 REAL(wp), POINTER, DIMENSION(:,:) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 80 !!---------------------------------------------------------------------- 81 82 CALL wrk_alloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy ) 83 78 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv, z2dx, z2dy ! 2D workspace 79 !!---------------------------------------------------------------------- 80 ! 84 81 IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN 85 82 ! … … 123 120 DO jj = 1, jpjm1 124 121 DO ji = 1, jpim1 125 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj 126 & * e1u (ji ,jj ) * e2u(ji,jj) * e3u_n(ji,jj,jk)127 zvs = ptrdy(ji,jj,jk) * tmask_i(ji 128 & * e1v (ji ,jj ) * e2v(ji,jj) * e3u_n(ji,jj,jk)122 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 123 & * e1e2u (ji,jj) * e3u_n(ji,jj,jk) 124 zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 125 & * e1e2v (ji,jj) * e3u_n(ji,jj,jk) 129 126 umo(ktrd) = umo(ktrd) + zvt 130 127 vmo(ktrd) = vmo(ktrd) + zvs … … 138 135 DO jj = 1, jpjm1 139 136 DO ji = 1, jpim1 140 zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj 141 & * z1_2rau0 * e1u (ji ,jj ) * e2u(ji,jj)142 zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji 143 & * z1_2rau0 * e1v (ji ,jj ) * e2v (ji,jj) * e3u_n(ji,jj,jk)137 zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 138 & * z1_2rau0 * e1e2u(ji,jj) 139 zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 140 & * z1_2rau0 * e1e2v(ji,jj) 144 141 umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 145 142 vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs … … 151 148 IF( ktrd == jpdyn_atf ) THEN ! last trend (asselin time filter) 152 149 ! 153 IF( ln_ bfrimp ) THEN ! implicit bfrcase: compute separately the bottom friction150 IF( ln_drgimp ) THEN ! implicit drag case: compute separately the bottom friction 154 151 z1_2rau0 = 0.5_wp / rau0 155 152 DO jj = 1, jpjm1 … … 157 154 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 158 155 ikbv = mbkv(ji,jj) 159 zvt = bfrua(ji,jj) * un(ji,jj,ikbu) * e1u(ji,jj) * e2v(ji,jj)160 zvs = bfrva(ji,jj) * vn(ji,jj,ikbv) * e1v(ji,jj) *e2v(ji,jj)156 zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * un(ji,jj,ikbu) * e1e2u(ji,jj) 157 zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vn(ji,jj,ikbv) * e1e2v(ji,jj) 161 158 umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt 162 159 vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs … … 165 162 END DO 166 163 ENDIF 164 !!gm top drag case is missing 167 165 ! 168 166 CALL glo_dyn_wri( kt ) ! print the results in ocean.output … … 178 176 ENDIF 179 177 ! 180 CALL wrk_dealloc( jpi, jpj, ztswu, ztswv, z2dx, z2dy )181 !182 178 END SUBROUTINE trd_glo 183 179 … … 193 189 INTEGER :: ji, jj, jk ! dummy loop indices 194 190 REAL(wp) :: zcof ! local scalar 195 REAL(wp), POINTER, DIMENSION(:,:,:) :: zkx, zky, zkz, zkepe 196 !!---------------------------------------------------------------------- 197 198 CALL wrk_alloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe ) 191 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zkx, zky, zkz, zkepe 192 !!---------------------------------------------------------------------- 199 193 200 194 ! I. Momentum trends … … 283 277 & + vmo(jpdyn_bfr) + vmo(jpdyn_atf) ) / tvolv 284 278 WRITE (numout,9513) umo(jpdyn_tau) / tvolu, vmo(jpdyn_tau) / tvolv 285 IF( ln_ bfrimp ) WRITE (numout,9514) umo(jpdyn_bfri) / tvolu, vmo(jpdyn_bfri) / tvolv279 IF( ln_drgimp ) WRITE (numout,9514) umo(jpdyn_bfri) / tvolu, vmo(jpdyn_bfri) / tvolv 286 280 ENDIF 287 281 … … 322 316 & + hke(jpdyn_bfr) + hke(jpdyn_atf) ) / tvolt 323 317 WRITE (numout,9533) hke(jpdyn_tau) / tvolt 324 IF( ln_ bfrimp ) WRITE (numout,9534) hke(jpdyn_bfri) / tvolt318 IF( ln_drgimp ) WRITE (numout,9534) hke(jpdyn_bfri) / tvolt 325 319 ENDIF 326 320 … … 372 366 ENDIF 373 367 ! 374 CALL wrk_dealloc( jpi, jpj, jpk, zkx, zky, zkz, zkepe )375 !376 368 END SUBROUTINE glo_dyn_wri 377 369 -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r7646 r8143 13 13 USE oce ! ocean dynamics and tracers variables 14 14 USE dom_oce ! ocean space and time domain variables 15 USE phycst ! physical constants 15 16 USE sbc_oce ! surface boundary condition: ocean 16 17 USE zdf_oce ! ocean vertical physics variables 18 USE zdfdrg ! ocean vertical physics: bottom friction 19 !!gm USE dynhpg ! hydrostatic pressure gradient 20 USE ldftra ! ocean active tracers lateral physics 17 21 USE trd_oce ! trends: ocean variables 18 !!gm USE dynhpg ! hydrostatic pressure gradient19 USE zdfbfr ! bottom friction20 USE ldftra ! ocean active tracers lateral physics21 USE phycst ! physical constants22 22 USE trdvor ! ocean vorticity trends 23 23 USE trdglo ! trends:global domain averaged … … 27 27 USE iom ! I/O manager library 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! Memory allocation30 29 USE ldfslp ! Isopycnal slopes 31 30 … … 74 73 !! diagnose separately the KE trend associated with wind stress 75 74 !! - bottom friction case (jpdyn_bfr): 76 !! explicit case (ln_ bfrimp=F): bottom trend put in the 1st level75 !! explicit case (ln_drgimp=F): bottom trend put in the 1st level 77 76 !! of putrd, pvtrd 78 77 ! … … 86 85 INTEGER :: ikbu , ikbv ! local integers 87 86 INTEGER :: ikbum1, ikbvm1 ! - - 88 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy, zke2d ! 2D workspace 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zke ! 3D workspace 90 !!---------------------------------------------------------------------- 91 ! 92 CALL wrk_alloc( jpi, jpj, jpk, zke ) 87 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: z2dx, z2dy, zke2d ! 2D workspace 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zke ! 3D workspace 89 !!---------------------------------------------------------------------- 93 90 ! 94 91 CALL lbc_lnk( putrd, 'U', -1. ) ; CALL lbc_lnk( pvtrd, 'V', -1. ) ! lateral boundary conditions … … 125 122 CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf" , zke ) ! vertical diffusion 126 123 ! ! ! wind stress trends 127 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d)124 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) , zke2d(jpi,jpj) ) 128 125 z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 129 126 z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) … … 136 133 END DO 137 134 CALL iom_put( "ketrd_tau" , zke2d ) ! 138 CALL wrk_dealloc( jpi, jpj , z2dx, z2dy, zke2d )135 DEALLOCATE( z2dx , z2dy , zke2d ) 139 136 CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr" , zke ) ! bottom friction (explicit case) 140 137 !!gm TO BE DONE properly 141 !!gm only valid if ln_ bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation....142 ! IF(.NOT. ln_ bfrimp) THEN138 !!gm only valid if ln_drgimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... 139 ! IF(.NOT. ln_drgimp) THEN 143 140 ! DO jj = 1, jpj ! 144 141 ! DO ji = 1, jpi … … 163 160 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... 164 161 ! 165 ! IF( ln_ bfrimp ) THEN ! bottom friction (implicit case)162 ! IF( ln_drgimp ) THEN ! bottom friction (implicit case) 166 163 ! DO jj = 1, jpj ! after velocity known (now filed at this stage) 167 164 ! DO ji = 1, jpi … … 192 189 END SELECT 193 190 ! 194 CALL wrk_dealloc( jpi, jpj, jpk, zke )195 !196 191 END SUBROUTINE trd_ken 197 192 … … 207 202 !! ** Work only for full steps and partial steps (ln_hpg_zco or ln_hpg_zps) 208 203 !!---------------------------------------------------------------------- 209 INTEGER, INTENT(in) :: kt ! ocean time-step index 210 !! 211 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: pconv 212 ! 213 INTEGER :: ji, jj, jk ! dummy loop indices 214 INTEGER :: iku, ikv ! temporary integers 215 REAL(wp) :: zcoef ! temporary scalars 216 REAL(wp), POINTER, DIMENSION(:,:,:) :: zconv ! temporary conv on W-grid 217 !!---------------------------------------------------------------------- 218 ! 219 CALL wrk_alloc( jpi,jpj,jpk, zconv ) 204 INTEGER , INTENT(in ) :: kt ! ocean time-step index 205 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pconv ! 206 ! 207 INTEGER :: ji, jj, jk ! dummy loop indices 208 INTEGER :: iku, ikv ! local integers 209 REAL(wp) :: zcoef ! local scalars 210 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zconv ! 3D workspace 211 !!---------------------------------------------------------------------- 220 212 ! 221 213 ! Local constant initialization … … 240 232 END DO 241 233 ! 242 CALL wrk_dealloc( jpi,jpj,jpk, zconv )243 !244 234 END SUBROUTINE ken_p2k 245 235 -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
r8093 r8143 4 4 !! Ocean physics : define vertical mixing variables 5 5 !!===================================================================== 6 !! history : 1.0 ! 2002-06 (G. Madec) Original code 7 !! 3.2 ! 2009-07 (G.Madec) addition of avm 6 !! history : 1.0 ! 2002-06 (G. Madec) Original code 7 !! 3.2 ! 2009-07 (G. Madec) addition of avm 8 !! 4.0 ! 2017-05 (G. Madec) drag coef. defined at t-point (zdfdrg.F90) 8 9 !!---------------------------------------------------------------------- 9 10 USE par_oce ! ocean parameters … … 54 55 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: avtb_2d !: horizontal shape of background Kz profile 55 56 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: avmb , avtb !: background profile of avm and avt 56 !!gm57 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: bfrua, bfrva !: bottom friction coefficients58 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: tfrua, tfrva !: top friction coefficients59 !!gm60 57 61 58 !!---------------------------------------------------------------------- … … 71 68 !!---------------------------------------------------------------------- 72 69 ! 73 ALLOCATE( avm (jpi,jpj,jpk) , avt (jpi,jpj,jpk) , avs(jpi,jpj,jpk) , & 74 & avm_k(jpi,jpj,jpk) , avt_k(jpi,jpj,jpk) , en (jpi,jpj,jpk) , & 75 & avmb(jpk) , bfrua(jpi,jpj) , tfrua(jpi, jpj) , & 76 & avtb(jpk) , bfrva(jpi,jpj) , tfrva(jpi, jpj) , avtb_2d(jpi,jpj) , & 77 & avmu(jpi,jpj,jpk), avmv(jpi,jpj,jpk) , STAT = zdf_oce_alloc ) 70 ALLOCATE( avm (jpi,jpj,jpk) , avt (jpi,jpj,jpk) , avs(jpi,jpj,jpk) , & 71 & avm_k(jpi,jpj,jpk) , avt_k(jpi,jpj,jpk) , en (jpi,jpj,jpk) , & 72 & avmb(jpk) , avtb(jpk) , avtb_2d(jpi,jpj) , & 73 & avmu(jpi,jpj,jpk), avmv(jpi,jpj,jpk) , STAT = zdf_oce_alloc ) 78 74 ! 79 75 IF( zdf_oce_alloc /= 0 ) CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfdrg.F90
r8093 r8143 10 10 !! 3.4 ! 2011-11 (H. Liu) implementation of semi-implicit bottom friction option 11 11 !! ! 2012-06 (H. Liu) implementation of Log Layer bottom friction option 12 !! 4.0 ! 2017-05 (G. Madec) zdfbfr becomes zdfdrg + variable names change 13 !! + drag defined at t-point + new user interface + top drag (ocean cavities) 12 14 !!---------------------------------------------------------------------- 13 15 … … 28 30 USE prtctl ! Print control 29 31 USE timing ! Timing 30 USE wrk_nemo ! Memory Allocation31 32 32 33 IMPLICIT NONE … … 137 138 ENDIF 138 139 ! 139 !!gm to be moved at the end of zdfphy140 CALL lbc_lnk( pCdU, 'T', 1. ) ! Lateral boundary condition141 !!gm end142 !143 140 IF(ln_ctl) CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ') 144 141 ! -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r8093 r8143 8 8 !! 3.3 ! 2010-10 (C. Bricaud) Add in the reference 9 9 !! 4.0 ! 2017-04 (G. Madec) remove CPP keys & avm at t-point only 10 !! - ! 2017-05 (G. Madec) add top friction as boundary condition 10 11 !!---------------------------------------------------------------------- 11 12 … … 19 20 USE domvvl ! ocean space and time domain : variable volume layer 20 21 USE zdf_oce ! ocean vertical physics 21 !!gm old22 USE zdfbfr , ONLY : rn_tfrz0, rn_bfrz0 ! top/bottom roughness23 !!gm new24 22 USE zdfdrg , ONLY : r_z0_top , r_z0_bot ! top/bottom roughness 25 23 USE zdfdrg , ONLY : rCdU_top , rCdU_bot ! top/bottom friction 26 !!gm27 24 USE sbc_oce ! surface boundary condition: ocean 28 25 USE phycst ! physical constants … … 32 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 30 USE lib_mpp ! MPP manager 34 USE wrk_nemo ! work arrays35 31 USE prtctl ! Print control 36 32 USE in_out_manager ! I/O manager … … 149 145 REAL(wp) :: prod, buoy, diss, zdiss, sm ! - - 150 146 REAL(wp) :: gh, gm, shr, dif, zsqen, zavt, zavm ! - - 147 REAL(wp) :: zmsku, zmskv ! - - 151 148 REAL(wp), DIMENSION(jpi,jpj) :: zdep 152 149 REAL(wp), DIMENSION(jpi,jpj) :: zkar … … 158 155 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwall_psi ! Wall function use in the wb case (ln_sigpsi) 159 156 REAL(wp), DIMENSION(jpi,jpj,jpk) :: psi ! psi at time now 160 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z_elem_a ! element of the first matrix diagonal 161 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z_elem_b ! element of the second matrix diagonal 162 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z_elem_c ! element of the third matrix diagonal 157 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zd_lw, zd_up, zdiag ! lower, upper and diagonal of the matrix 163 158 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zstt, zstm ! stability function on tracer and momentum 164 159 !!-------------------------------------------------------------------- … … 171 166 ustar2_top (:,:) = 0._wp ; zwall_psi(:,:,:) = 0._wp 172 167 ustar2_bot (:,:) = 0._wp 173 174 175 168 176 169 ! Compute surface, top and bottom friction at T-points … … 181 174 ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 182 175 ! 183 !!gm old184 ! bottom friction (explicit before friction)185 ! Note that we chose here not to bound the friction as in dynbfr)186 ztx2 = ( bfrua(ji,jj) * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) ) &187 & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1) )188 zty2 = ( bfrva(ji,jj) * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1)) ) &189 & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1) )190 ustar2_bot(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)191 END DO192 END DO193 !!gm new194 176 !!gm Rq we may add here r_ke0(_top/_bot) ? ==>> think about that... 195 !! bottom friction (explicit before friction)196 !zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) )197 !zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) ! (CAUTION: CdU<0)198 ! ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 199 !& + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 )200 !END DO201 !END DO202 !IF( ln_isfcav ) THEN !top friction203 !DO jj = 2, jpjm1204 !DO ji = fs_2, fs_jpim1 ! vector opt.205 !zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) )206 !zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) ! (CAUTION: CdU<0)207 ! ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 208 !& + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 )209 !END DO210 !END DO211 !ENDIF212 !!gm 177 ! bottom friction (explicit before friction) 178 zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 179 zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) ! (CAUTION: CdU<0) 180 ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 & 181 & + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 ) 182 END DO 183 END DO 184 IF( ln_isfcav ) THEN !top friction 185 DO jj = 2, jpjm1 186 DO ji = fs_2, fs_jpim1 ! vector opt. 187 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 188 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) ! (CAUTION: CdU<0) 189 ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 & 190 & + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 ) 191 END DO 192 END DO 193 ENDIF 194 213 195 SELECT CASE ( nn_z0_met ) !== Set surface roughness length ==! 214 196 CASE ( 0 ) ! Constant roughness … … 261 243 ! The surface boundary condition are set after 262 244 ! The bottom boundary condition are also set after. In standard e(bottom)=0. 263 ! z _elem_b : diagonal z_elem_c : upper diagonal z_elem_a: lower diagonal245 ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal 264 246 ! Warning : after this step, en : right hand side of the matrix 265 247 … … 296 278 zcof = rfact_tke * tmask(ji,jj,jk) 297 279 ! ! lower diagonal 298 z _elem_a(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )280 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) ) 299 281 ! ! upper diagonal 300 z _elem_c(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) )282 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) ) 301 283 ! ! diagonal 302 z _elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk)284 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) 303 285 ! ! right hand side in en 304 286 en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) … … 307 289 END DO 308 290 ! 309 z _elem_b(:,:,jpk) = 1._wp291 zdiag(:,:,jpk) = 1._wp 310 292 ! 311 293 ! Set surface condition on zwall_psi (1 at the bottom) … … 318 300 SELECT CASE ( nn_bc_surf ) 319 301 ! 320 CASE ( 0 ) ! Dirichlet case302 CASE ( 0 ) ! Dirichlet boundary condition (set e at k=1 & 2) 321 303 ! First level 322 en(:,:,1) = rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1)**r2_3 323 en(:,:,1) = MAX(en(:,:,1), rn_emin) 324 z_elem_a(:,:,1) = en(:,:,1) 325 z_elem_c(:,:,1) = 0._wp 326 z_elem_b(:,:,1) = 1._wp 304 en (:,:,1) = MAX( rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1)**r2_3 ) 305 zd_lw(:,:,1) = en(:,:,1) 306 zd_up(:,:,1) = 0._wp 307 zdiag(:,:,1) = 1._wp 327 308 ! 328 309 ! One level below 329 en(:,:,2) = rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2)) & 330 & / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp) 331 en(:,:,2) = MAX(en(:,:,2), rn_emin ) 332 z_elem_a(:,:,2) = 0._wp 333 z_elem_c(:,:,2) = 0._wp 334 z_elem_b(:,:,2) = 1._wp 335 ! 336 ! 337 CASE ( 1 ) ! Neumann boundary condition on d(e)/dz 310 en (:,:,2) = MAX( rc02r * ustar2_surf(:,:) * ( 1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2)) & 311 & / zhsro(:,:) )**(1.5_wp*ra_sf) )**(2._wp/3._wp) , rn_emin ) 312 zd_lw(:,:,2) = 0._wp 313 zd_up(:,:,2) = 0._wp 314 zdiag(:,:,2) = 1._wp 315 ! 316 ! 317 CASE ( 1 ) ! Neumann boundary condition (set d(e)/dz) 338 318 ! 339 319 ! Dirichlet conditions at k=1 340 en(:,:,1) = rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1)**r2_3 341 en(:,:,1) = MAX(en(:,:,1), rn_emin) 342 z_elem_a(:,:,1) = en(:,:,1) 343 z_elem_c(:,:,1) = 0._wp 344 z_elem_b(:,:,1) = 1._wp 320 en (:,:,1) = MAX( rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1)**r2_3 , rn_emin ) 321 zd_lw(:,:,1) = en(:,:,1) 322 zd_up(:,:,1) = 0._wp 323 zdiag(:,:,1) = 1._wp 345 324 ! 346 325 ! at k=2, set de/dz=Fw 347 326 !cbr 348 z _elem_b(:,:,2) = z_elem_b(:,:,2) + z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b349 z _elem_a(:,:,2) = 0._wp350 zkar (:,:)= (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) ))351 zflxs(:,:) 352 & * ((zhsro(:,:)+gdept_n(:,:,1)) / zhsro(:,:))**(1.5_wp*ra_sf)353 354 en(:,:,2) = en(:,:,2) + zflxs(:,:) /e3w_n(:,:,2)327 zdiag(:,:,2) = zdiag(:,:,2) + zd_lw(:,:,2) ! Remove zd_lw from zdiag 328 zd_lw(:,:,2) = 0._wp 329 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) )) 330 zflxs(:,:) = rsbc_tke2 * ustar2_surf(:,:)**1.5_wp * zkar(:,:) & 331 & * ( ( zhsro(:,:)+gdept_n(:,:,1) ) / zhsro(:,:) )**(1.5_wp*ra_sf) 332 !!gm why not : * ( 1._wp + gdept_n(:,:,1) / zhsro(:,:) )**(1.5_wp*ra_sf) 333 en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w_n(:,:,2) 355 334 ! 356 335 ! … … 377 356 ! Dirichlet condition applied at: 378 357 ! Bottom level (ibot) & Just above it (ibotm1) 379 z _elem_a(ji,jj,ibot) = 0._wp ; z_elem_a(ji,jj,ibotm1) = 0._wp380 z _elem_c(ji,jj,ibot) = 0._wp ; z_elem_c(ji,jj,ibotm1) = 0._wp381 z _elem_b(ji,jj,ibot) = 1._wp ; z_elem_b(ji,jj,ibotm1) = 1._wp382 en (ji,jj,ibot) = z_en ; en(ji,jj,ibotm1) = z_en383 END DO 384 END DO 385 !!gm new 386 !IF( ln_isfcav) THEN ! top boundary (ocean cavity)387 !DO jj = 2, jpjm1388 !DO ji = fs_2, fs_jpim1 ! vector opt.389 !itop = mikt(ji,jj) ! k top w-point390 !itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one391 !! ! mask at the ocean surface points392 !z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) )393 !!394 ! ! Dirichlet condition applied at: 395 ! ! top level (itop) & Just below it (itopp1)396 ! z_elem_a(ji,jj,itop) = 0._wp ; z_elem_a(ji,jj,ipotm1) = 0._wp 397 ! z_elem_c(ji,jj,itop) = 0._wp ; z_elem_c(ji,jj,itopp1) = 0._wp398 ! z_elem_b(ji,jj,itop) = 1._wp ; z_elem_b(ji,jj,itopp1) = 1._wp399 ! en (ji,jj,itop) = zen ; en (ji,jj,itopp1) = z_en 400 ! END DO 401 !END DO402 ! ENDIF 403 !!gm 358 zd_lw(ji,jj,ibot) = 0._wp ; zd_lw(ji,jj,ibotm1) = 0._wp 359 zd_up(ji,jj,ibot) = 0._wp ; zd_up(ji,jj,ibotm1) = 0._wp 360 zdiag(ji,jj,ibot) = 1._wp ; zdiag(ji,jj,ibotm1) = 1._wp 361 en (ji,jj,ibot) = z_en ; en (ji,jj,ibotm1) = z_en 362 END DO 363 END DO 364 ! 365 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 366 DO jj = 2, jpjm1 367 DO ji = fs_2, fs_jpim1 ! vector opt. 368 itop = mikt(ji,jj) ! k top w-point 369 itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one 370 ! ! mask at the ocean surface points 371 z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 372 ! 373 !!gm TO BE VERIFIED !!! 374 ! Dirichlet condition applied at: 375 ! top level (itop) & Just below it (itopp1) 376 zd_lw(ji,jj,itop) = 0._wp ; zd_lw(ji,jj,itopp1) = 0._wp 377 zd_up(ji,jj,itop) = 0._wp ; zd_up(ji,jj,itopp1) = 0._wp 378 zdiag(ji,jj,itop) = 1._wp ; zdiag(ji,jj,itopp1) = 1._wp 379 en (ji,jj,itop) = z_en ; en (ji,jj,itopp1) = z_en 380 END DO 381 END DO 382 ENDIF 404 383 ! 405 384 CASE ( 1 ) ! Neumman boundary condition … … 415 394 ! Bottom level (ibot) & Just above it (ibotm1) 416 395 ! Dirichlet ! Neumann 417 z_elem_a(ji,jj,ibot) = 0._wp ! ! Remove z_elem_c from z_elem_b 418 z_elem_b(ji,jj,ibot) = 1._wp ; z_elem_b(ji,jj,ibotm1) = z_elem_b(ji,jj,ibotm1) + z_elem_c(ji,jj,ibotm1) 419 z_elem_c(ji,jj,ibot) = 0._wp ; z_elem_c(ji,jj,ibotm1) = 0._wp 420 END DO 421 END DO 422 !!gm new 423 ! IF( ln_isfcav) THEN ! top boundary (ocean cavity) 424 ! DO jj = 2, jpjm1 425 ! DO ji = fs_2, fs_jpim1 ! vector opt. 426 ! itop = mikt(ji,jj) ! k top w-point 427 ! itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one 428 ! ! ! mask at the ocean surface points 429 ! z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 430 ! ! 431 ! ! Bottom level Dirichlet condition: 432 ! ! Bottom level (ibot) & Just above it (ibotm1) 433 ! ! Dirichlet ! Neumann 434 ! z_elem_a(ji,jj,itop) = 0._wp ! ! Remove z_elem_c from z_elem_b 435 ! z_elem_b(ji,jj,itop) = 1._wp ; z_elem_b(ji,jj,itopp1) = z_elem_b(ji,jj,itopp1) + z_elem_c(ji,jj,itopp1) 436 ! z_elem_c(ji,jj,itop) = 0._wp ; z_elem_c(ji,jj,itopp1) = 0._wp 437 ! END DO 438 ! END DO 439 ! ENDIF 440 !!gm 396 zd_lw(ji,jj,ibot) = 0._wp ! ! Remove zd_up from zdiag 397 zdiag(ji,jj,ibot) = 1._wp ; zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) 398 zd_up(ji,jj,ibot) = 0._wp ; zd_up(ji,jj,ibotm1) = 0._wp 399 END DO 400 END DO 401 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 402 DO jj = 2, jpjm1 403 DO ji = fs_2, fs_jpim1 ! vector opt. 404 itop = mikt(ji,jj) ! k top w-point 405 itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one 406 ! ! mask at the ocean surface points 407 z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 408 ! 409 ! Bottom level Dirichlet condition: 410 ! Bottom level (ibot) & Just above it (ibotm1) 411 ! Dirichlet ! Neumann 412 zd_lw(ji,jj,itop) = 0._wp ! ! Remove zd_up from zdiag 413 zdiag(ji,jj,itop) = 1._wp ; zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1) 414 zd_up(ji,jj,itop) = 0._wp ; zd_up(ji,jj,itopp1) = 0._wp 415 END DO 416 END DO 417 ENDIF 441 418 ! 442 419 END SELECT … … 448 425 DO jj = 2, jpjm1 449 426 DO ji = fs_2, fs_jpim1 ! vector opt. 450 z _elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1)427 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 451 428 END DO 452 429 END DO … … 455 432 DO jj = 2, jpjm1 456 433 DO ji = fs_2, fs_jpim1 ! vector opt. 457 z _elem_a(ji,jj,jk) = en(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1)434 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 458 435 END DO 459 436 END DO … … 462 439 DO jj = 2, jpjm1 463 440 DO ji = fs_2, fs_jpim1 ! vector opt. 464 en(ji,jj,jk) = ( z _elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * en(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)441 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 465 442 END DO 466 443 END DO … … 519 496 ! Resolution of a tridiagonal linear system by a "methode de chasse" 520 497 ! computation from level 2 to jpkm1 (e(1) already computed and e(jpk)=0 ). 521 ! z _elem_b : diagonal z_elem_c : upper diagonal z_elem_a: lower diagonal498 ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal 522 499 ! Warning : after this step, en : right hand side of the matrix 523 500 … … 543 520 diss = rpsi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk) 544 521 ! 545 zdir = 0.5_wp + SIGN( 0.5_wp, prod + buoy ) ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)522 zdir = 0.5_wp + SIGN( 0.5_wp, prod + buoy ) ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0) 546 523 ! 547 524 zesh2 = zdir * ( prod + buoy ) + (1._wp - zdir ) * prod ! production term … … 551 528 zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk) 552 529 ! ! lower diagonal 553 z _elem_a(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) )530 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) ) 554 531 ! ! upper diagonal 555 z _elem_c(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) )532 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) ) 556 533 ! ! diagonal 557 z _elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk)534 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) 558 535 ! ! right hand side in psi 559 536 psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) … … 562 539 END DO 563 540 ! 564 z _elem_b(:,:,jpk) = 1._wp541 zdiag(:,:,jpk) = 1._wp 565 542 566 543 ! Surface boundary condition on psi … … 574 551 zdep (:,:) = zhsro(:,:) * rl_sf ! Cosmetic 575 552 psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 576 z _elem_a(:,:,1) = psi(:,:,1)577 z _elem_c(:,:,1) = 0._wp578 z _elem_b(:,:,1) = 1._wp553 zd_lw(:,:,1) = psi(:,:,1) 554 zd_up(:,:,1) = 0._wp 555 zdiag(:,:,1) = 1._wp 579 556 ! 580 557 ! One level below … … 582 559 zdep (:,:) = (zhsro(:,:) + gdepw_n(:,:,2)) * zkar(:,:) 583 560 psi (:,:,2) = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 584 z _elem_a(:,:,2) = 0._wp585 z _elem_c(:,:,2) = 0._wp586 z _elem_b(:,:,2) = 1._wp561 zd_lw(:,:,2) = 0._wp 562 zd_up(:,:,2) = 0._wp 563 zdiag(:,:,2) = 1._wp 587 564 ! 588 565 CASE ( 1 ) ! Neumann boundary condition on d(psi)/dz … … 591 568 zdep (:,:) = zhsro(:,:) * rl_sf 592 569 psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 593 z _elem_a(:,:,1) = psi(:,:,1)594 z _elem_c(:,:,1) = 0._wp595 z _elem_b(:,:,1) = 1._wp570 zd_lw(:,:,1) = psi(:,:,1) 571 zd_up(:,:,1) = 0._wp 572 zdiag(:,:,1) = 1._wp 596 573 ! 597 574 ! Neumann condition at k=2 598 z _elem_b(:,:,2) = z_elem_b(:,:,2) + z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b599 z _elem_a(:,:,2) = 0._wp575 zdiag(:,:,2) = zdiag(:,:,2) + zd_lw(:,:,2) ! Remove zd_lw from zdiag 576 zd_lw(:,:,2) = 0._wp 600 577 ! 601 578 ! Set psi vertical flux at the surface: … … 613 590 ! -------------------------------- 614 591 ! 615 SELECT CASE ( nn_bc_bot ) 592 !!gm should be done for ISF (top boundary cond.) 593 !!gm so, totally new staff needed ===>>> think about that ! 594 ! 595 SELECT CASE ( nn_bc_bot ) ! bottom boundary 616 596 ! 617 597 CASE ( 0 ) ! Dirichlet 618 ! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r n_bfrz0598 ! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot 619 599 ! ! Balance between the production and the dissipation terms 620 600 DO jj = 2, jpjm1 … … 622 602 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 623 603 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 624 zdep(ji,jj) = vkarmn * r n_bfrz0604 zdep(ji,jj) = vkarmn * r_z0_bot 625 605 psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn 626 z _elem_a(ji,jj,ibot) = 0._wp627 z _elem_c(ji,jj,ibot) = 0._wp628 z _elem_b(ji,jj,ibot) = 1._wp606 zd_lw(ji,jj,ibot) = 0._wp 607 zd_up(ji,jj,ibot) = 0._wp 608 zdiag(ji,jj,ibot) = 1._wp 629 609 ! 630 610 ! Just above last level, Dirichlet condition again (GOTM like) 631 zdep(ji,jj) = vkarmn * ( r n_bfrz0+ e3t_n(ji,jj,ibotm1) )611 zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t_n(ji,jj,ibotm1) ) 632 612 psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot )**rmm * zdep(ji,jj)**rnn 633 z _elem_a(ji,jj,ibotm1) = 0._wp634 z _elem_c(ji,jj,ibotm1) = 0._wp635 z _elem_b(ji,jj,ibotm1) = 1._wp613 zd_lw(ji,jj,ibotm1) = 0._wp 614 zd_up(ji,jj,ibotm1) = 0._wp 615 zdiag(ji,jj,ibotm1) = 1._wp 636 616 END DO 637 617 END DO … … 645 625 ! 646 626 ! Bottom level Dirichlet condition: 647 zdep(ji,jj) = vkarmn * r n_bfrz0627 zdep(ji,jj) = vkarmn * r_z0_bot 648 628 psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn 649 629 ! 650 z _elem_a(ji,jj,ibot) = 0._wp651 z _elem_c(ji,jj,ibot) = 0._wp652 z _elem_b(ji,jj,ibot) = 1._wp630 zd_lw(ji,jj,ibot) = 0._wp 631 zd_up(ji,jj,ibot) = 0._wp 632 zdiag(ji,jj,ibot) = 1._wp 653 633 ! 654 634 ! Just above last level: Neumann condition with flux injection 655 z _elem_b(ji,jj,ibotm1) = z_elem_b(ji,jj,ibotm1) + z_elem_c(ji,jj,ibotm1) ! Remove z_elem_c from z_elem_b656 z _elem_c(ji,jj,ibotm1) = 0.635 zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) ! Remove zd_up from zdiag 636 zd_up(ji,jj,ibotm1) = 0. 657 637 ! 658 638 ! Set psi vertical flux at the bottom: 659 zdep(ji,jj) = r n_bfrz0+ 0.5_wp*e3t_n(ji,jj,ibotm1)639 zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t_n(ji,jj,ibotm1) 660 640 zflxb = rsbc_psi2 * ( p_avm(ji,jj,ibot) + p_avm(ji,jj,ibotm1) ) & 661 641 & * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp) … … 672 652 DO jj = 2, jpjm1 673 653 DO ji = fs_2, fs_jpim1 ! vector opt. 674 z _elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1)654 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 675 655 END DO 676 656 END DO … … 679 659 DO jj = 2, jpjm1 680 660 DO ji = fs_2, fs_jpim1 ! vector opt. 681 z _elem_a(ji,jj,jk) = psi(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1)661 zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 682 662 END DO 683 663 END DO … … 686 666 DO jj = 2, jpjm1 687 667 DO ji = fs_2, fs_jpim1 ! vector opt. 688 psi(ji,jj,jk) = ( z _elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * psi(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)668 psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 689 669 END DO 690 670 END DO … … 814 794 zstm(:,:,1) = zstm(:,:,2) 815 795 816 !!gm should be done for ISF (top boundary cond.)817 796 DO jj = 2, jpjm1 818 797 DO ji = fs_2, fs_jpim1 ! vector opt. … … 820 799 END DO 821 800 END DO 801 !!gm should be done for ISF (top boundary cond.) 802 !!gm so, totally new staff needed!!gm 822 803 823 804 ! Compute diffusivities/viscosities … … 904 885 WRITE(numout,*) ' Type of closure nn_clos = ', nn_clos 905 886 WRITE(numout,*) ' Surface roughness (m) rn_hsro = ', rn_hsro 906 !!gm old 907 WRITE(numout,*) ' top roughness (m) (nambfr namelist) rn_tfrz0 = ', rn_tfrz0 908 WRITE(numout,*) ' Bottom roughness (m) (nambfr namelist) rn_bfrz0 = ', rn_bfrz0 909 !!gm new 910 ! WRITE(numout,*) ' Namelist namdrg_top/_bot used values:' 911 ! WRITE(numout,*) ' top ocean cavity roughness (m) rn_z0(_top) = ', r_z0_top 912 ! WRITE(numout,*) ' Bottom seafloor roughness (m) rn_z0(_bot) = ', r_z0_bot 913 !!gm 887 WRITE(numout,*) 888 WRITE(numout,*) ' Namelist namdrg_top/_bot: used values:' 889 WRITE(numout,*) ' top ocean cavity roughness (m) rn_z0(_top) = ', r_z0_top 890 WRITE(numout,*) ' Bottom seafloor roughness (m) rn_z0(_bot) = ', r_z0_bot 914 891 WRITE(numout,*) 915 892 ENDIF -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r7753 r8143 11 11 !! zdf_mxl : Compute the turbocline and mixed layer depths. 12 12 !!---------------------------------------------------------------------- 13 USE oce ! ocean dynamics and tracers variables 14 USE dom_oce ! ocean space and time domain variables 15 USE trc_oce, ONLY: l_offline ! ocean space and time domain variables 16 USE zdf_oce ! ocean vertical physics 17 USE in_out_manager ! I/O manager 18 USE prtctl ! Print control 19 USE phycst ! physical constants 20 USE iom ! I/O library 21 USE lib_mpp ! MPP library 22 USE wrk_nemo ! work arrays 23 USE timing ! Timing 13 USE oce ! ocean dynamics and tracers variables 14 USE dom_oce ! ocean space and time domain variables 15 USE trc_oce , ONLY: l_offline ! ocean space and time domain variables 16 USE zdf_oce ! ocean vertical physics 17 USE in_out_manager ! I/O manager 18 USE prtctl ! Print control 19 USE phycst ! physical constants 20 USE iom ! I/O library 21 USE lib_mpp ! MPP library 22 USE timing ! Timing 24 23 25 24 IMPLICIT NONE 26 25 PRIVATE 27 26 28 PUBLIC zdf_mxl ! called by step.F9027 PUBLIC zdf_mxl ! called by zdfphy.F90 29 28 30 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nmln !: number of level in the mixed layer (used by TOP)31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld !: mixing layer depth (turbocline) [m] 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmlp !: mixed layer depth (rho=rho0+zdcrit) [m] 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmlpt !: depth of the last T-point inside the mixed layer [m] 29 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nmln !: number of level in the mixed layer (used by LDF, ZDF, TRD, TOP) 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld !: mixing layer depth (turbocline) [m] (used by TOP) 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmlp !: mixed layer depth (rho=rho0+zdcrit) [m] (used by LDF) 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmlpt !: depth of the last T-point inside the mixed layer [m] (used by LDF) 34 33 35 34 REAL(wp), PUBLIC :: rho_c = 0.01_wp !: density criterion for mixed layer depth … … 37 36 38 37 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 4.0 , NEMO Consortium (201 1)38 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 40 39 !! $Id$ 41 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 80 79 INTEGER :: iikn, iiki, ikt ! local integer 81 80 REAL(wp) :: zN2_c ! local scalar 82 INTEGER, POINTER, DIMENSION(:,:) :: imld ! 2D workspace81 INTEGER, DIMENSION(jpi,jpj) :: imld ! 2D workspace 83 82 !!---------------------------------------------------------------------- 84 83 ! 85 84 IF( nn_timing == 1 ) CALL timing_start('zdf_mxl') 86 85 ! 87 CALL wrk_alloc( jpi,jpj, imld )88 89 86 IF( kt == nit000 ) THEN 90 87 IF(lwp) WRITE(numout,*) … … 144 141 IF(ln_ctl) CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 ) 145 142 ! 146 CALL wrk_dealloc( jpi,jpj, imld )147 !148 143 IF( nn_timing == 1 ) CALL timing_stop('zdf_mxl') 149 144 ! -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfphy.F90
r8093 r8143 14 14 USE zdf_oce ! vertical physics: shared variables 15 15 USE zdfdrg ! vertical physics: top/bottom drag coef. 16 !!gm old17 USE zdfbfr ! vertical physics: bottom friction18 !!gm19 16 USE zdfsh2 ! vertical physics: shear production term of TKE 20 17 USE zdfric ! vertical physics: RIChardson dependent vertical mixing … … 195 192 ! !== top/bottom friction ==! 196 193 CALL zdf_drg_init 197 !!gm old198 CALL zdf_bfr_init199 !!gm200 194 ! 201 195 ! !== time-stepping ==! … … 224 218 !! --------------------------------------------------------------------- 225 219 ! 226 !!gm old 227 CALL zdf_bfr( kt ) !* bottom friction (if quadratic) 228 !!gm 229 ! 230 ! IF( l_zdfdrg ) THEN !== update top/bottom drag ==! (non-linear cases) 231 ! ! 232 ! ! !* bottom drag 233 ! CALL zdf_drg( kt, mbkt , r_Cdmin_bot, r_Cdmax_bot, & ! <<== in 234 ! & r_z0_bot, r_ke0_bot, rCd0_bot, & 235 ! & rCdU_bot ) ! ==>> out : bottom drag [m/s] 236 ! IF( ln_isfcav ) THEN !* top drag (ocean cavities) 237 ! CALL zdf_drg( kt, mikt , r_Cdmin_top, r_Cdmax_top, & ! <<== in 238 ! & r_z0_top, r_ke0_top, rCd0_top, & 239 ! & rCdU_top ) ! ==>> out : bottom drag [m/s] 240 ! ENDIF 241 ! ENDIF 220 IF( l_zdfdrg ) THEN !== update top/bottom drag ==! (non-linear cases) 221 ! 222 ! !* bottom drag 223 CALL zdf_drg( kt, mbkt , r_Cdmin_bot, r_Cdmax_bot, & ! <<== in 224 & r_z0_bot, r_ke0_bot, rCd0_bot, & 225 & rCdU_bot ) ! ==>> out : bottom drag [m/s] 226 IF( ln_isfcav ) THEN !* top drag (ocean cavities) 227 CALL zdf_drg( kt, mikt , r_Cdmin_top, r_Cdmax_top, & ! <<== in 228 & r_z0_top, r_ke0_top, rCd0_top, & 229 & rCdU_top ) ! ==>> out : bottom drag [m/s] 230 ENDIF 231 ENDIF 242 232 ! 243 233 ! !== Kz from chosen turbulent closure ==! (avm_k, avt_k) … … 290 280 CALL lbc_lnk( avs , 'W', 1. ) !!gm To be tested 291 281 ! 292 293 282 IF( l_zdfdrg ) THEN ! drag have been updated (non-linear cases) 283 IF( ln_isfcav ) CALL lbc_lnk( rCdU_top, 'T', 1. ) ! top drag 284 CALL lbc_lnk( rCdU_bot, 'T', 1. ) ! bottom drag 285 ENDIF 286 ! 294 287 CALL zdf_mxl( kt ) !* mixed layer depth, and level 295 288 -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r8093 r8143 61 61 SUBROUTINE zdf_ric_init 62 62 !!---------------------------------------------------------------------- 63 !! *** ROUTINE zdf bfr_init ***63 !! *** ROUTINE zdf_ric_init *** 64 64 !! 65 65 !! ** Purpose : Initialization of the vertical eddy diffusivity and … … 90 90 IF(lwp) THEN ! Control print 91 91 WRITE(numout,*) 92 WRITE(numout,*) 'zdf_ric : Ri depend vertical mixing scheme'93 WRITE(numout,*) '~~~~~~~ '92 WRITE(numout,*) 'zdf_ric_init : Ri depend vertical mixing scheme' 93 WRITE(numout,*) '~~~~~~~~~~~~' 94 94 WRITE(numout,*) ' Namelist namzdf_ric : set Kz=F(Ri) parameters' 95 95 WRITE(numout,*) ' maximum vertical viscosity rn_avmri = ', rn_avmri -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r8093 r8143 28 28 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 29 29 !! 4.0 ! 2017-04 (G. Madec) remove CPP ddm key & avm at t-point only 30 !! - ! 2017-05 (G. Madec) add top/bottom friction as boundary condition (ln_drg) 30 31 !!---------------------------------------------------------------------- 31 32 … … 43 44 USE sbc_oce ! surface boundary condition: ocean 44 45 USE zdf_oce ! vertical physics: ocean variables 45 !!gm new46 46 USE zdfdrg ! vertical physics: top/bottom drag coef. 47 !!gm48 47 USE zdfmxl ! vertical physics: mixed layer 49 48 #if defined key_agrif … … 57 56 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 58 57 USE prtctl ! Print control 59 USE wrk_nemo ! work arrays60 58 USE timing ! Timing 61 59 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 79 77 REAL(wp) :: rn_emin0 ! surface minimum value of tke [m2/s2] 80 78 REAL(wp) :: rn_bshear ! background shear (>0) currently a numerical threshold (do not change it) 79 LOGICAL :: ln_drg ! top/bottom friction forcing flag 81 80 INTEGER :: nn_etau ! type of depth penetration of surface tke (=0/1/2/3) 82 INTEGER :: nn_htau ! type of tke profile of penetration (=0/1)83 REAL(wp) :: rn_efr ! fraction of TKE surface value which penetrates in the ocean81 INTEGER :: nn_htau ! type of tke profile of penetration (=0/1) 82 REAL(wp) :: rn_efr ! fraction of TKE surface value which penetrates in the ocean 84 83 LOGICAL :: ln_lc ! Langmuir cells (LC) as a source term of TKE or not 85 REAL(wp) :: rn_lc ! coef to compute vertical velocity of Langmuir cells84 REAL(wp) :: rn_lc ! coef to compute vertical velocity of Langmuir cells 86 85 87 86 REAL(wp) :: ri_cri ! critic Richardson number (deduced from rn_ediff and rn_ediss values) … … 204 203 ! 205 204 INTEGER :: ji, jj, jk ! dummy loop arguments 206 !!bfr REAL(wp) :: zebot, zmshu, zmskv! local scalars207 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3208 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient209 REAL(wp) :: zbbrau, zri ! local scalars210 REAL(wp) :: zfact1, zfact2, zfact3 ! - -211 REAL(wp) :: ztx2 , zty2 , zcof ! - -212 REAL(wp) :: ztau , zdif ! - -213 REAL(wp) :: zus , zwlc , zind ! - -214 REAL(wp) :: zzd_up, zzd_lw ! - -205 REAL(wp) :: zetop, zebot, zmsku, zmskv ! local scalars 206 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 207 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 208 REAL(wp) :: zbbrau, zri ! local scalars 209 REAL(wp) :: zfact1, zfact2, zfact3 ! - - 210 REAL(wp) :: ztx2 , zty2 , zcof ! - - 211 REAL(wp) :: ztau , zdif ! - - 212 REAL(wp) :: zus , zwlc , zind ! - - 213 REAL(wp) :: zzd_up, zzd_lw ! - - 215 214 INTEGER , DIMENSION(jpi,jpj) :: imlc 216 215 REAL(wp), DIMENSION(jpi,jpj) :: zhlc … … 227 226 ! 228 227 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 229 ! ! Surface boundary condition on tke 230 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 228 ! ! Surface/top/bottom boundary condition on tke 229 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 230 231 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 232 DO ji = fs_2, fs_jpim1 ! vector opt. 233 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 234 END DO 235 END DO 231 236 IF ( ln_isfcav ) THEN 232 237 DO jj = 2, jpjm1 ! en(mikt(ji,jj)) = rn_emin … … 235 240 END DO 236 241 END DO 237 END IF 238 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 239 DO ji = fs_2, fs_jpim1 ! vector opt. 240 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 241 END DO 242 END DO 242 ENDIF 243 243 244 !!bfr - start commented area245 244 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 246 245 ! ! Bottom boundary condition on tke 247 246 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 248 247 ! 249 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 250 ! Tests to date have found the bottom boundary condition on tke to have very little effect. 251 ! The condition is coded here for completion but commented out until there is proof that the 252 ! computational cost is justified 253 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 254 ! en(bot) = (rn_ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin) 255 !!gm old 256 !! DO jj = 2, jpjm1 257 !! DO ji = fs_2, fs_jpim1 ! vector opt. 258 !! ztx2 = bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) + & 259 !! bfrua(ji ,jj) * ub(ji ,jj,mbku(ji ,jj) ) 260 !! zty2 = bfrva(ji,jj ) * vb(ji,jj ,mbkv(ji,jj )) + & 261 !! bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1) ) 262 !! zebot = 0.001875_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. 263 !! en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 264 !! END DO 265 !! END DO 266 !!gm new 267 !! 268 !! ====>>>> add below an wet-only calculation of u and v at t-point like in zdfsh2: 269 !! zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 270 !! zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 271 !! 272 !! 273 !! DO jj = 2, jpjm1 274 !! DO ji = fs_2, fs_jpim1 ! vector opt. 275 !! zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 276 !! zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 277 !! ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 278 !! zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 279 !! & + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 ) 280 !! en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 281 !! END DO 282 !! END DO 283 !! IF( ln_isfcav ) THEN !top friction 284 !! DO jj = 2, jpjm1 285 !! DO ji = fs_2, fs_jpim1 ! vector opt. 286 !! zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 287 !! zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 288 !! ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 289 !! zebot = - 0.001875_wp * rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 290 !! & + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 ) 291 !! en(ji,jj,mikt(ji,jj)+1) = MAX( zebot, rn_emin ) * (1._wp - tmask(ji,jj,1)) ! masked at ocean surface 292 !! END DO 293 !! END DO 294 !! ENDIF 295 !! 296 !!bfr - end commented area 248 ! en(bot) = (ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin) 249 ! where ebb0 does not includes surface wave enhancement (i.e. ebb0=3.75) 250 ! Note that stress averaged is done using an wet-only calculation of u and v at t-point like in zdfsh2 251 ! 252 IF( ln_drg ) THEN !== friction used as top/bottom boundary condition on TKE 253 ! 254 DO jj = 2, jpjm1 ! bottom friction 255 DO ji = fs_2, fs_jpim1 ! vector opt. 256 zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 257 zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 258 ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 259 zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 & 260 & + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 ) 261 en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 262 END DO 263 END DO 264 IF( ln_isfcav ) THEN ! top friction 265 DO jj = 2, jpjm1 266 DO ji = fs_2, fs_jpim1 ! vector opt. 267 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 268 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 269 ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 270 zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 & 271 & + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 ) 272 en(ji,jj,mikt(ji,jj)) = MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) ! masked at ocean surface 273 END DO 274 END DO 275 ENDIF 276 ! 277 ENDIF 297 278 ! 298 279 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 426 407 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 427 408 !!gm BUG : in the exp remove the depth of ssh !!! 409 !!gm i.e. use gde3w in argument (pdepw) 428 410 429 411 … … 678 660 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & 679 661 & rn_emin0, rn_bshear, nn_mxl , ln_mxl0 , & 680 & rn_mxl0 , nn_pdl , ln_ lc, rn_lc , &662 & rn_mxl0 , nn_pdl , ln_drg , ln_lc , rn_lc , & 681 663 & nn_etau , nn_htau , rn_efr 682 664 !!---------------------------------------------------------------------- … … 703 685 WRITE(numout,*) ' minimum value of tke rn_emin = ', rn_emin 704 686 WRITE(numout,*) ' surface minimum value of tke rn_emin0 = ', rn_emin0 687 WRITE(numout,*) ' prandl number flag nn_pdl = ', nn_pdl 705 688 WRITE(numout,*) ' background shear (>0) rn_bshear = ', rn_bshear 706 689 WRITE(numout,*) ' mixing length type nn_mxl = ', nn_mxl 707 WRITE(numout,*) ' prandl number flag nn_pdl = ', nn_pdl708 WRITE(numout,*) ' surface mixing length = F(stress) or not ln_mxl0 = ', ln_mxl0709 WRITE(numout,*) ' surface mixing length minimum value rn_mxl0 = ', rn_mxl0710 WRITE(numout,*) ' flag to take into acc. Langmuir circ.ln_lc = ', ln_lc711 WRITE(numout,*) ' coef to compute verticla velocity of LC rn_lc= ', rn_lc690 WRITE(numout,*) ' surface mixing length = F(stress) or not ln_mxl0 = ', ln_mxl0 691 WRITE(numout,*) ' surface mixing length minimum value rn_mxl0 = ', rn_mxl0 692 WRITE(numout,*) ' top/bottom friction forcing flag ln_drg = ', ln_drg 693 WRITE(numout,*) ' Langmuir cells parametrization ln_lc = ', ln_lc 694 WRITE(numout,*) ' coef to compute vertical velocity of LC rn_lc = ', rn_lc 712 695 WRITE(numout,*) ' test param. to add tke induced by wind nn_etau = ', nn_etau 713 WRITE(numout,*) ' flag for computation of exp. tke profilenn_htau = ', nn_htau714 WRITE(numout,*) ' fraction of en which pene. the thermoclinern_efr = ', rn_efr696 WRITE(numout,*) ' type of tke penetration profile nn_htau = ', nn_htau 697 WRITE(numout,*) ' fraction of TKE that penetrates rn_efr = ', rn_efr 715 698 WRITE(numout,*) 716 WRITE(numout,*) ' critical Richardson nb with your parameters ri_cri = ', ri_cri 699 IF( ln_drg ) THEN 700 WRITE(numout,*) ' Namelist namdrg_top/_bot: used values:' 701 WRITE(numout,*) ' top ocean cavity roughness (m) rn_z0(_top)= ', r_z0_top 702 WRITE(numout,*) ' Bottom seafloor roughness (m) rn_z0(_bot)= ', r_z0_bot 703 ENDIF 704 WRITE(numout,*) 705 WRITE(numout,*) 706 WRITE(numout,*) ' ==>> critical Richardson nb with your parameters ri_cri = ', ri_cri 717 707 WRITE(numout,*) 718 708 ENDIF -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/step.F90
r8093 r8143 129 129 130 130 ! VERTICAL PHYSICS 131 CALL zdf_phy( kstp ) ! vertical physics update ( bfr, avt, avs, avm + MLD)131 CALL zdf_phy( kstp ) ! vertical physics update (top/bot drag, avt, avs, avm + MLD) 132 132 133 133 … … 211 211 ENDIF 212 212 213 CALL dyn_bfr ( kstp ) ! bottom friction 213 IF( .NOT.ln_drgimp) CALL dyn_bfr ( kstp ) ! bottom friction 214 214 215 CALL dyn_zdf ( kstp ) ! vertical diffusion 215 216 -
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r7990 r8143 7 7 !! 3.7 ! 2014-01 (G. Madec) LDF simplication 8 8 !!---------------------------------------------------------------------- 9 USE oce ! ocean dynamics and tracers variables 10 USE dom_oce ! ocean space and time domain variables 11 USE zdf_oce ! ocean vertical physics variables 9 USE oce ! ocean dynamics and tracers variables 10 USE dom_oce ! ocean space and time domain variables 11 USE zdf_oce ! ocean vertical physics variables 12 USE zdfdrg , ONLY : ln_drgimp ! implicit top/bottom friction 12 13 13 USE daymod 14 USE daymod ! calendar (day routine) 14 15 15 USE sbc_oce 16 USE sbcmod 17 USE sbcrnf 18 USE sbccpl 19 USE sbcapr 20 USE sbctide 21 USE sbcwave 16 USE sbc_oce ! surface boundary condition: ocean 17 USE sbcmod ! surface boundary condition (sbc routine) 18 USE sbcrnf ! surface boundary condition: runoff variables 19 USE sbccpl ! surface boundary condition: coupled formulation (call send at end of step) 20 USE sbcapr ! surface boundary condition: atmospheric pressure 21 USE sbctide ! Tide initialisation 22 USE sbcwave ! Wave intialisation 22 23 23 USE traqsr 24 USE trasbc 25 USE trabbc 26 USE trabbl 27 USE tradmp 28 USE traadv 29 USE traldf 30 USE trazdf 31 USE tranxt 32 USE tranpc 24 USE traqsr ! solar radiation penetration (tra_qsr routine) 25 USE trasbc ! surface boundary condition (tra_sbc routine) 26 USE trabbc ! bottom boundary condition (tra_bbc routine) 27 USE trabbl ! bottom boundary layer (tra_bbl routine) 28 USE tradmp ! internal damping (tra_dmp routine) 29 USE traadv ! advection scheme control (tra_adv_ctl routine) 30 USE traldf ! lateral mixing (tra_ldf routine) 31 USE trazdf ! vertical mixing (tra_zdf routine) 32 USE tranxt ! time-stepping (tra_nxt routine) 33 USE tranpc ! non-penetrative convection (tra_npc routine) 33 34 34 USE eosbn2 35 USE eosbn2 ! equation of state (eos_bn2 routine) 35 36 36 USE divhor 37 USE dynadv 38 USE dynbfr 39 USE dynvor 40 USE dynhpg 41 USE dynldf 42 USE dynzdf 43 USE dynspg 37 USE divhor ! horizontal divergence (div_hor routine) 38 USE dynadv ! advection (dyn_adv routine) 39 USE dynbfr ! Bottom friction terms (dyn_bfr routine) 40 USE dynvor ! vorticity term (dyn_vor routine) 41 USE dynhpg ! hydrostatic pressure grad. (dyn_hpg routine) 42 USE dynldf ! lateral momentum diffusion (dyn_ldf routine) 43 USE dynzdf ! vertical diffusion (dyn_zdf routine) 44 USE dynspg ! surface pressure gradient (dyn_spg routine) 44 45 45 USE dynnxt 46 USE dynnxt ! time-stepping (dyn_nxt routine) 46 47 47 USE stopar 48 USE stopar ! Stochastic parametrization (sto_par routine) 48 49 USE stopts 49 50 50 USE bdy_oce , ONLY: ln_bdy51 USE bdydta 52 USE bdytra 53 USE bdydyn3d 51 USE bdy_oce , ONLY : ln_bdy 52 USE bdydta ! open boundary condition data (bdy_dta routine) 53 USE bdytra ! bdy cond. for tracers (bdy_tra routine) 54 USE bdydyn3d ! bdy cond. for baroclinic vel. (bdy_dyn3d routine) 54 55 55 USE sshwzv 56 USE sshwzv ! vertical velocity and ssh (ssh_nxt routine) 56 57 ! (ssh_swp routine) 57 58 ! (wzv routine) 58 USE domvvl 59 USE domvvl ! variable vertical scale factors (dom_vvl_sf_nxt routine) 59 60 ! (dom_vvl_sf_swp routine) 60 61 61 USE ldfslp 62 USE ldfdyn 63 USE ldftra 62 USE ldfslp ! iso-neutral slopes (ldf_slp routine) 63 USE ldfdyn ! lateral eddy viscosity coef. (ldf_dyn routine) 64 USE ldftra ! lateral eddy diffusive coef. (ldf_tra routine) 64 65 65 USE zdfphy ! vertical physics manager (zdf_phy_init routine)66 USE zdfphy ! vertical physics manager (zdf_phy_init routine) 66 67 67 68 USE step_diu ! Time stepping for diurnal sst … … 70 71 USE sbc_oce ! surface fluxes 71 72 72 USE zpshde 73 USE zpshde ! partial step: hor. derivative (zps_hde routine) 73 74 74 USE diawri 75 USE diaptr 76 USE diadct 77 USE diaar5 78 USE diahth 79 USE diahsb 75 USE diawri ! Standard run outputs (dia_wri routine) 76 USE diaptr ! poleward transports (dia_ptr routine) 77 USE diadct ! sections transports (dia_dct routine) 78 USE diaar5 ! AR5 diagnosics (dia_ar5 routine) 79 USE diahth ! thermocline depth (dia_hth routine) 80 USE diahsb ! heat, salt and volume budgets (dia_hsb routine) 80 81 USE diaharm 81 82 USE diacfl 82 USE flo_oce 83 USE floats 83 USE flo_oce ! floats variables 84 USE floats ! floats computation (flo_stp routine) 84 85 85 USE crsfld 86 USE crsfld ! Standard output on coarse grid (crs_fld routine) 86 87 87 USE asminc 88 USE asminc ! assimilation increments (tra_asm_inc routine) 88 89 ! (dyn_asm_inc routine) 89 90 USE asmbkg 90 USE stpctl 91 USE restart 92 USE prtctl 91 USE stpctl ! time stepping control (stp_ctl routine) 92 USE restart ! ocean restart (rst_wri routine) 93 USE prtctl ! Print control (prt_ctl routine) 93 94 94 USE diaobs 95 USE diaobs ! Observation operator 95 96 96 USE in_out_manager 97 USE iom 97 USE in_out_manager ! I/O manager 98 USE iom ! 98 99 USE lbclnk 99 USE timing 100 USE timing ! Timing 100 101 101 102 #if defined key_iomput 102 USE xios 103 USE xios ! I/O server 103 104 #endif 104 105 #if defined key_agrif
Note: See TracChangeset
for help on using the changeset viewer.