- Timestamp:
- 2020-07-02T17:33:41+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo
- Files:
-
- 55 edited
- 3 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg
r13015 r13229 95 95 ! ! bulk algorithm : 96 96 ln_NCAR = .true. ! "NCAR" algorithm (Large and Yeager 2008) 97 ln_COARE_3p0 = .false. ! "COARE 3.0" algorithm (Fairall et al. 2003)98 ln_COARE_3p6 = .false. ! "COARE 3.6" algorithm (Edson et al. 2013)99 ln_ECMWF = .false. ! "ECMWF" algorithm (IFS cycle 31)100 !101 rn_zqt = 10. ! Air temperature & humidity reference height (m)102 rn_zu = 10. ! Wind vector reference height (m)103 ln_Cd_L12 = .false. ! air-ice drags = F(ice concentration) (Lupkes et al. 2012)104 ln_Cd_L15 = .false. ! air-ice drags = F(ice concentration) (Lupkes et al. 2015)105 rn_pfac = 1. ! multiplicative factor for precipitation (total & snow)106 rn_efac = 1. ! multiplicative factor for evaporation (0. or 1.)107 rn_vfac = 0. ! multiplicative factor for ocean & ice velocity used to108 ! ! calculate the wind stress (0.=absolute or 1.=relative winds)109 ln_skin_cs = .false. ! use the cool-skin parameterization (only available in ECMWF and COARE algorithms) !LB110 ln_skin_wl = .false. ! use the warm-layer " " "111 !112 ln_humi_sph = .true. ! humidity specified below in "sn_humi" is specific humidity [kg/kg] if .true.113 ln_humi_dpt = .false. ! humidity specified below in "sn_humi" is dew-point temperature [K] if .true.114 ln_humi_rlh = .false. ! humidity specified below in "sn_humi" is relative humidity [%] if .true.115 97 ! 116 98 cn_dir = './' ! root directory for the bulk data location -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg
r13015 r13229 92 92 ! ! bulk algorithm : 93 93 ln_NCAR = .true. ! "NCAR" algorithm (Large and Yeager 2008) 94 ln_COARE_3p0 = .false. ! "COARE 3.0" algorithm (Fairall et al. 2003)95 ln_COARE_3p6 = .false. ! "COARE 3.6" algorithm (Edson et al. 2013)96 ln_ECMWF = .false. ! "ECMWF" algorithm (IFS cycle 31)97 !98 rn_zqt = 10. ! Air temperature & humidity reference height (m)99 rn_zu = 10. ! Wind vector reference height (m)100 ln_Cd_L12 = .false. ! air-ice drags = F(ice concentration) (Lupkes et al. 2012)101 ln_Cd_L15 = .false. ! air-ice drags = F(ice concentration) (Lupkes et al. 2015)102 rn_pfac = 1. ! multiplicative factor for precipitation (total & snow)103 rn_efac = 1. ! multiplicative factor for evaporation (0. or 1.)104 rn_vfac = 0. ! multiplicative factor for ocean & ice velocity used to105 ! ! calculate the wind stress (0.=absolute or 1.=relative winds)106 ln_skin_cs = .false. ! use the cool-skin parameterization (only available in ECMWF and COARE algorithms) !LB107 ln_skin_wl = .false. ! use the warm-layer " " "108 !109 ln_humi_sph = .true. ! humidity specified below in "sn_humi" is specific humidity [kg/kg] if .true.110 ln_humi_dpt = .false. ! humidity specified below in "sn_humi" is dew-point temperature [K] if .true.111 ln_humi_rlh = .false. ! humidity specified below in "sn_humi" is relative humidity [%] if .true.112 94 ! 113 95 cn_dir = './' ! root directory for the bulk data location … … 176 158 !----------------------------------------------------------------------- 177 159 ln_spc_dyn = .true. ! use 0 as special value for dynamics 178 rn_sponge_tra = 1440. ! coefficient for tracer sponge layer [m2/s]179 rn_sponge_dyn = 1440. ! coefficient for dynamics sponge layer [m2/s]180 160 ln_chk_bathy = .true. ! =T check the parent bathymetry 181 161 / -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg
r13015 r13229 158 158 !----------------------------------------------------------------------- 159 159 ln_spc_dyn = .true. ! use 0 as special value for dynamics 160 rn_sponge_tra = 480. ! coefficient for tracer sponge layer [m2/s]161 rn_sponge_dyn = 480. ! coefficient for dynamics sponge layer [m2/s]162 160 ln_chk_bathy = .true. ! =T check the parent bathymetry 163 161 / -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg
r13065 r13229 95 95 !----------------------------------------------------------------------- 96 96 ! ! bulk algorithm : 97 <<<<<<< .locale 97 98 ln_NCAR = .true. ! "NCAR" algorithm (Large and Yeager 2008) 98 99 100 ======= 101 ln_NCAR = .true. ! "NCAR" algorithm (Large and Yeager 2008) 102 ! 103 >>>>>>> .merge-dx.r13218 99 104 cn_dir = './' ! root directory for the bulk data location 100 105 !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/ORCA2_ICE_ABL/EXPREF/file_def_nemo-oce.xml
r12063 r13229 56 56 <field field_ref="t_abl" /> 57 57 <field field_ref="q_abl" /> 58 <field field_ref="uvz1_abl" /> 59 <field field_ref="tz1_abl" /> 60 <field field_ref="qz1_abl" /> 61 <field field_ref="uvz1_dta" /> 62 <field field_ref="tz1_dta" /> 63 <field field_ref="qz1_dta" /> 58 64 <field field_ref="pblh" /> 59 65 </file> -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/ORCA2_ICE_ABL/EXPREF/namelist_cfg
r13015 r13229 110 110 ! ! bulk algorithm : 111 111 ln_NCAR = .true. ! "NCAR" algorithm (Large and Yeager 2008) 112 ln_COARE_3p0 = .false. ! "COARE 3.0" algorithm (Fairall et al. 2003)113 ln_COARE_3p6 = .false. ! "COARE 3.6" algorithm (Edson et al. 2013)114 ln_ECMWF = .false. ! "ECMWF" algorithm (IFS cycle 31)115 rn_zqt = 10. ! Air temperature & humidity reference height (m)116 rn_zu = 10. ! Wind vector reference height (m)117 !118 ! Skin is ONLY available in ECMWF and COARE algorithms:119 ln_skin_cs = .false. ! use the cool-skin parameterization => set nn_fsbc=1 and ln_dm2dc=.true.!120 ln_skin_wl = .false. ! use the warm-layer " => set nn_fsbc=1 and ln_dm2dc=.true.!121 !122 ln_humi_sph = .true. ! humidity specified below in "sn_humi" is specific humidity [kg/kg] if .true.123 ln_humi_dpt = .false. ! humidity specified below in "sn_humi" is dew-point temperature [K] if .true.124 ln_humi_rlh = .false. ! humidity specified below in "sn_humi" is relative humidity [%] if .true.125 112 ! 126 113 cn_dir = './' ! root directory for the bulk data location … … 132 119 sn_tair = 'tair_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d', 24., 'tair' , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bilinear' , '' , '' 133 120 sn_humi = 'humi_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d', 24., 'humi' , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bilinear' , '' , '' 134 sn_hpgi = 'uhpg_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d', 24., 'uhpg' , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic' , 'UG' , ''135 sn_hpgj = 'vhpg_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d', 24., 'vhpg' , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic' , 'VG' , ''136 137 121 sn_qsr = 'ncar_rad.15JUNE2009_fill' , 24., 'SWDN_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 138 122 sn_qlw = 'ncar_rad.15JUNE2009_fill' , 24., 'LWDN_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' … … 140 124 sn_snow = 'ncar_precip.15JUNE2009_fill' , -1., 'SNOW' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 141 125 sn_slp = 'slp.15JUNE2009_fill' , 6., 'SLP' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 126 sn_hpgi = 'uhpg_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d', 24., 'uhpg' , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic' , 'UG' , '' 127 sn_hpgj = 'vhpg_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d', 24., 'vhpg' , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic' , 'VG' , '' 142 128 / 143 129 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg
r13015 r13229 121 121 / 122 122 !----------------------------------------------------------------------- 123 &namsbc_abl ! Atmospheric Boundary Layer formulation (ln_abl = T) 124 !----------------------------------------------------------------------- 125 / 126 !----------------------------------------------------------------------- 123 127 &namtra_qsr ! penetrative solar radiation (ln_traqsr =T) 124 128 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/ORCA2_SAS_ICE/EXPREF/namelist_cfg
r13015 r13229 68 68 ! ! bulk algorithm : 69 69 ln_NCAR = .true. ! "NCAR" algorithm (Large and Yeager 2008) 70 ln_COARE_3p0 = .false. ! "COARE 3.0" algorithm (Fairall et al. 2003)71 ln_COARE_3p6 = .false. ! "COARE 3.6" algorithm (Edson et al. 2013)72 ln_ECMWF = .false. ! "ECMWF" algorithm (IFS cycle 31)73 !74 rn_zqt = 10. ! Air temperature & humidity reference height (m)75 rn_zu = 10. ! Wind vector reference height (m)76 ln_Cd_L12 = .false. ! air-ice drags = F(ice concentration) (Lupkes et al. 2012)77 ln_Cd_L15 = .false. ! air-ice drags = F(ice concentration) (Lupkes et al. 2015)78 rn_pfac = 1. ! multiplicative factor for precipitation (total & snow)79 rn_efac = 1. ! multiplicative factor for evaporation (0. or 1.)80 rn_vfac = 0. ! multiplicative factor for ocean & ice velocity used to81 ! ! calculate the wind stress (0.=absolute or 1.=relative winds)82 ln_skin_cs = .false. ! use the cool-skin parameterization (only available in ECMWF and COARE algorithms) !LB83 ln_skin_wl = .false. ! use the warm-layer " " "84 !85 ln_humi_sph = .true. ! humidity specified below in "sn_humi" is specific humidity [kg/kg] if .true.86 ln_humi_dpt = .false. ! humidity specified below in "sn_humi" is dew-point temperature [K] if .true.87 ln_humi_rlh = .false. ! humidity specified below in "sn_humi" is relative humidity [%] if .true.88 70 ! 89 71 cn_dir = './' ! root directory for the bulk data location -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/SHARED/field_def_nemo-oce.xml
r13186 r13229 455 455 <field id="t_dta" long_name="DTA potential temperature" standard_name="dta_theta" unit="K" /> 456 456 <field id="q_dta" long_name="DTA specific humidity" standard_name="dta_qspe" unit="kg/kg" /> 457 <field id="coeft" long_name="ABL nudging coefficient" standard_name="coeft" unit="" /> 457 <field id="u_geo" long_name="GEO i-horizontal velocity" standard_name="geo_x_velocity" unit="m/s" /> 458 <field id="v_geo" long_name="GEO j-horizontal velocity" standard_name="geo_y_velocity" unit="m/s" /> 458 459 <field id="tke_abl" long_name="ABL turbulent kinetic energy" standard_name="abl_tke" unit="m2/s2" /> 459 460 <field id="avm_abl" long_name="ABL turbulent viscosity" standard_name="abl_avm" unit="m2/s" /> 460 461 <field id="avt_abl" long_name="ABL turbulent diffusivity" standard_name="abl_avt" unit="m2/s" /> 461 <field id="mxl_abl" long_name="ABL mixing length" standard_name="abl_mxl" unit="m" /> 462 <field id="mxlm_abl" long_name="ABL master mixing length" standard_name="abl_mxlm" unit="m" /> 463 <field id="mxld_abl" long_name="ABL dissipative mixing length" standard_name="abl_mxld" unit="m" /> 462 464 </field_group> 463 465 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/SHARED/namelist_ref
r13176 r13229 268 268 ln_Cd_L12 = .false. ! air-ice drags = F(ice conc.) (Lupkes et al. 2012) 269 269 ln_Cd_L15 = .false. ! air-ice drags = F(ice conc.) (Lupkes et al. 2015) 270 ! ! - module of the mean stress" data 270 ln_crt_fbk = .false. ! Add surface current feedback to the wind stress (Renault et al. 2020, doi: 10.1029/2019MS001715) 271 rn_stau_a = -2.9e-3 ! Alpha from eq. 10: Stau = Alpha * Wnd + Beta 272 rn_stau_b = 8.0e-3 ! Beta 271 273 rn_pfac = 1. ! multipl. factor for precipitation (total & snow) 272 274 rn_efac = 1. ! multipl. factor for evaporation (0. or 1.) 273 rn_vfac = 0. ! multipl. factor for ocean & ice velocity274 ! ! used to calculate the wind stress275 ! ! (0. => absolute or 1. => relative winds)276 275 ln_skin_cs = .false. ! use the cool-skin parameterization 277 276 ln_skin_wl = .false. ! use the warm-layer parameterization … … 280 279 ln_humi_dpt = .false. ! humidity "sn_humi" is dew-point temperature [K] 281 280 ln_humi_rlh = .false. ! humidity "sn_humi" is relative humidity [%] 281 ln_tpot = .true. !!GS: compute potential temperature or not 282 282 ! 283 283 cn_dir = './' ! root directory for the bulk data location … … 291 291 sn_tair = 't_10.15JUNE2009_fill' , 6. , 'T_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 292 292 sn_humi = 'q_10.15JUNE2009_fill' , 6. , 'Q_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 293 sn_hpgi = 'NOT USED' , 24. , 'uhpg' , .false. , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'UG' , ''294 sn_hpgj = 'NOT USED' , 24. , 'vhpg' , .false. , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'VG' , ''295 293 sn_prec = 'ncar_precip.15JUNE2009_fill', -1. , 'PRC_MOD1', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 296 294 sn_snow = 'ncar_precip.15JUNE2009_fill', -1. , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 297 295 sn_slp = 'slp.15JUNE2009_fill' , 6. , 'SLP' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 296 sn_uoatm = 'NOT USED' , 6. , 'UOATM' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , 'Uoceatm', '' 297 sn_voatm = 'NOT USED' , 6. , 'VOATM' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , 'Voceatm', '' 298 sn_hpgi = 'NOT USED' , 24. , 'uhpg' , .false. , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'UG' , '' 299 sn_hpgj = 'NOT USED' , 24. , 'vhpg' , .false. , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'VG' , '' 298 300 / 299 301 !----------------------------------------------------------------------- … … 308 310 cn_ablrst_outdir = "." ! directory to write output abl restarts 309 311 312 ln_rstart_abl = .false. 310 313 ln_hpgls_frc = .false. 311 314 ln_geos_winds = .false. 312 nn_dyn_restore = 2 ! restoring option for dynamical ABL variables: = 0 no restoring 315 ln_smth_pblh = .false. 316 nn_dyn_restore = 0 ! restoring option for dynamical ABL variables: = 0 no restoring 313 317 ! = 1 equatorial restoring 314 318 ! = 2 global restoring 315 rn_ldyn_min = 4.5 ! magnitude of the nudging on ABL dynamics at the bottom of the ABL [hour]316 rn_ldyn_max = 1.5 ! magnitude of the nudging on ABL dynamics at the top of the ABL [hour]317 rn_ltra_min = 4.5 ! magnitude of the nudging on ABL tracers at the bottom of the ABL [hour]318 rn_ltra_max = 1.5 ! magnitude of the nudging on ABL tracers at the top of the ABL [hour]319 rn_ldyn_min = 4.5 ! dynamics nudging magnitude inside the ABL [hour] (~3 rn_Dt) 320 rn_ldyn_max = 1.5 ! dynamics nudging magnitude above the ABL [hour] (~1 rn_Dt) 321 rn_ltra_min = 4.5 ! tracers nudging magnitude inside the ABL [hour] (~3 rn_Dt) 322 rn_ltra_max = 1.5 ! tracers nudging magnitude above the ABL [hour] (~1 rn_Dt) 319 323 nn_amxl = 0 ! mixing length: = 0 Deardorff 80 length-scale 320 324 ! = 1 length-scale based on the distance to the PBL height 321 325 ! = 2 Bougeault & Lacarrere 89 length-scale 322 rn_Cm = 0.0667 ! 0.126 in MesoNH 323 rn_Ct = 0.1667 ! 0.143 in MesoNH 324 rn_Ce = 0.4 ! 0.4 in MesoNH 325 rn_Ceps = 0.7 ! 0.85 in MesoNH 326 rn_Rod = 0.15 ! c0 in RMCA17 mixing length formulation (not yet implemented) 327 rn_Ric = 0.139 ! Critical Richardson number (to compute PBL height and diffusivities) 326 ! CBR00 ! CCH02 ! MesoNH ! 327 rn_Cm = 0.0667 ! 0.0667 ! 0.1260 ! 0.1260 ! 328 rn_Ct = 0.1667 ! 0.1667 ! 0.1430 ! 0.1430 ! 329 rn_Ce = 0.40 ! 0.40 ! 0.34 ! 0.40 ! 330 rn_Ceps = 0.700 ! 0.700 ! 0.845 ! 0.850 ! 331 rn_Ric = 0.139 ! 0.139 ! 0.143 ! ? ! Critical Richardson number (to compute PBL height and diffusivities) 332 rn_Rod = 0.15 ! c0 in RMCA17 mixing length formulation (not yet implemented) 328 333 / 329 334 !----------------------------------------------------------------------- … … 638 643 &namagrif ! AGRIF zoom ("key_agrif") 639 644 !----------------------------------------------------------------------- 640 ln_agrif_2way = .true. ! activate two way nesting 641 ln_spc_dyn = .true. ! use 0 as special value for dynamics 642 rn_sponge_tra = 2880. ! coefficient for tracer sponge layer [m2/s] 643 rn_sponge_dyn = 2880. ! coefficient for dynamics sponge layer [m2/s] 644 rn_trelax_tra = 0.01 ! inverse of relaxation time (in steps) for tracers [] 645 rn_trelax_dyn = 0.01 ! inverse of relaxation time (in steps) for dynamics [] 646 ln_chk_bathy = .false. ! =T check the parent bathymetry 645 ln_agrif_2way = .true. ! activate two way nesting 646 ln_init_chfrpar = .false. ! initialize child grids from parent 647 ln_spc_dyn = .true. ! use 0 as special value for dynamics 648 rn_sponge_tra = 0.002 ! coefficient for tracer sponge layer [] 649 rn_sponge_dyn = 0.002 ! coefficient for dynamics sponge layer [] 650 rn_trelax_tra = 0.01 ! inverse of relaxation time (in steps) for tracers [] 651 rn_trelax_dyn = 0.01 ! inverse of relaxation time (in steps) for dynamics [] 652 ln_chk_bathy = .false. ! =T check the parent bathymetry 647 653 / 648 654 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/WED025/EXPREF/namelist_cfg
r13015 r13229 138 138 !----------------------------------------------------------------------- 139 139 ! ! bulk algorithm : 140 ln_NCAR = .true. ! "NCAR" algorithm (Large and Yeager 2008)140 ln_NCAR = .true. ! "NCAR" algorithm (Large and Yeager 2008) 141 141 ln_COARE_3p0 = .false. ! "COARE 3.0" algorithm (Fairall et al. 2003) 142 142 ln_COARE_3p6 = .false. ! "COARE 3.6" algorithm (Edson et al. 2013) 143 143 ln_ECMWF = .false. ! "ECMWF" algorithm (IFS cycle 45r1) 144 144 ! 145 145 cn_dir = './' ! root directory for the bulk data location 146 146 !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/doc/latex/NEMO/subfiles/chap_SBC.tex
r12377 r13229 832 832 Solid precipitation & snow & $Kg.m^{-2}.s^{-1}$ & T \\ 833 833 \hline 834 Mean sea-level pressure & slp & $ hPa$ & T \\834 Mean sea-level pressure & slp & $Pa$ & T \\ 835 835 \hline 836 836 \end{tabular} -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ABL/abl.F90
r12489 r13229 29 29 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avm_abl !: turbulent viscosity [m2/s] 30 30 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: avt_abl !: turbulent diffusivity [m2/s] 31 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: mxl_abl !: mixing length [m] 31 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: mxld_abl !: dissipative mixing length [m] 32 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: mxlm_abl !: master mixing length [m] 32 33 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: tke_abl !: turbulent kinetic energy [m2/s2] 33 34 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: fft_abl !: Coriolis parameter [1/s] … … 55 56 !!---------------------------------------------------------------------- 56 57 ! 57 ALLOCATE( u_abl (1:jpi,1:jpj,1:jpka,jptime), & 58 & v_abl (1:jpi,1:jpj,1:jpka,jptime), & 59 & tq_abl (1:jpi,1:jpj,1:jpka,jptime,jptq), & 60 & avm_abl(1:jpi,1:jpj,1:jpka), & 61 & avt_abl(1:jpi,1:jpj,1:jpka), & 62 & mxl_abl(1:jpi,1:jpj,1:jpka), & 63 & tke_abl(1:jpi,1:jpj,1:jpka,jptime), & 64 & fft_abl(1:jpi,1:jpj), & 65 & pblh (1:jpi,1:jpj), & 66 & msk_abl(1:jpi,1:jpj), & 67 & rest_eq(1:jpi,1:jpj), & 68 & e3t_abl(1:jpka), e3w_abl(1:jpka), ght_abl(1:jpka), ghw_abl(1:jpka), STAT=ierr ) 58 ALLOCATE( u_abl (1:jpi,1:jpj,1:jpka,jptime ), & 59 & v_abl (1:jpi,1:jpj,1:jpka,jptime ), & 60 & tq_abl (1:jpi,1:jpj,1:jpka,jptime,jptq), & 61 & tke_abl (1:jpi,1:jpj,1:jpka,jptime ), & 62 & avm_abl (1:jpi,1:jpj,1:jpka ), & 63 & avt_abl (1:jpi,1:jpj,1:jpka ), & 64 & mxld_abl(1:jpi,1:jpj,1:jpka ), & 65 & mxlm_abl(1:jpi,1:jpj,1:jpka ), & 66 & fft_abl (1:jpi,1:jpj ), & 67 & pblh (1:jpi,1:jpj ), & 68 & msk_abl (1:jpi,1:jpj ), & 69 & rest_eq (1:jpi,1:jpj ), & 70 & e3t_abl (1:jpka), e3w_abl(1:jpka) , & 71 & ght_abl (1:jpka), ghw_abl(1:jpka) , STAT=ierr ) 69 72 ! 70 73 abl_alloc = ierr -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ABL/ablmod.F90
r13176 r13229 2 2 !!====================================================================== 3 3 !! *** MODULE ablmod *** 4 !! Surface module : ABL computation to provide atmospheric data 4 !! Surface module : ABL computation to provide atmospheric data 5 5 !! for surface fluxes computation 6 6 !!====================================================================== 7 7 !! History : 3.6 ! 2019-03 (F. Lemarié & G. Samson) Original code 8 8 !!---------------------------------------------------------------------- 9 9 10 10 !!---------------------------------------------------------------------- 11 11 !! abl_stp : ABL single column model … … 16 16 17 17 USE phycst ! physical constants 18 USE dom_oce, ONLY : tmask 18 USE dom_oce, ONLY : tmask 19 19 USE sbc_oce, ONLY : ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1, rhoa 20 USE sbcblk ! use rn_ ?fac20 USE sbcblk ! use rn_efac, cdn_oce 21 21 USE sbcblk_phy ! use some physical constants for flux computation 22 22 ! … … 30 30 31 31 PUBLIC abl_stp ! called by sbcabl.F90 32 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustar2 32 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustar2, zrough 33 33 !! * Substitutions 34 34 # include "do_loop_substitute.h90" … … 38 38 39 39 !=================================================================================================== 40 SUBROUTINE abl_stp( kt, psst, pssu, pssv, pssq, &! in41 & pu_dta, pv_dta, pt_dta, pq_dta, & 40 SUBROUTINE abl_stp( kt, psst, pssu, pssv, pssq, & ! in 41 & pu_dta, pv_dta, pt_dta, pq_dta, & 42 42 & pslp_dta, pgu_dta, pgv_dta, & 43 & pcd_du, psen, pevp, & ! in/out 44 & pwndm, ptaui, ptauj, ptaum & 45 #if defined key_si3 46 & , ptm_su,pssu_ice,pssv_ice,pssq_ice,pcd_du_ice & 47 & , psen_ice, pevp_ice, pwndm_ice, pfrac_oce & 48 & , ptaui_ice, ptauj_ice & 49 #endif 50 & ) 43 & pcd_du, psen, pevp, & ! in/out 44 & pwndm, ptaui, ptauj, ptaum & 45 #if defined key_si3 46 & , ptm_su, pssu_ice, pssv_ice & 47 & , pssq_ice, pcd_du_ice, psen_ice & 48 & , pevp_ice, pwndm_ice, pfrac_oce & 49 & , ptaui_ice, ptauj_ice & 50 #endif 51 & ) 51 52 !--------------------------------------------------------------------------------------------------- 52 53 … … 54 55 !! *** ROUTINE abl_stp *** 55 56 !! 56 !! ** Purpose : Time-integration of the ABL model 57 !! ** Purpose : Time-integration of the ABL model 57 58 !! 58 !! ** Method : Compute atmospheric variables : vertical turbulence 59 !! ** Method : Compute atmospheric variables : vertical turbulence 59 60 !! + Coriolis term + newtonian relaxation 60 !! 61 !! 61 62 !! ** Action : - Advance TKE to time n+1 and compute Avm_abl, Avt_abl, PBLh 62 63 !! - Advance tracers to time n+1 (Euler backward scheme) … … 70 71 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: psst ! sea-surface temperature [Celsius] 71 72 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pssu ! sea-surface u (U-point) 72 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pssv ! sea-surface v (V-point) 73 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pssv ! sea-surface v (V-point) 73 74 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pssq ! sea-surface humidity 74 75 REAL(wp) , INTENT(in ), DIMENSION(:,:,:) :: pu_dta ! large-scale windi … … 82 83 REAL(wp) , INTENT(inout), DIMENSION(:,: ) :: psen ! Ch x Du 83 84 REAL(wp) , INTENT(inout), DIMENSION(:,: ) :: pevp ! Ce x Du 84 REAL(wp) , INTENT(inout), DIMENSION(:,: ) :: pwndm ! ||uwnd|| 85 REAL(wp) , INTENT(inout), DIMENSION(:,: ) :: pwndm ! ||uwnd|| 85 86 REAL(wp) , INTENT( out), DIMENSION(:,: ) :: ptaui ! taux 86 87 REAL(wp) , INTENT( out), DIMENSION(:,: ) :: ptauj ! tauy 87 REAL(wp) , INTENT( out), DIMENSION(:,: ) :: ptaum ! ||tau|| 88 ! 89 #if defined key_si3 88 REAL(wp) , INTENT( out), DIMENSION(:,: ) :: ptaum ! ||tau|| 89 ! 90 #if defined key_si3 90 91 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: ptm_su ! ice-surface temperature [K] 91 92 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pssu_ice ! ice-surface u (U-point) 92 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pssv_ice ! ice-surface v (V-point) 93 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pssq_ice ! ice-surface humidity 93 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pssv_ice ! ice-surface v (V-point) 94 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pssq_ice ! ice-surface humidity 94 95 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pcd_du_ice ! Cd x Du over ice (T-point) 95 96 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: psen_ice ! Ch x Du over ice (T-point) 96 97 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pevp_ice ! Ce x Du over ice (T-point) 97 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pwndm_ice ! ||uwnd - uice|| 98 !REAL(wp) , INTENT(inout), DIMENSION(:,: ) :: pfrac_oce !!GS: out useless ? 99 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pfrac_oce ! 98 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pwndm_ice ! ||uwnd - uice|| 99 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pfrac_oce ! ocean fraction 100 100 REAL(wp) , INTENT( out), DIMENSION(:,: ) :: ptaui_ice ! ice-surface taux stress (U-point) 101 REAL(wp) , INTENT( out), DIMENSION(:,: ) :: ptauj_ice ! ice-surface tauy stress (V-point) 102 #endif 103 ! 104 REAL(wp), DIMENSION(1:jpi,1:jpj ) :: zwnd_i, zwnd_j 105 REAL(wp), DIMENSION(1:jpi,2:jpka ) :: zCF 106 REAL(wp), DIMENSION(1:jpi,1:jpj,1:jpka) :: z_cft !--FL--to be removed after the test phase 107 ! 108 REAL(wp), DIMENSION(1:jpi,1:jpka ) :: z_elem_a 109 REAL(wp), DIMENSION(1:jpi,1:jpka ) :: z_elem_b 110 REAL(wp), DIMENSION(1:jpi,1:jpka ) :: z_elem_c 101 REAL(wp) , INTENT( out), DIMENSION(:,: ) :: ptauj_ice ! ice-surface tauy stress (V-point) 102 #endif 103 ! 104 REAL(wp), DIMENSION(1:jpi,1:jpj ) :: zwnd_i, zwnd_j 105 REAL(wp), DIMENSION(1:jpi ,2:jpka) :: zCF 106 ! 107 REAL(wp), DIMENSION(1:jpi ,1:jpka) :: z_elem_a 108 REAL(wp), DIMENSION(1:jpi ,1:jpka) :: z_elem_b 109 REAL(wp), DIMENSION(1:jpi ,1:jpka) :: z_elem_c 111 110 ! 112 111 INTEGER :: ji, jj, jk, jtra, jbak ! dummy loop indices 113 112 REAL(wp) :: zztmp, zcff, ztemp, zhumi, zcff1, zztmp1, zztmp2 114 113 REAL(wp) :: zcff2, zfcor, zmsk, zsig, zcffu, zcffv, zzice,zzoce 115 ! 116 !!--------------------------------------------------------------------- 114 LOGICAL :: SemiImp_Cor = .TRUE. 115 ! 116 !!--------------------------------------------------------------------- 117 117 ! 118 118 IF(lwp .AND. kt == nit000) THEN ! control print … … 120 120 WRITE(numout,*) 'abl_stp : ABL time stepping' 121 121 WRITE(numout,*) '~~~~~~' 122 ENDIF 122 ENDIF 123 123 ! 124 124 IF( kt == nit000 ) ALLOCATE ( ustar2( 1:jpi, 1:jpj ) ) 125 !! Compute ustar squared as Cd || Uatm-Uoce ||^2 126 !! needed for surface boundary condition of TKE 125 IF( kt == nit000 ) ALLOCATE ( zrough( 1:jpi, 1:jpj ) ) 126 !! Compute ustar squared as Cd || Uatm-Uoce ||^2 127 !! needed for surface boundary condition of TKE 127 128 !! pwndm contains | U10m - U_oce | (see blk_oce_1 in sbcblk) 128 129 DO_2D_11_11 129 130 zzoce = pCd_du (ji,jj) * pwndm (ji,jj) 130 131 #if defined key_si3 131 zzice = pCd_du_ice(ji,jj) * pwndm_ice(ji,jj) 132 ustar2(ji,jj) = zzoce * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * zzice 132 zzice = pCd_du_ice(ji,jj) * pwndm_ice(ji,jj) 133 ustar2(ji,jj) = zzoce * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * zzice 133 134 #else 134 ustar2(ji,jj) = zzoce 135 ustar2(ji,jj) = zzoce 135 136 #endif 137 zrough(ji,jj) = ght_abl(2) * EXP( - vkarmn / SQRT( MAX( Cdn_oce(ji,jj), 1.e-4 ) ) ) !<-- recover the value of z0 from Cdn_oce 136 138 END_2D 137 139 ! … … 140 142 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 141 143 142 CALL abl_zdf_tke( ) !--> Avm_abl, Avt_abl, pblh defined on (1,jpi) x (1,jpj) 143 144 CALL abl_zdf_tke( ) !--> Avm_abl, Avt_abl, pblh defined on (1,jpi) x (1,jpj) 145 144 146 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 145 147 ! ! 2 *** Advance tracers to time n+1 146 148 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 147 149 148 150 !------------- 149 151 DO jj = 1, jpj ! outer loop !--> tq_abl computed on (1:jpi) x (1:jpj) 150 !------------- 151 ! Compute matrix elements for interior points 152 !------------- 153 ! Compute matrix elements for interior points 152 154 DO jk = 3, jpkam1 153 155 DO ji = 1, jpi ! vector opt. 154 z_elem_a( ji, jk) = - rDt_abl * Avt_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 ) ! lower-diagonal155 z_elem_c( ji, jk ) = - rDt_abl * Avt_abl( ji, jj, jk ) / e3w_abl( jk ) ! upper-diagonal156 z_elem_b( ji, jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk ) ! diagonal157 END DO 158 END DO 159 ! Boundary conditions 160 DO ji = 1, jpi ! vector opt. 161 ! Neumann at the bottom 162 z_elem_a( ji, 2) = 0._wp163 z_elem_c( ji, 2 ) = - rDt_abl * Avt_abl( ji, jj, 2 ) / e3w_abl( 2 )156 z_elem_a( ji, jk ) = - rDt_abl * Avt_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 ) ! lower-diagonal 157 z_elem_c( ji, jk ) = - rDt_abl * Avt_abl( ji, jj, jk ) / e3w_abl( jk ) ! upper-diagonal 158 z_elem_b( ji, jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk ) ! diagonal 159 END DO 160 END DO 161 ! Boundary conditions 162 DO ji = 1, jpi ! vector opt. 163 ! Neumann at the bottom 164 z_elem_a( ji, 2 ) = 0._wp 165 z_elem_c( ji, 2 ) = - rDt_abl * Avt_abl( ji, jj, 2 ) / e3w_abl( 2 ) 164 166 ! Homogeneous Neumann at the top 165 z_elem_a( ji, jpka ) = - rDt_abl * Avt_abl( ji, jj, jpka ) / e3w_abl( jpka )166 z_elem_c( ji, jpka) = 0._wp167 z_elem_b( ji, jpka ) = e3t_abl( jpka ) - z_elem_a( ji,jpka )168 END DO 167 z_elem_a( ji, jpka ) = - rDt_abl * Avt_abl( ji, jj, jpka ) / e3w_abl( jpka ) 168 z_elem_c( ji, jpka ) = 0._wp 169 z_elem_b( ji, jpka ) = e3t_abl( jpka ) - z_elem_a( ji, jpka ) 170 END DO 169 171 170 172 DO jtra = 1,jptq ! loop on active tracers 171 173 172 174 DO jk = 3, jpkam1 173 DO ji = 1,jpi 174 tq_abl ( ji, jj, jk, nt_a, jtra ) = e3t_abl(jk) * tq_abl ( ji, jj, jk, nt_n, jtra ) ! initialize right-hand-side 175 !DO ji = 2, jpim1 176 DO ji = 1,jpi !!GS: to be checked if needed 177 tq_abl( ji, jj, jk, nt_a, jtra ) = e3t_abl(jk) * tq_abl( ji, jj, jk, nt_n, jtra ) ! initialize right-hand-side 175 178 END DO 176 179 END DO 177 180 178 181 IF(jtra == jp_ta) THEN 179 DO ji = 1,jpi ! boundary conditions for temperature180 zztmp1 = psen(ji, jj) 181 zztmp2 = psen(ji, jj) * ( psst(ji, jj) + rt0 ) 182 #if defined key_si3 183 zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * psen_ice(ji,jj) 182 DO ji = 1,jpi ! surface boundary condition for temperature 183 zztmp1 = psen(ji, jj) 184 zztmp2 = psen(ji, jj) * ( psst(ji, jj) + rt0 ) 185 #if defined key_si3 186 zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * psen_ice(ji,jj) 184 187 zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * psen_ice(ji,jj) * ptm_su(ji,jj) 185 #endif 186 z_elem_b( ji, 2 ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1187 tq_abl ( ji, jj, 2 , nt_a, jtra ) = e3t_abl( 2 ) * tq_abl ( ji, jj, 2 , nt_n, jtra ) + rDt_abl * zztmp2188 #endif 189 z_elem_b( ji, 2 ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1 190 tq_abl ( ji, jj, 2, nt_a, jtra ) = e3t_abl( 2 ) * tq_abl ( ji, jj, 2, nt_n, jtra ) + rDt_abl * zztmp2 188 191 tq_abl ( ji, jj, jpka, nt_a, jtra ) = e3t_abl( jpka ) * tq_abl ( ji, jj, jpka, nt_n, jtra ) 189 END DO 190 ELSE 191 DO ji = 1,jpi ! boundary conditions for humidity192 zztmp1 = pevp(ji, jj) 193 zztmp2 = pevp(ji, jj) * pssq(ji, jj) 194 #if defined key_si3 195 zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pevp_ice(ji,jj) 196 zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pevp_ice(ji, jj) * pssq_ice(ji, jj) 197 #endif 198 z_elem_b( ji, 2 ) = e3t_abl( 2 ) - z_elem_c( ji, 2) + rDt_abl * zztmp1199 tq_abl ( ji, jj, 2 , nt_a, jtra ) = e3t_abl( 2 ) * tq_abl ( ji, jj, 2 , nt_n, jtra ) + rDt_abl * zztmp2192 END DO 193 ELSE ! jp_qa 194 DO ji = 1,jpi ! surface boundary condition for humidity 195 zztmp1 = pevp(ji, jj) 196 zztmp2 = pevp(ji, jj) * pssq(ji, jj) 197 #if defined key_si3 198 zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pevp_ice(ji,jj) 199 zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pevp_ice(ji, jj) * pssq_ice(ji, jj) 200 #endif 201 z_elem_b( ji, 2 ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1 202 tq_abl ( ji, jj, 2 , nt_a, jtra ) = e3t_abl( 2 ) * tq_abl ( ji, jj, 2, nt_n, jtra ) + rDt_abl * zztmp2 200 203 tq_abl ( ji, jj, jpka, nt_a, jtra ) = e3t_abl( jpka ) * tq_abl ( ji, jj, jpka, nt_n, jtra ) 201 END DO 204 END DO 202 205 END IF 203 206 !! 204 207 !! Matrix inversion 205 208 !! ---------------------------------------------------------- 206 DO ji = 1,jpi 207 zcff = 1._wp / z_elem_b( ji, 2 )208 zCF ( ji, 2) = - zcff * z_elem_c( ji, 2 )209 tq_abl( ji,jj,2,nt_a,jtra) = zcff * tq_abl(ji,jj,2,nt_a,jtra)210 END DO 211 212 DO jk = 3, jpka 213 DO ji = 1,jpi 214 zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF (ji, jk-1 ) )209 DO ji = 1,jpi 210 zcff = 1._wp / z_elem_b( ji, 2 ) 211 zCF ( ji, 2 ) = - zcff * z_elem_c( ji, 2 ) 212 tq_abl( ji, jj, 2, nt_a, jtra ) = zcff * tq_abl( ji, jj, 2, nt_a, jtra ) 213 END DO 214 215 DO jk = 3, jpka 216 DO ji = 1,jpi 217 zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF( ji, jk-1 ) ) 215 218 zCF(ji,jk) = - zcff * z_elem_c( ji, jk ) 216 219 tq_abl(ji,jj,jk,nt_a,jtra) = zcff * ( tq_abl(ji,jj,jk ,nt_a,jtra) & 217 & - z_elem_a(ji, jk) *tq_abl(ji,jj,jk-1,nt_a,jtra) )218 END DO 219 END DO 220 !!FL at this point we could check positivity of tq_abl(:,:,:,nt_a,jp_qa) ... test to do ... 221 DO jk = jpkam1,2,-1 222 DO ji = 1,jpi 220 & - z_elem_a(ji, jk) * tq_abl(ji,jj,jk-1,nt_a,jtra) ) 221 END DO 222 END DO 223 !!FL at this point we could check positivity of tq_abl(:,:,:,nt_a,jp_qa) ... test to do ... 224 DO jk = jpkam1,2,-1 225 DO ji = 1,jpi 223 226 tq_abl(ji,jj,jk,nt_a,jtra) = tq_abl(ji,jj,jk,nt_a,jtra) + & 224 227 & zCF(ji,jk) * tq_abl(ji,jj,jk+1,nt_a,jtra) 225 228 END DO 226 229 END DO 227 228 END DO !<-- loop on tracers 229 !! 230 !------------- 231 END DO ! end outer loop 232 !------------- 233 234 230 231 END DO !<-- loop on tracers 232 !! 233 !------------- 234 END DO ! end outer loop 235 !------------- 236 235 237 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 236 238 ! ! 3 *** Compute Coriolis term with geostrophic guide 237 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 238 !------------- 239 DO jk = 2, jpka ! outer loop 240 !------------- 241 ! 242 ! Advance u_abl & v_abl to time n+1 243 DO_2D_11_11 244 zcff = ( fft_abl(ji,jj) * rDt_abl )*( fft_abl(ji,jj) * rDt_abl ) ! (f dt)**2 239 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 240 IF( SemiImp_Cor ) THEN 241 242 !------------- 243 DO jk = 2, jpka ! outer loop 244 !------------- 245 ! 246 ! Advance u_abl & v_abl to time n+1 247 DO_2D_11_11 248 zcff = ( fft_abl(ji,jj) * rDt_abl )*( fft_abl(ji,jj) * rDt_abl ) ! (f dt)**2 249 250 u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( & 251 & (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff) * u_abl( ji, jj, jk, nt_n ) & 252 & + rDt_abl * fft_abl(ji, jj) * v_abl( ji, jj, jk, nt_n ) ) & 253 & / (1._wp + gamma_Cor*gamma_Cor*zcff) 245 254 246 u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( & 247 & (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*u_abl( ji, jj, jk, nt_n ) & 248 & + rDt_abl * fft_abl(ji, jj) * v_abl ( ji , jj , jk, nt_n ) ) & 249 & / (1._wp + gamma_Cor*gamma_Cor*zcff) 250 251 v_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( & 252 & (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*v_abl( ji, jj, jk, nt_n ) & 253 & - rDt_abl * fft_abl(ji, jj) * u_abl ( ji , jj, jk, nt_n ) ) & 254 & / (1._wp + gamma_Cor*gamma_Cor*zcff) 255 END_2D 256 ! 257 !------------- 258 END DO ! end outer loop !<-- u_abl and v_abl are properly updated on (1:jpi) x (1:jpj) 259 !------------- 260 ! 261 IF( ln_geos_winds ) THEN 262 DO jj = 1, jpj ! outer loop 263 DO jk = 1, jpka 264 DO ji = 1, jpi 265 u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_a ) & 266 & - rDt_abl * e3t_abl(jk) * fft_abl(ji , jj) * pgv_dta(ji ,jj ,jk) 267 v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_a ) & 268 & + rDt_abl * e3t_abl(jk) * fft_abl(ji, jj ) * pgu_dta(ji ,jj ,jk) 269 END DO 270 END DO 271 END DO 272 END IF 273 !------------- 274 ! 275 IF( ln_hpgls_frc ) THEN 276 DO jj = 1, jpj ! outer loop 277 DO jk = 1, jpka 278 DO ji = 1, jpi 279 u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_a ) - rDt_abl * e3t_abl(jk) * pgu_dta(ji,jj,jk) 280 v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_a ) - rDt_abl * e3t_abl(jk) * pgv_dta(ji,jj,jk) 255 v_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( & 256 & (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff) * v_abl( ji, jj, jk, nt_n ) & 257 & - rDt_abl * fft_abl(ji, jj) * u_abl( ji, jj, jk, nt_n ) ) & 258 & / (1._wp + gamma_Cor*gamma_Cor*zcff) 259 END_2D 260 ! 261 !------------- 262 END DO ! end outer loop !<-- u_abl and v_abl are properly updated on (1:jpi) x (1:jpj) 263 !------------- 264 ! 265 IF( ln_geos_winds ) THEN 266 DO jj = 1, jpj ! outer loop 267 DO jk = 1, jpka 268 DO ji = 1, jpi 269 u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_a ) & 270 & - rDt_abl * e3t_abl(jk) * fft_abl(ji , jj) * pgv_dta(ji ,jj ,jk) 271 v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_a ) & 272 & + rDt_abl * e3t_abl(jk) * fft_abl(ji, jj ) * pgu_dta(ji ,jj ,jk) 273 END DO 274 END DO 275 END DO 276 END IF 277 ! 278 IF( ln_hpgls_frc ) THEN 279 DO jj = 1, jpj ! outer loop 280 DO jk = 1, jpka 281 DO ji = 1, jpi 282 u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_a ) - rDt_abl * e3t_abl(jk) * pgu_dta(ji,jj,jk) 283 v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_a ) - rDt_abl * e3t_abl(jk) * pgv_dta(ji,jj,jk) 284 ENDDO 281 285 ENDDO 282 286 ENDDO 283 ENDDO 284 END IF 285 286 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 287 ! ! 4 *** Advance u,v to time n+1 288 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 289 ! 290 ! Vertical diffusion for u_abl 287 END IF 288 289 ELSE ! SemiImp_Cor = .FALSE. 290 291 IF( ln_geos_winds ) THEN 292 293 !------------- 294 DO jk = 2, jpka ! outer loop 295 !------------- 296 ! 297 IF( MOD( kt, 2 ) == 0 ) then 298 ! Advance u_abl & v_abl to time n+1 299 DO jj = 1, jpj 300 DO ji = 1, jpi 301 zcff = fft_abl(ji,jj) * ( v_abl ( ji , jj , jk, nt_n ) - pgv_dta(ji ,jj ,jk) ) 302 u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_n ) + rDt_abl * zcff 303 zcff = fft_abl(ji,jj) * ( u_abl ( ji , jj , jk, nt_a ) - pgu_dta(ji ,jj ,jk) ) 304 v_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( v_abl( ji, jj, jk, nt_n ) - rDt_abl * zcff ) 305 u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) * u_abl( ji, jj, jk, nt_a ) 306 END DO 307 END DO 308 ELSE 309 DO jj = 1, jpj 310 DO ji = 1, jpi 311 zcff = fft_abl(ji,jj) * ( u_abl ( ji , jj , jk, nt_n ) - pgu_dta(ji ,jj ,jk) ) 312 v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_n ) - rDt_abl * zcff 313 zcff = fft_abl(ji,jj) * ( v_abl ( ji , jj , jk, nt_a ) - pgv_dta(ji ,jj ,jk) ) 314 u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( u_abl( ji, jj, jk, nt_n ) + rDt_abl * zcff ) 315 v_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) * v_abl( ji, jj, jk, nt_a ) 316 END DO 317 END DO 318 END IF 319 ! 320 !------------- 321 END DO ! end outer loop !<-- u_abl and v_abl are properly updated on (1:jpi) x (1:jpj) 322 !------------- 323 324 ENDIF ! ln_geos_winds 325 326 ENDIF ! SemiImp_Cor 327 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 328 ! ! 4 *** Advance u,v to time n+1 329 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 330 ! 331 ! Vertical diffusion for u_abl 291 332 !------------- 292 333 DO jj = 1, jpj ! outer loop 293 !------------- 334 !------------- 294 335 295 336 DO jk = 3, jpkam1 296 DO ji = 1, jpi 297 z_elem_a( ji, 298 z_elem_c( ji, jk ) = - rDt_abl * Avm_abl( ji, jj, jk ) / e3w_abl( jk ) ! upper-diagonal299 z_elem_b( ji, jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )! diagonal300 END DO 301 END DO 302 303 DO ji = 2, jpi ! boundary conditions (Avm_abl and pcd_du must be available at ji=jpi) 337 DO ji = 1, jpi 338 z_elem_a( ji, jk ) = - rDt_abl * Avm_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 ) ! lower-diagonal 339 z_elem_c( ji, jk ) = - rDt_abl * Avm_abl( ji, jj, jk ) / e3w_abl( jk ) ! upper-diagonal 340 z_elem_b( ji, jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk ) ! diagonal 341 END DO 342 END DO 343 344 DO ji = 2, jpi ! boundary conditions (Avm_abl and pcd_du must be available at ji=jpi) 304 345 !++ Surface boundary condition 305 z_elem_a( ji, 2) = 0._wp306 z_elem_c( ji, 2 ) = - rDt_abl * Avm_abl( ji, jj, 2 ) / e3w_abl( 2 )307 ! 308 309 zztmp2 = 0.5_wp * pcd_du(ji, jj) * ( pssu(ji-1, jj) + pssu(ji,jj) ) 310 #if defined key_si3 346 z_elem_a( ji, 2 ) = 0._wp 347 z_elem_c( ji, 2 ) = - rDt_abl * Avm_abl( ji, jj, 2 ) / e3w_abl( 2 ) 348 ! 349 zztmp1 = pcd_du(ji, jj) 350 zztmp2 = 0.5_wp * pcd_du(ji, jj) * ( pssu(ji-1, jj) + pssu(ji,jj) ) 351 #if defined key_si3 311 352 zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) 312 zzice = 0.5_wp * ( pssu_ice(ji-1, jj) + pssu_ice(ji,jj) )313 314 #endif 315 z_elem_b( ji, 2 ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1 353 zzice = 0.5_wp * ( pssu_ice(ji-1, jj) + pssu_ice(ji, jj) ) 354 zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) * zzice 355 #endif 356 z_elem_b( ji, 2 ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1 316 357 u_abl( ji, jj, 2, nt_a ) = u_abl( ji, jj, 2, nt_a ) + rDt_abl * zztmp2 317 318 !++ Top Neumann B.C. 319 !z_elem_a( ji, jpka ) = - 0.5_wp * rDt_abl * ( Avm_abl( ji, jj, jpka )+ Avm_abl( ji+1, jj, jpka ) ) / e3w_abl( jpka ) 320 !z_elem_c( ji, jpka ) = 0._wp 321 !z_elem_b( ji, jpka ) = e3t_abl( jpka ) - z_elem_a( ji, jpka ) 322 !++ Top Dirichlet B.C. 323 z_elem_a( ji, jpka ) = 0._wp 324 z_elem_c( ji, jpka ) = 0._wp 325 z_elem_b( ji, jpka ) = e3t_abl( jpka ) 326 u_abl ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * pu_dta(ji,jj,jk) 327 END DO 358 359 ! idealized test cases only 360 !IF( ln_topbc_neumann ) THEN 361 ! !++ Top Neumann B.C. 362 ! z_elem_a( ji, jpka ) = - rDt_abl * Avm_abl( ji, jj, jpka ) / e3w_abl( jpka ) 363 ! z_elem_c( ji, jpka ) = 0._wp 364 ! z_elem_b( ji, jpka ) = e3t_abl( jpka ) - z_elem_a( ji, jpka ) 365 ! !u_abl ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * u_abl ( ji, jj, jpka, nt_a ) 366 !ELSE 367 !++ Top Dirichlet B.C. 368 z_elem_a( ji, jpka ) = 0._wp 369 z_elem_c( ji, jpka ) = 0._wp 370 z_elem_b( ji, jpka ) = e3t_abl( jpka ) 371 u_abl ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * pu_dta(ji,jj,jk) 372 !ENDIF 373 374 END DO 328 375 !! 329 376 !! Matrix inversion 330 377 !! ---------------------------------------------------------- 331 DO ji = 2, jpi 378 !DO ji = 2, jpi 379 DO ji = 1, jpi !!GS: TBI 332 380 zcff = 1._wp / z_elem_b( ji, 2 ) 333 zCF (ji, 2 ) = - zcff * z_elem_c( ji, 2 ) 381 zCF (ji, 2 ) = - zcff * z_elem_c( ji, 2 ) 334 382 u_abl (ji,jj,2,nt_a) = zcff * u_abl(ji,jj,2,nt_a) 335 END DO 336 337 DO jk = 3, jpka 338 DO ji = 2, jpi 383 END DO 384 385 DO jk = 3, jpka 386 DO ji = 2, jpi 339 387 zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF (ji, jk-1 ) ) 340 388 zCF(ji,jk) = - zcff * z_elem_c( ji, jk ) … … 343 391 END DO 344 392 END DO 345 346 DO jk = jpkam1,2,-1 393 394 DO jk = jpkam1,2,-1 347 395 DO ji = 2, jpi 348 396 u_abl(ji,jj,jk,nt_a) = u_abl(ji,jj,jk,nt_a) + zCF(ji,jk) * u_abl(ji,jj,jk+1,nt_a) 349 397 END DO 350 398 END DO 351 352 !------------- 353 END DO ! end outer loop 354 !------------- 355 356 ! 357 ! Vertical diffusion for v_abl 399 400 !------------- 401 END DO ! end outer loop 402 !------------- 403 404 ! 405 ! Vertical diffusion for v_abl 358 406 !------------- 359 407 DO jj = 2, jpj ! outer loop 360 !------------- 408 !------------- 361 409 ! 362 410 DO jk = 3, jpkam1 363 DO ji = 1, jpi 364 z_elem_a( ji, 365 z_elem_c( ji, jk ) = -rDt_abl * Avm_abl( ji, jj, jk ) / e3w_abl( jk ) ! upper-diagonal366 z_elem_b( ji, 367 END DO 368 END DO 369 370 DO ji = 1, jpi ! boundary conditions (Avm_abl and pcd_du must be available at jj=jpj) 411 DO ji = 1, jpi 412 z_elem_a( ji, jk ) = -rDt_abl * Avm_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 ) ! lower-diagonal 413 z_elem_c( ji, jk ) = -rDt_abl * Avm_abl( ji, jj, jk ) / e3w_abl( jk ) ! upper-diagonal 414 z_elem_b( ji, jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk ) ! diagonal 415 END DO 416 END DO 417 418 DO ji = 1, jpi ! boundary conditions (Avm_abl and pcd_du must be available at jj=jpj) 371 419 !++ Surface boundary condition 372 z_elem_a( ji, 2) = 0._wp373 z_elem_c( ji, 2 ) = - rDt_abl * Avm_abl( ji, jj, 2 ) / e3w_abl( 2 )374 ! 375 376 zztmp2 = 0.5_wp * pcd_du(ji, jj) * ( pssv(ji, jj) + pssv(ji, jj-1) ) 377 #if defined key_si3 420 z_elem_a( ji, 2 ) = 0._wp 421 z_elem_c( ji, 2 ) = - rDt_abl * Avm_abl( ji, jj, 2 ) / e3w_abl( 2 ) 422 ! 423 zztmp1 = pcd_du(ji, jj) 424 zztmp2 = 0.5_wp * pcd_du(ji, jj) * ( pssv(ji, jj) + pssv(ji, jj-1) ) 425 #if defined key_si3 378 426 zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) 379 zzice = 0.5_wp * ( pssv_ice(ji, jj) + pssv_ice(ji,jj-1) )380 381 #endif 382 z_elem_b( ji, 2 ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1 427 zzice = 0.5_wp * ( pssv_ice(ji, jj) + pssv_ice(ji, jj-1) ) 428 zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) * zzice 429 #endif 430 z_elem_b( ji, 2 ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1 383 431 v_abl( ji, jj, 2, nt_a ) = v_abl( ji, jj, 2, nt_a ) + rDt_abl * zztmp2 384 !++ Top Neumann B.C. 385 !z_elem_a( ji, jpka ) = -rDt_abl * Avm_abl( ji, jj, jpka ) / e3w_abl( jpka ) 386 !z_elem_c( ji, jpka ) = 0._wp 387 !z_elem_b( ji, jpka ) = e3t_abl( jpka ) - z_elem_a( ji, jpka ) 388 !++ Top Dirichlet B.C. 389 z_elem_a( ji, jpka ) = 0._wp 390 z_elem_c( ji, jpka ) = 0._wp 391 z_elem_b( ji, jpka ) = e3t_abl( jpka ) 392 v_abl ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * pv_dta(ji,jj,jk) 393 END DO 432 433 ! idealized test cases only 434 !IF( ln_topbc_neumann ) THEN 435 ! !++ Top Neumann B.C. 436 ! z_elem_a( ji, jpka ) = - rDt_abl * Avm_abl( ji, jj, jpka ) / e3w_abl( jpka ) 437 ! z_elem_c( ji, jpka ) = 0._wp 438 ! z_elem_b( ji, jpka ) = e3t_abl( jpka ) - z_elem_a( ji, jpka ) 439 ! !v_abl ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * v_abl ( ji, jj, jpka, nt_a ) 440 !ELSE 441 !++ Top Dirichlet B.C. 442 z_elem_a( ji, jpka ) = 0._wp 443 z_elem_c( ji, jpka ) = 0._wp 444 z_elem_b( ji, jpka ) = e3t_abl( jpka ) 445 v_abl ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * pv_dta(ji,jj,jk) 446 !ENDIF 447 448 END DO 394 449 !! 395 450 !! Matrix inversion 396 451 !! ---------------------------------------------------------- 397 DO ji = 1, jpi 452 DO ji = 1, jpi 398 453 zcff = 1._wp / z_elem_b( ji, 2 ) 399 zCF (ji, 2 ) = - zcff * z_elem_c( ji, 2 ) 400 v_abl (ji,jj,2,nt_a) = zcff * v_abl ( ji, jj, 2, nt_a ) 401 END DO 402 403 DO jk = 3, jpka 404 DO ji = 1, jpi 454 zCF (ji, 2 ) = - zcff * z_elem_c( ji, 2 ) 455 v_abl (ji,jj,2,nt_a) = zcff * v_abl ( ji, jj, 2, nt_a ) 456 END DO 457 458 DO jk = 3, jpka 459 DO ji = 1, jpi 405 460 zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF (ji, jk-1 ) ) 406 461 zCF(ji,jk) = - zcff * z_elem_c( ji, jk ) … … 409 464 END DO 410 465 END DO 411 412 DO jk = jpkam1,2,-1 413 DO ji = 1, jpi 466 467 DO jk = jpkam1,2,-1 468 DO ji = 1, jpi 414 469 v_abl(ji,jj,jk,nt_a) = v_abl(ji,jj,jk,nt_a) + zCF(ji,jk) * v_abl(ji,jj,jk+1,nt_a) 415 470 END DO 416 471 END DO 417 ! 418 !------------- 419 END DO ! end outer loop 420 !------------- 421 422 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 423 ! ! 5 *** Apply nudging on the dynamics and the tracers 424 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 425 z_cft(:,:,:) = 0._wp 426 472 ! 473 !------------- 474 END DO ! end outer loop 475 !------------- 476 477 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 478 ! ! 5 *** Apply nudging on the dynamics and the tracers 479 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 480 427 481 IF( nn_dyn_restore > 0 ) THEN 428 !------------- 482 !------------- 429 483 DO jk = 2, jpka ! outer loop 430 !------------- 484 !------------- 431 485 DO_2D_01_01 432 486 zcff1 = pblh( ji, jj ) 433 zsig = ght_abl(jk) / MAX( jp_pblh_min, MIN( jp_pblh_max, zcff1 ) ) 434 zsig = MIN( jp_bmax , MAX( zsig, jp_bmin) ) 487 zsig = ght_abl(jk) / MAX( jp_pblh_min, MIN( jp_pblh_max, zcff1 ) ) 488 zsig = MIN( jp_bmax , MAX( zsig, jp_bmin) ) 435 489 zmsk = msk_abl(ji,jj) 436 490 zcff2 = jp_alp3_dyn * zsig**3 + jp_alp2_dyn * zsig**2 & 437 491 & + jp_alp1_dyn * zsig + jp_alp0_dyn 438 492 zcff = (1._wp-zmsk) + zmsk * zcff2 * rn_Dt ! zcff = 1 for masked points 439 ! rn_Dt = rDt_abl / nn_fsbc 493 ! rn_Dt = rDt_abl / nn_fsbc 440 494 zcff = zcff * rest_eq(ji,jj) 441 z_cft( ji, jj, jk ) = zcff442 495 u_abl( ji, jj, jk, nt_a ) = (1._wp - zcff ) * u_abl( ji, jj, jk, nt_a ) & 443 & + zcff * pu_dta( ji, jj, jk ) 496 & + zcff * pu_dta( ji, jj, jk ) 444 497 v_abl( ji, jj, jk, nt_a ) = (1._wp - zcff ) * v_abl( ji, jj, jk, nt_a ) & 445 498 & + zcff * pv_dta( ji, jj, jk ) … … 447 500 !------------- 448 501 END DO ! end outer loop 449 !------------- 502 !------------- 450 503 END IF 451 504 452 !------------- 505 !------------- 453 506 DO jk = 2, jpka ! outer loop 454 !------------- 507 !------------- 455 508 DO_2D_11_11 456 509 zcff1 = pblh( ji, jj ) 457 510 zsig = ght_abl(jk) / MAX( jp_pblh_min, MIN( jp_pblh_max, zcff1 ) ) 458 zsig = MIN( jp_bmax , MAX( zsig, jp_bmin) ) 511 zsig = MIN( jp_bmax , MAX( zsig, jp_bmin) ) 459 512 zmsk = msk_abl(ji,jj) 460 513 zcff2 = jp_alp3_tra * zsig**3 + jp_alp2_tra * zsig**2 & 461 514 & + jp_alp1_tra * zsig + jp_alp0_tra 462 515 zcff = (1._wp-zmsk) + zmsk * zcff2 * rn_Dt ! zcff = 1 for masked points 463 ! rn_Dt = rDt_abl / nn_fsbc 464 !z_cft( ji, jj, jk ) = zcff 516 ! rn_Dt = rDt_abl / nn_fsbc 465 517 tq_abl( ji, jj, jk, nt_a, jp_ta ) = (1._wp - zcff ) * tq_abl( ji, jj, jk, nt_a, jp_ta ) & 466 518 & + zcff * pt_dta( ji, jj, jk ) 467 519 468 520 tq_abl( ji, jj, jk, nt_a, jp_qa ) = (1._wp - zcff ) * tq_abl( ji, jj, jk, nt_a, jp_qa ) & 469 521 & + zcff * pq_dta( ji, jj, jk ) 470 522 471 523 END_2D 472 524 !------------- 473 525 END DO ! end outer loop 474 !------------- 475 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 476 ! ! 6 *** MPI exchanges 477 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 478 ! 479 CALL lbc_lnk_multi( 'ablmod', u_abl(:,:,:,nt_a ), 'T', -1., v_abl(:,:,:,nt_a ), 'T', -1.)526 !------------- 527 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 528 ! ! 6 *** MPI exchanges 529 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 530 ! 531 CALL lbc_lnk_multi( 'ablmod', u_abl(:,:,:,nt_a ), 'T', -1., v_abl(:,:,:,nt_a) , 'T', -1. ) 480 532 CALL lbc_lnk_multi( 'ablmod', tq_abl(:,:,:,nt_a,jp_ta), 'T', 1., tq_abl(:,:,:,nt_a,jp_qa), 'T', 1., kfillmode = jpfillnothing ) ! ++++ this should not be needed... 481 533 ! 482 ! first ABL level 534 #if defined key_iomput 535 ! 2D & first ABL level 536 IF ( iom_use("pblh" ) ) CALL iom_put ( "pblh", pblh(:,: ) ) 483 537 IF ( iom_use("uz1_abl") ) CALL iom_put ( "uz1_abl", u_abl(:,:,2,nt_a ) ) 484 538 IF ( iom_use("vz1_abl") ) CALL iom_put ( "vz1_abl", v_abl(:,:,2,nt_a ) ) … … 489 543 IF ( iom_use("tz1_dta") ) CALL iom_put ( "tz1_dta", pt_dta(:,:,2 ) ) 490 544 IF ( iom_use("qz1_dta") ) CALL iom_put ( "qz1_dta", pq_dta(:,:,2 ) ) 491 ! all ABL levels 492 IF ( iom_use("u_abl" ) ) CALL iom_put ( "u_abl" , u_abl(:,:,2:jpka,nt_a ) ) 493 IF ( iom_use("v_abl" ) ) CALL iom_put ( "v_abl" , v_abl(:,:,2:jpka,nt_a ) ) 494 IF ( iom_use("t_abl" ) ) CALL iom_put ( "t_abl" , tq_abl(:,:,2:jpka,nt_a,jp_ta) ) 495 IF ( iom_use("q_abl" ) ) CALL iom_put ( "q_abl" , tq_abl(:,:,2:jpka,nt_a,jp_qa) ) 496 IF ( iom_use("tke_abl") ) CALL iom_put ( "tke_abl", tke_abl(:,:,2:jpka,nt_a ) ) 497 IF ( iom_use("avm_abl") ) CALL iom_put ( "avm_abl", avm_abl(:,:,2:jpka ) ) 498 IF ( iom_use("avt_abl") ) CALL iom_put ( "avt_abl", avm_abl(:,:,2:jpka ) ) 499 IF ( iom_use("mxl_abl") ) CALL iom_put ( "mxl_abl", mxl_abl(:,:,2:jpka ) ) 500 IF ( iom_use("pblh" ) ) CALL iom_put ( "pblh" , pblh(:,: ) ) 501 ! debug (to be removed) 545 ! debug 2D 546 IF( ln_geos_winds ) THEN 547 IF ( iom_use("uz1_geo") ) CALL iom_put ( "uz1_geo", pgu_dta(:,:,2) ) 548 IF ( iom_use("vz1_geo") ) CALL iom_put ( "vz1_geo", pgv_dta(:,:,2) ) 549 END IF 550 IF( ln_hpgls_frc ) THEN 551 IF ( iom_use("uz1_geo") ) CALL iom_put ( "uz1_geo", pgu_dta(:,:,2)/MAX(fft_abl(:,:),2.5e-5_wp) ) 552 IF ( iom_use("vz1_geo") ) CALL iom_put ( "vz1_geo", -pgv_dta(:,:,2)/MAX(fft_abl(:,:),2.5e-5_wp) ) 553 END IF 554 ! 3D (all ABL levels) 555 IF ( iom_use("u_abl" ) ) CALL iom_put ( "u_abl" , u_abl(:,:,2:jpka,nt_a ) ) 556 IF ( iom_use("v_abl" ) ) CALL iom_put ( "v_abl" , v_abl(:,:,2:jpka,nt_a ) ) 557 IF ( iom_use("t_abl" ) ) CALL iom_put ( "t_abl" , tq_abl(:,:,2:jpka,nt_a,jp_ta) ) 558 IF ( iom_use("q_abl" ) ) CALL iom_put ( "q_abl" , tq_abl(:,:,2:jpka,nt_a,jp_qa) ) 559 IF ( iom_use("tke_abl" ) ) CALL iom_put ( "tke_abl" , tke_abl(:,:,2:jpka,nt_a ) ) 560 IF ( iom_use("avm_abl" ) ) CALL iom_put ( "avm_abl" , avm_abl(:,:,2:jpka ) ) 561 IF ( iom_use("avt_abl" ) ) CALL iom_put ( "avt_abl" , avt_abl(:,:,2:jpka ) ) 562 IF ( iom_use("mxlm_abl") ) CALL iom_put ( "mxlm_abl", mxlm_abl(:,:,2:jpka ) ) 563 IF ( iom_use("mxld_abl") ) CALL iom_put ( "mxld_abl", mxld_abl(:,:,2:jpka ) ) 564 ! debug 3D 502 565 IF ( iom_use("u_dta") ) CALL iom_put ( "u_dta", pu_dta(:,:,2:jpka) ) 503 566 IF ( iom_use("v_dta") ) CALL iom_put ( "v_dta", pv_dta(:,:,2:jpka) ) 504 567 IF ( iom_use("t_dta") ) CALL iom_put ( "t_dta", pt_dta(:,:,2:jpka) ) 505 568 IF ( iom_use("q_dta") ) CALL iom_put ( "q_dta", pq_dta(:,:,2:jpka) ) 506 IF ( iom_use("coeft") ) CALL iom_put ( "coeft", z_cft(:,:,2:jpka) )507 569 IF( ln_geos_winds ) THEN 508 IF ( iom_use("u z1_geo") ) CALL iom_put ( "uz1_geo", pgu_dta(:,:,2) )509 IF ( iom_use("v z1_geo") ) CALL iom_put ( "vz1_geo", pgv_dta(:,:,2) )570 IF ( iom_use("u_geo") ) CALL iom_put ( "u_geo", pgu_dta(:,:,2:jpka) ) 571 IF ( iom_use("v_geo") ) CALL iom_put ( "v_geo", pgv_dta(:,:,2:jpka) ) 510 572 END IF 511 573 IF( ln_hpgls_frc ) THEN 512 IF ( iom_use("u z1_geo") ) CALL iom_put ( "uz1_geo", pgu_dta(:,:,2)/MAX(fft_abl(:,:),2.5e-5_wp))513 IF ( iom_use("v z1_geo") ) CALL iom_put ( "vz1_geo", -pgv_dta(:,:,2)/MAX(fft_abl(:,:),2.5e-5_wp))574 IF ( iom_use("u_geo") ) CALL iom_put ( "u_geo", pgu_dta(:,:,2:jpka)/MAX( RESHAPE( fft_abl(:,:), (/jpi,jpj,jpka-1/), fft_abl(:,:)), 2.5e-5_wp) ) 575 IF ( iom_use("v_geo") ) CALL iom_put ( "v_geo", -pgv_dta(:,:,2:jpka)/MAX( RESHAPE( fft_abl(:,:), (/jpi,jpj,jpka-1/), fft_abl(:,:)), 2.5e-5_wp) ) 514 576 END IF 515 ! 577 #endif 516 578 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 517 579 ! ! 7 *** Finalize flux computation 518 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 519 580 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 581 ! 520 582 DO_2D_11_11 521 ztemp = tq_abl ( ji, jj, 2, nt_a, jp_ta ) 522 zhumi = tq_abl ( ji, jj, 2, nt_a, jp_qa ) 523 !zcff = pslp_dta( ji, jj ) / & !<-- At this point ztemp and zhumi should not be zero ... 524 ! & ( R_dry*ztemp * ( 1._wp + rctv0*zhumi ) ) 525 zcff = rho_air( ztemp, zhumi, pslp_dta( ji, jj ) ) 526 psen ( ji, jj ) = cp_air(zhumi) * zcff * psen(ji,jj) * ( psst(ji,jj) + rt0 - ztemp ) 527 pevp ( ji, jj ) = rn_efac*MAX( 0._wp, zcff * pevp(ji,jj) * ( pssq(ji,jj) - zhumi ) ) 528 rhoa( ji, jj ) = zcff 583 ztemp = tq_abl( ji, jj, 2, nt_a, jp_ta ) 584 zhumi = tq_abl( ji, jj, 2, nt_a, jp_qa ) 585 zcff = rho_air( ztemp, zhumi, pslp_dta( ji, jj ) ) 586 psen( ji, jj ) = - cp_air(zhumi) * zcff * psen(ji,jj) * ( psst(ji,jj) + rt0 - ztemp ) !GS: negative sign to respect aerobulk convention 587 pevp( ji, jj ) = rn_efac*MAX( 0._wp, zcff * pevp(ji,jj) * ( pssq(ji,jj) - zhumi ) ) 588 rhoa( ji, jj ) = zcff 529 589 END_2D 530 590 531 591 DO_2D_01_01 532 zwnd_i(ji,jj) = u_abl(ji ,jj,2,nt_a) - 0.5_wp * rn_vfac *( pssu(ji ,jj) + pssu(ji-1,jj) )533 zwnd_j(ji,jj) = v_abl(ji,jj ,2,nt_a) - 0.5_wp * rn_vfac *( pssv(ji,jj ) + pssv(ji,jj-1) )592 zwnd_i(ji,jj) = u_abl(ji ,jj,2,nt_a) - 0.5_wp * ( pssu(ji ,jj) + pssu(ji-1,jj) ) 593 zwnd_j(ji,jj) = v_abl(ji,jj ,2,nt_a) - 0.5_wp * ( pssv(ji,jj ) + pssv(ji,jj-1) ) 534 594 END_2D 535 ! 595 ! 536 596 CALL lbc_lnk_multi( 'ablmod', zwnd_i(:,:) , 'T', -1., zwnd_j(:,:) , 'T', -1. ) 537 597 ! … … 539 599 DO_2D_11_11 540 600 zcff = SQRT( zwnd_i(ji,jj) * zwnd_i(ji,jj) & 541 & + zwnd_j(ji,jj) * zwnd_j(ji,jj) )! * msk_abl(ji,jj)601 & + zwnd_j(ji,jj) * zwnd_j(ji,jj) ) ! * msk_abl(ji,jj) 542 602 zztmp = rhoa(ji,jj) * pcd_du(ji,jj) 543 603 544 604 pwndm (ji,jj) = zcff 545 605 ptaum (ji,jj) = zztmp * zcff … … 564 624 565 625 IF(sn_cfctl%l_prtctl) THEN 566 CALL prt_ctl( tab2d_1=p wndm , clinfo1=' abl_stp: wndm : ' )567 CALL prt_ctl( tab2d_1=ptaui , clinfo1=' abl_stp: utau : ', &568 & tab2d_2=ptauj , clinfo2= 'vtau: ' )626 CALL prt_ctl( tab2d_1=ptaui , clinfo1=' abl_stp: utau : ', mask1=umask, & 627 & tab2d_2=ptauj , clinfo2=' vtau : ', mask2=vmask ) 628 CALL prt_ctl( tab2d_1=pwndm , clinfo1=' abl_stp: wndm : ' ) 569 629 ENDIF 570 630 571 631 #if defined key_si3 572 ! ------------------------------------------------------------ ! 573 ! Wind stress relative to the moving ice ( U10m - U_ice ) ! 574 ! ------------------------------------------------------------ ! 575 DO_2D_00_00 576 577 zztmp1 = 0.5_wp * ( u_abl(ji+1,jj,2,nt_a) + u_abl(ji,jj,2,nt_a) ) 578 zztmp2 = 0.5_wp * ( v_abl(ji,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) ) 579 580 ptaui_ice(ji,jj) = 0.5_wp * ( rhoa(ji+1,jj) * pCd_du_ice(ji+1,jj) & 581 & + rhoa(ji ,jj) * pCd_du_ice(ji ,jj) ) & 582 & * ( zztmp1 - rn_vfac * pssu_ice(ji,jj) ) 583 ptauj_ice(ji,jj) = 0.5_wp * ( rhoa(ji,jj+1) * pCd_du_ice(ji,jj+1) & 584 & + rhoa(ji,jj ) * pCd_du_ice(ji,jj ) ) & 585 & * ( zztmp2 - rn_vfac * pssv_ice(ji,jj) ) 586 END_2D 587 CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1., ptauj_ice, 'V', -1. ) 588 ! 589 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=ptaui_ice , clinfo1=' abl_stp: putaui : ' & 590 & , tab2d_2=ptauj_ice , clinfo2=' pvtaui : ' ) 632 ! ------------------------------------------------------------ ! 633 ! Wind stress relative to the moving ice ( U10m - U_ice ) ! 634 ! ------------------------------------------------------------ ! 635 DO_2D_00_00 636 ptaui_ice(ji,jj) = 0.5_wp * ( rhoa(ji+1,jj) * pCd_du_ice(ji+1,jj) + rhoa(ji,jj) * pCd_du_ice(ji,jj) ) & 637 & * ( 0.5_wp * ( u_abl(ji+1,jj,2,nt_a) + u_abl(ji,jj,2,nt_a) ) - pssu_ice(ji,jj) ) 638 ptauj_ice(ji,jj) = 0.5_wp * ( rhoa(ji,jj+1) * pCd_du_ice(ji,jj+1) + rhoa(ji,jj) * pCd_du_ice(ji,jj) ) & 639 & * ( 0.5_wp * ( v_abl(ji,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) ) - pssv_ice(ji,jj) ) 640 END_2D 641 CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1., ptauj_ice, 'V', -1. ) 642 ! 643 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=ptaui_ice , clinfo1=' abl_stp: putaui : ' & 644 & , tab2d_2=ptauj_ice , clinfo2=' pvtaui : ' ) 645 ! ------------------------------------------------------------ ! 646 ! Wind stress relative to the moving ice ( U10m - U_ice ) ! 647 ! ------------------------------------------------------------ ! 648 DO_2D_00_00 649 650 zztmp1 = 0.5_wp * ( u_abl(ji+1,jj ,2,nt_a) + u_abl(ji,jj,2,nt_a) ) 651 zztmp2 = 0.5_wp * ( v_abl(ji ,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) ) 652 653 ptaui_ice(ji,jj) = 0.5_wp * ( rhoa(ji+1,jj) * pCd_du_ice(ji+1,jj) & 654 & + rhoa(ji ,jj) * pCd_du_ice(ji ,jj) ) & 655 & * ( zztmp1 - pssu_ice(ji,jj) ) 656 ptauj_ice(ji,jj) = 0.5_wp * ( rhoa(ji,jj+1) * pCd_du_ice(ji,jj+1) & 657 & + rhoa(ji,jj ) * pCd_du_ice(ji,jj ) ) & 658 & * ( zztmp2 - pssv_ice(ji,jj) ) 659 END_2D 660 CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1., ptauj_ice, 'V', -1. ) 661 ! 662 IF(sn_cfctl%l_prtctl) THEN 663 CALL prt_ctl( tab2d_1=ptaui_ice , clinfo1=' abl_stp: utau_ice : ', mask1=umask, & 664 & tab2d_2=ptauj_ice , clinfo2=' vtau_ice : ', mask2=vmask ) 665 END IF 591 666 #endif 592 667 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 599 674 END SUBROUTINE abl_stp 600 675 !=================================================================================================== 601 602 603 604 605 606 607 608 609 610 611 612 613 614 676 615 677 … … 634 696 !! (= Kz dz[Ub] * dz[Un] ) 635 697 !! --------------------------------------------------------------------- 636 INTEGER :: ji, jj, jk, tind, jbak, jkup, jkdwn 698 INTEGER :: ji, jj, jk, tind, jbak, jkup, jkdwn 637 699 INTEGER, DIMENSION(1:jpi ) :: ikbl 638 700 REAL(wp) :: zcff, zcff2, ztken, zesrf, zetop, ziRic, ztv 639 REAL(wp) :: zdU , zdV, zcff1,zshear,zbuoy,zsig, zustar2640 REAL(wp) :: zdU2, zdV2641 REAL(wp) :: zwndi, zwndj701 REAL(wp) :: zdU , zdV , zcff1, zshear, zbuoy, zsig, zustar2 702 REAL(wp) :: zdU2, zdV2, zbuoy1, zbuoy2 ! zbuoy for BL89 703 REAL(wp) :: zwndi, zwndj 642 704 REAL(wp), DIMENSION(1:jpi, 1:jpka) :: zsh2 643 705 REAL(wp), DIMENSION(1:jpi,1:jpj,1:jpka) :: zbn2 644 REAL(wp), DIMENSION(1:jpi,1:jpka ) :: zFC, zRH, zCF 706 REAL(wp), DIMENSION(1:jpi,1:jpka ) :: zFC, zRH, zCF 645 707 REAL(wp), DIMENSION(1:jpi,1:jpka ) :: z_elem_a 646 708 REAL(wp), DIMENSION(1:jpi,1:jpka ) :: z_elem_b … … 648 710 LOGICAL :: ln_Patankar = .FALSE. 649 711 LOGICAL :: ln_dumpvar = .FALSE. 650 LOGICAL , DIMENSION(1:jpi ) :: ln_foundl 712 LOGICAL , DIMENSION(1:jpi ) :: ln_foundl 651 713 ! 652 714 tind = nt_n … … 660 722 !------------- 661 723 ! 662 ! Compute vertical shear 724 ! Compute vertical shear 663 725 DO jk = 2, jpkam1 664 DO ji = 1, jpi665 zcff = 1.0_wp / e3w_abl( jk )**2 666 zdU = zcff* Avm_abl(ji,jj,jk) * (u_abl( ji, jj, jk+1, tind)-u_abl( ji, jj, jk , tind) )**2 726 DO ji = 1, jpi 727 zcff = 1.0_wp / e3w_abl( jk )**2 728 zdU = zcff* Avm_abl(ji,jj,jk) * (u_abl( ji, jj, jk+1, tind)-u_abl( ji, jj, jk , tind) )**2 667 729 zdV = zcff* Avm_abl(ji,jj,jk) * (v_abl( ji, jj, jk+1, tind)-v_abl( ji, jj, jk , tind) )**2 668 zsh2(ji,jk) = zdU+zdV 669 END DO 670 END DO 730 zsh2(ji,jk) = zdU+zdV !<-- zsh2 = Km ( ( du/dz )^2 + ( dv/dz )^2 ) 731 END DO 732 END DO 671 733 ! 672 734 ! Compute brunt-vaisala frequency 673 735 DO jk = 2, jpkam1 674 DO ji = 1,jpi 675 zcff = grav * itvref / e3w_abl( jk ) 736 DO ji = 1,jpi 737 zcff = grav * itvref / e3w_abl( jk ) 676 738 zcff1 = tq_abl( ji, jj, jk+1, tind, jp_ta) - tq_abl( ji, jj, jk , tind, jp_ta) 677 739 zcff2 = tq_abl( ji, jj, jk+1, tind, jp_ta) * tq_abl( ji, jj, jk+1, tind, jp_qa) & … … 679 741 zbn2(ji,jj,jk) = zcff * ( zcff1 + rctv0 * zcff2 ) !<-- zbn2 defined on (2,jpi) 680 742 END DO 681 END DO 743 END DO 682 744 ! 683 745 ! Terms for the tridiagonal problem 684 746 DO jk = 2, jpkam1 685 DO ji = 1, jpi686 zshear = zsh2( ji, jk )! zsh2 is already multiplied by Avm_abl at this point687 zsh2(ji,jk) = zsh2( ji, jk ) / Avm_abl( ji, jj, jk ) ! reformulate zsh2 as a 'true' vertical shear for PBLH computation688 zbuoy = - Avt_abl( ji, jj, jk ) * zbn2( ji, jj, jk )689 690 z_elem_a( ji, jk ) = - 0.5_wp * rDt_abl * rn_Sch * ( Avm_abl( ji, jj, jk )+Avm_abl( ji, jj, jk-1 ) ) / e3t_abl( jk ) ! lower-diagonal691 z_elem_c( ji, jk ) = - 0.5_wp * rDt_abl * rn_Sch * ( Avm_abl( ji, jj, jk )+Avm_abl( ji, jj, jk+1 ) ) / e3t_abl( jk+1 ) ! upper-diagonal747 DO ji = 1, jpi 748 zshear = zsh2( ji, jk ) ! zsh2 is already multiplied by Avm_abl at this point 749 zsh2(ji,jk) = zsh2( ji, jk ) / Avm_abl( ji, jj, jk ) ! reformulate zsh2 as a 'true' vertical shear for PBLH computation 750 zbuoy = - Avt_abl( ji, jj, jk ) * zbn2( ji, jj, jk ) 751 752 z_elem_a( ji, jk ) = - 0.5_wp * rDt_abl * rn_Sch * ( Avm_abl( ji, jj, jk ) + Avm_abl( ji, jj, jk-1 ) ) / e3t_abl( jk ) ! lower-diagonal 753 z_elem_c( ji, jk ) = - 0.5_wp * rDt_abl * rn_Sch * ( Avm_abl( ji, jj, jk ) + Avm_abl( ji, jj, jk+1 ) ) / e3t_abl( jk+1 ) ! upper-diagonal 692 754 IF( (zbuoy + zshear) .gt. 0.) THEN ! Patankar trick to avoid negative values of TKE 693 z_elem_b( ji, jk )= e3w_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk ) &694 & + e3w_abl(jk) * rDt_abl * rn_Ceps * sqrt(tke_abl( ji, jj, jk, nt_n )) / mxl_abl(ji,jj,jk) ! diagonal695 tke_abl( ji, jj, jk, nt_a ) = e3w_abl(jk) * ( tke_abl( ji, jj, jk, nt_n ) + rDt_abl * ( zbuoy + zshear ) )! right-hand-side755 z_elem_b( ji, jk ) = e3w_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk ) & 756 & + e3w_abl(jk) * rDt_abl * rn_Ceps * sqrt(tke_abl( ji, jj, jk, nt_n )) / mxld_abl(ji,jj,jk) ! diagonal 757 tke_abl( ji, jj, jk, nt_a ) = e3w_abl(jk) * ( tke_abl( ji, jj, jk, nt_n ) + rDt_abl * ( zbuoy + zshear ) ) ! right-hand-side 696 758 ELSE 697 z_elem_b( ji, jk )= e3w_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk ) &698 & + e3w_abl(jk) * rDt_abl * rn_Ceps * sqrt(tke_abl( ji, jj, jk, nt_n )) / mxl_abl(ji,jj,jk) & ! diagonal699 & - e3w_abl(jk) * rDt_abl * zbuoy700 tke_abl( ji, jj, jk, nt_a ) = e3w_abl(jk) * ( tke_abl( ji, jj, jk, nt_n ) + rDt_abl * zshear ) ! right-hand-side759 z_elem_b( ji, jk ) = e3w_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk ) & 760 & + e3w_abl(jk) * rDt_abl * rn_Ceps * sqrt(tke_abl( ji, jj, jk, nt_n )) / mxld_abl(ji,jj,jk) & ! diagonal 761 & - e3w_abl(jk) * rDt_abl * zbuoy 762 tke_abl( ji, jj, jk, nt_a ) = e3w_abl(jk) * ( tke_abl( ji, jj, jk, nt_n ) + rDt_abl * zshear ) ! right-hand-side 701 763 END IF 702 764 END DO 703 END DO 704 705 DO ji = 1,jpi ! vector opt. 706 zesrf = MAX( 4.63_wp * ustar2(ji,jj), tke_min ) 707 zetop = tke_min 708 z_elem_a ( ji, 1 ) = 0._wp; z_elem_c ( ji, 1 ) = 0._wp; z_elem_b ( ji, 1 ) = 1._wp 709 z_elem_a ( ji, jpka ) = 0._wp; z_elem_c ( ji, jpka ) = 0._wp; z_elem_b ( ji, jpka ) = 1._wp 710 tke_abl( ji, jj, 1, nt_a ) = zesrf 711 tke_abl( ji, jj, jpka, nt_a ) = zetop 712 zbn2(ji,jj, 1) = zbn2( ji,jj, 2) 713 zsh2(ji, 1) = zsh2( ji, 2) 714 zbn2(ji,jj,jpka) = zbn2( ji,jj,jpkam1) 715 zsh2(ji, jpka) = zsh2( ji , jpkam1) 716 END DO 765 END DO 766 767 DO ji = 1,jpi ! vector opt. 768 zesrf = MAX( rn_Esfc * ustar2(ji,jj), tke_min ) 769 zetop = tke_min 770 771 z_elem_a ( ji, 1 ) = 0._wp 772 z_elem_c ( ji, 1 ) = 0._wp 773 z_elem_b ( ji, 1 ) = 1._wp 774 tke_abl ( ji, jj, 1, nt_a ) = zesrf 775 776 !++ Top Neumann B.C. 777 !z_elem_a ( ji, jpka ) = - 0.5 * rDt_abl * rn_Sch * (Avm_abl(ji,jj, jpka-1 )+Avm_abl(ji,jj, jpka )) / e3t_abl( jpka ) 778 !z_elem_c ( ji, jpka ) = 0._wp 779 !z_elem_b ( ji, jpka ) = e3w_abl(jpka) - z_elem_a(ji, jpka ) 780 !tke_abl ( ji, jj, jpka, nt_a ) = e3w_abl(jpka) * tke_abl( ji,jj, jpka, nt_n ) 781 782 !++ Top Dirichlet B.C. 783 z_elem_a ( ji, jpka ) = 0._wp 784 z_elem_c ( ji, jpka ) = 0._wp 785 z_elem_b ( ji, jpka ) = 1._wp 786 tke_abl ( ji, jj, jpka, nt_a ) = zetop 787 788 zbn2 ( ji, jj, 1 ) = zbn2 ( ji, jj, 2 ) 789 zsh2 ( ji, 1 ) = zsh2 ( ji, 2 ) 790 zbn2 ( ji, jj, jpka ) = zbn2 ( ji, jj, jpkam1 ) 791 zsh2 ( ji, jpka ) = zsh2 ( ji , jpkam1 ) 792 END DO 717 793 !! 718 794 !! Matrix inversion … … 720 796 DO ji = 1,jpi 721 797 zcff = 1._wp / z_elem_b( ji, 1 ) 722 zCF (ji, 1 ) = - zcff * z_elem_c( ji, 1 ) 723 tke_abl(ji,jj,1,nt_a) = zcff * tke_abl ( ji, jj, 1, nt_a ) 724 END DO 725 726 DO jk = 2, jpka 798 zCF (ji, 1 ) = - zcff * z_elem_c( ji, 1 ) 799 tke_abl(ji,jj,1,nt_a) = zcff * tke_abl ( ji, jj, 1, nt_a ) 800 END DO 801 802 DO jk = 2, jpka 727 803 DO ji = 1,jpi 728 804 zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF(ji, jk-1 ) ) … … 732 808 END DO 733 809 END DO 734 735 DO jk = jpkam1,1,-1 810 811 DO jk = jpkam1,1,-1 736 812 DO ji = 1,jpi 737 813 tke_abl(ji,jj,jk,nt_a) = tke_abl(ji,jj,jk,nt_a) + zCF(ji,jk) * tke_abl(ji,jj,jk+1,nt_a) 738 814 END DO 739 815 END DO 740 741 !!FL should not be needed because of Patankar procedure 816 817 !!FL should not be needed because of Patankar procedure 742 818 tke_abl(2:jpi,jj,1:jpka,nt_a) = MAX( tke_abl(2:jpi,jj,1:jpka,nt_a), tke_min ) 743 819 … … 745 821 !! Diagnose PBL height 746 822 !! ---------------------------------------------------------- 747 748 749 ! 823 824 825 ! 750 826 ! arrays zRH, zFC and zCF are available at this point 751 827 ! and zFC(:, 1 ) = 0. 752 828 ! diagnose PBL height based on zsh2 and zbn2 753 829 zFC ( : ,1) = 0._wp 754 ikbl( 1:jpi ) = 0 755 830 ikbl( 1:jpi ) = 0 831 756 832 DO jk = 2,jpka 757 DO ji = 1, jpi 833 DO ji = 1, jpi 758 834 zcff = ghw_abl( jk-1 ) 759 835 zcff1 = zcff / ( zcff + rn_epssfc * pblh ( ji, jj ) ) … … 781 857 ELSE 782 858 pblh( ji, jj ) = ghw_abl(jpka) 783 END IF 784 END DO 785 !------------- 786 END DO 787 !------------- 788 ! 789 ! Optional : could add pblh smoothing if pblh is noisy horizontally ... 859 END IF 860 END DO 861 !------------- 862 END DO 863 !------------- 864 ! 865 ! Optional : could add pblh smoothing if pblh is noisy horizontally ... 790 866 IF(ln_smth_pblh) THEN 791 CALL lbc_lnk( 'ablmod', pblh, 'T', 1.) 867 CALL lbc_lnk( 'ablmod', pblh, 'T', 1.) !, kfillmode = jpfillnothing) 792 868 CALL smooth_pblh( pblh, msk_abl ) 793 CALL lbc_lnk( 'ablmod', pblh, 'T', 1.) 869 CALL lbc_lnk( 'ablmod', pblh, 'T', 1.) !, kfillmode = jpfillnothing) 794 870 ENDIF 795 871 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 799 875 SELECT CASE ( nn_amxl ) 800 876 ! 801 CASE ( 0 ) ! Deardroff 80 length-scale bounded by the distance to surface and bottom 802 # define zlup zRH 803 # define zldw zFC 877 CASE ( 0 ) ! Deardroff 80 length-scale bounded by the distance to surface and bottom 878 # define zlup zRH 879 # define zldw zFC 804 880 DO jj = 1, jpj ! outer loop 805 881 ! 806 882 DO ji = 1, jpi 807 mxl_abl ( ji, jj, 1 ) = 0._wp 808 mxl_abl ( ji, jj, jpka ) = mxl_min 809 zldw( ji, 1 ) = 0._wp 810 zlup( ji, jpka ) = 0._wp 811 END DO 812 ! 813 DO jk = 2, jpkam1 814 DO ji = 1, jpi 815 zbuoy = MAX( zbn2(ji, jj, jk), rsmall ) 816 mxl_abl( ji, jj, jk ) = MAX( mxl_min, & 817 & SQRT( 2._wp * tke_abl( ji, jj, jk, nt_a ) / zbuoy ) ) 818 END DO 819 END DO 883 mxld_abl( ji, jj, 1 ) = mxl_min 884 mxld_abl( ji, jj, jpka ) = mxl_min 885 mxlm_abl( ji, jj, 1 ) = mxl_min 886 mxlm_abl( ji, jj, jpka ) = mxl_min 887 zldw ( ji, 1 ) = zrough(ji,jj) * rn_Lsfc 888 zlup ( ji, jpka ) = mxl_min 889 END DO 890 ! 891 DO jk = 2, jpkam1 892 DO ji = 1, jpi 893 zbuoy = MAX( zbn2(ji, jj, jk), rsmall ) 894 mxlm_abl( ji, jj, jk ) = MAX( mxl_min, & 895 & SQRT( 2._wp * tke_abl( ji, jj, jk, nt_a ) / zbuoy ) ) 896 END DO 897 END DO 820 898 ! 821 899 ! Limit mxl 822 DO jk = jpkam1,1,-1 823 DO ji = 1, jpi 824 zlup(ji,jk) = MIN( zlup(ji,jk+1) + (ghw_abl(jk+1)-ghw_abl(jk)) , mxl _abl(ji, jj, jk) )825 END DO 826 END DO 900 DO jk = jpkam1,1,-1 901 DO ji = 1, jpi 902 zlup(ji,jk) = MIN( zlup(ji,jk+1) + (ghw_abl(jk+1)-ghw_abl(jk)) , mxlm_abl(ji, jj, jk) ) 903 END DO 904 END DO 827 905 ! 828 906 DO jk = 2, jpka 829 DO ji = 1, jpi 830 zldw(ji,jk) = MIN( zldw(ji,jk-1) + (ghw_abl(jk)-ghw_abl(jk-1)) , mxl_abl(ji, jj, jk) ) 831 END DO 832 END DO 907 DO ji = 1, jpi 908 zldw(ji,jk) = MIN( zldw(ji,jk-1) + (ghw_abl(jk)-ghw_abl(jk-1)) , mxlm_abl(ji, jj, jk) ) 909 END DO 910 END DO 911 ! 912 ! DO jk = 1, jpka 913 ! DO ji = 1, jpi 914 ! mxlm_abl( ji, jj, jk ) = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 915 ! mxld_abl( ji, jj, jk ) = MIN ( zldw( ji, jk ), zlup( ji, jk ) ) 916 ! END DO 917 ! END DO 833 918 ! 834 919 DO jk = 1, jpka 835 920 DO ji = 1, jpi 836 mxl_abl( ji, jj, jk ) = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 837 END DO 838 END DO 839 ! 840 END DO 841 # undef zlup 842 # undef zldw 843 ! 844 ! 845 CASE ( 1 ) ! length-scale computed as the distance to the PBL height 846 DO jj = 1,jpj ! outer loop 847 ! 848 DO ji = 1, jpi ! vector opt. 849 zcff = 1._wp / pblh( ji, jj ) ! inverse of hbl 850 DO jk = 1, jpka 851 zsig = MIN( zcff * ghw_abl( jk ), 1. ) 852 zcff1 = pblh( ji, jj ) 853 mxl_abl( ji, jj, jk ) = mxl_min & 854 & + zsig * ( amx1*zcff1 + bmx1*mxl_min ) & 855 & + zsig * zsig * ( amx2*zcff1 + bmx2*mxl_min ) & 856 & + zsig**3 * ( amx3*zcff1 + bmx3*mxl_min ) & 857 & + zsig**4 * ( amx4*zcff1 + bmx4*mxl_min ) & 858 & + zsig**5 * ( amx5*zcff1 + bmx5*mxl_min ) 859 END DO 860 END DO 861 ! 862 END DO 921 ! zcff = 2.*SQRT(2.)*( zldw( ji, jk )**(-2._wp/3._wp) + zlup( ji, jk )**(-2._wp/3._wp) )**(-3._wp/2._wp) 922 zcff = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 923 mxlm_abl( ji, jj, jk ) = MAX( zcff, mxl_min ) 924 mxld_abl( ji, jj, jk ) = MAX( MIN( zldw( ji, jk ), zlup( ji, jk ) ), mxl_min ) 925 END DO 926 END DO 927 ! 928 END DO 929 # undef zlup 930 # undef zldw 931 ! 932 ! 933 CASE ( 1 ) ! Modified Deardroff 80 length-scale bounded by the distance to surface and bottom 934 # define zlup zRH 935 # define zldw zFC 936 DO jj = 1, jpj ! outer loop 937 ! 938 DO jk = 2, jpkam1 939 DO ji = 1,jpi 940 zcff = 1.0_wp / e3w_abl( jk )**2 941 zdU = zcff* (u_abl( ji, jj, jk+1, tind)-u_abl( ji, jj, jk , tind) )**2 942 zdV = zcff* (v_abl( ji, jj, jk+1, tind)-v_abl( ji, jj, jk , tind) )**2 943 zsh2(ji,jk) = SQRT(zdU+zdV) !<-- zsh2 = SQRT ( ( du/dz )^2 + ( dv/dz )^2 ) 944 ENDDO 945 ENDDO 946 ! 947 DO ji = 1, jpi 948 zcff = zrough(ji,jj) * rn_Lsfc 949 mxld_abl ( ji, jj, 1 ) = zcff 950 mxld_abl ( ji, jj, jpka ) = mxl_min 951 mxlm_abl ( ji, jj, 1 ) = zcff 952 mxlm_abl ( ji, jj, jpka ) = mxl_min 953 zldw ( ji, 1 ) = zcff 954 zlup ( ji, jpka ) = mxl_min 955 END DO 956 ! 957 DO jk = 2, jpkam1 958 DO ji = 1, jpi 959 zbuoy = MAX( zbn2(ji, jj, jk), rsmall ) 960 zcff = 2.*SQRT(tke_abl( ji, jj, jk, nt_a )) / ( rn_Rod*zsh2(ji,jk) & 961 & + SQRT( rn_Rod*rn_Rod*zsh2(ji,jk)*zsh2(ji,jk)+2.*zbuoy ) ) 962 mxlm_abl( ji, jj, jk ) = MAX( mxl_min, zcff ) 963 END DO 964 END DO 965 ! 966 ! Limit mxl 967 DO jk = jpkam1,1,-1 968 DO ji = 1, jpi 969 zlup(ji,jk) = MIN( zlup(ji,jk+1) + (ghw_abl(jk+1)-ghw_abl(jk)) , mxlm_abl(ji, jj, jk) ) 970 END DO 971 END DO 972 ! 973 DO jk = 2, jpka 974 DO ji = 1, jpi 975 zldw(ji,jk) = MIN( zldw(ji,jk-1) + (ghw_abl(jk)-ghw_abl(jk-1)) , mxlm_abl(ji, jj, jk) ) 976 END DO 977 END DO 978 ! 979 DO jk = 1, jpka 980 DO ji = 1, jpi 981 !mxlm_abl( ji, jj, jk ) = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 982 !zcff = 2.*SQRT(2.)*( zldw( ji, jk )**(-2._wp/3._wp) + zlup( ji, jk )**(-2._wp/3._wp) )**(-3._wp/2._wp) 983 zcff = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 984 mxlm_abl( ji, jj, jk ) = MAX( zcff, mxl_min ) 985 !mxld_abl( ji, jj, jk ) = MIN( zldw( ji, jk ), zlup( ji, jk ) ) 986 mxld_abl( ji, jj, jk ) = MAX( MIN( zldw( ji, jk ), zlup( ji, jk ) ), mxl_min ) 987 END DO 988 END DO 989 ! 990 END DO 991 # undef zlup 992 # undef zldw 863 993 ! 864 994 CASE ( 2 ) ! Bougeault & Lacarrere 89 length-scale 865 995 ! 866 # define zlup zRH 867 # define zldw zFC 996 # define zlup zRH 997 # define zldw zFC 868 998 ! zCF is used for matrix inversion 869 ! 999 ! 870 1000 DO jj = 1, jpj ! outer loop 871 872 DO ji = 1, jpi 873 zlup( ji, 1 ) = mxl_min 874 zldw( ji, 1 ) = mxl_min 1001 1002 DO ji = 1, jpi 1003 zcff = zrough(ji,jj) * rn_Lsfc 1004 zlup( ji, 1 ) = zcff 1005 zldw( ji, 1 ) = zcff 875 1006 zlup( ji, jpka ) = mxl_min 876 zldw( ji, jpka ) = mxl_min 877 END DO 878 1007 zldw( ji, jpka ) = mxl_min 1008 END DO 1009 879 1010 DO jk = 2,jpka-1 880 1011 DO ji = 1, jpi 881 1012 zlup(ji,jk) = ghw_abl(jpka) - ghw_abl(jk) 882 zldw(ji,jk) = ghw_abl(jk ) - ghw_abl( 1) 883 END DO 884 END DO 1013 zldw(ji,jk) = ghw_abl(jk ) - ghw_abl( 1) 1014 END DO 1015 END DO 885 1016 !! 886 1017 !! BL89 search for lup 887 !! ---------------------------------------------------------- 888 DO jk=2,jpka-1 1018 !! ---------------------------------------------------------- 1019 DO jk=2,jpka-1 889 1020 ! 890 1021 DO ji = 1, jpi … … 892 1023 zCF(ji, jk ) = - tke_abl( ji, jj, jk, nt_a ) 893 1024 ln_foundl(ji ) = .false. 894 END DO 895 ! 1025 END DO 1026 ! 896 1027 DO jkup=jk+1,jpka-1 897 1028 DO ji = 1, jpi 1029 zbuoy1 = MAX( zbn2(ji,jj,jkup ), rsmall ) 1030 zbuoy2 = MAX( zbn2(ji,jj,jkup-1), rsmall ) 898 1031 zCF (ji,jkup) = zCF (ji,jkup-1) + 0.5_wp * e3t_abl(jkup) * & 899 & ( zb n2(ji,jj,jkup )*(ghw_abl(jkup )-ghw_abl(jk)) &900 & + zb n2(ji,jj,jkup-1)*(ghw_abl(jkup-1)-ghw_abl(jk)) )1032 & ( zbuoy1*(ghw_abl(jkup )-ghw_abl(jk)) & 1033 & + zbuoy2*(ghw_abl(jkup-1)-ghw_abl(jk)) ) 901 1034 IF( zCF (ji,jkup) * zCF (ji,jkup-1) .le. 0._wp .and. .not. ln_foundl(ji) ) THEN 902 1035 zcff2 = ghw_abl(jkup ) - ghw_abl(jk) 903 zcff1 = ghw_abl(jkup-1) - ghw_abl(jk) 1036 zcff1 = ghw_abl(jkup-1) - ghw_abl(jk) 904 1037 zcff = ( zcff1 * zCF(ji,jkup) - zcff2 * zCF(ji,jkup-1) ) / & 905 & ( zCF(ji,jkup) - zCF(ji,jkup-1) ) 906 zlup(ji,jk) = zcff 1038 & ( zCF(ji,jkup) - zCF(ji,jkup-1) ) 1039 zlup(ji,jk) = zcff 1040 zlup(ji,jk) = ghw_abl(jkup ) - ghw_abl(jk) 907 1041 ln_foundl(ji) = .true. 908 1042 END IF … … 910 1044 END DO 911 1045 ! 912 END DO 1046 END DO 913 1047 !! 914 1048 !! BL89 search for ldwn 915 !! ---------------------------------------------------------- 916 DO jk=2,jpka-1 1049 !! ---------------------------------------------------------- 1050 DO jk=2,jpka-1 917 1051 ! 918 1052 DO ji = 1, jpi … … 920 1054 zCF(ji, jk ) = - tke_abl( ji, jj, jk, nt_a ) 921 1055 ln_foundl(ji ) = .false. 922 END DO 923 ! 1056 END DO 1057 ! 924 1058 DO jkdwn=jk-1,1,-1 925 DO ji = 1, jpi 1059 DO ji = 1, jpi 1060 zbuoy1 = MAX( zbn2(ji,jj,jkdwn+1), rsmall ) 1061 zbuoy2 = MAX( zbn2(ji,jj,jkdwn ), rsmall ) 926 1062 zCF (ji,jkdwn) = zCF (ji,jkdwn+1) + 0.5_wp * e3t_abl(jkdwn+1) & 927 & * ( zb n2(ji,jj,jkdwn+1)*(ghw_abl(jk)-ghw_abl(jkdwn+1)) &928 + zb n2(ji,jj,jkdwn )*(ghw_abl(jk)-ghw_abl(jkdwn )) )929 IF(zCF (ji,jkdwn) * zCF (ji,jkdwn+1) .le. 0._wp .and. .not. ln_foundl(ji) ) THEN 1063 & * ( zbuoy1*(ghw_abl(jk)-ghw_abl(jkdwn+1)) & 1064 + zbuoy2*(ghw_abl(jk)-ghw_abl(jkdwn )) ) 1065 IF(zCF (ji,jkdwn) * zCF (ji,jkdwn+1) .le. 0._wp .and. .not. ln_foundl(ji) ) THEN 930 1066 zcff2 = ghw_abl(jk) - ghw_abl(jkdwn+1) 931 zcff1 = ghw_abl(jk) - ghw_abl(jkdwn ) 1067 zcff1 = ghw_abl(jk) - ghw_abl(jkdwn ) 932 1068 zcff = ( zcff1 * zCF(ji,jkdwn+1) - zcff2 * zCF(ji,jkdwn) ) / & 933 & ( zCF(ji,jkdwn+1) - zCF(ji,jkdwn) ) 934 zldw(ji,jk) = zcff 935 ln_foundl(ji) = .true. 936 END IF 937 END DO 938 END DO 939 ! 1069 & ( zCF(ji,jkdwn+1) - zCF(ji,jkdwn) ) 1070 zldw(ji,jk) = zcff 1071 zldw(ji,jk) = ghw_abl(jk) - ghw_abl(jkdwn ) 1072 ln_foundl(ji) = .true. 1073 END IF 1074 END DO 1075 END DO 1076 ! 940 1077 END DO 941 1078 942 1079 DO jk = 1, jpka 943 DO ji = 1, jpi 944 mxl_abl( ji, jj, jk ) = MAX( SQRT( zldw( ji, jk ) * zlup( ji, jk ) ), mxl_min ) 945 END DO 946 END DO 1080 DO ji = 1, jpi 1081 !zcff = 2.*SQRT(2.)*( zldw( ji, jk )**(-2._wp/3._wp) + zlup( ji, jk )**(-2._wp/3._wp) )**(-3._wp/2._wp) 1082 zcff = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 1083 mxlm_abl( ji, jj, jk ) = MAX( zcff, mxl_min ) 1084 mxld_abl( ji, jj, jk ) = MAX( MIN( zldw( ji, jk ), zlup( ji, jk ) ), mxl_min ) 1085 END DO 1086 END DO 947 1087 948 1088 END DO 949 # undef zlup 950 # undef zldw 951 ! 952 END SELECT 1089 # undef zlup 1090 # undef zldw 1091 ! 1092 CASE ( 3 ) ! Bougeault & Lacarrere 89 length-scale 1093 ! 1094 # define zlup zRH 1095 # define zldw zFC 1096 ! zCF is used for matrix inversion 1097 ! 1098 DO jj = 1, jpj ! outer loop 1099 ! 1100 DO jk = 2, jpkam1 1101 DO ji = 1,jpi 1102 zcff = 1.0_wp / e3w_abl( jk )**2 1103 zdU = zcff* (u_abl( ji, jj, jk+1, tind)-u_abl( ji, jj, jk , tind) )**2 1104 zdV = zcff* (v_abl( ji, jj, jk+1, tind)-v_abl( ji, jj, jk , tind) )**2 1105 zsh2(ji,jk) = SQRT(zdU+zdV) !<-- zsh2 = SQRT ( ( du/dz )^2 + ( dv/dz )^2 ) 1106 ENDDO 1107 ENDDO 1108 zsh2(:, 1) = zsh2( :, 2) 1109 zsh2(:, jpka) = zsh2( :, jpkam1) 1110 1111 DO ji = 1, jpi 1112 zcff = zrough(ji,jj) * rn_Lsfc 1113 zlup( ji, 1 ) = zcff 1114 zldw( ji, 1 ) = zcff 1115 zlup( ji, jpka ) = mxl_min 1116 zldw( ji, jpka ) = mxl_min 1117 END DO 1118 1119 DO jk = 2,jpka-1 1120 DO ji = 1, jpi 1121 zlup(ji,jk) = ghw_abl(jpka) - ghw_abl(jk) 1122 zldw(ji,jk) = ghw_abl(jk ) - ghw_abl( 1) 1123 END DO 1124 END DO 1125 !! 1126 !! BL89 search for lup 1127 !! ---------------------------------------------------------- 1128 DO jk=2,jpka-1 1129 ! 1130 DO ji = 1, jpi 1131 zCF(ji,1:jpka) = 0._wp 1132 zCF(ji, jk ) = - tke_abl( ji, jj, jk, nt_a ) 1133 ln_foundl(ji ) = .false. 1134 END DO 1135 ! 1136 DO jkup=jk+1,jpka-1 1137 DO ji = 1, jpi 1138 zbuoy1 = MAX( zbn2(ji,jj,jkup ), rsmall ) 1139 zbuoy2 = MAX( zbn2(ji,jj,jkup-1), rsmall ) 1140 zCF (ji,jkup) = zCF (ji,jkup-1) + 0.5_wp * e3t_abl(jkup) * & 1141 & ( zbuoy1*(ghw_abl(jkup )-ghw_abl(jk)) & 1142 & + zbuoy2*(ghw_abl(jkup-1)-ghw_abl(jk)) ) & 1143 & + 0.5_wp * e3t_abl(jkup) * rn_Rod * & 1144 & ( SQRT(tke_abl( ji, jj, jkup , nt_a ))*zsh2(ji,jkup ) & 1145 & + SQRT(tke_abl( ji, jj, jkup-1, nt_a ))*zsh2(ji,jkup-1) ) 1146 1147 IF( zCF (ji,jkup) * zCF (ji,jkup-1) .le. 0._wp .and. .not. ln_foundl(ji) ) THEN 1148 zcff2 = ghw_abl(jkup ) - ghw_abl(jk) 1149 zcff1 = ghw_abl(jkup-1) - ghw_abl(jk) 1150 zcff = ( zcff1 * zCF(ji,jkup) - zcff2 * zCF(ji,jkup-1) ) / & 1151 & ( zCF(ji,jkup) - zCF(ji,jkup-1) ) 1152 zlup(ji,jk) = zcff 1153 zlup(ji,jk) = ghw_abl(jkup ) - ghw_abl(jk) 1154 ln_foundl(ji) = .true. 1155 END IF 1156 END DO 1157 END DO 1158 ! 1159 END DO 1160 !! 1161 !! BL89 search for ldwn 1162 !! ---------------------------------------------------------- 1163 DO jk=2,jpka-1 1164 ! 1165 DO ji = 1, jpi 1166 zCF(ji,1:jpka) = 0._wp 1167 zCF(ji, jk ) = - tke_abl( ji, jj, jk, nt_a ) 1168 ln_foundl(ji ) = .false. 1169 END DO 1170 ! 1171 DO jkdwn=jk-1,1,-1 1172 DO ji = 1, jpi 1173 zbuoy1 = MAX( zbn2(ji,jj,jkdwn+1), rsmall ) 1174 zbuoy2 = MAX( zbn2(ji,jj,jkdwn ), rsmall ) 1175 zCF (ji,jkdwn) = zCF (ji,jkdwn+1) + 0.5_wp * e3t_abl(jkdwn+1) & 1176 & * (zbuoy1*(ghw_abl(jk)-ghw_abl(jkdwn+1)) & 1177 & +zbuoy2*(ghw_abl(jk)-ghw_abl(jkdwn )) ) & 1178 & + 0.5_wp * e3t_abl(jkup) * rn_Rod * & 1179 & ( SQRT(tke_abl( ji, jj, jkdwn+1, nt_a ))*zsh2(ji,jkdwn+1) & 1180 & + SQRT(tke_abl( ji, jj, jkdwn , nt_a ))*zsh2(ji,jkdwn ) ) 1181 1182 IF(zCF (ji,jkdwn) * zCF (ji,jkdwn+1) .le. 0._wp .and. .not. ln_foundl(ji) ) THEN 1183 zcff2 = ghw_abl(jk) - ghw_abl(jkdwn+1) 1184 zcff1 = ghw_abl(jk) - ghw_abl(jkdwn ) 1185 zcff = ( zcff1 * zCF(ji,jkdwn+1) - zcff2 * zCF(ji,jkdwn) ) / & 1186 & ( zCF(ji,jkdwn+1) - zCF(ji,jkdwn) ) 1187 zldw(ji,jk) = zcff 1188 zldw(ji,jk) = ghw_abl(jk) - ghw_abl(jkdwn ) 1189 ln_foundl(ji) = .true. 1190 END IF 1191 END DO 1192 END DO 1193 ! 1194 END DO 1195 1196 DO jk = 1, jpka 1197 DO ji = 1, jpi 1198 !zcff = 2.*SQRT(2.)*( zldw( ji, jk )**(-2._wp/3._wp) + zlup( ji, jk )**(-2._wp/3._wp) )**(-3._wp/2._wp) 1199 zcff = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 1200 mxlm_abl( ji, jj, jk ) = MAX( zcff, mxl_min ) 1201 mxld_abl( ji, jj, jk ) = MAX( MIN( zldw( ji, jk ), zlup( ji, jk ) ), mxl_min ) 1202 END DO 1203 END DO 1204 1205 END DO 1206 # undef zlup 1207 # undef zldw 1208 ! 1209 ! 1210 END SELECT 953 1211 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 954 1212 ! ! Finalize the computation of turbulent visc./diff. 955 1213 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 956 1214 957 1215 !------------- 958 1216 DO jj = 1, jpj ! outer loop 959 1217 !------------- 960 DO jk = 1, jpka 1218 DO jk = 1, jpka 961 1219 DO ji = 1, jpi ! vector opt. 962 zcff = MAX( rn_phimax, rn_Ric * mxl_abl( ji, jj, jk ) * mxl_abl( ji, jj, jk ) &963 & * zbn2(ji, jj, jk) / tke_abl( ji, jj, jk, nt_a ) )964 zcff2 965 zcff = mxl_abl( ji, jj, jk ) * SQRT( tke_abl( ji, jj, jk, nt_a ) )966 !!FL: MAX function probably useless because of the definition of mxl_min 1220 zcff = MAX( rn_phimax, rn_Ric * mxlm_abl( ji, jj, jk ) * mxld_abl( ji, jj, jk ) & 1221 & * MAX( zbn2(ji, jj, jk), rsmall ) / tke_abl( ji, jj, jk, nt_a ) ) 1222 zcff2 = 1. / ( 1. + zcff ) !<-- phi_z(z) 1223 zcff = mxlm_abl( ji, jj, jk ) * SQRT( tke_abl( ji, jj, jk, nt_a ) ) 1224 !!FL: MAX function probably useless because of the definition of mxl_min 967 1225 Avm_abl( ji, jj, jk ) = MAX( rn_Cm * zcff , avm_bak ) 968 Avt_abl( ji, jj, jk ) = MAX( rn_Ct * zcff * zcff2 , avt_bak ) 969 END DO 970 END DO 971 !------------- 972 END DO 1226 Avt_abl( ji, jj, jk ) = MAX( rn_Ct * zcff * zcff2 , avt_bak ) 1227 END DO 1228 END DO 1229 !------------- 1230 END DO 973 1231 !------------- 974 1232 … … 988 1246 !! 989 1247 !! --------------------------------------------------------------------- 990 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: msk 991 1248 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: msk 1249 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvar2d 992 1250 INTEGER :: ji,jj 993 994 995 1251 REAL(wp) :: smth_a, smth_b 1252 REAL(wp), DIMENSION(jpi,jpj) :: zdX,zdY,zFX,zFY 1253 REAL(wp) :: zumsk,zvmsk 996 1254 !! 997 1255 !!========================================================= … … 1005 1263 zdX ( ji, jj ) = ( pvar2d( ji+1,jj ) - pvar2d( ji ,jj ) ) * zumsk 1006 1264 END_2D 1007 1008 1265 1266 DO_2D_10_11 1009 1267 zvmsk = msk(ji,jj) * msk(ji,jj+1) 1010 1268 zdY ( ji, jj ) = ( pvar2d( ji, jj+1 ) - pvar2d( ji ,jj ) ) * zvmsk 1011 1012 1013 1269 END_2D 1270 1271 DO_2D_10_00 1014 1272 zFY ( ji, jj ) = zdY ( ji, jj ) & 1015 1273 & + smth_a* ( (zdX ( ji, jj+1 ) - zdX( ji-1, jj+1 )) & 1016 1274 & - (zdX ( ji, jj ) - zdX( ji-1, jj )) ) 1017 1275 END_2D 1018 1276 1019 1277 DO_2D_00_10 … … 1029 1287 & +zFY( ji, jj ) - zFY( ji, jj-1 ) ) 1030 1288 END_2D 1031 !! 1289 1032 1290 !--------------------------------------------------------------------------------------------------- 1033 1291 END SUBROUTINE smooth_pblh -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ABL/ablrst.F90
r12939 r13229 109 109 CALL iom_delay_rst( 'WRITE', 'ABL', numraw ) ! save only abl delayed global communication variables 110 110 111 ! Prognostic variables111 ! Prognostic (after timestep + swap time indices = now timestep) variables 112 112 CALL iom_rstput( iter, nitrst, numraw, 'u_abl', u_abl(:,:,:,nt_n ) ) 113 113 CALL iom_rstput( iter, nitrst, numraw, 'v_abl', v_abl(:,:,:,nt_n ) ) … … 117 117 CALL iom_rstput( iter, nitrst, numraw, 'avm_abl', avm_abl(:,:,: ) ) 118 118 CALL iom_rstput( iter, nitrst, numraw, 'avt_abl', avt_abl(:,:,: ) ) 119 CALL iom_rstput( iter, nitrst, numraw, 'mxl_abl', mxl_abl(:,:,: ) )119 CALL iom_rstput( iter, nitrst, numraw,'mxld_abl',mxld_abl(:,:,: ) ) 120 120 CALL iom_rstput( iter, nitrst, numraw, 'pblh', pblh(:,: ) ) 121 121 ! … … 172 172 CALL iom_get( numrar, jpdom_auto, 'avm_abl', avm_abl(:,:,: ) ) 173 173 CALL iom_get( numrar, jpdom_auto, 'avt_abl', avt_abl(:,:,: ) ) 174 CALL iom_get( numrar, jpdom_auto, 'mxl_abl', mxl_abl(:,:,: ) )174 CALL iom_get( numrar, jpdom_auto,'mxld_abl',mxld_abl(:,:,: ) ) 175 175 CALL iom_get( numrar, jpdom_auto, 'pblh', pblh(:,: ) ) 176 176 CALL iom_delay_rst( 'READ', 'ABL', numrar ) ! read only abl delayed global communication variables -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ABL/par_abl.F90
r12939 r13229 28 28 LOGICAL , PUBLIC :: ln_hpgls_frc !: forcing of ABL winds by large-scale pressure gradient 29 29 LOGICAL , PUBLIC :: ln_smth_pblh !: smoothing of atmospheric PBL height 30 !LOGICAL , PUBLIC :: ln_topbc_neumann = .FALSE. !: idealised testcases only 30 31 31 LOGICAL , PUBLIC :: ln_rstart_abl !: (de)activate abl restart32 CHARACTER(len=256), PUBLIC :: cn_ablrst_in !: suffix of abl restart name (input)33 CHARACTER(len=256), PUBLIC :: cn_ablrst_out !: suffix of abl restart name (output)34 CHARACTER(len=256), PUBLIC :: cn_ablrst_indir !: abl restart input directory35 CHARACTER(len=256), PUBLIC :: cn_ablrst_outdir !: abl restart output directory32 LOGICAL , PUBLIC :: ln_rstart_abl !: (de)activate abl restart 33 CHARACTER(len=256), PUBLIC :: cn_ablrst_in !: suffix of abl restart name (input) 34 CHARACTER(len=256), PUBLIC :: cn_ablrst_out !: suffix of abl restart name (output) 35 CHARACTER(len=256), PUBLIC :: cn_ablrst_indir !: abl restart input directory 36 CHARACTER(len=256), PUBLIC :: cn_ablrst_outdir !: abl restart output directory 36 37 37 38 !!--------------------------------------------------------------------- … … 46 47 REAL(wp), PUBLIC, PARAMETER :: rn_Cek = 258._wp !: Ekman constant for Richardson number 47 48 REAL(wp), PUBLIC, PARAMETER :: rn_epssfc = 1._wp / ( 1._wp + 2.8_wp * 2.8_wp ) 48 REAL(wp), PUBLIC :: rn_ ceps !: namelist parameter49 REAL(wp), PUBLIC :: rn_ cm !: namelist parameter50 REAL(wp), PUBLIC :: rn_ ct !: namelist parameter51 REAL(wp), PUBLIC :: rn_ ce !: namelist parameter49 REAL(wp), PUBLIC :: rn_Ceps !: namelist parameter 50 REAL(wp), PUBLIC :: rn_Cm !: namelist parameter 51 REAL(wp), PUBLIC :: rn_Ct !: namelist parameter 52 REAL(wp), PUBLIC :: rn_Ce !: namelist parameter 52 53 REAL(wp), PUBLIC :: rn_Rod !: namelist parameter 53 54 REAL(wp), PUBLIC :: rn_Sch 55 REAL(wp), PUBLIC :: rn_Esfc 56 REAL(wp), PUBLIC :: rn_Lsfc 54 57 REAL(wp), PUBLIC :: mxl_min 55 58 REAL(wp), PUBLIC :: rn_ldyn_min !: namelist parameter -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ABL/sbcabl.F90
r12939 r13229 71 71 & ln_hpgls_frc, ln_geos_winds, nn_dyn_restore, & 72 72 & rn_ldyn_min , rn_ldyn_max, rn_ltra_min, rn_ltra_max, & 73 & nn_amxl, rn_ cm, rn_ct, rn_ce, rn_ceps, rn_Rod, rn_Ric, &73 & nn_amxl, rn_Cm, rn_Ct, rn_Ce, rn_Ceps, rn_Rod, rn_Ric, & 74 74 & ln_smth_pblh 75 75 !!--------------------------------------------------------------------- 76 76 77 ! Namelist namsbc_abl in reference namelist : ABL parameters77 ! Namelist namsbc_abl in reference namelist : ABL parameters 78 78 READ ( numnam_ref, namsbc_abl, IOSTAT = ios, ERR = 901 ) 79 79 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in reference namelist' ) 80 ! Namelist namsbc_abl in configuration namelist : ABL parameters 80 ! 81 ! Namelist namsbc_abl in configuration namelist : ABL parameters 81 82 READ ( numnam_cfg, namsbc_abl, IOSTAT = ios, ERR = 902 ) 82 83 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in configuration namelist' ) … … 165 166 rn_Sch = rn_ce / rn_cm 166 167 mxl_min = (avm_bak / rn_cm) / sqrt( tke_min ) 168 rn_Esfc = 1._wp / SQRT(rn_cm*rn_ceps) 169 rn_Lsfc = vkarmn * SQRT(SQRT(rn_cm*rn_ceps)) / rn_cm 167 170 168 171 IF(lwp) THEN … … 171 174 WRITE(numout,*) ' ~~~~~~~~~~~' 172 175 IF(nn_amxl==0) WRITE(numout,*) 'Deardorff 80 length-scale ' 173 IF(nn_amxl==1) WRITE(numout,*) 'length-scale based on the distance to the PBL height ' 176 IF(nn_amxl==1) WRITE(numout,*) 'Modified Deardorff 80 length-scale ' 177 IF(nn_amxl==2) WRITE(numout,*) 'Bougeault and Lacarrere length-scale ' 178 IF(nn_amxl==3) WRITE(numout,*) 'Rodier et al. length-scale ' 174 179 WRITE(numout,*) ' Minimum value of atmospheric TKE = ',tke_min,' m^2 s^-2' 175 180 WRITE(numout,*) ' Minimum value of atmospheric mixing length = ',mxl_min,' m' … … 178 183 WRITE(numout,*) ' Constant for Schmidt number = ',rn_Sch 179 184 WRITE(numout,*) ' Constant for TKE dissipation = ',rn_Ceps 185 WRITE(numout,*) ' Constant for TKE sfc boundary condition = ',rn_Esfc 186 WRITE(numout,*) ' Constant for mxl sfc boundary condition = ',rn_Lsfc 180 187 END IF 181 188 … … 202 209 ! ABL timestep 203 210 rDt_abl = nn_fsbc * rn_Dt 211 IF(lwp) WRITE(numout,*) ' ABL timestep = ', rDt_abl,' s' 204 212 205 213 ! Check parameters for dynamics … … 248 256 zcff = 2._wp * omega * SIN( rad * 90._wp ) !++ fmax 249 257 rest_eq(:,:) = SIN( 0.5_wp*rpi*( (fft_abl(:,:) - zcff) / zcff ) )**8 250 !!GS: alternative shape251 !rest_eq(:,:) = SIN( 0.5_wp*rpi*(zcff - ABS(ff_t(:,:))) / (zcff - 3.e-5) )**8252 !WHERE(ABS(ff_t(:,:)).LE.3.e-5) rest_eq(:,:) = 1._wp253 258 ELSE 254 259 rest_eq(:,:) = 1._wp … … 271 276 CALL fld_read( nit000, nn_fsbc, sf ) ! input fields provided at the first time-step 272 277 273 u_abl(:,:,:,nt_n ) = sf(jp_wndi)%fnow(:,:,:)274 v_abl(:,:,:,nt_n ) = sf(jp_wndj)%fnow(:,:,:)278 u_abl(:,:,:,nt_n ) = sf(jp_wndi)%fnow(:,:,:) 279 v_abl(:,:,:,nt_n ) = sf(jp_wndj)%fnow(:,:,:) 275 280 tq_abl(:,:,:,nt_n,jp_ta) = sf(jp_tair)%fnow(:,:,:) 276 281 tq_abl(:,:,:,nt_n,jp_qa) = sf(jp_humi)%fnow(:,:,:) … … 279 284 avm_abl(:,:,: ) = avm_bak 280 285 avt_abl(:,:,: ) = avt_bak 281 mxl_abl(:,:,: ) = mxl_min282 286 pblh (:,: ) = ghw_abl( 3 ) !<-- assume that the pbl contains 3 grid points 283 287 u_abl (:,:,:,nt_a ) = 0._wp … … 285 289 tq_abl (:,:,:,nt_a,: ) = 0._wp 286 290 tke_abl(:,:,:,nt_a ) = 0._wp 291 292 mxlm_abl(:,:,: ) = mxl_min 293 mxld_abl(:,:,: ) = mxl_min 287 294 ENDIF 288 295 … … 335 342 & tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), & ! <<= in 336 343 & sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m , & ! <<= in 344 & sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1), & ! <<= in 337 345 & sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) , & ! <<= in 338 346 & tsk_m, zssq, zcd_du, zsen, zevp ) ! =>> out -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ICE/iceistate.F90
r12939 r13229 32 32 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) 33 33 USE fldread ! read input fields 34 35 # if defined key_agrif 36 USE agrif_oce 37 USE agrif_ice 38 USE agrif_ice_interp 39 # endif 34 40 35 41 IMPLICIT NONE … … 168 174 ! 2) overwrite some of the fields with namelist parameters or netcdf file 169 175 !------------------------------------------------------------------------ 176 177 170 178 IF( ln_iceini ) THEN 171 179 ! !---------------! 172 IF( ln_iceini_file )THEN ! Read a file ! 173 ! !---------------! 174 WHERE( ff_t(:,:) >= 0._wp ) ; zswitch(:,:) = 1._wp 175 ELSEWHERE ; zswitch(:,:) = 0._wp 180 181 IF( Agrif_Root() ) THEN 182 183 IF( ln_iceini_file )THEN ! Read a file ! 184 ! !---------------! 185 WHERE( ff_t(:,:) >= 0._wp ) ; zswitch(:,:) = 1._wp 186 ELSEWHERE ; zswitch(:,:) = 0._wp 187 END WHERE 188 ! 189 CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step 190 ! 191 ! -- mandatory fields -- ! 192 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 193 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 194 zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 195 196 ! -- optional fields -- ! 197 ! if fields do not exist then set them to the values present in the namelist (except for snow and surface temperature) 198 ! 199 ! ice salinity 200 IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & 201 & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 202 ! 203 ! temperatures 204 IF ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. & 205 & TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN 206 si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 207 si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 208 si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 209 ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 210 si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) 211 ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 212 si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 ) 213 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_su, set T_su = T_s 214 si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1) 215 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_su, set T_su = T_i 216 si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 217 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_s, set T_s = T_su 218 si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1) 219 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_s, set T_s = T_i 220 si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 221 ENDIF 222 ! 223 ! pond concentration 224 IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 225 & si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. 226 & * si(jp_ati)%fnow(:,:,1) 227 ! 228 ! pond depth 229 IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 230 & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 231 ! 232 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 233 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 234 zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 235 ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 236 zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 237 zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 238 ! 239 ! change the switch for the following 240 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 241 ELSEWHERE ; zswitch(:,:) = 0._wp 242 END WHERE 243 244 ! !---------------! 245 ELSE ! Read namelist ! 246 ! !---------------! 247 ! no ice if (sst - Tfreez) >= thresold 248 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 249 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 250 END WHERE 251 ! 252 ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 253 WHERE( ff_t(:,:) >= 0._wp ) 254 zht_i_ini(:,:) = rn_hti_ini_n * zswitch(:,:) 255 zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:) 256 zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:) 257 zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:) 258 ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 259 zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 260 ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 261 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 262 zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 263 ELSEWHERE 264 zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 265 zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:) 266 zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:) 267 zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:) 268 ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 269 zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 270 ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 271 zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 272 zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 273 END WHERE 274 ! 275 ENDIF 276 277 278 279 ! make sure ponds = 0 if no ponds scheme 280 IF ( .NOT.ln_pnd ) THEN 281 zapnd_ini(:,:) = 0._wp 282 zhpnd_ini(:,:) = 0._wp 283 ENDIF 284 285 !-------------! 286 ! fill fields ! 287 !-------------! 288 ! select ice covered grid points 289 npti = 0 ; nptidx(:) = 0 290 DO_2D_11_11 291 IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 292 npti = npti + 1 293 nptidx(npti) = (jj - 1) * jpi + ji 294 ENDIF 295 END_2D 296 297 ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 298 CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti) , zht_i_ini ) 299 CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti) , zht_s_ini ) 300 CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti) , zat_i_ini ) 301 CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) 302 CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) 303 CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti) , zt_su_ini ) 304 CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti) , zsm_i_ini ) 305 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti) , zapnd_ini ) 306 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti) , zhpnd_ini ) 307 308 ! allocate temporary arrays 309 ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 310 & zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 311 312 ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 313 CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), & 314 & zhi_2d , zhs_2d , zai_2d , & 315 & t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti), a_ip_1d(1:npti), h_ip_1d(1:npti), & 316 & zti_2d , zts_2d , ztsu_2d , zsi_2d , zaip_2d , zhip_2d ) 317 318 ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 319 DO jl = 1, jpl 320 zti_3d(:,:,jl) = rt0 * tmask(:,:,1) 321 zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 322 END DO 323 CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d , h_i ) 324 CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d , h_s ) 325 CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d , a_i ) 326 CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d , zti_3d ) 327 CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d , zts_3d ) 328 CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d , t_su ) 329 CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d , s_i ) 330 CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d , a_ip ) 331 CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d , h_ip ) 332 333 ! deallocate temporary arrays 334 DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 335 & zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 336 337 ! calculate extensive and intensive variables 338 CALL ice_var_salprof ! for sz_i 339 DO jl = 1, jpl 340 DO_2D_11_11 341 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 342 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 343 sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 344 END_2D 345 END DO 346 ! 347 DO jl = 1, jpl 348 DO_3D_11_11( 1, nlay_s ) 349 t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 350 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 351 & rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 352 END_3D 353 END DO 354 ! 355 DO jl = 1, jpl 356 DO_3D_11_11( 1, nlay_i ) 357 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 358 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 359 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 360 & rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 361 & rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 362 & - rcp * ( ztmelts - rt0 ) ) 363 END_3D 364 END DO 365 366 ! Melt ponds 367 WHERE( a_i > epsi10 ) 368 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 369 ELSEWHERE 370 a_ip_frac(:,:,:) = 0._wp 176 371 END WHERE 372 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 373 374 ! specific temperatures for coupled runs 375 tn_ice(:,:,:) = t_su(:,:,:) 376 t1_ice(:,:,:) = t_i (:,:,1,:) 177 377 ! 178 CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step 179 ! 180 ! -- mandatory fields -- ! 181 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 182 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 183 zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 184 185 ! -- optional fields -- ! 186 ! if fields do not exist then set them to the values present in the namelist (except for snow and surface temperature) 187 ! 188 ! ice salinity 189 IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & 190 & si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 191 ! 192 ! temperatures 193 IF ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. & 194 & TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN 195 si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 196 si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 197 si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 198 ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 199 si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) 200 ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 201 si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 ) 202 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_su, set T_su = T_s 203 si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1) 204 ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_su, set T_su = T_i 205 si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 206 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_s, set T_s = T_su 207 si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1) 208 ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_s, set T_s = T_i 209 si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 210 ENDIF 211 ! 212 ! pond concentration 213 IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 214 & si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. 215 & * si(jp_ati)%fnow(:,:,1) 216 ! 217 ! pond depth 218 IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 219 & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 220 ! 221 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 222 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 223 zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 224 ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 225 zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 226 zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 227 ! 228 ! change the switch for the following 229 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 230 ELSEWHERE ; zswitch(:,:) = 0._wp 378 379 #if defined key_agrif 380 ELSE 381 382 Agrif_SpecialValue = -9999. 383 Agrif_UseSpecialValue = .TRUE. 384 CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice) 385 use_sign_north = .TRUE. 386 sign_north = -1. 387 CALL Agrif_init_variable(u_iceini_id ,procname=interp_u_ice) 388 CALL Agrif_init_variable(v_iceini_id ,procname=interp_v_ice) 389 Agrif_SpecialValue = 0._wp 390 use_sign_north = .FALSE. 391 Agrif_UseSpecialValue = .FALSE. 392 ! lbc ???? 393 ! Here we know : a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i 394 CALL ice_var_glo2eqv 395 CALL ice_var_zapsmall 396 CALL ice_var_agg(2) 397 398 ! Melt ponds 399 WHERE( a_i > epsi10 ) 400 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 401 ELSEWHERE 402 a_ip_frac(:,:,:) = 0._wp 231 403 END WHERE 232 ! !---------------! 233 ELSE ! Read namelist ! 234 ! !---------------! 235 ! no ice if (sst - Tfreez) >= thresold 236 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 237 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 238 END WHERE 239 ! 240 ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 241 WHERE( ff_t(:,:) >= 0._wp ) 242 zht_i_ini(:,:) = rn_hti_ini_n * zswitch(:,:) 243 zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:) 244 zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:) 245 zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:) 246 ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 247 zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 248 ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 249 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 250 zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 404 WHERE( a_ip > 0._wp ) ! ??????? 405 h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 251 406 ELSEWHERE 252 zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 253 zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:) 254 zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:) 255 zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:) 256 ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 257 zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 258 ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 259 zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 260 zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 261 END WHERE 262 ! 263 ENDIF 264 265 ! make sure ponds = 0 if no ponds scheme 266 IF ( .NOT.ln_pnd ) THEN 267 zapnd_ini(:,:) = 0._wp 268 zhpnd_ini(:,:) = 0._wp 269 ENDIF 270 271 !-------------! 272 ! fill fields ! 273 !-------------! 274 ! select ice covered grid points 275 npti = 0 ; nptidx(:) = 0 276 DO_2D_11_11 277 IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 278 npti = npti + 1 279 nptidx(npti) = (jj - 1) * jpi + ji 280 ENDIF 281 END_2D 282 283 ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 284 CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti) , zht_i_ini ) 285 CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti) , zht_s_ini ) 286 CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti) , zat_i_ini ) 287 CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) 288 CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) 289 CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti) , zt_su_ini ) 290 CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti) , zsm_i_ini ) 291 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti) , zapnd_ini ) 292 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti) , zhpnd_ini ) 293 294 ! allocate temporary arrays 295 ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 296 & zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 297 298 ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 299 CALL ice_var_itd( h_i_1d(1:npti) , h_s_1d(1:npti) , at_i_1d(1:npti), & 300 & zhi_2d , zhs_2d , zai_2d , & 301 & t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti), a_ip_1d(1:npti), h_ip_1d(1:npti), & 302 & zti_2d , zts_2d , ztsu_2d , zsi_2d , zaip_2d , zhip_2d ) 303 304 ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 305 DO jl = 1, jpl 306 zti_3d(:,:,jl) = rt0 * tmask(:,:,1) 307 zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 308 END DO 309 CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d , h_i ) 310 CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d , h_s ) 311 CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d , a_i ) 312 CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d , zti_3d ) 313 CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d , zts_3d ) 314 CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d , t_su ) 315 CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d , s_i ) 316 CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d , a_ip ) 317 CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d , h_ip ) 318 319 ! deallocate temporary arrays 320 DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 321 & zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 322 323 ! calculate extensive and intensive variables 324 CALL ice_var_salprof ! for sz_i 325 DO jl = 1, jpl 326 DO_2D_11_11 327 v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 328 v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 329 sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 330 END_2D 331 END DO 332 ! 333 DO jl = 1, jpl 334 DO_3D_11_11( 1, nlay_s ) 335 t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 336 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 337 & rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 338 END_3D 339 END DO 340 ! 341 DO jl = 1, jpl 342 DO_3D_11_11( 1, nlay_i ) 343 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 344 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 345 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 346 & rhoi * ( rcpi * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 347 & rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 348 & - rcp * ( ztmelts - rt0 ) ) 349 END_3D 350 END DO 351 352 ! Melt ponds 353 WHERE( a_i > epsi10 ) 354 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 355 ELSEWHERE 356 a_ip_frac(:,:,:) = 0._wp 357 END WHERE 358 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 359 360 ! specific temperatures for coupled runs 361 tn_ice(:,:,:) = t_su(:,:,:) 362 t1_ice(:,:,:) = t_i (:,:,1,:) 363 ! 407 h_ip(:,:,:) = 0._wp 408 END WHERE 409 410 tn_ice(:,:,:) = t_su(:,:,:) 411 t1_ice(:,:,:) = t_i (:,:,1,:) 412 #endif 413 ENDIF ! Agrif_Root 364 414 ENDIF ! ln_iceini 365 415 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ICE/icestp.F90
r12489 r13229 240 240 CALL par_init ! set some ice run parameters 241 241 ! 242 #if defined key_agrif 243 CALL Agrif_Declare_Var_ice ! " " " " " Sea ice 244 #endif 245 ! 242 246 ! ! Allocate the ice arrays (sbc_ice already allocated in sbc_init) 243 247 ierr = ice_alloc () ! ice variables -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_ice.F90
r10068 r13229 16 16 17 17 INTEGER, PUBLIC :: u_ice_id, v_ice_id, tra_ice_id 18 INTEGER, PUBLIC :: u_iceini_id, v_iceini_id, tra_iceini_id 18 19 INTEGER, PUBLIC :: nbstep_ice = 0 ! child time position in sea-ice model 19 20 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_ice_interp.F90
r12807 r13229 14 14 !!---------------------------------------------------------------------- 15 15 !! agrif_interp_ice : interpolation of ice at "after" sea-ice time step 16 !! agrif_interp_u_ice : atomic routine to interpolate u_ice17 !! agrif_interp_v_ice : atomic routine to interpolate v_ice18 !! agrif_interp_tra_ice : atomic routine to interpolate ice properties16 !! interp_u_ice : atomic routine to interpolate u_ice 17 !! interp_v_ice : atomic routine to interpolate v_ice 18 !! interp_tra_ice : atomic routine to interpolate ice properties 19 19 !!---------------------------------------------------------------------- 20 20 USE par_oce … … 23 23 USE ice 24 24 USE agrif_ice 25 USE agrif_oce 25 26 USE phycst , ONLY: rt0 26 27 … … 29 30 30 31 PUBLIC agrif_interp_ice ! called by agrif_user.F90 32 PUBLIC interp_tra_ice, interp_u_ice, interp_v_ice ! called by iceistate.F90 31 33 32 34 !!---------------------------------------------------------------------- … … 68 70 Agrif_SpecialValue = -9999. 69 71 Agrif_UseSpecialValue = .TRUE. 72 73 use_sign_north = .TRUE. 74 sign_north = -1. 75 if (cd_type == 'T') use_sign_north = .FALSE. 76 70 77 SELECT CASE( cd_type ) 71 78 CASE('U') ; CALL Agrif_Bc_variable( u_ice_id , procname=interp_u_ice , calledweight=zbeta ) … … 75 82 Agrif_SpecialValue = 0._wp 76 83 Agrif_UseSpecialValue = .FALSE. 84 85 use_sign_north = .FALSE. 77 86 ! 78 87 END SUBROUTINE agrif_interp_ice … … 156 165 ! and it is ok since we conserve tracers (same as in the ocean). 157 166 ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) ) 158 167 159 168 IF( before ) THEN ! parent grid 160 169 jm = 1 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_ice_update.F90
r12377 r13229 66 66 CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/1,0/), procname = update_tra_ice ) 67 67 #endif 68 use_sign_north = .TRUE. 69 sign_north = -1. 70 68 71 # if ! defined DECAL_FEEDBACK 69 72 CALL Agrif_Update_Variable( u_ice_id , procname = update_u_ice ) … … 73 76 CALL Agrif_Update_Variable( v_ice_id , locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname=update_v_ice) 74 77 #endif 78 use_sign_north = .FALSE. 75 79 ! CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_ice ) 76 80 ! CALL Agrif_Update_Variable( u_ice_id , locupdate=(/0,1/), procname = update_u_ice ) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce.F90
r13065 r13229 19 19 20 20 ! !!* Namelist namagrif: AGRIF parameters 21 LOGICAL , PUBLIC :: ln_init_chfrpar = .FALSE. !: set child grids initial state from parent 21 22 LOGICAL , PUBLIC :: ln_agrif_2way = .TRUE. !: activate two way nesting 22 23 LOGICAL , PUBLIC :: ln_spc_dyn = .FALSE. !: use zeros (.false.) or not (.true.) in … … 29 30 ! 30 31 INTEGER , PUBLIC, PARAMETER :: nn_sponge_len = 2 !: Sponge width (in number of parent grid points) 32 31 33 LOGICAL , PUBLIC :: spongedoneT = .FALSE. !: tracer sponge layer indicator 32 34 LOGICAL , PUBLIC :: spongedoneU = .FALSE. !: dynamics sponge layer indicator … … 49 51 INTEGER , PUBLIC, SAVE :: Kbb_a, Kmm_a, Krhs_a !: AGRIF module-specific copies of time-level indices 50 52 51 # if defined key_vertical52 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht0_parent, hu0_parent, hv0_parent 53 54 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt_parent, mbku_parent, mbkv_parent 54 # endif55 55 56 56 INTEGER, PUBLIC :: tsn_id ! AGRIF profile for tracers interpolation and update … … 58 58 INTEGER, PUBLIC :: un_update_id, vn_update_id ! AGRIF profiles for udpates 59 59 INTEGER, PUBLIC :: tsn_sponge_id, un_sponge_id, vn_sponge_id ! AGRIF profiles for sponge layers 60 INTEGER, PUBLIC :: tsini_id, uini_id, vini_id, sshini_id ! AGRIF profile for initialization 60 61 # if defined key_top 61 62 INTEGER, PUBLIC :: trn_id, trn_sponge_id … … 69 70 INTEGER, PUBLIC :: glamt_id, gphit_id 70 71 INTEGER, PUBLIC :: kindic_agr 72 73 ! North fold 74 !$AGRIF_DO_NOT_TREAT 75 LOGICAL, PUBLIC :: use_sign_north 76 REAL, PUBLIC :: sign_north 77 LOGICAL, PUBLIC :: l_ini_child = .FALSE. 78 # if defined key_vertical 79 LOGICAL, PUBLIC :: l_vremap = .TRUE. 80 # else 81 LOGICAL, PUBLIC :: l_vremap = .FALSE. 82 # endif 83 !$AGRIF_END_DO_NOT_TREAT 71 84 72 85 !!---------------------------------------------------------------------- … … 92 105 & tabspongedone_trn(jpi,jpj), & 93 106 # endif 94 # if defined key_vertical95 107 & ht0_parent(jpi,jpj), mbkt_parent(jpi,jpj), & 96 108 & hu0_parent(jpi,jpj), mbku_parent(jpi,jpj), & 97 109 & hv0_parent(jpi,jpj), mbkv_parent(jpi,jpj), & 98 # endif99 110 & tabspongedone_u (jpi,jpj), & 100 111 & tabspongedone_v (jpi,jpj), STAT = ierr(1) ) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_interp.F90
r13130 r13229 95 95 ! 96 96 ! --- West --- ! 97 ibdy1 = nn_hls + 2 ! halo + land + 1 98 ibdy2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 99 ! 100 IF( .NOT.ln_dynspg_ts ) THEN ! Store tangential transport 97 IF( lk_west ) THEN 98 ibdy1 = nn_hls + 2 ! halo + land + 1 99 ibdy2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 100 ! 101 IF( .NOT.ln_dynspg_ts ) THEN ! Store tangential transport 102 DO ji = mi0(ibdy1), mi1(ibdy2) 103 uu_b(ji,:,Krhs_a) = 0._wp 104 105 DO jk = 1, jpkm1 106 DO jj = 1, jpj 107 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 108 END DO 109 END DO 110 111 DO jj = 1, jpj 112 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 113 END DO 114 END DO 115 ENDIF 116 ! 101 117 DO ji = mi0(ibdy1), mi1(ibdy2) 102 uu_b(ji,:,Krhs_a) = 0._wp 103 118 zub(ji,:) = 0._wp ! Correct tangential transport 104 119 DO jk = 1, jpkm1 105 120 DO jj = 1, jpj 106 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 107 END DO 108 END DO 109 110 DO jj = 1, jpj 111 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 112 END DO 113 END DO 114 ENDIF 115 ! 116 DO ji = mi0(ibdy1), mi1(ibdy2) 117 zub(ji,:) = 0._wp ! Correct tangential transport 118 DO jk = 1, jpkm1 119 DO jj = 1, jpj 120 zub(ji,jj) = zub(ji,jj) & 121 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a)*umask(ji,jj,jk) 122 END DO 123 END DO 124 DO jj=1,jpj 125 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 126 END DO 121 zub(ji,jj) = zub(ji,jj) & 122 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a)*umask(ji,jj,jk) 123 END DO 124 END DO 125 DO jj=1,jpj 126 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 127 END DO 127 128 128 DO jk = 1, jpkm1129 DO jj = 1, jpj130 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a)-zub(ji,jj)) * umask(ji,jj,jk)131 END DO132 END DO133 END DO134 135 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate136 DO ji = mi0(ibdy1), mi1(ibdy2)137 zvb(ji,:) = 0._wp138 129 DO jk = 1, jpkm1 139 130 DO jj = 1, jpj 140 zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 141 END DO 142 END DO 143 DO jj = 1, jpj 144 zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 145 END DO 131 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a)-zub(ji,jj)) * umask(ji,jj,jk) 132 END DO 133 END DO 134 END DO 135 136 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 137 DO ji = mi0(ibdy1), mi1(ibdy2) 138 zvb(ji,:) = 0._wp 139 DO jk = 1, jpkm1 140 DO jj = 1, jpj 141 zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 142 END DO 143 END DO 144 DO jj = 1, jpj 145 zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 146 END DO 147 DO jk = 1, jpkm1 148 DO jj = 1, jpj 149 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a)-zvb(ji,jj))*vmask(ji,jj,jk) 150 END DO 151 END DO 152 END DO 153 ENDIF 154 ENDIF 155 156 ! --- East --- ! 157 IF( lk_east ) THEN 158 ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 159 ibdy2 = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 160 ! 161 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 162 DO ji = mi0(ibdy1), mi1(ibdy2) 163 uu_b(ji,:,Krhs_a) = 0._wp 164 DO jk = 1, jpkm1 165 DO jj = 1, jpj 166 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) & 167 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 168 END DO 169 END DO 170 DO jj = 1, jpj 171 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 172 END DO 173 END DO 174 ENDIF 175 ! 176 DO ji = mi0(ibdy1), mi1(ibdy2) 177 zub(ji,:) = 0._wp ! Correct transport 146 178 DO jk = 1, jpkm1 147 179 DO jj = 1, jpj 148 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a)-zvb(ji,jj))*vmask(ji,jj,jk) 149 END DO 150 END DO 151 END DO 152 ENDIF 153 154 ! --- East --- ! 155 ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 156 ibdy2 = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 157 ! 158 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 159 DO ji = mi0(ibdy1), mi1(ibdy2) 160 uu_b(ji,:,Krhs_a) = 0._wp 180 zub(ji,jj) = zub(ji,jj) & 181 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 182 END DO 183 END DO 184 DO jj=1,jpj 185 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 186 END DO 187 161 188 DO jk = 1, jpkm1 162 189 DO jj = 1, jpj 163 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) & 164 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 165 END DO 166 END DO 167 DO jj = 1, jpj 168 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 169 END DO 170 END DO 171 ENDIF 172 ! 173 DO ji = mi0(ibdy1), mi1(ibdy2) 174 zub(ji,:) = 0._wp ! Correct transport 175 DO jk = 1, jpkm1 176 DO jj = 1, jpj 177 zub(ji,jj) = zub(ji,jj) & 178 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 179 END DO 180 END DO 181 DO jj=1,jpj 182 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 190 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 191 & + uu_b(ji,jj,Krhs_a)-zub(ji,jj))*umask(ji,jj,jk) 192 END DO 193 END DO 183 194 END DO 184 195 185 DO jk = 1, jpkm1 186 DO jj = 1, jpj 187 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 188 & + uu_b(ji,jj,Krhs_a)-zub(ji,jj))*umask(ji,jj,jk) 189 END DO 190 END DO 191 END DO 192 193 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 194 ibdy1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 195 ibdy2 = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 196 DO ji = mi0(ibdy1), mi1(ibdy2) 197 zvb(ji,:) = 0._wp 198 DO jk = 1, jpkm1 196 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 197 ibdy1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 198 ibdy2 = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 199 DO ji = mi0(ibdy1), mi1(ibdy2) 200 zvb(ji,:) = 0._wp 201 DO jk = 1, jpkm1 202 DO jj = 1, jpj 203 zvb(ji,jj) = zvb(ji,jj) & 204 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 205 END DO 206 END DO 199 207 DO jj = 1, jpj 200 zvb(ji,jj) = zvb(ji,jj) & 208 zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 209 END DO 210 DO jk = 1, jpkm1 211 DO jj = 1, jpj 212 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 213 & + vv_b(ji,jj,Krhs_a)-zvb(ji,jj)) * vmask(ji,jj,jk) 214 END DO 215 END DO 216 END DO 217 ENDIF 218 ENDIF 219 220 ! --- South --- ! 221 IF( lk_south ) THEN 222 jbdy1 = nn_hls + 2 ! halo + land + 1 223 jbdy2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 224 ! 225 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 226 DO jj = mj0(jbdy1), mj1(jbdy2) 227 vv_b(:,jj,Krhs_a) = 0._wp 228 DO jk = 1, jpkm1 229 DO ji = 1, jpi 230 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) & 231 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 232 END DO 233 END DO 234 DO ji=1,jpi 235 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a) 236 END DO 237 END DO 238 ENDIF 239 ! 240 DO jj = mj0(jbdy1), mj1(jbdy2) 241 zvb(:,jj) = 0._wp ! Correct transport 242 DO jk=1,jpkm1 243 DO ji=1,jpi 244 zvb(ji,jj) = zvb(ji,jj) & 201 245 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 202 246 END DO 203 247 END DO 204 DO j j = 1, jpj248 DO ji = 1, jpi 205 249 zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 206 250 END DO 207 DO jk = 1, jpkm1 208 DO jj = 1, jpj 209 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 210 & + vv_b(ji,jj,Krhs_a)-zvb(ji,jj)) * vmask(ji,jj,jk) 211 END DO 212 END DO 213 END DO 214 ENDIF 215 216 ! --- South --- ! 217 jbdy1 = nn_hls + 2 ! halo + land + 1 218 jbdy2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 219 ! 220 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 221 DO jj = mj0(jbdy1), mj1(jbdy2) 222 vv_b(:,jj,Krhs_a) = 0._wp 251 223 252 DO jk = 1, jpkm1 224 253 DO ji = 1, jpi 225 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) & 226 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 227 END DO 228 END DO 229 DO ji=1,jpi 230 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a) 231 END DO 232 END DO 233 ENDIF 234 ! 235 DO jj = mj0(jbdy1), mj1(jbdy2) 236 zvb(:,jj) = 0._wp ! Correct transport 237 DO jk=1,jpkm1 238 DO ji=1,jpi 239 zvb(ji,jj) = zvb(ji,jj) & 240 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 241 END DO 242 END DO 243 DO ji = 1, jpi 244 zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 245 END DO 246 247 DO jk = 1, jpkm1 254 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 255 & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 256 END DO 257 END DO 258 END DO 259 260 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 261 DO jj = mj0(jbdy1), mj1(jbdy2) 262 zub(:,jj) = 0._wp 263 DO jk = 1, jpkm1 264 DO ji = 1, jpi 265 zub(ji,jj) = zub(ji,jj) & 266 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 267 END DO 268 END DO 269 DO ji = 1, jpi 270 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 271 END DO 272 273 DO jk = 1, jpkm1 274 DO ji = 1, jpi 275 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 276 & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 277 END DO 278 END DO 279 END DO 280 ENDIF 281 ENDIF 282 283 ! --- North --- ! 284 IF( lk_north ) THEN 285 jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 286 jbdy2 = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 287 ! 288 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 289 DO jj = mj0(jbdy1), mj1(jbdy2) 290 vv_b(:,jj,Krhs_a) = 0._wp 291 DO jk = 1, jpkm1 292 DO ji = 1, jpi 293 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) & 294 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 295 END DO 296 END DO 297 DO ji=1,jpi 298 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a) 299 END DO 300 END DO 301 ENDIF 302 ! 303 DO jj = mj0(jbdy1), mj1(jbdy2) 304 zvb(:,jj) = 0._wp ! Correct transport 305 DO jk=1,jpkm1 306 DO ji=1,jpi 307 zvb(ji,jj) = zvb(ji,jj) & 308 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 309 END DO 310 END DO 248 311 DO ji = 1, jpi 249 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 250 & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 251 END DO 252 END DO 253 END DO 254 255 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 256 DO jj = mj0(jbdy1), mj1(jbdy2) 257 zub(:,jj) = 0._wp 312 zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 313 END DO 314 258 315 DO jk = 1, jpkm1 259 316 DO ji = 1, jpi 260 zub(ji,jj) = zub(ji,jj) & 261 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 262 END DO 263 END DO 264 DO ji = 1, jpi 265 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 266 END DO 317 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 318 & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 319 END DO 320 END DO 321 END DO 322 323 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 324 jbdy1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 325 jbdy2 = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 326 DO jj = mj0(jbdy1), mj1(jbdy2) 327 zub(:,jj) = 0._wp 328 DO jk = 1, jpkm1 329 DO ji = 1, jpi 330 zub(ji,jj) = zub(ji,jj) & 331 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 332 END DO 333 END DO 334 DO ji = 1, jpi 335 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 336 END DO 267 337 268 DO jk = 1, jpkm1 269 DO ji = 1, jpi 270 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 271 & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 272 END DO 273 END DO 274 END DO 275 ENDIF 276 277 ! --- North --- ! 278 jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 279 jbdy2 = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 280 ! 281 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 282 DO jj = mj0(jbdy1), mj1(jbdy2) 283 vv_b(:,jj,Krhs_a) = 0._wp 284 DO jk = 1, jpkm1 285 DO ji = 1, jpi 286 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) & 287 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 288 END DO 289 END DO 290 DO ji=1,jpi 291 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a) 292 END DO 293 END DO 294 ENDIF 295 ! 296 DO jj = mj0(jbdy1), mj1(jbdy2) 297 zvb(:,jj) = 0._wp ! Correct transport 298 DO jk=1,jpkm1 299 DO ji=1,jpi 300 zvb(ji,jj) = zvb(ji,jj) & 301 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 302 END DO 303 END DO 304 DO ji = 1, jpi 305 zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 306 END DO 307 308 DO jk = 1, jpkm1 309 DO ji = 1, jpi 310 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 311 & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 312 END DO 313 END DO 314 END DO 315 316 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 317 jbdy1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 318 jbdy2 = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 319 DO jj = mj0(jbdy1), mj1(jbdy2) 320 zub(:,jj) = 0._wp 321 DO jk = 1, jpkm1 322 DO ji = 1, jpi 323 zub(ji,jj) = zub(ji,jj) & 324 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 325 END DO 326 END DO 327 DO ji = 1, jpi 328 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 329 END DO 330 331 DO jk = 1, jpkm1 332 DO ji = 1, jpi 333 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 334 & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 335 END DO 336 END DO 337 END DO 338 DO jk = 1, jpkm1 339 DO ji = 1, jpi 340 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 341 & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 342 END DO 343 END DO 344 END DO 345 ENDIF 338 346 ENDIF 339 347 ! … … 354 362 ! 355 363 !--- West ---! 356 istart = nn_hls + 2 ! halo + land + 1 357 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 358 DO ji = mi0(istart), mi1(iend) 359 DO jj=1,jpj 360 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 361 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 362 END DO 363 END DO 364 IF( lk_west ) THEN 365 istart = nn_hls + 2 ! halo + land + 1 366 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 367 DO ji = mi0(istart), mi1(iend) 368 DO jj=1,jpj 369 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 370 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 371 END DO 372 END DO 373 ENDIF 364 374 ! 365 375 !--- East ---! 366 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 367 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 368 DO ji = mi0(istart), mi1(iend) 369 DO jj=1,jpj 370 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 371 END DO 372 END DO 373 istart = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 374 iend = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 375 DO ji = mi0(istart), mi1(iend) 376 DO jj=1,jpj 377 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 378 END DO 379 END DO 376 IF( lk_east ) THEN 377 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 378 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 379 DO ji = mi0(istart), mi1(iend) 380 DO jj=1,jpj 381 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 382 END DO 383 END DO 384 istart = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 385 iend = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 386 DO ji = mi0(istart), mi1(iend) 387 DO jj=1,jpj 388 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 389 END DO 390 END DO 391 ENDIF 380 392 ! 381 393 !--- South ---! 382 jstart = nn_hls + 2 ! halo + land + 1 383 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 384 DO jj = mj0(jstart), mj1(jend) 385 DO ji=1,jpi 386 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 387 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 388 END DO 389 END DO 394 IF( lk_south ) THEN 395 jstart = nn_hls + 2 ! halo + land + 1 396 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 397 DO jj = mj0(jstart), mj1(jend) 398 DO ji=1,jpi 399 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 400 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 401 END DO 402 END DO 403 ENDIF 390 404 ! 391 405 !--- North ---! 392 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 393 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 394 DO jj = mj0(jstart), mj1(jend) 395 DO ji=1,jpi 396 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 397 END DO 398 END DO 399 jstart = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 400 jend = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 401 DO jj = mj0(jstart), mj1(jend) 402 DO ji=1,jpi 403 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 404 END DO 405 END DO 406 IF( lk_north ) THEN 407 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 408 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 409 DO jj = mj0(jstart), mj1(jend) 410 DO ji=1,jpi 411 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 412 END DO 413 END DO 414 jstart = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 415 jend = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 416 DO jj = mj0(jstart), mj1(jend) 417 DO ji=1,jpi 418 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 419 END DO 420 END DO 421 ENDIF 406 422 ! 407 423 END SUBROUTINE Agrif_dyn_ts … … 421 437 ! 422 438 !--- West ---! 423 istart = nn_hls + 2 ! halo + land + 1 424 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 425 DO ji = mi0(istart), mi1(iend) 426 DO jj=1,jpj 427 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 428 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 429 END DO 430 END DO 439 IF( lk_west ) THEN 440 istart = nn_hls + 2 ! halo + land + 1 441 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 442 DO ji = mi0(istart), mi1(iend) 443 DO jj=1,jpj 444 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 445 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 446 END DO 447 END DO 448 ENDIF 431 449 ! 432 450 !--- East ---! 433 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 434 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 435 DO ji = mi0(istart), mi1(iend) 436 DO jj=1,jpj 437 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 438 END DO 439 END DO 440 istart = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 441 iend = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 442 DO ji = mi0(istart), mi1(iend) 443 DO jj=1,jpj 444 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 445 END DO 446 END DO 451 IF( lk_east ) THEN 452 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 453 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 454 DO ji = mi0(istart), mi1(iend) 455 DO jj=1,jpj 456 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 457 END DO 458 END DO 459 istart = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 460 iend = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 461 DO ji = mi0(istart), mi1(iend) 462 DO jj=1,jpj 463 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 464 END DO 465 END DO 466 ENDIF 447 467 ! 448 468 !--- South ---! 449 jstart = nn_hls + 2 ! halo + land + 1 450 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 451 DO jj = mj0(jstart), mj1(jend) 452 DO ji=1,jpi 453 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 454 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 455 END DO 456 END DO 469 IF( lk_south ) THEN 470 jstart = nn_hls + 2 ! halo + land + 1 471 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 472 DO jj = mj0(jstart), mj1(jend) 473 DO ji=1,jpi 474 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 475 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 476 END DO 477 END DO 478 ENDIF 457 479 ! 458 480 !--- North ---! 459 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 460 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 461 DO jj = mj0(jstart), mj1(jend) 462 DO ji=1,jpi 463 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 464 END DO 465 END DO 466 jstart = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 467 jend = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 468 DO jj = mj0(jstart), mj1(jend) 469 DO ji=1,jpi 470 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 471 END DO 472 END DO 481 IF( lk_north ) THEN 482 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 483 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 484 DO jj = mj0(jstart), mj1(jend) 485 DO ji=1,jpi 486 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 487 END DO 488 END DO 489 jstart = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 490 jend = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 491 DO jj = mj0(jstart), mj1(jend) 492 DO ji=1,jpi 493 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 494 END DO 495 END DO 496 ENDIF 473 497 ! 474 498 END SUBROUTINE Agrif_dyn_ts_flux … … 489 513 ! 490 514 ! Enforce volume conservation if no time refinement: 491 IF ( Agrif_rhot()==1 ) ll_int_cons=.TRUE.515 IF ( Agrif_rhot()==1 ) ll_int_cons=.TRUE. 492 516 ! 493 517 ! Interpolate barotropic fluxes … … 542 566 ! 543 567 ! --- West --- ! 544 istart = nn_hls + 2 ! halo + land + 1 545 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 546 DO ji = mi0(istart), mi1(iend) 547 DO jj = 1, jpj 548 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 568 IF( lk_west ) THEN 569 istart = nn_hls + 2 ! halo + land + 1 570 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 571 DO ji = mi0(istart), mi1(iend) 572 DO jj = 1, jpj 573 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 574 ENDDO 549 575 ENDDO 550 END DO576 ENDIF 551 577 ! 552 578 ! --- East --- ! 553 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 554 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 555 DO ji = mi0(istart), mi1(iend) 556 DO jj = 1, jpj 557 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 579 IF( lk_east ) THEN 580 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 581 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 582 DO ji = mi0(istart), mi1(iend) 583 DO jj = 1, jpj 584 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 585 ENDDO 558 586 ENDDO 559 END DO587 ENDIF 560 588 ! 561 589 ! --- South --- ! 562 jstart = nn_hls + 2 ! halo + land + 1 563 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 564 DO jj = mj0(jstart), mj1(jend) 565 DO ji = 1, jpi 566 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 590 IF( lk_south ) THEN 591 jstart = nn_hls + 2 ! halo + land + 1 592 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 593 DO jj = mj0(jstart), mj1(jend) 594 DO ji = 1, jpi 595 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 596 ENDDO 567 597 ENDDO 568 END DO598 ENDIF 569 599 ! 570 600 ! --- North --- ! 571 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 572 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 573 DO jj = mj0(jstart), mj1(jend) 574 DO ji = 1, jpi 575 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 601 IF( lk_north ) THEN 602 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 603 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 604 DO jj = mj0(jstart), mj1(jend) 605 DO ji = 1, jpi 606 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 607 ENDDO 576 608 ENDDO 577 END DO609 ENDIF 578 610 ! 579 611 END SUBROUTINE Agrif_ssh … … 593 625 ! 594 626 ! --- West --- ! 595 istart = nn_hls + 2 ! halo + land + 1 596 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 597 DO ji = mi0(istart), mi1(iend) 598 DO jj = 1, jpj 599 ssha_e(ji,jj) = hbdy(ji,jj) 627 IF( lk_west ) THEN 628 istart = nn_hls + 2 ! halo + land + 1 629 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 630 DO ji = mi0(istart), mi1(iend) 631 DO jj = 1, jpj 632 ssha_e(ji,jj) = hbdy(ji,jj) 633 ENDDO 600 634 ENDDO 601 END DO635 ENDIF 602 636 ! 603 637 ! --- East --- ! 604 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 605 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 606 DO ji = mi0(istart), mi1(iend) 607 DO jj = 1, jpj 608 ssha_e(ji,jj) = hbdy(ji,jj) 638 IF( lk_east ) THEN 639 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 640 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 641 DO ji = mi0(istart), mi1(iend) 642 DO jj = 1, jpj 643 ssha_e(ji,jj) = hbdy(ji,jj) 644 ENDDO 609 645 ENDDO 610 END DO646 ENDIF 611 647 ! 612 648 ! --- South --- ! 613 jstart = nn_hls + 2 ! halo + land + 1 614 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 615 DO jj = mj0(jstart), mj1(jend) 616 DO ji = 1, jpi 617 ssha_e(ji,jj) = hbdy(ji,jj) 649 IF( lk_south ) THEN 650 jstart = nn_hls + 2 ! halo + land + 1 651 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 652 DO jj = mj0(jstart), mj1(jend) 653 DO ji = 1, jpi 654 ssha_e(ji,jj) = hbdy(ji,jj) 655 ENDDO 618 656 ENDDO 619 END DO657 ENDIF 620 658 ! 621 659 ! --- North --- ! 622 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 623 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 624 DO jj = mj0(jstart), mj1(jend) 625 DO ji = 1, jpi 626 ssha_e(ji,jj) = hbdy(ji,jj) 660 IF( lk_north ) THEN 661 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 662 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 663 DO jj = mj0(jstart), mj1(jend) 664 DO ji = 1, jpi 665 ssha_e(ji,jj) = hbdy(ji,jj) 666 ENDDO 627 667 ENDDO 628 END DO668 ENDIF 629 669 ! 630 670 END SUBROUTINE Agrif_ssh_ts -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_sponge.F90
r13065 r13229 131 131 132 132 ! --- West --- ! 133 ztabramp(:,:) = 0._wp 134 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 135 DO ji = mi0(ind1), mi1(ind1) 136 ztabramp(ji,:) = ssumask(ji,:) 137 END DO 138 ! 139 zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 140 zmskwest(jpj+1:jpjmax) = 0._wp 133 IF( lk_west ) THEN 134 ztabramp(:,:) = 0._wp 135 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 136 DO ji = mi0(ind1), mi1(ind1) 137 ztabramp(ji,:) = ssumask(ji,:) 138 END DO 139 ! 140 zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 141 zmskwest(jpj+1:jpjmax) = 0._wp 142 ENDIF 141 143 142 144 ! --- East --- ! 143 ztabramp(:,:) = 0._wp 144 ind1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 145 DO ji = mi0(ind1), mi1(ind1) 146 ztabramp(ji,:) = ssumask(ji,:) 147 END DO 148 ! 149 zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 150 zmskeast(jpj+1:jpjmax) = 0._wp 145 IF( lk_east ) THEN 146 ztabramp(:,:) = 0._wp 147 ind1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 148 DO ji = mi0(ind1), mi1(ind1) 149 ztabramp(ji,:) = ssumask(ji,:) 150 END DO 151 ! 152 zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 153 zmskeast(jpj+1:jpjmax) = 0._wp 154 ENDIF 151 155 152 156 ! --- South --- ! 153 ztabramp(:,:) = 0._wp 154 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 155 DO jj = mj0(ind1), mj1(ind1) 156 ztabramp(:,jj) = ssvmask(:,jj) 157 END DO 158 ! 159 zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 160 zmsksouth(jpi+1:jpimax) = 0._wp 157 IF( lk_south ) THEN 158 ztabramp(:,:) = 0._wp 159 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 160 DO jj = mj0(ind1), mj1(ind1) 161 ztabramp(:,jj) = ssvmask(:,jj) 162 END DO 163 ! 164 zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 165 zmsksouth(jpi+1:jpimax) = 0._wp 166 ENDIF 161 167 162 168 ! --- North --- ! 163 ztabramp(:,:) = 0._wp 164 ind1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 165 DO jj = mj0(ind1), mj1(ind1) 166 ztabramp(:,jj) = ssvmask(:,jj) 167 END DO 168 ! 169 zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 170 zmsknorth(jpi+1:jpimax) = 0._wp 169 IF( lk_north ) THEN 170 ztabramp(:,:) = 0._wp 171 ind1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 172 DO jj = mj0(ind1), mj1(ind1) 173 ztabramp(:,jj) = ssvmask(:,jj) 174 END DO 175 ! 176 zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 177 zmsknorth(jpi+1:jpimax) = 0._wp 178 ENDIF 171 179 172 180 ! JC: SPONGE MASKING TO BE SORTED OUT: … … 197 205 198 206 ! --- West --- ! 199 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 200 ind2 = nn_hls + 1 + nbghostcells + ispongearea 201 DO ji = mi0(ind1), mi1(ind2) 202 DO jj = 1, jpj 203 ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 204 END DO 205 END DO 206 207 ! ghost cells: 208 ind1 = 1 209 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 210 DO ji = mi0(ind1), mi1(ind2) 211 DO jj = 1, jpj 212 ztabramp(ji,jj) = zmskwest(jj) 213 END DO 214 END DO 207 IF( lk_west ) THEN 208 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 209 ind2 = nn_hls + 1 + nbghostcells + ispongearea 210 DO ji = mi0(ind1), mi1(ind2) 211 DO jj = 1, jpj 212 ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 213 END DO 214 END DO 215 216 ! ghost cells: 217 ind1 = 1 218 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 219 DO ji = mi0(ind1), mi1(ind2) 220 DO jj = 1, jpj 221 ztabramp(ji,jj) = zmskwest(jj) 222 END DO 223 END DO 224 ENDIF 215 225 216 226 ! --- East --- ! 217 ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 218 ind2 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 219 DO ji = mi0(ind1), mi1(ind2) 220 DO jj = 1, jpj 221 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 222 ENDDO 223 END DO 224 225 ! ghost cells: 226 ind1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 227 ind2 = jpiglo 228 DO ji = mi0(ind1), mi1(ind2) 229 DO jj = 1, jpj 230 ztabramp(ji,jj) = zmskeast(jj) 231 ENDDO 232 END DO 227 IF( lk_east ) THEN 228 ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 229 ind2 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 230 DO ji = mi0(ind1), mi1(ind2) 231 DO jj = 1, jpj 232 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 233 ENDDO 234 END DO 235 236 ! ghost cells: 237 ind1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 238 ind2 = jpiglo 239 DO ji = mi0(ind1), mi1(ind2) 240 DO jj = 1, jpj 241 ztabramp(ji,jj) = zmskeast(jj) 242 ENDDO 243 END DO 244 ENDIF 233 245 234 246 ! --- South --- ! 235 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 236 ind2 = nn_hls + 1 + nbghostcells + jspongearea 237 DO jj = mj0(ind1), mj1(ind2) 238 DO ji = 1, jpi 239 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 240 END DO 241 END DO 242 243 ! ghost cells: 244 ind1 = 1 245 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 246 DO jj = mj0(ind1), mj1(ind2) 247 DO ji = 1, jpi 248 ztabramp(ji,jj) = zmsksouth(ji) 249 END DO 250 END DO 247 IF( lk_south ) THEN 248 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 249 ind2 = nn_hls + 1 + nbghostcells + jspongearea 250 DO jj = mj0(ind1), mj1(ind2) 251 DO ji = 1, jpi 252 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 253 END DO 254 END DO 255 256 ! ghost cells: 257 ind1 = 1 258 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 259 DO jj = mj0(ind1), mj1(ind2) 260 DO ji = 1, jpi 261 ztabramp(ji,jj) = zmsksouth(ji) 262 END DO 263 END DO 264 ENDIF 251 265 252 266 ! --- North --- ! 253 ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 254 ind2 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 255 DO jj = mj0(ind1), mj1(ind2) 256 DO ji = 1, jpi 257 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 258 END DO 259 END DO 260 261 ! ghost cells: 262 ind1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 263 ind2 = jpjglo 264 DO jj = mj0(ind1), mj1(ind2) 265 DO ji = 1, jpi 266 ztabramp(ji,jj) = zmsknorth(ji) 267 END DO 268 END DO 267 IF( lk_north ) THEN 268 ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 269 ind2 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 270 DO jj = mj0(ind1), mj1(ind2) 271 DO ji = 1, jpi 272 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 273 END DO 274 END DO 275 276 ! ghost cells: 277 ind1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 278 ind2 = jpjglo 279 DO jj = mj0(ind1), mj1(ind2) 280 DO ji = 1, jpi 281 ztabramp(ji,jj) = zmsknorth(ji) 282 END DO 283 END DO 284 ENDIF 269 285 270 286 ENDIF -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_update.F90
r12489 r13229 26 26 USE domvvl ! Need interpolation routines 27 27 USE vremap ! Vertical remapping 28 USE lbclnk 28 29 29 30 IMPLICIT NONE … … 85 86 Agrif_UseSpecialValueInUpdate = .FALSE. 86 87 Agrif_SpecialValueFineGrid = 0. 88 89 use_sign_north = .TRUE. 90 sign_north = -1. 91 87 92 ! 88 93 # if ! defined DECAL_FEEDBACK … … 127 132 END IF 128 133 ! 134 use_sign_north = .FALSE. 135 ! 129 136 END SUBROUTINE Agrif_Update_Dyn 130 137 … … 148 155 # if defined VOL_REFLUX 149 156 IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 157 use_sign_north = .TRUE. 158 sign_north = -1. 150 159 ! Refluxing on ssh: 151 160 # if defined DECAL_FEEDBACK_2D … … 156 165 CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/ 0, 0/),locupdate2=(/-1,-1/),procname = reflux_sshv) 157 166 # endif 167 use_sign_north = .FALSE. 158 168 END IF 159 169 # endif … … 826 836 SUBROUTINE correct_v_bdy( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 827 837 !!--------------------------------------------- 828 !! *** ROUTINE correct_ u_bdy ***838 !! *** ROUTINE correct_v_bdy *** 829 839 !!--------------------------------------------- 830 840 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_top_interp.F90
r12377 r13229 119 119 tr(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 120 120 END DO 121 122 121 ENDIF 123 122 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_user.F90
r13130 r13229 28 28 ! 29 29 ! !* Agrif initialization 30 CALL agrif_nemo_init31 CALL Agrif_InitValues_cont_dom32 30 CALL Agrif_InitValues_cont 33 31 # if defined key_top … … 40 38 END SUBROUTINE Agrif_initvalues 41 39 42 SUBROUTINE Agrif_InitValues_cont_dom 43 !!---------------------------------------------------------------------- 44 !! *** ROUTINE Agrif_InitValues_cont_dom *** 45 !!---------------------------------------------------------------------- 46 ! 47 CALL agrif_declare_var_dom 48 ! 49 END SUBROUTINE Agrif_InitValues_cont_dom 50 51 SUBROUTINE agrif_declare_var_dom 52 !!---------------------------------------------------------------------- 53 !! *** ROUTINE agrif_declare_var_dom *** 54 !!---------------------------------------------------------------------- 55 USE par_oce, ONLY: nbghostcells 40 SUBROUTINE agrif_istate( Kbb, Kmm, Kaa ) 41 42 USE domvvl 43 USE domain 44 USE par_oce 45 USE agrif_oce 46 USE agrif_oce_interp 47 USE oce 48 USE lib_mpp 49 USe lbclnk 50 51 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 52 INTEGER :: jn 53 54 IF(lwp) WRITE(numout,*) ' ' 55 IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent' 56 IF(lwp) WRITE(numout,*) ' ' 57 58 l_ini_child = .TRUE. 59 Agrif_SpecialValue = 0._wp 60 Agrif_UseSpecialValue = .TRUE. 61 uu(:,:,:,:) = 0. ; vv(:,:,:,:) = 0. ; ts(:,:,:,:,:) = 0. 62 63 Krhs_a = Kbb ; Kmm_a = Kbb 64 65 ! Brutal fix to pas 1x1 refinment. 66 ! IF(Agrif_Irhox() == 1) THEN 67 ! CALL Agrif_Init_Variable(tsini_id, procname=agrif_initts) 68 ! ELSE 69 CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 70 71 ! ENDIF 72 ! just for VORTEX because Parent velocities can actually be exactly zero 73 ! Agrif_UseSpecialValue = .FALSE. 74 Agrif_UseSpecialValue = ln_spc_dyn 75 use_sign_north = .TRUE. 76 sign_north = -1. 77 CALL Agrif_Init_Variable(uini_id , procname=interpun ) 78 CALL Agrif_Init_Variable(vini_id , procname=interpvn ) 79 use_sign_north = .FALSE. 80 81 Agrif_UseSpecialValue = .FALSE. ! 82 l_ini_child = .FALSE. 83 84 Krhs_a = Kaa ; Kmm_a = Kmm 85 86 DO jn = 1, jpts 87 ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 88 END DO 89 uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:) 90 vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 91 92 93 CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:,Kbb), 'U', -1. , vv(:,:,:,Kbb), 'V', -1. ) 94 CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1. ) 95 96 END SUBROUTINE agrif_istate 97 98 SUBROUTINE agrif_declare_var_ini 99 !!---------------------------------------------------------------------- 100 !! *** ROUTINE agrif_declare_var *** 101 !!---------------------------------------------------------------------- 102 USE agrif_util 103 USE agrif_oce 104 USE par_oce 105 USE zdf_oce 106 USE oce 107 USE dom_oce 56 108 ! 57 109 IMPLICIT NONE 58 110 ! 59 111 INTEGER :: ind1, ind2, ind3 60 !!---------------------------------------------------------------------- 112 External :: nemo_mapping 113 !!---------------------------------------------------------------------- 114 115 ! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries 116 ! The procnames will not be called at these boundaries 117 IF (jperio == 1) THEN 118 CALL Agrif_Set_NearCommonBorderX(.TRUE.) 119 CALL Agrif_Set_DistantCommonBorderX(.TRUE.) 120 ENDIF 121 122 IF ( .NOT. lk_south ) THEN 123 CALL Agrif_Set_NearCommonBorderY(.TRUE.) 124 ENDIF 61 125 62 126 ! 1. Declaration of the type of variable which have to be interpolated 63 127 !--------------------------------------------------------------------- 64 ind1 = nbghostcells ! do the interpolation over nbghostcells points 65 ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid 66 ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid 67 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 68 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 69 128 ind1 = nbghostcells 129 ind2 = nn_hls + 2 + nbghostcells_x 130 ind3 = nn_hls + 2 + nbghostcells_y_s 131 132 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id) 133 CALL agrif_declare_variable((/2,2/) ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id) 134 CALL agrif_declare_variable((/2,2/) ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id) 135 136 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 137 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 138 139 140 ! Initial or restart velues 141 142 CALL agrif_declare_variable((/2,2,0,0/),(/ind2 ,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsini_id) 143 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/) ,uini_id ) 144 CALL agrif_declare_variable((/2,1,0,0/),(/ind2 ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/) ,vini_id ) 145 CALL agrif_declare_variable((/2,2/) ,(/ind2,ind3/) ,(/'x','y'/),(/1,1/),(/jpi,jpj/),sshini_id) 146 ! 147 70 148 ! 2. Type of interpolation 71 149 !------------------------- 150 CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 151 152 CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 153 CALL Agrif_Set_interp (mbkt_id,interp=AGRIF_constant) 154 CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 155 CALL Agrif_Set_interp (ht0_id ,interp=AGRIF_constant) 156 72 157 CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm ) 73 158 CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm , interp2=Agrif_linear ) 74 159 75 ! 3. Location of interpolation 160 ! Initial fields 161 CALL Agrif_Set_bcinterp(tsini_id ,interp=AGRIF_linear) 162 CALL Agrif_Set_interp (tsini_id ,interp=AGRIF_linear) 163 CALL Agrif_Set_bcinterp(uini_id ,interp=AGRIF_linear) 164 CALL Agrif_Set_interp (uini_id ,interp=AGRIF_linear) 165 CALL Agrif_Set_bcinterp(vini_id ,interp=AGRIF_linear) 166 CALL Agrif_Set_interp (vini_id ,interp=AGRIF_linear) 167 CALL Agrif_Set_bcinterp(sshini_id,interp=AGRIF_linear) 168 CALL Agrif_Set_interp (sshini_id,interp=AGRIF_linear) 169 170 ! 3. Location of interpolation 76 171 !----------------------------- 172 ! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) 173 ! JC: check near the boundary only until matching in sponge has been sorted out: 174 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) ) 175 176 ! extend the interpolation zone by 1 more point than necessary: 177 ! RB check here 178 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 179 CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 180 77 181 CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 78 CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 182 CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 183 184 CALL Agrif_Set_bc( tsini_id , (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4 185 CALL Agrif_Set_bc( uini_id , (/0,ind1-1/) ) 186 CALL Agrif_Set_bc( vini_id , (/0,ind1-1/) ) 187 CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 79 188 80 189 ! 4. Update type … … 87 196 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 88 197 #endif 89 90 END SUBROUTINE agrif_declare_var_dom 91 92 SUBROUTINE Agrif_InitValues_cont 93 !!---------------------------------------------------------------------- 94 !! *** ROUTINE Agrif_InitValues_cont *** 95 !!---------------------------------------------------------------------- 96 USE agrif_oce 198 199 ! CALL Agrif_Set_ExternalMapping(nemo_mapping) 200 ! 201 END SUBROUTINE agrif_declare_var_ini 202 203 204 SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa ) 205 !!---------------------------------------------------------------------- 206 !! *** ROUTINE Agrif_InitValues_cont_dom *** 207 !!---------------------------------------------------------------------- 208 209 !!---------------------------------------------------------------------- 210 !! *** ROUTINE Agrif_InitValues_cont *** 211 !! 212 !! ** Purpose :: Declaration of variables to be interpolated 213 !!---------------------------------------------------------------------- 214 USE agrif_oce_update 97 215 USE agrif_oce_interp 98 216 USE agrif_oce_sponge 217 USE Agrif_Util 218 USE oce 99 219 USE dom_oce 100 USE oce 220 USE zdf_oce 221 USE nemogcm 222 USE agrif_oce 223 ! 224 USE lbclnk 101 225 USE lib_mpp 102 USE lbclnk226 USE in_out_manager 103 227 ! 104 228 IMPLICIT NONE 105 229 ! 106 INTEGER :: ji, jj 230 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 231 ! 107 232 LOGICAL :: check_namelist 108 233 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 109 #if defined key_vertical110 234 REAL(wp), DIMENSION(jpi,jpj) :: zk ! workspace 111 #endif 112 !!---------------------------------------------------------------------- 113 114 ! 1. Declaration of the type of variable which have to be interpolated 115 !--------------------------------------------------------------------- 116 CALL agrif_declare_var 117 118 ! 2. First interpolations of potentially non zero fields 119 !------------------------------------------------------- 120 121 #if defined key_vertical 235 INTEGER :: ji, jj, jk 236 !!---------------------------------------------------------------------- 237 238 ! CALL Agrif_Declare_Var_ini 239 240 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 241 122 242 ! Build consistent parent bathymetry and number of levels 123 243 ! on the child grid … … 126 246 mbkt_parent(:,:) = 0 127 247 ! 128 CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 129 CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 248 ! CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 249 ! CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 250 CALL Agrif_Init_Variable(ht0_id , procname=interpht0 ) 251 CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt) 130 252 ! 131 253 ! Assume step wise change of bathymetry near interface … … 149 271 ENDIF 150 272 ! 151 CALL lbc_lnk( 'Agrif_Init Values_cont', hu0_parent, 'U', 1. )152 CALL lbc_lnk( 'Agrif_Init Values_cont', hv0_parent, 'V', 1. )273 CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1. ) 274 CALL lbc_lnk( 'Agrif_Init_Domain', hv0_parent, 'V', 1. ) 153 275 zk(:,:) = REAL( mbku_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. ) 154 mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 276 mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) ; 155 277 zk(:,:) = REAL( mbkv_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. ) 156 278 mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 157 #endif 158 279 280 IF ( ln_init_chfrpar ) THEN 281 CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 282 CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 283 DO jk = 1, jpk 284 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 285 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 286 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 287 END DO 288 ENDIF 289 290 ! check if masks and bathymetries match 291 IF(ln_chk_bathy) THEN 292 Agrif_UseSpecialValue = .FALSE. 293 ! 294 IF(lwp) WRITE(numout,*) ' ' 295 IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 296 ! 297 kindic_agr = 0 298 IF( .NOT. l_vremap ) THEN 299 ! 300 ! check if tmask and vertical scale factors agree with parent in sponge area: 301 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 302 ! 303 ELSE 304 ! 305 ! In case of vertical interpolation, check only that total depths agree between child and parent: 306 DO ji = 1, jpi 307 DO jj = 1, jpj 308 IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 309 IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 310 IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 311 END DO 312 END DO 313 314 CALL mpp_sum( 'agrif_user', kindic_agr ) 315 IF( kindic_agr /= 0 ) THEN 316 CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 317 ELSE 318 IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 319 IF(lwp) WRITE(numout,*) ' ' 320 ENDIF 321 ENDIF 322 ENDIF 323 324 IF( l_vremap ) THEN 325 ! Additional constrain that should be removed someday: 326 IF ( Agrif_Parent(jpk).GT.jpk ) THEN 327 CALL ctl_stop( ' With l_vremap, child grids must have jpk greater or equal to the parent value' ) 328 ENDIF 329 ENDIF 330 ! 331 END SUBROUTINE Agrif_Init_Domain 332 333 334 SUBROUTINE Agrif_InitValues_cont 335 !!---------------------------------------------------------------------- 336 !! *** ROUTINE Agrif_InitValues_cont *** 337 !! 338 !! ** Purpose :: Declaration of variables to be interpolated 339 !!---------------------------------------------------------------------- 340 USE agrif_oce_update 341 USE agrif_oce_interp 342 USE agrif_oce_sponge 343 USE Agrif_Util 344 USE oce 345 USE dom_oce 346 USE zdf_oce 347 USE nemogcm 348 USE agrif_oce 349 ! 350 USE lbclnk 351 USE lib_mpp 352 USE in_out_manager 353 ! 354 IMPLICIT NONE 355 ! 356 LOGICAL :: check_namelist 357 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 358 REAL(wp), DIMENSION(jpi,jpj) :: zk ! workspace 359 INTEGER :: ji, jj 360 361 ! 1. Declaration of the type of variable which have to be interpolated 362 !--------------------------------------------------------------------- 363 CALL agrif_declare_var 364 365 ! 2. First interpolations of potentially non zero fields 366 !------------------------------------------------------- 159 367 Agrif_SpecialValue = 0._wp 160 368 Agrif_UseSpecialValue = .TRUE. … … 163 371 tabspongedone_tsn = .FALSE. 164 372 CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 165 ! reset ts (:,:,:,:,Krhs_a)to zero373 ! reset tsa to zero 166 374 ts(:,:,:,:,Krhs_a) = 0._wp 167 375 168 376 Agrif_UseSpecialValue = ln_spc_dyn 377 use_sign_north = .TRUE. 378 sign_north = -1. 169 379 CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 170 380 CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) … … 175 385 tabspongedone_v = .FALSE. 176 386 CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 387 use_sign_north = .FALSE. 177 388 uu(:,:,:,Krhs_a) = 0._wp 178 389 vv(:,:,:,Krhs_a) = 0._wp … … 185 396 IF ( ln_dynspg_ts ) THEN 186 397 Agrif_UseSpecialValue = ln_spc_dyn 398 use_sign_north = .TRUE. 399 sign_north = -1. 187 400 CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 188 401 CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 189 402 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 190 403 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 404 use_sign_north = .FALSE. 191 405 ubdy(:,:) = 0._wp 192 406 vbdy(:,:) = 0._wp 193 407 ENDIF 194 195 Agrif_UseSpecialValue = .FALSE. 196 197 ! 3. Some controls 408 Agrif_UseSpecialValue = .FALSE. 409 198 410 !----------------- 199 411 check_namelist = .TRUE. 200 412 201 413 IF( check_namelist ) THEN 202 203 ! Check time steps204 IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN205 WRITE(cl_check1,*) NINT(Agrif_Parent(rn_Dt))206 WRITE(cl_check2,*) NINT(rn_Dt)207 WRITE(cl_check3,*) NINT(Agrif_Parent(rn_Dt)/Agrif_Rhot())208 CALL ctl_stop( 'Incompatible time step between ocean grids', &209 & 'parent grid value : '//cl_check1 , &210 & 'child grid value : '//cl_check2 , &211 & 'value on child grid should be changed to : '//cl_check3 )212 ENDIF213 214 ! Check run length215 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &216 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN217 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1218 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot()219 CALL ctl_warn( 'Incompatible run length between grids' , &220 & 'nit000 on fine grid will be changed to : '//cl_check1, &221 & 'nitend on fine grid will be changed to : '//cl_check2 )222 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1223 nitend = Agrif_Parent(nitend) *Agrif_IRhot()224 ENDIF225 226 414 ! Check free surface scheme 227 415 IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& … … 251 439 STOP 252 440 ENDIF 253 254 ENDIF 255 256 ! check if masks and bathymetries match 257 IF(ln_chk_bathy) THEN 258 Agrif_UseSpecialValue = .FALSE. 259 ! 260 IF(lwp) WRITE(numout,*) ' ' 261 IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 262 ! 263 kindic_agr = 0 264 # if ! defined key_vertical 265 ! 266 ! check if tmask and vertical scale factors agree with parent in sponge area: 267 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 268 ! 269 # else 270 ! 271 ! In case of vertical interpolation, check only that total depths agree between child and parent: 272 DO_2D_00_00 273 IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 274 IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 275 IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 276 END_2D 277 # endif 278 CALL mpp_sum( 'agrif_user', kindic_agr ) 279 IF( kindic_agr /= 0 ) THEN 280 CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 281 ELSE 282 IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 283 IF(lwp) WRITE(numout,*) ' ' 284 END IF 285 ! 286 !!$ IF(lwp) WRITE(numout,*) ' ' 287 !!$ IF(lwp) WRITE(numout,*) 'AGRIF: Check longitude and latitude near bdys. Level: ', Agrif_Level() 288 !!$ ! 289 !!$ ! check glamt in sponge area: 290 !!$ kindic_agr = 0 291 !!$ CALL Agrif_Bc_variable(glamt_id,calledweight=1.,procname=interpglamt) 292 !!$ CALL mpp_sum( 'agrif_user', kindic_agr ) 293 !!$ IF( kindic_agr /= 0 ) THEN 294 !!$ CALL ctl_stop('==> Child glamt is NOT correct near boundaries.')1 295 !!$ ELSE 296 !!$ IF(lwp) WRITE(numout,*) '==> Child glamt is ok near boundaries.' 297 !!$ IF(lwp) WRITE(numout,*) ' ' 298 !!$ END IF 299 !!$ ! 300 !!$ ! check gphit in sponge area: 301 !!$ kindic_agr = 0 302 !!$ CALL Agrif_Bc_variable(gphit_id,calledweight=1.,procname=interpgphit) 303 !!$ CALL mpp_sum( 'agrif_user', kindic_agr ) 304 !!$ IF( kindic_agr /= 0 ) THEN 305 !!$ CALL ctl_stop('==> Child gphit is NOT correct near boundaries.') 306 !!$ ELSE 307 !!$ IF(lwp) WRITE(numout,*) '==> Child gphit is ok near boundaries.' 308 !!$ IF(lwp) WRITE(numout,*) ' ' 309 !!$ END IF 310 ! 311 ENDIF 312 313 # if defined key_vertical 314 ! Additional constrain that should be removed someday: 315 IF ( Agrif_Parent(jpk).GT.jpk ) THEN 316 CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' ) 317 ENDIF 318 # endif 319 ! 441 ENDIF 442 320 443 END SUBROUTINE Agrif_InitValues_cont 321 444 … … 337 460 ! 1. Declaration of the type of variable which have to be interpolated 338 461 !--------------------------------------------------------------------- 339 ind1 = nbghostcells ! do the interpolation over nbghostcells points340 ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid341 ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid462 ind1 = nbghostcells 463 ind2 = nn_hls + 2 + nbghostcells_x 464 ind3 = nn_hls + 2 + nbghostcells_y_s 342 465 # if defined key_vertical 343 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 344 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 345 346 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 347 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 348 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 349 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 350 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 351 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 466 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 467 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 468 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 469 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 470 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 471 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 472 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 473 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 352 474 # else 353 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 354 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 355 356 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 357 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 358 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 359 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 360 CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 361 CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 475 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 476 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 477 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 478 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 479 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 480 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 481 CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 482 CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 362 483 # endif 363 364 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id) 365 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 366 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 367 368 # if defined key_vertical 369 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id) 370 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id) 371 # endif 372 373 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,3/),scales_t_id) 374 375 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 376 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 377 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 378 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 379 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 380 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 381 382 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 383 384 IF( ln_zdftke.OR.ln_zdfgls ) THEN 484 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 485 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 486 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 487 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 488 CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 489 CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 490 491 ! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 492 ! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 493 CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 494 495 496 IF( ln_zdftke.OR.ln_zdfgls ) THEN ! logical not known at this point 385 497 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 386 498 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 387 499 # if defined key_vertical 388 CALL agrif_declare_variable((/2,2,0,0/),(/ind 3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id)500 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 389 501 # else 390 CALL agrif_declare_variable((/2,2,0,0/),(/ind 3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id)502 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 391 503 # endif 392 504 ENDIF 393 505 394 506 ! 2. Type of interpolation 395 507 !------------------------- 396 508 CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 397 398 509 CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 399 510 CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 400 511 401 512 CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 513 CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 514 CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 402 515 403 516 CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) … … 415 528 !< 416 529 417 CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 418 CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 419 420 CALL Agrif_Set_bcinterp( e3t_id,interp=AGRIF_constant) 421 CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 422 CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 423 424 # if defined key_vertical 425 CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 426 CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 427 # endif 428 429 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 530 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 531 532 533 ! CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 534 ! CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 430 535 431 536 ! 3. Location of interpolation … … 445 550 CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 446 551 447 ! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) 448 ! JC: check near the boundary only until matching in sponge has been sorted out: 449 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) ) 552 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 450 553 CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) ) 451 554 CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) ) 452 555 453 # if defined key_vertical454 ! extend the interpolation zone by 1 more point than necessary:455 CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )456 CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )457 # endif458 459 IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) )460 461 556 ! 4. Update type 462 557 !--------------- 463 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)464 558 465 559 # if defined UPD_HIGH … … 473 567 CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 474 568 475 IF( ln_zdftke.OR.ln_zdfgls ) THEN569 ! IF( ln_zdftke.OR.ln_zdfgls ) THEN 476 570 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 477 571 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 478 572 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 479 ENDIF573 ! ENDIF 480 574 481 575 #else … … 489 583 CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 490 584 491 IF( ln_zdftke.OR.ln_zdfgls ) THEN585 ! IF( ln_zdftke.OR.ln_zdfgls ) THEN 492 586 ! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 493 587 ! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 494 588 ! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 495 ENDIF589 ! ENDIF 496 590 497 591 #endif … … 501 595 #if defined key_si3 502 596 SUBROUTINE Agrif_InitValues_cont_ice 503 !!----------------------------------------------------------------------504 !! *** ROUTINE Agrif_InitValues_cont_ice ***505 !!----------------------------------------------------------------------506 597 USE Agrif_Util 507 598 USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc … … 511 602 USE agrif_ice_interp 512 603 USE lib_mpp 513 ! 514 IMPLICIT NONE 515 !!---------------------------------------------------------------------- 516 ! 517 ! Declaration of the type of variable which have to be interpolated (parent=>child) 518 !---------------------------------------------------------------------------------- 519 CALL agrif_declare_var_ice 604 !!---------------------------------------------------------------------- 605 !! *** ROUTINE Agrif_InitValues_cont_ice *** 606 !!---------------------------------------------------------------------- 520 607 521 608 ! Controls … … 524 611 ! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 525 612 ! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 526 ! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 613 ! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 527 614 IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 528 615 … … 545 632 !! *** ROUTINE agrif_declare_var_ice *** 546 633 !!---------------------------------------------------------------------- 634 547 635 USE Agrif_Util 548 636 USE ice 549 USE par_oce, ONLY : nbghostcells 637 USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s 550 638 ! 551 639 IMPLICIT NONE 552 640 ! 553 641 INTEGER :: ind1, ind2, ind3 554 !!----------------------------------------------------------------------642 !!---------------------------------------------------------------------- 555 643 ! 556 644 ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) … … 561 649 ! 2,2 = two ghost lines 562 650 !------------------------------------------------------------------------------------- 563 ind1 = nbghostcells ! do the interpolation over nbghostcells points 564 ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid 565 ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid 566 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 567 CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,u_ice_id ) 568 CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,v_ice_id ) 651 ind1 = nbghostcells 652 ind2 = nn_hls + 2 + nbghostcells_x 653 ind3 = nn_hls + 2 + nbghostcells_y_s 654 CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 655 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,u_ice_id ) 656 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,v_ice_id ) 657 658 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_iceini_id) 659 CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,u_iceini_id ) 660 CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,v_iceini_id ) 569 661 570 662 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) … … 574 666 CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear) 575 667 668 CALL Agrif_Set_bcinterp(tra_iceini_id, interp = AGRIF_linear) 669 CALL Agrif_Set_interp (tra_iceini_id, interp = AGRIF_linear) 670 CALL Agrif_Set_bcinterp(u_iceini_id , interp = AGRIF_linear ) 671 CALL Agrif_Set_interp (u_iceini_id , interp = AGRIF_linear ) 672 CALL Agrif_Set_bcinterp(v_iceini_id , interp = AGRIF_linear) 673 CALL Agrif_Set_interp (v_iceini_id , interp = AGRIF_linear) 674 576 675 ! 3. Set location of interpolations 577 676 !---------------------------------- … … 579 678 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/)) 580 679 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/)) 680 681 CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/)) 682 CALL Agrif_Set_bc(u_iceini_id ,(/0,ind1/)) 683 CALL Agrif_Set_bc(v_iceini_id ,(/0,ind1/)) 581 684 582 685 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) … … 586 689 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 587 690 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average ) 588 # else691 # else 589 692 CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) 590 693 CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 591 694 CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 592 # endif695 # endif 593 696 594 697 END SUBROUTINE agrif_declare_var_ice … … 614 717 USE agrif_top_sponge 615 718 !! 616 IMPLICIT NONE 617 ! 618 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 619 LOGICAL :: check_namelist 620 !!---------------------------------------------------------------------- 621 622 ! 1. Declaration of the type of variable which have to be interpolated 623 !--------------------------------------------------------------------- 624 CALL agrif_declare_var_top 625 626 ! 2. First interpolations of potentially non zero fields 627 !------------------------------------------------------- 628 Agrif_SpecialValue=0._wp 629 Agrif_UseSpecialValue = .TRUE. 630 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 631 Agrif_UseSpecialValue = .FALSE. 632 CALL Agrif_Sponge 633 tabspongedone_trn = .FALSE. 634 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 635 ! reset ts(:,:,:,:,Krhs_a) to zero 636 tr(:,:,:,:,Krhs_a) = 0._wp 637 638 ! 3. Some controls 639 !----------------- 640 check_namelist = .TRUE. 641 642 IF( check_namelist ) THEN 643 ! Check time steps 644 IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN 645 WRITE(cl_check1,*) Agrif_Parent(rn_Dt) 646 WRITE(cl_check2,*) rn_Dt 647 WRITE(cl_check3,*) rn_Dt*Agrif_Rhot() 719 720 !! 721 IMPLICIT NONE 722 ! 723 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 724 LOGICAL :: check_namelist 725 !!---------------------------------------------------------------------- 726 727 728 ! 1. Declaration of the type of variable which have to be interpolated 729 !--------------------------------------------------------------------- 730 CALL agrif_declare_var_top 731 732 ! 2. First interpolations of potentially non zero fields 733 !------------------------------------------------------- 734 Agrif_SpecialValue=0. 735 Agrif_UseSpecialValue = .TRUE. 736 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 737 Agrif_UseSpecialValue = .FALSE. 738 CALL Agrif_Sponge 739 tabspongedone_trn = .FALSE. 740 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 741 ! reset tsa to zero 742 tra(:,:,:,:) = 0. 743 744 ! 3. Some controls 745 !----------------- 746 check_namelist = .TRUE. 747 748 IF( check_namelist ) THEN 749 ! Check time steps 750 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 751 WRITE(cl_check1,*) Agrif_Parent(rdt) 752 WRITE(cl_check2,*) rdt 753 WRITE(cl_check3,*) rdt*Agrif_Rhot() 648 754 CALL ctl_stop( 'incompatible time step between grids', & 649 755 & 'parent grid value : '//cl_check1 , & … … 664 770 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 665 771 ENDIF 666 667 772 ENDIF 668 773 ! … … 684 789 !!---------------------------------------------------------------------- 685 790 791 792 793 !RB_CMEMS : declare here init for top 686 794 ! 1. Declaration of the type of variable which have to be interpolated 687 795 !--------------------------------------------------------------------- 688 ind1 = nbghostcells ! do the interpolation over nbghostcells points689 ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid690 ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid796 ind1 = nbghostcells 797 ind2 = nn_hls + 2 + nbghostcells_x 798 ind3 = nn_hls + 2 + nbghostcells_y_s 691 799 # if defined key_vertical 692 CALL agrif_declare_variable((/2,2,0,0/),(/ind 3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id)693 CALL agrif_declare_variable((/2,2,0,0/),(/ind 3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id)800 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 801 CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 694 802 # else 695 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 696 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 803 ! LAURENT: STRANGE why (3,3) here ? 804 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 805 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 697 806 # endif 698 807 … … 734 843 !! *** ROUTINE agrif_init *** 735 844 !!---------------------------------------------------------------------- 736 USE agrif_oce 737 USE agrif_ice 738 USE in_out_manager 739 USE lib_mpp 845 USE agrif_oce 846 USE agrif_ice 847 USE dom_oce 848 USE in_out_manager 849 USE lib_mpp 740 850 !! 741 851 IMPLICIT NONE 742 852 ! 743 853 INTEGER :: ios ! Local integer output status for namelist read 744 NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &854 NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 745 855 & ln_spc_dyn, ln_chk_bathy 746 856 !!-------------------------------------------------------------------------------------- … … 758 868 WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters' 759 869 WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way 760 WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' m^2/s' 761 WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s' 762 WRITE(numout,*) ' time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra, ' ad.' 763 WRITE(numout,*) ' time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn, ' ad.' 870 WRITE(numout,*) ' child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar 871 WRITE(numout,*) ' ad. sponge coeft for tracers rn_sponge_tra = ', rn_sponge_tra 872 WRITE(numout,*) ' ad. sponge coeft for dynamics rn_sponge_tra = ', rn_sponge_dyn 873 WRITE(numout,*) ' ad. time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra 874 WRITE(numout,*) ' ad. time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn 764 875 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 765 876 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 766 877 ENDIF 767 ! 768 ! 769 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 878 879 lk_west = .NOT. ( Agrif_Ix() == 1 ) 880 lk_east = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(jpiglo) -1 ) 881 lk_south = .NOT. ( Agrif_Iy() == 1 ) 882 lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(jpjglo) -1 ) 883 884 ! 885 ! Set the number of ghost cells according to periodicity 886 nbghostcells_x = nbghostcells 887 nbghostcells_y_s = nbghostcells 888 nbghostcells_y_n = nbghostcells 889 ! 890 IF ( jperio == 1 ) nbghostcells_x = 0 891 IF ( .NOT. lk_south ) nbghostcells_y_s = 0 892 893 ! Some checks 894 IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells_x ) & 895 CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells_x' ) 896 IF( jpjglo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n ) & 897 CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' ) 898 IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 770 899 ! 771 900 END SUBROUTINE agrif_nemo_init 772 901 773 902 # if defined key_mpp_mpi 774 775 903 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 776 904 !!---------------------------------------------------------------------- … … 831 959 # endif 832 960 961 SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks) 962 !!---------------------------------------------------------------------- 963 !! *** ROUTINE Nemo_mapping *** 964 !!---------------------------------------------------------------------- 965 USE dom_oce 966 !! 967 IMPLICIT NONE 968 ! 969 INTEGER :: ndim 970 INTEGER :: ptx, pty 971 INTEGER, DIMENSION(ndim,2,2) :: bounds 972 INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks 973 LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required 974 INTEGER :: nb_chunks 975 ! 976 INTEGER :: i 977 978 IF (agrif_debug_interp) THEN 979 DO i=1,ndim 980 WRITE(*,*) 'direction = ',i,bounds(i,1,2),bounds(i,2,2) 981 ENDDO 982 ENDIF 983 984 IF( bounds(2,2,2) > jpjglo) THEN 985 IF( bounds(2,1,2) <=jpjglo) THEN 986 nb_chunks = 2 987 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 988 ALLOCATE(correction_required(nb_chunks)) 989 DO i = 1,nb_chunks 990 bounds_chunks(i,:,:,:) = bounds 991 END DO 992 993 ! FIRST CHUNCK (for j<=jpjglo) 994 995 ! Original indices 996 bounds_chunks(1,1,1,1) = bounds(1,1,2) 997 bounds_chunks(1,1,2,1) = bounds(1,2,2) 998 bounds_chunks(1,2,1,1) = bounds(2,1,2) 999 bounds_chunks(1,2,2,1) = jpjglo 1000 1001 bounds_chunks(1,1,1,2) = bounds(1,1,2) 1002 bounds_chunks(1,1,2,2) = bounds(1,2,2) 1003 bounds_chunks(1,2,1,2) = bounds(2,1,2) 1004 bounds_chunks(1,2,2,2) = jpjglo 1005 1006 ! Correction required or not 1007 correction_required(1)=.FALSE. 1008 1009 ! SECOND CHUNCK (for j>jpjglo) 1010 1011 ! Original indices 1012 bounds_chunks(2,1,1,1) = bounds(1,1,2) 1013 bounds_chunks(2,1,2,1) = bounds(1,2,2) 1014 bounds_chunks(2,2,1,1) = jpjglo-2 1015 bounds_chunks(2,2,2,1) = bounds(2,2,2) 1016 1017 ! Where to find them 1018 ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo)) 1019 1020 IF( ptx == 2) THEN ! T, V points 1021 bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2 1022 bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2 1023 ELSE ! U, F points 1024 bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1 1025 bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1 1026 ENDIF 1027 1028 IF( pty == 2) THEN ! T, U points 1029 bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 1030 bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2 -jpjglo) 1031 ELSE ! V, F points 1032 bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 1033 bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2 -jpjglo) 1034 ENDIF 1035 ! Correction required or not 1036 correction_required(2)=.TRUE. 1037 1038 ELSE 1039 nb_chunks = 1 1040 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1041 ALLOCATE(correction_required(nb_chunks)) 1042 DO i=1,nb_chunks 1043 bounds_chunks(i,:,:,:) = bounds 1044 END DO 1045 1046 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1047 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1048 bounds_chunks(1,2,1,1) = bounds(2,1,2) 1049 bounds_chunks(1,2,2,1) = bounds(2,2,2) 1050 1051 bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 1052 bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 1053 1054 bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo) 1055 bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo) 1056 1057 IF( ptx == 2) THEN ! T, V points 1058 bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 1059 bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 1060 ELSE ! U, F points 1061 bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1 1062 bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1 1063 ENDIF 1064 1065 IF (pty == 2) THEN ! T, U points 1066 bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 1067 bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo) 1068 ELSE ! V, F points 1069 bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 1070 bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo) 1071 ENDIF 1072 1073 correction_required(1)=.TRUE. 1074 ENDIF 1075 1076 ELSE IF (bounds(1,1,2) < 1) THEN 1077 IF (bounds(1,2,2) > 0) THEN 1078 nb_chunks = 2 1079 ALLOCATE(correction_required(nb_chunks)) 1080 correction_required=.FALSE. 1081 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1082 DO i=1,nb_chunks 1083 bounds_chunks(i,:,:,:) = bounds 1084 END DO 1085 1086 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 1087 bounds_chunks(1,1,2,2) = 1+jpiglo-2 1088 1089 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1090 bounds_chunks(1,1,2,1) = 1 1091 1092 bounds_chunks(2,1,1,2) = 2 1093 bounds_chunks(2,1,2,2) = bounds(1,2,2) 1094 1095 bounds_chunks(2,1,1,1) = 2 1096 bounds_chunks(2,1,2,1) = bounds(1,2,2) 1097 1098 ELSE 1099 nb_chunks = 1 1100 ALLOCATE(correction_required(nb_chunks)) 1101 correction_required=.FALSE. 1102 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1103 DO i=1,nb_chunks 1104 bounds_chunks(i,:,:,:) = bounds 1105 END DO 1106 bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 1107 bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2 1108 1109 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1110 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1111 ENDIF 1112 ELSE 1113 nb_chunks=1 1114 ALLOCATE(correction_required(nb_chunks)) 1115 correction_required=.FALSE. 1116 ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 1117 DO i=1,nb_chunks 1118 bounds_chunks(i,:,:,:) = bounds 1119 END DO 1120 bounds_chunks(1,1,1,2) = bounds(1,1,2) 1121 bounds_chunks(1,1,2,2) = bounds(1,2,2) 1122 bounds_chunks(1,2,1,2) = bounds(2,1,2) 1123 bounds_chunks(1,2,2,2) = bounds(2,2,2) 1124 1125 bounds_chunks(1,1,1,1) = bounds(1,1,2) 1126 bounds_chunks(1,1,2,1) = bounds(1,2,2) 1127 bounds_chunks(1,2,1,1) = bounds(2,1,2) 1128 bounds_chunks(1,2,2,1) = bounds(2,2,2) 1129 ENDIF 1130 1131 END SUBROUTINE nemo_mapping 1132 1133 FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 1134 1135 USE dom_oce 1136 1137 INTEGER :: ptx, pty, i1, isens 1138 INTEGER :: agrif_external_switch_index 1139 1140 IF( isens == 1 ) THEN 1141 IF( ptx == 2 ) THEN ! T, V points 1142 agrif_external_switch_index = jpiglo-i1+2 1143 ELSE ! U, F points 1144 agrif_external_switch_index = jpiglo-i1+1 1145 ENDIF 1146 ELSE IF( isens ==2 ) THEN 1147 IF ( pty == 2 ) THEN ! T, U points 1148 agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 1149 ELSE ! V, F points 1150 agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 1151 ENDIF 1152 ENDIF 1153 1154 END FUNCTION agrif_external_switch_index 1155 1156 SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2) 1157 !!---------------------------------------------------------------------- 1158 !! *** ROUTINE Correct_field *** 1159 !!---------------------------------------------------------------------- 1160 1161 USE dom_oce 1162 USE agrif_oce 1163 1164 INTEGER :: i1,i2,j1,j2 1165 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 1166 1167 INTEGER :: i,j 1168 REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 1169 1170 tab2dtemp = tab2d 1171 1172 IF( .NOT. use_sign_north ) THEN 1173 DO j=j1,j2 1174 DO i=i1,i2 1175 tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 1176 END DO 1177 END DO 1178 ELSE 1179 DO j=j1,j2 1180 DO i=i1,i2 1181 tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 1182 END DO 1183 END DO 1184 ENDIF 1185 1186 END SUBROUTINE Correct_field 1187 833 1188 #else 834 1189 SUBROUTINE Subcalledbyagrif -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/dom_oce.F90
r12993 r13229 214 214 #if defined key_agrif 215 215 LOGICAL, PUBLIC, PARAMETER :: lk_agrif = .TRUE. !: agrif flag 216 LOGICAL, PUBLIC :: lk_south, lk_north, lk_west, lk_east !: Child grid boundaries (interpolation or not) 216 217 #else 217 218 LOGICAL, PUBLIC, PARAMETER :: lk_agrif = .FALSE. !: agrif flag -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domain.F90
r13176 r13229 187 187 ENDIF 188 188 ! 189 189 190 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 190 191 ! 192 193 #if defined key_agrif 194 IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa ) 195 #endif 191 196 IF( ln_meshmask ) CALL dom_wri ! Create a domain file 192 197 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control … … 296 301 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist' ) 297 302 IF(lwm) WRITE ( numond, namrun ) 303 304 #if defined key_agrif 305 IF( .NOT. Agrif_Root() ) THEN 306 nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1 307 nn_itend = Agrif_Parent(nn_itend) *Agrif_IRhot() 308 ENDIF 309 #endif 298 310 ! 299 311 IF(lwp) THEN ! control print … … 388 400 IF(lwm) WRITE( numond, namdom ) 389 401 ! 402 #if defined key_agrif 403 IF( .NOT. Agrif_Root() ) THEN 404 rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot() 405 ENDIF 406 #endif 407 ! 390 408 IF(lwp) THEN 391 409 WRITE(numout,*) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/istate.F90
r13124 r13229 34 34 USE lib_mpp ! MPP library 35 35 USE restart ! restart 36 #if defined key_agrif 37 USE agrif_oce_interp 38 USE agrif_oce 39 #endif 36 40 37 41 IMPLICIT NONE … … 69 73 !!gm Why not include in the first call of dta_tsd ? 70 74 !!gm probably associated with the use of internal damping... 71 75 CALL dta_tsd_init ! Initialisation of T & S input data 72 76 !!gm to be moved in usrdef of C1D case 73 77 ! IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data … … 83 87 #endif 84 88 89 #if defined key_agrif 90 IF ( (.NOT.Agrif_root()).AND.ln_init_chfrpar ) THEN 91 numror = 0 ! define numror = 0 -> no restart file to read 92 ln_1st_euler = .true. ! Set time-step indicator at nit000 (euler forward) 93 CALL day_init 94 CALL agrif_istate( Kbb, Kmm, Kaa ) ! Interp from parent 95 ! 96 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) 97 ssh (:,:,Kmm) = ssh(:,:,Kbb) 98 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 99 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 100 ELSE 101 #endif 85 102 IF( ln_rstart ) THEN ! Restart from a file 86 103 ! ! ------------------- … … 99 116 ! 100 117 ssh(:,:,Kbb) = 0._wp ! set the ocean at rest 118 uu (:,:,:,Kbb) = 0._wp 119 vv (:,:,:,Kbb) = 0._wp 120 ! 101 121 IF( ll_wd ) THEN 102 122 ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD … … 110 130 END_2D 111 131 ENDIF 112 uu (:,:,:,Kbb) = 0._wp 113 vv (:,:,:,Kbb) = 0._wp 114 ! 132 ! 115 133 ELSE ! user defined initial T and S 116 134 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) … … 147 165 ! 148 166 ENDIF 167 #if defined key_agrif 168 ENDIF 169 #endif 149 170 ! 150 171 ! Initialize "now" and "before" barotropic velocities: -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DYN/dynspg_ts.F90
r13065 r13229 513 513 END_2D 514 514 ! 515 ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) 516 IF( ln_bdy ) CALL bdy_ssh( ssha_e ) 517 #if defined key_agrif 518 IF( .NOT.Agrif_Root() ) CALL agrif_ssh_ts( jn ) 519 #endif 520 515 521 CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp, zhU, 'U', -1._wp, zhV, 'V', -1._wp ) 516 522 ! … … 525 531 END IF 526 532 ! 527 ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T)528 IF( ln_bdy ) CALL bdy_ssh( ssha_e )529 #if defined key_agrif530 IF( .NOT.Agrif_Root() ) CALL agrif_ssh_ts( jn )531 #endif532 533 ! 533 534 ! Sea Surface Height at u-,v-points (vvl case only) … … 643 644 ENDIF 644 645 645 IF( .NOT.ln_linssh ) THEN 646 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 646 647 hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1) 647 648 hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) ) 648 649 hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1) 649 650 hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) ) 651 ENDIF 652 ! ! open boundaries 653 IF( ln_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e ) 654 #if defined key_agrif 655 IF( .NOT.Agrif_Root() ) CALL agrif_dyn_ts( jn ) ! Agrif 656 #endif 657 ! 658 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 650 659 CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp & 651 660 & , hu_e , 'U', 1._wp, hv_e , 'V', 1._wp & … … 655 664 ENDIF 656 665 ! 657 !658 ! ! open boundaries659 IF( ln_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e )660 #if defined key_agrif661 IF( .NOT.Agrif_Root() ) CALL agrif_dyn_ts( jn ) ! Agrif662 #endif663 666 ! !* Swap 664 667 ! ! ---- -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DYN/sshwzv.F90
r13138 r13229 200 200 ENDIF 201 201 ! 202 #if defined key_agrif 202 203 IF( .NOT. AGRIF_Root() ) THEN 203 204 ! … … 206 207 DO jk = 1, jpkm1 207 208 ! --- West --- ! 208 DO ji = mi0(2+nn_hls), mi1(2+nn_hls) 209 DO jj = 1, jpj 210 pww(ji,jj,jk) = 0._wp 209 IF( lk_west ) THEN 210 DO ji = mi0(2+nn_hls), mi1(2+nn_hls) 211 DO jj = 1, jpj 212 pww(ji,jj,jk) = 0._wp 213 END DO 211 214 END DO 212 END DO215 ENDIF 213 216 ! 214 217 ! --- East --- ! 215 DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls) 216 DO jj = 1, jpj 217 pww(ji,jj,jk) = 0._wp 218 IF( lk_east ) THEN 219 DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls) 220 DO jj = 1, jpj 221 pww(ji,jj,jk) = 0._wp 222 END DO 218 223 END DO 219 END DO224 ENDIF 220 225 ! 221 226 ! --- South --- ! 222 DO jj = mj0(2+nn_hls), mj1(2+nn_hls) 223 DO ji = 1, jpi 224 pww(ji,jj,jk) = 0._wp 227 IF( lk_south ) THEN 228 DO jj = mj0(2+nn_hls), mj1(2+nn_hls) 229 DO ji = 1, jpi 230 pww(ji,jj,jk) = 0._wp 231 END DO 225 232 END DO 226 END DO233 ENDIF 227 234 ! 228 235 ! --- North --- ! 229 DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls) 230 DO ji = 1, jpi 231 pww(ji,jj,jk) = 0._wp 236 IF( lk_north ) THEN 237 DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls) 238 DO ji = 1, jpi 239 pww(ji,jj,jk) = 0._wp 240 END DO 232 241 END DO 233 END DO242 ENDIF 234 243 END DO 235 244 ! 236 245 ENDIF 246 #endif 237 247 ! 238 248 IF( ln_timing ) CALL timing_stop('wzv') -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/FLO/floblk.F90
r12939 r13229 41 41 INTEGER, INTENT( in ) :: Kbb, Kmm ! ocean time level indices 42 42 !! 43 #ifndef key_agrif 44 45 !RB super quick fix to compile with agrif 46 43 47 INTEGER :: jfl ! dummy loop arguments 44 48 INTEGER :: ind, ifin, iloop … … 364 368 GO TO 222 365 369 ENDIF 370 #endif 366 371 ! 367 372 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90
r13130 r13229 1112 1112 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 1113 1113 idmspc = idmspc - 1 1114 ELSE 1115 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 1116 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 1117 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 1114 !!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation 1115 !ELSE 1116 ! CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,', & 1117 ! & 'we do not accept data with '//cldmspc//' spatial dimensions' , & 1118 ! & 'Use ncwa -a to suppress the unnecessary dimensions' ) 1118 1119 ENDIF 1119 1120 ENDIF -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lib_mpp.F90
r13124 r13229 137 137 138 138 ! Communications summary report 139 CHARACTER(len= 128), DIMENSION(:), ALLOCATABLE :: crname_lbc !: names of lbc_lnk calling routines140 CHARACTER(len= 128), DIMENSION(:), ALLOCATABLE :: crname_glb !: names of global comm calling routines141 CHARACTER(len= 128), DIMENSION(:), ALLOCATABLE :: crname_dlg !: names of delayed global comm calling routines139 CHARACTER(len=lca), DIMENSION(:), ALLOCATABLE :: crname_lbc !: names of lbc_lnk calling routines 140 CHARACTER(len=lca), DIMENSION(:), ALLOCATABLE :: crname_glb !: names of global comm calling routines 141 CHARACTER(len=lca), DIMENSION(:), ALLOCATABLE :: crname_dlg !: names of delayed global comm calling routines 142 142 INTEGER, PUBLIC :: ncom_stp = 0 !: copy of time step # istp 143 143 INTEGER, PUBLIC :: ncom_fsbc = 1 !: copy of sbc time step # nn_fsbc -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90
r13176 r13229 103 103 & 'the domain is lay out for distributed memory computing!' ) 104 104 ! 105 #if defined key_agrif 106 IF (.NOT.agrif_root()) THEN 107 call agrif_nemo_init() 108 ENDIF 109 #endif 105 110 END SUBROUTINE mpp_init 106 111 … … 341 346 CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires jpjglo == nbcellsy + 2*( nbghostcells + 1 + nn_hls )' ) 342 347 IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'mpp_init:Agrif children requires ln_use_jattr = .false. ' ) 348 CALL agrif_nemo_init() 343 349 ENDIF 344 350 #endif -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/OBS/diaobs.F90
r12489 r13229 94 94 TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: profdataqc !: Profile data after quality control 95 95 96 CHARACTER(len= 6), PUBLIC, DIMENSION(:), ALLOCATABLE :: cobstypesprof, cobstypessurf !: Profile & surface obs types96 CHARACTER(len=lca), PUBLIC, DIMENSION(:), ALLOCATABLE :: cobstypesprof, cobstypessurf !: Profile & surface obs types 97 97 98 98 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbcblk.F90
r13186 r13229 74 74 #endif 75 75 76 INTEGER , PUBLIC :: jpfld ! maximum number of files to read 77 INTEGER , PUBLIC, PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point 78 INTEGER , PUBLIC, PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point 79 INTEGER , PUBLIC, PARAMETER :: jp_tair = 3 ! index of 10m air temperature (Kelvin) 80 INTEGER , PUBLIC, PARAMETER :: jp_humi = 4 ! index of specific humidity ( % ) 81 INTEGER , PUBLIC, PARAMETER :: jp_qsr = 5 ! index of solar heat (W/m2) 82 INTEGER , PUBLIC, PARAMETER :: jp_qlw = 6 ! index of Long wave (W/m2) 83 INTEGER , PUBLIC, PARAMETER :: jp_prec = 7 ! index of total precipitation (rain+snow) (Kg/m2/s) 84 INTEGER , PUBLIC, PARAMETER :: jp_snow = 8 ! index of snow (solid prcipitation) (kg/m2/s) 85 INTEGER , PUBLIC, PARAMETER :: jp_slp = 9 ! index of sea level pressure (Pa) 86 INTEGER , PUBLIC, PARAMETER :: jp_hpgi =10 ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 87 INTEGER , PUBLIC, PARAMETER :: jp_hpgj =11 ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 88 76 INTEGER , PUBLIC, PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point 77 INTEGER , PUBLIC, PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point 78 INTEGER , PUBLIC, PARAMETER :: jp_tair = 3 ! index of 10m air temperature (Kelvin) 79 INTEGER , PUBLIC, PARAMETER :: jp_humi = 4 ! index of specific humidity ( % ) 80 INTEGER , PUBLIC, PARAMETER :: jp_qsr = 5 ! index of solar heat (W/m2) 81 INTEGER , PUBLIC, PARAMETER :: jp_qlw = 6 ! index of Long wave (W/m2) 82 INTEGER , PUBLIC, PARAMETER :: jp_prec = 7 ! index of total precipitation (rain+snow) (Kg/m2/s) 83 INTEGER , PUBLIC, PARAMETER :: jp_snow = 8 ! index of snow (solid prcipitation) (kg/m2/s) 84 INTEGER , PUBLIC, PARAMETER :: jp_slp = 9 ! index of sea level pressure (Pa) 85 INTEGER , PUBLIC, PARAMETER :: jp_uoatm = 10 ! index of surface current (i-component) 86 ! ! seen by the atmospheric forcing (m/s) at T-point 87 INTEGER , PUBLIC, PARAMETER :: jp_voatm = 11 ! index of surface current (j-component) 88 ! ! seen by the atmospheric forcing (m/s) at T-point 89 INTEGER , PUBLIC, PARAMETER :: jp_hpgi = 12 ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 90 INTEGER , PUBLIC, PARAMETER :: jp_hpgj = 13 ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 91 INTEGER , PUBLIC, PARAMETER :: jpfld = 13 ! maximum number of files to read 92 93 ! Warning: keep this structure allocatable for Agrif... 89 94 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf ! structure of input atmospheric fields (file informations, fields read) 90 95 … … 98 103 LOGICAL :: ln_Cd_L15 ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 99 104 ! 105 LOGICAL :: ln_crt_fbk ! Add surface current feedback to the wind stress computation (Renault et al. 2020) 106 REAL(wp) :: rn_stau_a ! Alpha and Beta coefficients of Renault et al. 2020, eq. 10: Stau = Alpha * Wnd + Beta 107 REAL(wp) :: rn_stau_b ! 108 ! 100 109 REAL(wp) :: rn_pfac ! multiplication factor for precipitation 101 110 REAL(wp), PUBLIC :: rn_efac ! multiplication factor for evaporation 102 REAL(wp), PUBLIC :: rn_vfac ! multiplication factor for ice/ocean velocity in the calculation of wind stress103 111 REAL(wp) :: rn_zqt ! z(q,t) : height of humidity and temperature measurements 104 112 REAL(wp) :: rn_zu ! z(u) : height of wind measurements 105 113 ! 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cd_ice , Ch_ice , Ce_ice ! transfert coefficients over ice107 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cdn_oce, Chn_oce, Cen_oce ! neutral coeffs over ocean (L15 bulk scheme)108 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: t_zu, q_zu ! air temp. and spec. hum. at wind speed height (L15 bulk scheme)114 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: Cdn_oce, Chn_oce, Cen_oce ! neutral coeffs over ocean (L15 bulk scheme and ABL) 115 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cd_ice , Ch_ice , Ce_ice ! transfert coefficients over ice 116 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: t_zu, q_zu ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 109 117 110 118 LOGICAL :: ln_skin_cs ! use the cool-skin (only available in ECMWF and COARE algorithms) !LB … … 113 121 LOGICAL :: ln_humi_dpt ! humidity read in files ("sn_humi") is dew-point temperature [K] if .true. !LB 114 122 LOGICAL :: ln_humi_rlh ! humidity read in files ("sn_humi") is relative humidity [%] if .true. !LB 123 LOGICAL :: ln_tpot !!GS: flag to compute or not potential temperature 115 124 ! 116 125 INTEGER :: nhumi ! choice of the bulk algorithm … … 162 171 !! 163 172 CHARACTER(len=100) :: cn_dir ! Root directory for location of atmospheric forcing files 164 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read 165 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 166 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow ! " " 167 TYPE(FLD_N) :: sn_slp , sn_hpgi, sn_hpgj ! " " 173 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read 174 TYPE(FLD_N) :: sn_wndi, sn_wndj , sn_humi, sn_qsr ! informations about the fields to be read 175 TYPE(FLD_N) :: sn_qlw , sn_tair , sn_prec, sn_snow ! " " 176 TYPE(FLD_N) :: sn_slp , sn_uoatm, sn_voatm ! " " 177 TYPE(FLD_N) :: sn_hpgi, sn_hpgj ! " " 178 INTEGER :: ipka ! number of levels in the atmospheric variable 168 179 NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw , & ! input fields 169 & sn_tair, sn_prec, sn_snow, sn_slp, sn_hpgi, sn_hpgj, & 180 & sn_tair, sn_prec, sn_snow, sn_slp, sn_uoatm, sn_voatm, & 181 & sn_hpgi, sn_hpgj, & 170 182 & ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF, & ! bulk algorithm 171 183 & cn_dir , rn_zqt, rn_zu, & 172 & rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15, & 184 & rn_pfac, rn_efac, ln_Cd_L12, ln_Cd_L15, ln_tpot, & 185 & ln_crt_fbk, rn_stau_a, rn_stau_b, & ! current feedback 173 186 & ln_skin_cs, ln_skin_wl, ln_humi_sph, ln_humi_dpt, ln_humi_rlh ! cool-skin / warm-layer !LB 174 187 !!--------------------------------------------------------------------- … … 242 255 ! !* set the bulk structure 243 256 ! !- store namelist information in an array 244 IF( ln_blk ) jpfld = 9 245 IF( ln_abl ) jpfld = 11 246 ALLOCATE( slf_i(jpfld) ) 247 ! 248 slf_i(jp_wndi) = sn_wndi ; slf_i(jp_wndj) = sn_wndj 249 slf_i(jp_qsr ) = sn_qsr ; slf_i(jp_qlw ) = sn_qlw 250 slf_i(jp_tair) = sn_tair ; slf_i(jp_humi) = sn_humi 251 slf_i(jp_prec) = sn_prec ; slf_i(jp_snow) = sn_snow 252 slf_i(jp_slp ) = sn_slp 253 IF( ln_abl ) THEN 254 slf_i(jp_hpgi) = sn_hpgi ; slf_i(jp_hpgj) = sn_hpgj 255 END IF 257 ! 258 slf_i(jp_wndi ) = sn_wndi ; slf_i(jp_wndj ) = sn_wndj 259 slf_i(jp_qsr ) = sn_qsr ; slf_i(jp_qlw ) = sn_qlw 260 slf_i(jp_tair ) = sn_tair ; slf_i(jp_humi ) = sn_humi 261 slf_i(jp_prec ) = sn_prec ; slf_i(jp_snow ) = sn_snow 262 slf_i(jp_slp ) = sn_slp 263 slf_i(jp_uoatm) = sn_uoatm ; slf_i(jp_voatm) = sn_voatm 264 slf_i(jp_hpgi ) = sn_hpgi ; slf_i(jp_hpgj ) = sn_hpgj 265 ! 266 IF( .NOT. ln_abl ) THEN ! force to not use jp_hpgi and jp_hpgj, should already be done in namelist_* but we never know... 267 slf_i(jp_hpgi)%clname = 'NOT USED' 268 slf_i(jp_hpgj)%clname = 'NOT USED' 269 ENDIF 256 270 ! 257 271 ! !- allocate the bulk structure … … 264 278 DO jfpr= 1, jpfld 265 279 ! 266 IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to zero) 267 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 268 sf(jfpr)%fnow(:,:,1) = 0._wp 280 IF( ln_abl .AND. & 281 & ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR. & 282 & jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair ) ) THEN 283 ipka = jpka ! ABL: some fields are 3D input 284 ELSE 285 ipka = 1 286 ENDIF 287 ! 288 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,ipka) ) 289 ! 290 IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to default) 291 IF( jfpr == jp_slp ) THEN 292 sf(jfpr)%fnow(:,:,1:ipka) = 101325._wp ! use standard pressure in Pa 293 ELSEIF( jfpr == jp_prec .OR. jfpr == jp_snow .OR. jfpr == jp_uoatm .OR. jfpr == jp_voatm ) THEN 294 sf(jfpr)%fnow(:,:,1:ipka) = 0._wp ! no precip or no snow or no surface currents 295 ELSEIF( ( jfpr == jp_hpgi .OR. jfpr == jp_hpgj ) .AND. .NOT. ln_abl ) THEN 296 DEALLOCATE( sf(jfpr)%fnow ) ! deallocate as not used in this case 297 ELSE 298 WRITE(ctmp1,*) 'sbc_blk_init: no default value defined for field number', jfpr 299 CALL ctl_stop( ctmp1 ) 300 ENDIF 269 301 ELSE !-- used field --! 270 IF( ln_abl .AND. & 271 & ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR. & 272 & jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair ) ) THEN ! ABL: some fields are 3D input 273 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,jpka) ) 274 IF( sf(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,jpka,2) ) 275 ELSE ! others or Bulk fields are 2D fiels 276 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 277 IF( sf(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 278 ENDIF 302 IF( sf(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,ipka,2) ) ! allocate array for temporal interpolation 279 303 ! 280 304 IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 ) & … … 327 351 WRITE(numout,*) ' factor applied on precipitation (total & snow) rn_pfac = ', rn_pfac 328 352 WRITE(numout,*) ' factor applied on evaporation rn_efac = ', rn_efac 329 WRITE(numout,*) ' factor applied on ocean/ice velocity rn_vfac = ', rn_vfac330 353 WRITE(numout,*) ' (form absolute (=0) to relative winds(=1))' 331 354 WRITE(numout,*) ' use ice-atm drag from Lupkes2012 ln_Cd_L12 = ', ln_Cd_L12 332 355 WRITE(numout,*) ' use ice-atm drag from Lupkes2015 ln_Cd_L15 = ', ln_Cd_L15 356 WRITE(numout,*) ' use surface current feedback on wind stress ln_crt_fbk = ', ln_crt_fbk 357 IF(ln_crt_fbk) THEN 358 WRITE(numout,*) ' Renault et al. 2020, eq. 10: Stau = Alpha * Wnd + Beta' 359 WRITE(numout,*) ' Alpha rn_stau_a = ', rn_stau_a 360 WRITE(numout,*) ' Beta rn_stau_b = ', rn_stau_b 361 ENDIF 333 362 ! 334 363 WRITE(numout,*) … … 429 458 ! ! compute the surface ocean fluxes using bulk formulea 430 459 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 431 CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1), & ! <<= in 432 & sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), & ! <<= in 433 & sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m, & ! <<= in 434 & sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1), & ! <<= in (wl/cs) 435 & tsk_m, zssq, zcd_du, zsen, zevp ) ! =>> out 436 437 CALL blk_oce_2( sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1), & ! <<= in 438 & sf(jp_qlw )%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), & ! <<= in 439 & sf(jp_snow)%fnow(:,:,1), tsk_m, & ! <<= in 440 & zsen, zevp ) ! <=> in out 460 CALL blk_oce_1( kt, sf(jp_wndi )%fnow(:,:,1), sf(jp_wndj )%fnow(:,:,1), & ! <<= in 461 & sf(jp_tair )%fnow(:,:,1), sf(jp_humi )%fnow(:,:,1), & ! <<= in 462 & sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m, & ! <<= in 463 & sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1), & ! <<= in 464 & sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1), & ! <<= in (wl/cs) 465 & tsk_m, zssq, zcd_du, zsen, zevp ) ! =>> out 466 467 CALL blk_oce_2( sf(jp_tair )%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1), & ! <<= in 468 & sf(jp_qlw )%fnow(:,:,1), sf(jp_prec )%fnow(:,:,1), & ! <<= in 469 & sf(jp_snow )%fnow(:,:,1), tsk_m, & ! <<= in 470 & zsen, zevp ) ! <=> in out 441 471 ENDIF 442 472 ! … … 470 500 471 501 472 SUBROUTINE blk_oce_1( kt, pwndi, pwndj , ptair, phumi,& ! inp473 & pslp , pst , pu , pv,& ! inp474 & pqsr , pqlw ,& ! inp475 & ptsk, pssq , pcd_du, psen , pevp )! out502 SUBROUTINE blk_oce_1( kt, pwndi, pwndj, ptair, phumi, & ! inp 503 & pslp , pst , pu , pv, & ! inp 504 & puatm, pvatm, pqsr , pqlw , & ! inp 505 & ptsk , pssq , pcd_du, psen, pevp ) ! out 476 506 !!--------------------------------------------------------------------- 477 507 !! *** ROUTINE blk_oce_1 *** … … 498 528 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pu ! surface current at U-point (i-component) [m/s] 499 529 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pv ! surface current at V-point (j-component) [m/s] 530 REAL(wp), INTENT(in ), DIMENSION(:,:) :: puatm ! surface current seen by the atm at T-point (i-component) [m/s] 531 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pvatm ! surface current seen by the atm at T-point (j-component) [m/s] 500 532 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pqsr ! 501 533 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pqlw ! … … 508 540 INTEGER :: ji, jj ! dummy loop indices 509 541 REAL(wp) :: zztmp ! local variable 542 REAL(wp) :: zstmax, zstau 543 #if defined key_cyclone 510 544 REAL(wp), DIMENSION(jpi,jpj) :: zwnd_i, zwnd_j ! wind speed components at T-point 545 #endif 546 REAL(wp), DIMENSION(jpi,jpj) :: ztau_i, ztau_j ! wind stress components at T-point 511 547 REAL(wp), DIMENSION(jpi,jpj) :: zU_zu ! bulk wind speed at height zu [m/s] 512 548 REAL(wp), DIMENSION(jpi,jpj) :: ztpot ! potential temperature of air at z=rn_zqt [K] … … 532 568 zwnd_j(:,:) = 0._wp 533 569 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add analytical tropical cyclone (Vincent et al. JGR 2012) 534 DO_2D_00_00 535 pwndi(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 536 pwndj(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) 570 DO_2D_11_11 571 zwnd_i(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 572 zwnd_j(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) 573 ! ... scalar wind at T-point (not masked) 574 wndm(ji,jj) = SQRT( zwnd_i(ji,jj) * zwnd_i(ji,jj) + zwnd_j(ji,jj) * zwnd_j(ji,jj) ) 575 END_2D 576 #else 577 ! ... scalar wind module at T-point (not masked) 578 DO_2D_11_11 579 wndm(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 537 580 END_2D 538 581 #endif 539 DO_2D_00_00540 zwnd_i(ji,jj) = ( pwndi(ji,jj) - rn_vfac * 0.5 * ( pu(ji-1,jj ) + pu(ji,jj) ) )541 zwnd_j(ji,jj) = ( pwndj(ji,jj) - rn_vfac * 0.5 * ( pv(ji ,jj-1) + pv(ji,jj) ) )542 END_2D543 CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. )544 ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)545 wndm(:,:) = SQRT( zwnd_i(:,:) * zwnd_i(:,:) &546 & + zwnd_j(:,:) * zwnd_j(:,:) ) * tmask(:,:,1)547 548 582 ! ----------------------------------------------------------------------------- ! 549 583 ! I Solar FLUX ! … … 593 627 !#LB: because AGRIF hates functions that return something else than a scalar, need to 594 628 ! use scalar version of gamma_moist() ... 595 DO_2D_11_11 596 ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 597 END_2D 598 ENDIF 599 600 629 IF( ln_tpot ) THEN 630 DO_2D_11_11 631 ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 632 END_2D 633 ELSE 634 ztpot = ptair(:,:) 635 ENDIF 636 ENDIF 601 637 602 638 !! Time to call the user-selected bulk parameterization for … … 674 710 pevp(:,:) = pevp(:,:) * tmask(:,:,1) 675 711 676 ! Tau i and j component on T-grid points, using array "zcd_oce" as a temporary array... 677 zcd_oce = 0._wp 678 WHERE ( wndm > 0._wp ) zcd_oce = taum / wndm 679 zwnd_i = zcd_oce * zwnd_i 680 zwnd_j = zcd_oce * zwnd_j 681 682 CALL iom_put( "taum_oce", taum ) ! output wind stress module 712 DO_2D_11_11 713 IF( wndm(ji,jj) > 0._wp ) THEN 714 zztmp = taum(ji,jj) / wndm(ji,jj) 715 #if defined key_cyclone 716 ztau_i(ji,jj) = zztmp * zwnd_i(ji,jj) 717 ztau_j(ji,jj) = zztmp * zwnd_j(ji,jj) 718 #else 719 ztau_i(ji,jj) = zztmp * pwndi(ji,jj) 720 ztau_j(ji,jj) = zztmp * pwndj(ji,jj) 721 #endif 722 ELSE 723 ztau_i(ji,jj) = 0._wp 724 ztau_j(ji,jj) = 0._wp 725 ENDIF 726 END_2D 727 728 IF( ln_crt_fbk ) THEN ! aply eq. 10 and 11 of Renault et al. 2020 (doi: 10.1029/2019MS001715) 729 zstmax = MIN( rn_stau_a * 3._wp + rn_stau_b, 0._wp ) ! set the max value of Stau corresponding to a wind of 3 m/s (<0) 730 DO_2D_01_01 ! end at jpj and jpi, as ztau_j(ji,jj+1) ztau_i(ji+1,jj) used in the next loop 731 zstau = MIN( rn_stau_a * wndm(ji,jj) + rn_stau_b, zstmax ) ! stau (<0) must be smaller than zstmax 732 ztau_i(ji,jj) = ztau_i(ji,jj) + zstau * ( 0.5_wp * ( pu(ji-1,jj ) + pu(ji,jj) ) - puatm(ji,jj) ) 733 ztau_j(ji,jj) = ztau_j(ji,jj) + zstau * ( 0.5_wp * ( pv(ji ,jj-1) + pv(ji,jj) ) - pvatm(ji,jj) ) 734 taum(ji,jj) = SQRT( ztau_i(ji,jj) * ztau_i(ji,jj) + ztau_j(ji,jj) * ztau_j(ji,jj) ) 735 END_2D 736 ENDIF 683 737 684 738 ! ... utau, vtau at U- and V_points, resp. 685 739 ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 686 740 ! Note that coastal wind stress is not used in the code... so this extra care has no effect 687 DO_2D_00_00 688 utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( z wnd_i(ji,jj) + zwnd_i(ji+1,jj ) ) &689 & * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))690 vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( z wnd_j(ji,jj) + zwnd_j(ji ,jj+1) ) &691 & * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))741 DO_2D_00_00 ! start loop at 2, in case ln_crt_fbk = T 742 utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( ztau_i(ji,jj) + ztau_i(ji+1,jj ) ) & 743 & * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 744 vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( ztau_j(ji,jj) + ztau_j(ji ,jj+1) ) & 745 & * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1)) 692 746 END_2D 693 CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 747 748 IF( ln_crt_fbk ) THEN 749 CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1., taum, 'T', -1. ) 750 ELSE 751 CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 752 ENDIF 753 754 CALL iom_put( "taum_oce", taum ) ! output wind stress module 694 755 695 756 IF(sn_cfctl%l_prtctl) THEN … … 862 923 ! 863 924 INTEGER :: ji, jj ! dummy loop indices 864 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point865 925 REAL(wp) :: zootm_su ! sea-ice surface mean temperature 866 926 REAL(wp) :: zztmp1, zztmp2 ! temporary arrays … … 873 933 ! ------------------------------------------------------------ ! 874 934 ! C-grid ice dynamics : U & V-points (same as ocean) 875 DO_2D_00_00 876 zwndi_t = ( pwndi(ji,jj) - rn_vfac * 0.5_wp * ( puice(ji-1,jj ) + puice(ji,jj) ) ) 877 zwndj_t = ( pwndj(ji,jj) - rn_vfac * 0.5_wp * ( pvice(ji ,jj-1) + pvice(ji,jj) ) ) 878 wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 935 DO_2D_11_11 936 wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 879 937 END_2D 880 CALL lbc_lnk( 'sbcblk', wndm_ice, 'T', 1. )881 938 ! 882 939 ! Make ice-atm. drag dependent on ice concentration … … 898 955 899 956 IF( ln_blk ) THEN 900 ! ---------------------------------------------------- ---------!901 ! Wind stress relative to the moving ice ( U10m - U_ice) !902 ! ---------------------------------------------------- ---------!903 zztmp1 = rn_vfac * 0.5_wp957 ! ---------------------------------------------------- ! 958 ! Wind stress relative to nonmoving ice ( U10m ) ! 959 ! ---------------------------------------------------- ! 960 ! supress moving ice in wind stress computation as we don't know how to do it properly... 904 961 DO_2D_01_01 ! at T point 905 putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndi(ji,jj) - zztmp1 * ( puice(ji-1,jj ) + puice(ji,jj) ))906 pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndj(ji,jj) - zztmp1 * ( pvice(ji ,jj-1) + pvice(ji,jj) ))962 putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndi(ji,jj) 963 pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndj(ji,jj) 907 964 END_2D 908 965 ! … … 918 975 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=putaui , clinfo1=' blk_ice: putaui : ' & 919 976 & , tab2d_2=pvtaui , clinfo2=' pvtaui : ' ) 920 ELSE 977 ELSE ! ln_abl 921 978 zztmp1 = 11637800.0_wp 922 979 zztmp2 = -5897.8_wp -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbcblk_phy.F90
r12939 r13229 640 640 !! *** FUNCTION alpha_sw_vctr *** 641 641 !! 642 !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface ( P =~ 1010 hpa)642 !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (i.e. P =~ 101000 Pa) 643 643 !! 644 644 !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) … … 654 654 !! *** FUNCTION alpha_sw_sclr *** 655 655 !! 656 !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface ( P =~ 1010 hpa)656 !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (i.e. P =~ 101000 Pa) 657 657 !! 658 658 !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbcmod.F90
r13015 r13229 121 121 #endif 122 122 ! 123 ! 123 124 IF(lwp) THEN !* Control print 124 125 WRITE(numout,*) ' Namelist namsbc (partly overwritten with CPP key setting)' -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/STO/stopar.F90
r12939 r13229 56 56 INTEGER, DIMENSION(:), ALLOCATABLE :: sto3d_ord ! order of autoregressive process 57 57 58 CHARACTER(len= 1), DIMENSION(:), ALLOCATABLE :: sto2d_typ ! nature of grid point (T, U, V, W, F, I)59 CHARACTER(len= 1), DIMENSION(:), ALLOCATABLE :: sto3d_typ ! nature of grid point (T, U, V, W, F, I)58 CHARACTER(len=lca), DIMENSION(:), ALLOCATABLE :: sto2d_typ ! nature of grid point (T, U, V, W, F, I) 59 CHARACTER(len=lca), DIMENSION(:), ALLOCATABLE :: sto3d_typ ! nature of grid point (T, U, V, W, F, I) 60 60 REAL(wp), DIMENSION(:), ALLOCATABLE :: sto2d_sgn ! control of the sign accross the north fold 61 61 REAL(wp), DIMENSION(:), ALLOCATABLE :: sto3d_sgn ! control of the sign accross the north fold -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traqsr.F90
r12738 r13229 110 110 REAL(wp) :: zc0 , zc1 , zc2 , zc3 ! - - 111 111 REAL(wp) :: zzc0, zzc1, zzc2, zzc3 ! - - 112 REAL(wp) :: zz0 , zz1 ! - - 113 REAL(wp) :: zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 114 REAL(wp) :: zlogc, zlogc2, zlogc3 115 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zekb, zekg, zekr 116 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 117 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d 112 REAL(wp) :: zz0 , zz1 , ze3t, zlui ! - - 113 REAL(wp) :: zCb, zCmax, zpsi, zpsimax, zrdpsi, zCze 114 REAL(wp) :: zlogc, zlogze, zlogCtot, zlogCze 115 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ze0, ze1, ze2, ze3 116 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, zetot, ztmp3d 118 117 !!---------------------------------------------------------------------- 119 118 ! … … 160 159 CASE( np_RGB , np_RGBc ) !== R-G-B fluxes ==! 161 160 ! 162 ALLOCATE( ze kb(jpi,jpj) , zekg(jpi,jpj) , zekr (jpi,jpj) ,&163 & ze 0 (jpi,jpj,jpk) , ze1 (jpi,jpj,jpk) , ze2 (jpi,jpj,jpk) ,&164 & z e3 (jpi,jpj,jpk) , zea (jpi,jpj,jpk) , zchl3d(jpi,jpj,jpk) )161 ALLOCATE( ze0 (jpi,jpj) , ze1 (jpi,jpj) , & 162 & ze2 (jpi,jpj) , ze3 (jpi,jpj) , & 163 & ztmp3d(jpi,jpj,nksr + 1) ) 165 164 ! 166 165 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll 167 166 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 167 ! 168 ! Separation in R-G-B depending on the surface Chl 169 ! perform and store as many of the 2D calculations as possible 170 ! before the 3D loop (use the temporary 2D arrays to replace the 171 ! most expensive calculations) 172 ! 173 DO_2D_00_00 174 ! zlogc = log(zchl) 175 zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) ) 176 ! zc1 : log(zCze) = log (1.12 * zchl**0.803) 177 zc1 = 0.113328685307 + 0.803 * zlogc 178 ! zc2 : log(zCtot) = log(40.6 * zchl**0.459) 179 zc2 = 3.703768066608 + 0.459 * zlogc 180 ! zc3 : log(zze) = log(568.2 * zCtot**(-0.746)) 181 zc3 = 6.34247346942 - 0.746 * zc2 182 ! IF( log(zze) > log(102.) ) log(zze) = log(200.0 * zCtot**(-0.293)) 183 IF( zc3 > 4.62497281328 ) zc3 = 5.298317366548 - 0.293 * zc2 184 ! 185 ze0(ji,jj) = zlogc ! ze0 = log(zchl) 186 ze1(ji,jj) = EXP( zc1 ) ! ze1 = zCze 187 ze2(ji,jj) = 1._wp / ( 0.710 + zlogc * ( 0.159 + zlogc * 0.021 ) ) ! ze2 = 1/zdelpsi 188 ze3(ji,jj) = EXP( - zc3 ) ! ze3 = 1/zze 189 END_2D 190 191 ! 192 DO_3D_00_00 ( 1, nksr + 1 ) 193 ! zchl = ALOG( ze0(ji,jj) ) 194 zlogc = ze0(ji,jj) 195 ! 196 zCb = 0.768 + zlogc * ( 0.087 - zlogc * ( 0.179 + zlogc * 0.025 ) ) 197 zCmax = 0.299 - zlogc * ( 0.289 - zlogc * 0.579 ) 198 zpsimax = 0.6 - zlogc * ( 0.640 - zlogc * ( 0.021 + zlogc * 0.115 ) ) 199 ! zdelpsi = 0.710 + zlogc * ( 0.159 + zlogc * 0.021 ) 200 ! 201 zCze = ze1(ji,jj) 202 zrdpsi = ze2(ji,jj) ! 1/zdelpsi 203 zpsi = ze3(ji,jj) * gdepw(ji,jj,jk,Kmm) ! gdepw/zze 204 ! 205 ! NB. make sure zchl value is such that: zchl = MIN( 10. , MAX( 0.03, zchl ) ) 206 zchl = MIN( 10. , MAX( 0.03, zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) * zrdpsi )**2 ) ) ) ) 207 ! Convert chlorophyll value to attenuation coefficient look-up table index 208 ztmp3d(ji,jj,jk) = 41 + 20.*LOG10(zchl) + 1.e-15 209 END_3D 210 ELSE !* constant chlorophyll 211 zchl = 0.05 212 ! NB. make sure constant value is such that: 213 zchl = MIN( 10. , MAX( 0.03, zchl ) ) 214 ! Convert chlorophyll value to attenuation coefficient look-up table index 215 zlui = 41 + 20.*LOG10(zchl) + 1.e-15 168 216 DO jk = 1, nksr + 1 169 DO jj = 2, jpjm1 ! Separation in R-G-B depending of the surface Chl 170 DO ji = 2, jpim1 171 zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 172 zCtot = 40.6 * zchl**0.459 173 zze = 568.2 * zCtot**(-0.746) 174 IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293) 175 zpsi = gdepw(ji,jj,jk,Kmm) / zze 176 ! 177 zlogc = LOG( zchl ) 178 zlogc2 = zlogc * zlogc 179 zlogc3 = zlogc * zlogc * zlogc 180 zCb = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3 181 zCmax = 0.299 - 0.289 * zlogc + 0.579 * zlogc2 182 zpsimax = 0.6 - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3 183 zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2 184 zCze = 1.12 * (zchl)**0.803 185 ! 186 zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) ) 187 END DO 188 ! 189 END DO 217 ztmp3d(:,:,jk) = zlui 190 218 END DO 191 ELSE !* constant chrlorophyll192 DO jk = 1, nksr + 1193 zchl3d(:,:,jk) = 0.05194 ENDDO195 219 ENDIF 196 220 ! 197 221 zcoef = ( 1. - rn_abs ) / 3._wp !* surface equi-partition in R-G-B 198 222 DO_2D_00_00 199 ze0(ji,jj,1) = rn_abs * qsr(ji,jj) 200 ze1(ji,jj,1) = zcoef * qsr(ji,jj) 201 ze2(ji,jj,1) = zcoef * qsr(ji,jj) 202 ze3(ji,jj,1) = zcoef * qsr(ji,jj) 203 zea(ji,jj,1) = qsr(ji,jj) 223 ze0(ji,jj) = rn_abs * qsr(ji,jj) 224 ze1(ji,jj) = zcoef * qsr(ji,jj) 225 ze2(ji,jj) = zcoef * qsr(ji,jj) 226 ze3(ji,jj) = zcoef * qsr(ji,jj) 227 ! store the surface SW radiation; re-use the surface ztmp3d array 228 ! since the surface attenuation coefficient is not used 229 ztmp3d(ji,jj,1) = qsr(ji,jj) 204 230 END_2D 205 231 ! 206 DO jk = 2, nksr+1 !* interior equi-partition in R-G-B depending of vertical profile of Chl 207 DO_2D_00_00 208 zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) ) 209 irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 210 zekb(ji,jj) = rkrgb(1,irgb) 211 zekg(ji,jj) = rkrgb(2,irgb) 212 zekr(ji,jj) = rkrgb(3,irgb) 213 END_2D 214 215 DO_2D_00_00 216 zc0 = ze0(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * xsi0r ) 217 zc1 = ze1(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekb(ji,jj) ) 218 zc2 = ze2(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekg(ji,jj) ) 219 zc3 = ze3(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekr(ji,jj) ) 220 ze0(ji,jj,jk) = zc0 221 ze1(ji,jj,jk) = zc1 222 ze2(ji,jj,jk) = zc2 223 ze3(ji,jj,jk) = zc3 224 zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk) 225 END_2D 226 END DO 232 !* interior equi-partition in R-G-B depending on vertical profile of Chl 233 DO_3D_00_00 ( 2, nksr + 1 ) 234 ze3t = e3t(ji,jj,jk-1,Kmm) 235 irgb = NINT( ztmp3d(ji,jj,jk) ) 236 zc0 = ze0(ji,jj) * EXP( - ze3t * xsi0r ) 237 zc1 = ze1(ji,jj) * EXP( - ze3t * rkrgb(1,irgb) ) 238 zc2 = ze2(ji,jj) * EXP( - ze3t * rkrgb(2,irgb) ) 239 zc3 = ze3(ji,jj) * EXP( - ze3t * rkrgb(3,irgb) ) 240 ze0(ji,jj) = zc0 241 ze1(ji,jj) = zc1 242 ze2(ji,jj) = zc2 243 ze3(ji,jj) = zc3 244 ztmp3d(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk) 245 END_3D 227 246 ! 228 247 DO_3D_00_00( 1, nksr ) 229 qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( z ea(ji,jj,jk) - zea(ji,jj,jk+1) )248 qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) ) 230 249 END_3D 231 250 ! 232 DEALLOCATE( ze kb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d )251 DEALLOCATE( ze0 , ze1 , ze2 , ze3 , ztmp3d ) 233 252 ! 234 253 CASE( np_2BD ) !== 2-bands fluxes ==! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_hgr.F90
r13176 r13229 95 95 #if defined key_agrif 96 96 ! ! Upper left longitude and latitude from parent: 97 ! Laurent: Should be modify in case of an east-west cyclic parent grid 97 98 IF (.NOT.Agrif_root()) THEN 98 99 zlam0 = zlam1 + Agrif_irhox() * REAL(Agrif_Parent(Ni0glo) -2, wp) * ze1deg * zcos_alpha & -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_nam.F90
r13065 r13229 73 73 #if defined key_agrif 74 74 IF( .NOT. Agrif_Root() ) THEN 75 kpi = nbcellsx + 2 * ( nbghostcells + 1 ) ! Global Domain size: add nbghostcells + 1 "land" point on each side76 kpj = nbcellsy + 2 * ( nbghostcells + 1 )75 kpi = nbcellsx + 2 * ( nbghostcells_x + 1 ) ! Global Domain size: add nbghostcells + 1 "land" point on each side 76 kpj = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 77 77 ENDIF 78 78 #endif -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/nemogcm.F90
r13176 r13229 145 145 #if defined key_agrif 146 146 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 147 CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM 148 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 147 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 149 148 # if defined key_top 150 149 CALL Agrif_Declare_Var_top ! " " " " " TOP 151 # endif152 # if defined key_si3153 CALL Agrif_Declare_Var_ice ! " " " " " Sea ice154 150 # endif 155 151 #endif … … 402 398 ! Initialise time level indices 403 399 Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 404 400 #if defined key_agrif 401 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 402 #endif 405 403 ! !-------------------------------! 406 404 ! ! NEMO general initialization ! … … 417 415 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 418 416 CALL wad_init ! Wetting and drying options 417 418 #if defined key_agrif 419 CALL Agrif_Declare_Var_ini ! " " " " " DOM 420 #endif 419 421 CALL dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 422 423 424 420 425 IF( ln_crs ) CALL crs_init( Nnn ) ! coarsened grid: domain initialization 421 426 IF( sn_cfctl%l_prtctl ) & … … 438 443 ENDIF 439 444 ! 440 445 441 446 CALL istate_init( Nbb, Nnn, Naa ) ! ocean initial state (Dynamics and tracers) 442 447 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/par_kind.F90
r10068 r13229 31 31 32 32 ! !!** Integer ** 33 INTEGER, PUBLIC, PARAMETER :: lc = 256 !: Lenght of Character strings 33 INTEGER, PUBLIC, PARAMETER :: lc = 256 !: Lenght of Character strings 34 INTEGER, PUBLIC, PARAMETER :: lca = 400 !: Lenght of Character arrays 34 35 35 36 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/par_oce.F90
r13065 r13229 47 47 ! global domain size for AGRIF !!! * total AGRIF computational domain * 48 48 INTEGER, PUBLIC :: nbug_in_agrif_conv_do_not_remove_or_modify = 1 - 1 49 INTEGER, PUBLIC, PARAMETER :: nbghostcells = 3 !: number of ghost cells 50 INTEGER, PUBLIC :: nbcellsx ! = jpiglo - 2 * (nbghostcells + 1 + nn_hls) !: number of cells in i-direction 51 INTEGER, PUBLIC :: nbcellsy ! = jpjglo - 2 * (nbghostcells + 1 + nn_hls) !: number of cells in j-direction 49 INTEGER, PUBLIC, PARAMETER :: nbghostcells = 3 !: number of ghost cells: default value 50 INTEGER, PUBLIC :: nbghostcells_x !: number of ghost cells in i-direction 51 INTEGER, PUBLIC :: nbghostcells_y_s !: number of ghost cells in j-direction at south 52 INTEGER, PUBLIC :: nbghostcells_y_n !: number of ghost cells in j-direction at north !: number of ghost cells 53 INTEGER, PUBLIC :: nbcellsx ! = jpiglo - 2 - 2*nbghostcells_x !: number of cells in i-direction 54 INTEGER, PUBLIC :: nbcellsy ! = jpjglo - 2 - 2*nbghostcells-y !: number of cells in j-direction 52 55 53 56 ! local domain size !!! * local computational domain * -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/stpctl.F90
r13186 r13229 119 119 ! !== test of local extrema ==! 120 120 ! !== done by all processes at every time step ==! 121 !122 ! define zmax default value. needed for land processors123 IF( ll_colruns ) THEN ! default value: must not be kept when calling mpp_max -> must be as small as possible124 zmax(:) = -HUGE(1._wp)125 ELSE ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...)126 zmax(:) = 0._wp127 zmax(3) = -1._wp ! avoid salinity minimum at 0.128 ENDIF129 !130 121 llmsk(:,:,1) = ssmask(:,:) == 1._wp 131 IF( COUNT( llmsk(:,:,1) ) > 0 ) THEN ! avoid huge values sent back for land processors... 132 IF( ll_wd ) THEN 133 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) ) ! ssh max 122 IF( ll_wd ) THEN 123 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) ) ! ssh max 124 ELSE 125 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ), mask = llmsk(:,:,1) ) ! ssh max 126 ENDIF 127 llmsk(:,:,:) = umask(:,:,:) == 1._wp 128 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ), mask = llmsk ) ! velocity max (zonal only) 129 llmsk(:,:,:) = tmask(:,:,:) == 1._wp 130 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! minus salinity max 131 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! salinity max 132 IF( ll_colruns .OR. jpnij == 1 ) THEN ! following variables are used only in the netcdf file 133 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! minus temperature max 134 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! temperature max 135 IF( ln_zad_Aimp ) THEN 136 zmax(7) = MAXVAL( Cu_adv(:,:,:) , mask = llmsk ) ! partitioning coeff. max 137 llmsk(:,:,:) = wmask(:,:,:) == 1._wp 138 zmax(8) = MAXVAL( ABS( wi(:,:,:) ) , mask = llmsk ) ! implicit vertical vel. max 134 139 ELSE 135 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ), mask = llmsk(:,:,1) ) ! ssh max 136 ENDIF 137 ENDIF 138 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) ) ! velocity max (zonal only) 139 llmsk(:,:,:) = tmask(:,:,:) == 1._wp 140 IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 141 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! minus salinity max 142 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! salinity max 143 IF( ll_colruns .OR. jpnij == 1 ) THEN ! following variables are used only in the netcdf file 144 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! minus temperature max 145 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! temperature max 146 IF( ln_zad_Aimp ) THEN 147 zmax(7) = MAXVAL( Cu_adv(:,:,:) , mask = llmsk ) ! partitioning coeff. max 148 llmsk(:,:,:) = wmask(:,:,:) == 1._wp 149 IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 150 zmax(8) = MAXVAL(ABS( wi(:,:,:) ), mask = llmsk ) ! implicit vertical vel. max 151 ENDIF 152 ENDIF 153 ENDIF 140 zmax(7:8) = 0._wp 141 ENDIF 142 ELSE 143 zmax(5:8) = 0._wp 154 144 ENDIF 155 145 zmax(9) = REAL( nstop, wp ) ! stop indicator -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/SAS/nemogcm.F90
r13176 r13229 93 93 #if defined key_agrif 94 94 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 95 CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM96 95 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 97 96 # if defined key_top 98 97 CALL Agrif_Declare_Var_top ! " " " " " TOP 99 # endif100 # if defined key_si3101 CALL Agrif_Declare_Var_ice ! " " " " " Sea ice102 98 # endif 103 99 #endif … … 348 344 ! Initialise time level indices 349 345 Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 346 #if defined key_agrif 347 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 348 #endif 350 349 351 350 ! !-------------------------------! … … 361 360 CALL phy_cst ! Physical constants 362 361 CALL eos_init ! Equation of seawater 362 #if defined key_agrif 363 CALL Agrif_Declare_Var_ini ! " " " " " DOM 364 #endif 363 365 CALL dom_init( Nbb, Nnn, Naa, 'SAS') ! Domain 364 366 IF( sn_cfctl%l_prtctl ) & -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/CANAL/MY_SRC/stpctl.F90
r13186 r13229 119 119 ! !== test of local extrema ==! 120 120 ! !== done by all processes at every time step ==! 121 !122 ! define zmax default value. needed for land processors123 IF( ll_colruns ) THEN ! default value: must not be kept when calling mpp_max -> must be as small as possible124 zmax(:) = -HUGE(1._wp)125 ELSE ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...)126 zmax(:) = 0._wp127 zmax(3) = -1._wp ! avoid salinity minimum at 0.128 ENDIF129 !130 121 llmsk(:,:,1) = ssmask(:,:) == 1._wp 131 IF( COUNT( llmsk(:,:,1) ) > 0 ) THEN ! avoid huge values sent back for land processors... 132 IF( ll_wd ) THEN 133 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) ) ! ssh max 122 IF( ll_wd ) THEN 123 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) ) ! ssh max 124 ELSE 125 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ), mask = llmsk(:,:,1) ) ! ssh max 126 ENDIF 127 llmsk(:,:,:) = umask(:,:,:) == 1._wp 128 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ), mask = llmsk ) ! velocity max (zonal only) 129 llmsk(:,:,:) = tmask(:,:,:) == 1._wp 130 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! minus salinity max 131 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! salinity max 132 IF( ll_colruns .OR. jpnij == 1 ) THEN ! following variables are used only in the netcdf file 133 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! minus temperature max 134 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! temperature max 135 IF( ln_zad_Aimp ) THEN 136 zmax(7) = MAXVAL( Cu_adv(:,:,:) , mask = llmsk ) ! partitioning coeff. max 137 llmsk(:,:,:) = wmask(:,:,:) == 1._wp 138 zmax(8) = MAXVAL( ABS( wi(:,:,:) ) , mask = llmsk ) ! implicit vertical vel. max 134 139 ELSE 135 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ), mask = llmsk(:,:,1) ) ! ssh max 136 ENDIF 137 ENDIF 138 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) ) ! velocity max (zonal only) 139 llmsk(:,:,:) = tmask(:,:,:) == 1._wp 140 IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 141 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! minus salinity max 142 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! salinity max 143 IF( ll_colruns .OR. jpnij == 1 ) THEN ! following variables are used only in the netcdf file 144 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! minus temperature max 145 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! temperature max 146 IF( ln_zad_Aimp ) THEN 147 zmax(7) = MAXVAL( Cu_adv(:,:,:) , mask = llmsk ) ! partitioning coeff. max 148 llmsk(:,:,:) = wmask(:,:,:) == 1._wp 149 IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 150 zmax(8) = MAXVAL(ABS( wi(:,:,:) ), mask = llmsk ) ! implicit vertical vel. max 151 ENDIF 152 ENDIF 153 ENDIF 140 zmax(7:8) = 0._wp 141 ENDIF 142 ELSE 143 zmax(5:8) = 0._wp 154 144 ENDIF 155 145 zmax(9) = REAL( nstop, wp ) ! stop indicator -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/README.rst
r11743 r13229 205 205 :style: unsrt 206 206 :labelprefix: T 207 208 CPL_OASIS 209 --------- 210 | This test case checks the OASIS interface in OCE/SBC, allowing to set up 211 a coupled configuration through OASIS. See CPL_OASIS/README.md for more information. -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/STATION_ASF/EXPREF/launch_sasf.sh
r13186 r13229 1 1 #!/bin/bash 2 2 3 ################################################################ 4 # 5 # Script to launch a set of STATION_ASF simulations 6 # 7 # L. Brodeau, 2020 8 # 9 ################################################################ 3 # NEMO directory where to fetch compiled STATION_ASF nemo.exe + setup: 4 NEMO_DIR=`pwd | sed -e "s|/tests/STATION_ASF/EXPREF||g"` 10 5 11 # What directory inside "tests" actually contains the compiled "nemo.exe" for STATION_ASF ? 6 echo "Using NEMO_DIR=${NEMO_DIR}" 7 8 # what directory inside "tests" actually contains the compiled test-case? 12 9 TC_DIR="STATION_ASF2" 13 10 14 # DATA_IN_DIR => Directory containing sea-surface + atmospheric forcings 11 # => so the executable to use is: 12 NEMO_EXE="${NEMO_DIR}/tests/${TC_DIR}/BLD/bin/nemo.exe" 13 14 # Directory where to run the simulation: 15 WORK_DIR="${HOME}/tmp/STATION_ASF" 16 17 18 # FORC_DIR => Directory containing sea-surface + atmospheric forcings 15 19 # (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/): 16 20 if [ `hostname` = "merlat" ]; then 17 DATA_IN_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018"21 FORC_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 18 22 elif [ `hostname` = "luitel" ]; then 19 DATA_IN_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018"23 FORC_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018" 20 24 elif [ `hostname` = "ige-meom-cal1" ]; then 21 DATA_IN_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018"25 FORC_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018" 22 26 elif [ `hostname` = "salvelinus" ]; then 23 DATA_IN_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018"27 FORC_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 24 28 else 25 echo " Oops! We don't know `hostname` yet! Define 'DATA_IN_DIR' in the script!"; exit29 echo "Boo!"; exit 26 30 fi 27 28 expdir=`basename ${PWD}`; # we expect "EXPREF" or "EXP00" normally... 29 30 # NEMOGCM root directory where to fetch compiled STATION_ASF nemo.exe + setup: 31 NEMO_WRK_DIR=`pwd | sed -e "s|/tests/STATION_ASF/${expdir}||g"` 32 33 # Directory where to run the simulation: 34 PROD_DIR="${HOME}/tmp/STATION_ASF" 31 #====================== 32 mkdir -p ${WORK_DIR} 35 33 36 34 37 ####### End of normal user configurable section ####### 35 if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled nemo.exe found into ${NEMO_DIR}/tests/STATION_ASF/BLD/bin !"; exit; fi 38 36 39 #================================================================================ 40 41 # NEMO executable to use is: 42 NEMO_EXE="${NEMO_WRK_DIR}/tests/${TC_DIR}/BLD/bin/nemo.exe" 43 44 45 echo "###########################################################" 46 echo "# S T A T I O N A i r - S e a F l u x #" 47 echo "###########################################################" 48 echo 49 echo " We shall work in here: ${STATION_ASF_DIR}/" 50 echo " NEMOGCM work depository is: ${NEMO_WRK_DIR}/" 51 echo " ==> NEMO EXE to use: ${NEMO_EXE}" 52 echo " Input forcing data into: ${DATA_IN_DIR}/" 53 echo " Production will be done into: ${PROD_DIR}/" 54 echo 55 56 mkdir -p ${PROD_DIR} 57 58 if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled 'nemo.exe' found into `dirname ${NEMO_EXE}` !"; exit; fi 59 60 echo 61 echo " *** Using the following NEMO executable:" 62 echo " ${NEMO_EXE} " 63 echo 64 65 NEMO_EXPREF="${NEMO_WRK_DIR}/tests/STATION_ASF/EXPREF" 37 NEMO_EXPREF="${NEMO_DIR}/tests/STATION_ASF/EXPREF" 66 38 if [ ! -d ${NEMO_EXPREF} ]; then echo " Mhhh, no EXPREF directory ${NEMO_EXPREF} !"; exit; fi 67 39 68 rsync -avP ${NEMO_EXE} ${ PROD_DIR}/40 rsync -avP ${NEMO_EXE} ${WORK_DIR}/ 69 41 70 42 for ff in "context_nemo.xml" "domain_def_nemo.xml" "field_def_nemo-oce.xml" "file_def_nemo-oce.xml" "grid_def_nemo.xml" "iodef.xml" "namelist_ref"; do 71 43 if [ ! -f ${NEMO_EXPREF}/${ff} ]; then echo " Mhhh, ${ff} not found into ${NEMO_EXPREF} !"; exit; fi 72 rsync -avPL ${NEMO_EXPREF}/${ff} ${ PROD_DIR}/44 rsync -avPL ${NEMO_EXPREF}/${ff} ${WORK_DIR}/ 73 45 done 74 46 75 47 # Copy forcing to work directory: 76 rsync -avP ${ DATA_IN_DIR}/Station_PAPA_50N-145W*.nc ${PROD_DIR}/48 rsync -avP ${FORC_DIR}/Station_PAPA_50N-145W*.nc ${WORK_DIR}/ 77 49 78 50 for CASE in "ECMWF" "COARE3p6" "NCAR" "ECMWF-noskin" "COARE3p6-noskin"; do … … 86 58 scase=`echo "${CASE}" | tr '[:upper:]' '[:lower:]'` 87 59 88 rm -f ${ PROD_DIR}/namelist_cfg89 rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${ PROD_DIR}/namelist_cfg60 rm -f ${WORK_DIR}/namelist_cfg 61 rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${WORK_DIR}/namelist_cfg 90 62 91 cd ${ PROD_DIR}/63 cd ${WORK_DIR}/ 92 64 echo 93 65 echo "Launching NEMO !" -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/VORTEX/EXPREF/1_namelist_cfg
r12489 r13229 98 98 &namagrif ! AGRIF zoom ("key_agrif") 99 99 !----------------------------------------------------------------------- 100 ln_spc_dyn = .true. ! use 0 as special value for dynamics 101 rn_sponge_tra = 800. ! coefficient for tracer sponge layer [m2/s] 102 rn_sponge_dyn = 800. ! coefficient for dynamics sponge layer [m2/s] 103 ln_chk_bathy = .FALSE. ! 100 rn_sponge_tra = 0.00768 ! coefficient for tracer sponge layer [] 101 rn_sponge_dyn = 0.00768 ! coefficient for dynamics sponge layer [] 104 102 / 105 103 !!====================================================================== -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/demo_cfgs.txt
r12377 r13229 11 11 BENCH OCE ICE TOP 12 12 STATION_ASF OCE 13 CPL_OASIS OCE TOP ICE NST
Note: See TracChangeset
for help on using the changeset viewer.