Changeset 14021
- Timestamp:
- 2020-12-02T20:53:00+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice
- Files:
-
- 50 added
- 63 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg
r13558 r14021 90 90 ! ! =2 annual global mean of e-p-r set to zero 91 91 ln_wave = .false. ! Activate coupling with wave (T => fill namsbc_wave) 92 ln_cdgw = .false. ! Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave)93 ln_sdw = .false. ! Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave)94 nn_sdrift = 0 ! Parameterization for the calculation of 3D-Stokes drift from the surface Stokes drift95 ! ! = 0 Breivik 2015 parameterization: v_z=v_0*[exp(2*k*z)/(1-8*k*z)]96 ! ! = 1 Phillips: v_z=v_o*[exp(2*k*z)-beta*sqrt(-2*k*pi*z)*erfc(sqrt(-2*k*z))]97 ! ! = 2 Phillips as (1) but using the wave frequency from a wave model98 ln_tauwoc = .false. ! Activate ocean stress modified by external wave induced stress (T => ln_wave=.true. & fill namsbc_wave)99 ln_tauw = .false. ! Activate ocean stress components from wave model100 ln_stcor = .false. ! Activate Stokes Coriolis term (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave)101 92 / 102 93 !----------------------------------------------------------------------- … … 167 158 &namsbc_wave ! External fields from wave model (ln_wave=T) 168 159 !----------------------------------------------------------------------- 160 ln_sdw = .false. ! get the 2D Surf Stokes Drift & Compute the 3D stokes drift 161 ln_stcor = .false. ! add Stokes Coriolis and tracer advection terms 162 ln_cdgw = .false. ! Neutral drag coefficient read from wave model 163 ln_tauoc = .false. ! ocean stress is modified by wave induced stress 164 ln_wave_test= .false. ! Test case with constant wave fields 165 ! 166 ln_charn = .false. ! Charnock coefficient read from wave model (IFS only) 167 ln_taw = .false. ! ocean stress is modified by wave induced stress (coupled mode) 168 ln_phioc = .false. ! TKE flux from wave model 169 ln_bern_srfc= .false. ! wave induced pressure. Bernoulli head J term 170 ln_breivikFV_2016 = .false. ! breivik 2016 vertical stokes profile 171 ln_vortex_force = .false. 172 ! 173 cn_dir = './' ! root directory for the waves data location 174 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 175 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 176 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename ! 177 sn_cdg = 'sdw_ecwaves_orca2' , 6. , 'drag_coeff' , .true. , .true. , 'yearly' , '' , '' , '' 178 sn_usd = 'sdw_ecwaves_orca2' , 6. , 'u_sd2d' , .true. , .true. , 'yearly' , '' , '' , '' 179 sn_vsd = 'sdw_ecwaves_orca2' , 6. , 'v_sd2d' , .true. , .true. , 'yearly' , '' , '' , '' 180 sn_hsw = 'sdw_ecwaves_orca2' , 6. , 'hs' , .true. , .true. , 'yearly' , '' , '' , '' 181 sn_wmp = 'sdw_ecwaves_orca2' , 6. , 'wmp' , .true. , .true. , 'yearly' , '' , '' , '' 182 sn_wnum = 'sdw_ecwaves_orca2' , 6. , 'wave_num' , .true. , .true. , 'yearly' , '' , '' , '' 169 183 / 170 184 !----------------------------------------------------------------------- … … 378 392 ! = 2 add a tke source just at the base of the ML 379 393 ! = 3 as = 1 applied on HF part of the stress (ln_cpl=T) 394 ln_mxhsw = .false. ! surface mixing length scale = F(wave height) 380 395 / 381 396 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/axis_def_nemo.xml
r12377 r14021 1 1 <!-- 2 ============================================================================================================3 = Axis definition = = DO NOT CHANGE =4 ============================================================================================================5 2 ============================================================================================================ 3 = Axis definition = = DO NOT CHANGE = 4 ============================================================================================================ 5 --> 6 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 7 <axis_definition> 8 <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" /> 9 <!-- Vertical zoom for a 31-levels ORCA2 grid for eORCA1 300m corresponds to n=35 --> 10 <axis id="deptht300" axis_ref="deptht" > 11 <zoom_axis begin="0" n="19" /> 12 </axis> 13 <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" /> 14 <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" /> 15 <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" /> 16 <axis id="nfloat" long_name="Float number" unit="-" /> 17 <axis id="icbcla" long_name="Iceberg class" unit="1" /> 18 <axis id="ncatice" long_name="Ice category" unit="1" /> 19 <axis id="iax_20C" long_name="20 degC isotherm" unit="degC" /> 20 <axis id="iax_26C" long_name="26 degC isotherm" unit="degC" /> 21 <axis id="iax_28C" long_name="28 degC isotherm" unit="degC" /> 22 <axis id="basin" long_name="Sub-basin mask (1=Global 2=Atlantic 3=Indo-Pacific 4=Indian, 5=Pacific)" unit="1" /> 23 <axis id="nstrait" long_name="Number of straits" unit="1" /> 24 <!-- ABL vertical axis definition --> 25 <axis id="ght_abl" long_name="ABL Vertical T levels" unit="m" positive="up" /> 26 <axis id="ghw_abl" long_name="ABL Vertical W levels" unit="m" positive="up" /> 27 <axis id="section" n_glo="16" /> 28 <axis id="section_ice" n_glo="4" /> 29 <axis id="gau" /> 30 </axis_definition> -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/domain_def_nemo.xml
r12276 r14021 1 1 2 2 <domain_definition> 3 3 4 <!-- T grid --> 5 <domain id="grid_T" long_name="grid T"/> 6 7 <!-- My zoom: example of hand defined zoom --> 8 <domain id="myzoomT" domain_ref="grid_T" > 9 <zoom_domain ibegin="1" jbegin="1" ni="2" nj="3"/> 10 </domain> 4 <!-- T grid --> 5 <domain id="grid_T" long_name="grid T"/> 11 6 12 <domain id="1point" domain_ref="grid_T" > 13 <zoom_domain ibegin="139" jbegin="119" ni="1" nj="1"/> 14 </domain> 7 <!-- My zoom: example of hand defined zoom --> 8 <domain id="myzoomT" domain_ref="grid_T" > 9 <zoom_domain ibegin="1" jbegin="1" ni="2" nj="3"/> 10 </domain> 11 12 <domain id="1point" domain_ref="grid_T" > 13 <zoom_domain ibegin="139" jbegin="119" ni="1" nj="1"/> 14 </domain> 15 15 16 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 17 <!-- Eq section --> 18 <domain id="EqT" domain_ref="grid_T" > <zoom_domain id="EqT"/> </domain> 19 <!-- TAO : see example above --> 20 <!-- 137e --> 21 <domain id="2n137eT" domain_ref="grid_T" > <zoom_domain id="2n137eT"/> </domain> 22 <domain id="5n137eT" domain_ref="grid_T" > <zoom_domain id="5n137eT"/> </domain> 23 <domain id="8n137eT" domain_ref="grid_T" > <zoom_domain id="8n137eT"/> </domain> 24 <!-- <\!-- 147e -\-> --> 25 <domain id="0n147eT" domain_ref="grid_T" > <zoom_domain id="0n147eT"/> </domain> 26 <domain id="2n147eT" domain_ref="grid_T" > <zoom_domain id="2n147eT"/> </domain> 27 <domain id="5n147eT" domain_ref="grid_T" > <zoom_domain id="5n147eT"/> </domain> 28 <!-- <\!-- 156e -\-> --> 29 <domain id="5s156eT" domain_ref="grid_T" > <zoom_domain id="5s156eT"/> </domain> 30 <domain id="2s156eT" domain_ref="grid_T" > <zoom_domain id="2s156eT"/> </domain> 31 <domain id="0n156eT" domain_ref="grid_T" > <zoom_domain id="0n156eT"/> </domain> 32 <domain id="2n156eT" domain_ref="grid_T" > <zoom_domain id="2n156eT"/> </domain> 33 <domain id="5n156eT" domain_ref="grid_T" > <zoom_domain id="5n156eT"/> </domain> 34 <domain id="8n156eT" domain_ref="grid_T" > <zoom_domain id="8n156eT"/> </domain> 35 <!-- <\!-- 165e -\-> --> 36 <domain id="8s165eT" domain_ref="grid_T" > <zoom_domain id="8s165eT"/> </domain> 37 <domain id="5s165eT" domain_ref="grid_T" > <zoom_domain id="5s165eT"/> </domain> 38 <domain id="2s165eT" domain_ref="grid_T" > <zoom_domain id="2s165eT"/> </domain> 39 <domain id="0n165eT" domain_ref="grid_T" > <zoom_domain id="0n165eT"/> </domain> 40 <domain id="2n165eT" domain_ref="grid_T" > <zoom_domain id="2n165eT"/> </domain> 41 <domain id="5n165eT" domain_ref="grid_T" > <zoom_domain id="5n165eT"/> </domain> 42 <domain id="8n165eT" domain_ref="grid_T" > <zoom_domain id="8n165eT"/> </domain> 43 <!-- <\!-- 180w -\-> --> 44 <domain id="8s180wT" domain_ref="grid_T" > <zoom_domain id="8s180wT"/> </domain> 45 <domain id="5s180wT" domain_ref="grid_T" > <zoom_domain id="5s180wT"/> </domain> 46 <domain id="2s180wT" domain_ref="grid_T" > <zoom_domain id="2s180wT"/> </domain> 47 <domain id="0n180wT" domain_ref="grid_T" > <zoom_domain id="0n180wT"/> </domain> 48 <domain id="2n180wT" domain_ref="grid_T" > <zoom_domain id="2n180wT"/> </domain> 49 <domain id="5n180wT" domain_ref="grid_T" > <zoom_domain id="5n180wT"/> </domain> 50 <domain id="8n180wT" domain_ref="grid_T" > <zoom_domain id="8n180wT"/> </domain> 51 <!-- <\!-- 170w -\-> --> 52 <domain id="8s170wT" domain_ref="grid_T" > <zoom_domain id="8s170wT"/> </domain> 53 <domain id="5s170wT" domain_ref="grid_T" > <zoom_domain id="5s170wT"/> </domain> 54 <domain id="2s170wT" domain_ref="grid_T" > <zoom_domain id="2s170wT"/> </domain> 55 <domain id="0n170wT" domain_ref="grid_T" > <zoom_domain id="0n170wT"/> </domain> 56 <domain id="2n170wT" domain_ref="grid_T" > <zoom_domain id="2n170wT"/> </domain> 57 <domain id="5n170wT" domain_ref="grid_T" > <zoom_domain id="5n170wT"/> </domain> 58 <domain id="8n170wT" domain_ref="grid_T" > <zoom_domain id="8n170wT"/> </domain> 59 <!-- <\!-- 155w -\-> --> 60 <domain id="8s155wT" domain_ref="grid_T" > <zoom_domain id="8s155wT"/> </domain> 61 <domain id="5s155wT" domain_ref="grid_T" > <zoom_domain id="5s155wT"/> </domain> 62 <domain id="2s155wT" domain_ref="grid_T" > <zoom_domain id="2s155wT"/> </domain> 63 <domain id="0n155wT" domain_ref="grid_T" > <zoom_domain id="0n155wT"/> </domain> 64 <domain id="2n155wT" domain_ref="grid_T" > <zoom_domain id="2n155wT"/> </domain> 65 <domain id="5n155wT" domain_ref="grid_T" > <zoom_domain id="5n155wT"/> </domain> 66 <domain id="8n155wT" domain_ref="grid_T" > <zoom_domain id="8n155wT"/> </domain> 67 <!-- <\!-- 140w -\-> --> 68 <domain id="8s140wT" domain_ref="grid_T" > <zoom_domain id="8s140wT"/> </domain> 69 <domain id="5s140wT" domain_ref="grid_T" > <zoom_domain id="5s140wT"/> </domain> 70 <domain id="2s140wT" domain_ref="grid_T" > <zoom_domain id="2s140wT"/> </domain> 71 <domain id="0n140wT" domain_ref="grid_T" > <zoom_domain id="0n140wT"/> </domain> 72 <domain id="2n140wT" domain_ref="grid_T" > <zoom_domain id="2n140wT"/> </domain> 73 <domain id="5n140wT" domain_ref="grid_T" > <zoom_domain id="5n140wT"/> </domain> 74 <domain id="8n140wT" domain_ref="grid_T" > <zoom_domain id="8n140wT"/> </domain> 75 <!-- <\!-- 125w -\-> --> 76 <domain id="8s125wT" domain_ref="grid_T" > <zoom_domain id="8s125wT"/> </domain> 77 <domain id="5s125wT" domain_ref="grid_T" > <zoom_domain id="5s125wT"/> </domain> 78 <domain id="2s125wT" domain_ref="grid_T" > <zoom_domain id="2s125wT"/> </domain> 79 <domain id="0n125wT" domain_ref="grid_T" > <zoom_domain id="0n125wT"/> </domain> 80 <domain id="2n125wT" domain_ref="grid_T" > <zoom_domain id="2n125wT"/> </domain> 81 <domain id="5n125wT" domain_ref="grid_T" > <zoom_domain id="5n125wT"/> </domain> 82 <domain id="8n125wT" domain_ref="grid_T" > <zoom_domain id="8n125wT"/> </domain> 83 <!-- <\!-- 110w -\-> --> 84 <domain id="8s110wT" domain_ref="grid_T" > <zoom_domain id="8s110wT"/> </domain> 85 <domain id="5s110wT" domain_ref="grid_T" > <zoom_domain id="5s110wT"/> </domain> 86 <domain id="2s110wT" domain_ref="grid_T" > <zoom_domain id="2s110wT"/> </domain> 87 <domain id="0n110wT" domain_ref="grid_T" > <zoom_domain id="0n110wT"/> </domain> 88 <domain id="2n110wT" domain_ref="grid_T" > <zoom_domain id="2n110wT"/> </domain> 89 <domain id="5n110wT" domain_ref="grid_T" > <zoom_domain id="5n110wT"/> </domain> 90 <domain id="8n110wT" domain_ref="grid_T" > <zoom_domain id="8n110wT"/> </domain> 91 <!-- <\!-- 95w -\-> --> 92 <domain id="8s95wT" domain_ref="grid_T" > <zoom_domain id="8s95wT"/> </domain> 93 <domain id="5s95wT" domain_ref="grid_T" > <zoom_domain id="5s95wT"/> </domain> 94 <domain id="2s95wT" domain_ref="grid_T" > <zoom_domain id="2s95wT"/> </domain> 95 <domain id="0n95wT" domain_ref="grid_T" > <zoom_domain id="0n95wT"/> </domain> 96 <domain id="2n95wT" domain_ref="grid_T" > <zoom_domain id="2n95wT"/> </domain> 97 <domain id="5n95wT" domain_ref="grid_T" > <zoom_domain id="5n95wT"/> </domain> 98 <domain id="8n95wT" domain_ref="grid_T" > <zoom_domain id="8n95wT"/> </domain> 99 <!-- <\!-- RAMA -\-> --> 100 <!-- <\!-- 55e -\-> --> 101 <domain id="16s55eT" domain_ref="grid_T" > <zoom_domain id="16s55eT" /> </domain> 102 <domain id="12s55eT" domain_ref="grid_T" > <zoom_domain id="12s55eT" /> </domain> 103 <domain id="8s55eT" domain_ref="grid_T" > <zoom_domain id="8s55eT" /> </domain> 104 <domain id="4s55eT" domain_ref="grid_T" > <zoom_domain id="4s55eT" /> </domain> 105 <domain id="1.5s55eT" domain_ref="grid_T" > <zoom_domain id="1.5s55eT" /> </domain> 106 <domain id="0n55eT" domain_ref="grid_T" > <zoom_domain id="0n55eT" /> </domain> 107 <domain id="1.5n55eT" domain_ref="grid_T" > <zoom_domain id="1.5n55eT" /> </domain> 108 <domain id="4n55eT" domain_ref="grid_T" > <zoom_domain id="4n55eT" /> </domain> 109 <!-- <\!-- 65e -\-> --> 110 <domain id="15n65eT" domain_ref="grid_T" > <zoom_domain id="15n65eT" /> </domain> 111 <!-- <\!-- 67e -\-> --> 112 <domain id="16s67eT" domain_ref="grid_T" > <zoom_domain id="16s67eT" /> </domain> 113 <domain id="12s67eT" domain_ref="grid_T" > <zoom_domain id="12s67eT" /> </domain> 114 <domain id="8s67eT" domain_ref="grid_T" > <zoom_domain id="8s67eT" /> </domain> 115 <domain id="4s67eT" domain_ref="grid_T" > <zoom_domain id="4s67eT" /> </domain> 116 <domain id="1.5s67eT" domain_ref="grid_T" > <zoom_domain id="1.5s67eT" /> </domain> 117 <domain id="0n67eT" domain_ref="grid_T" > <zoom_domain id="0n67eT" /> </domain> 118 <domain id="1.5n67eT" domain_ref="grid_T" > <zoom_domain id="1.5n67eT" /> </domain> 119 <domain id="4n67eT" domain_ref="grid_T" > <zoom_domain id="4n67eT" /> </domain> 120 <domain id="8n67eT" domain_ref="grid_T" > <zoom_domain id="8n67eT" /> </domain> 121 <!-- <\!-- 80.5e -\-> --> 122 <domain id="16s80.5eT" domain_ref="grid_T" > <zoom_domain id="16s80.5eT" /> </domain> 123 <domain id="12s80.5eT" domain_ref="grid_T" > <zoom_domain id="12s80.5eT" /> </domain> 124 <domain id="8s80.5eT" domain_ref="grid_T" > <zoom_domain id="8s80.5eT" /> </domain> 125 <domain id="4s80.5eT" domain_ref="grid_T" > <zoom_domain id="4s80.5eT" /> </domain> 126 <domain id="1.5s80.5eT" domain_ref="grid_T" > <zoom_domain id="1.5s80.5eT"/> </domain> 127 <domain id="0n80.5eT" domain_ref="grid_T" > <zoom_domain id="0n80.5eT" /> </domain> 128 <domain id="1.5n80.5eT" domain_ref="grid_T" > <zoom_domain id="1.5n80.5eT"/> </domain> 129 <domain id="4n80.5eT" domain_ref="grid_T" > <zoom_domain id="4n80.5eT" /> </domain> 130 <!-- <\!-- 90e -\-> --> 131 <domain id="1.5s90eT" domain_ref="grid_T" > <zoom_domain id="1.5s90eT" /> </domain> 132 <domain id="0n90eT" domain_ref="grid_T" > <zoom_domain id="0n90eT" /> </domain> 133 <domain id="1.5n90eT" domain_ref="grid_T" > <zoom_domain id="1.5n90eT" /> </domain> 134 <domain id="4n90eT" domain_ref="grid_T" > <zoom_domain id="4n90eT" /> </domain> 135 <domain id="8n90eT" domain_ref="grid_T" > <zoom_domain id="8n90eT" /> </domain> 136 <domain id="12n90eT" domain_ref="grid_T" > <zoom_domain id="12n90eT" /> </domain> 137 <domain id="15n90eT" domain_ref="grid_T" > <zoom_domain id="15n90eT" /> </domain> 138 <!-- <\!-- 95e -\-> --> 139 <domain id="16s95eT" domain_ref="grid_T" > <zoom_domain id="16s95eT" /> </domain> 140 <domain id="12s95eT" domain_ref="grid_T" > <zoom_domain id="12s95eT" /> </domain> 141 <domain id="8s95eT" domain_ref="grid_T" > <zoom_domain id="8s95eT" /> </domain> 142 <domain id="5s95eT" domain_ref="grid_T" > <zoom_domain id="5s95eT" /> </domain> 143 <!-- <\!-- PIRATA -\-> --> 144 <!-- <\!-- 38w-30w -\-> --> 145 <domain id="19s34wT" domain_ref="grid_T" > <zoom_domain id="19s34wT"/> </domain> 146 <domain id="14s32wT" domain_ref="grid_T" > <zoom_domain id="14s32wT"/> </domain> 147 <domain id="8s30wT" domain_ref="grid_T" > <zoom_domain id="8s30wT" /> </domain> 148 <domain id="0n35wT" domain_ref="grid_T" > <zoom_domain id="0n35wT" /> </domain> 149 <domain id="4n38wT" domain_ref="grid_T" > <zoom_domain id="4n38wT" /> </domain> 150 <domain id="8n38wT" domain_ref="grid_T" > <zoom_domain id="8n38wT" /> </domain> 151 <domain id="12n38wT" domain_ref="grid_T" > <zoom_domain id="12n38wT"/> </domain> 152 <domain id="15n38wT" domain_ref="grid_T" > <zoom_domain id="15n38wT"/> </domain> 153 <domain id="20n38wT" domain_ref="grid_T" > <zoom_domain id="20n38wT"/> </domain> 154 <!-- <\!-- 23w -\-> --> 155 <domain id="0n23wT" domain_ref="grid_T" > <zoom_domain id="0n23wT" /> </domain> 156 <domain id="4n23wT" domain_ref="grid_T" > <zoom_domain id="4n23wT" /> </domain> 157 <domain id="12n23wT" domain_ref="grid_T" > <zoom_domain id="12n23wT"/> </domain> 158 <domain id="21n23wT" domain_ref="grid_T" > <zoom_domain id="21n23wT"/> </domain> 159 <!-- <\!-- 10w -\-> --> 160 <domain id="10s10wT" domain_ref="grid_T" > <zoom_domain id="10s10wT"/> </domain> 161 <domain id="6s10wT" domain_ref="grid_T" > <zoom_domain id="6s10wT" /> </domain> 162 <domain id="0n10wT" domain_ref="grid_T" > <zoom_domain id="0n10wT" /> </domain> 163 <!-- <\!-- 0e -\-> --> 164 <domain id="0n0eT" domain_ref="grid_T" > <zoom_domain id="0n0eT" /> </domain> 165 165 166 167 <!-- U grid -->168 <domain id="grid_U" long_name="grid U"/>169 <!-- Eq section -->170 <domain id="EqU" domain_ref="grid_U" > <zoom_domain id="EqU"/> </domain>171 166 172 173 <!-- V grid -->174 <domain id="grid_V" long_name="grid V"/>175 <!-- Eq section : no V point on the Equator... -->167 <!-- U grid --> 168 <domain id="grid_U" long_name="grid U"/> 169 <!-- Eq section --> 170 <domain id="EqU" domain_ref="grid_U" > <zoom_domain id="EqU"/> </domain> 176 171 177 178 <!-- W grid -->179 <domain id="grid_W" long_name="grid W"/>180 <!-- Eq section -->181 <domain id="EqW" domain_ref="grid_W" > <zoom_domain id="EqW"/> </domain>182 172 183 <!-- zonal mean grid --> 184 <domain_group id="gznl"> 185 <domain id="gznl" long_name="gznl"/> 186 <domain id="ptr" domain_ref="gznl" > 187 <zoom_domain id="ptr" ibegin="0000" jbegin="0" ni="1" nj="0000" /> 188 </domain> 189 </domain_group> 173 <!-- V grid --> 174 <domain id="grid_V" long_name="grid V"/> 175 <!-- Eq section : no V point on the Equator... --> 190 176 191 192 <!-- other grids -->193 <domain id="scalarpoint" long_name="scalar"/>194 195 177 196 </domain_definition> 197 178 <!-- W grid --> 179 <domain id="grid_W" long_name="grid W"/> 180 <!-- Eq section --> 181 <domain id="EqW" domain_ref="grid_W" > <zoom_domain id="EqW"/> </domain> 182 183 <!-- zonal mean grid --> 184 <domain_group id="gznl"> 185 <domain id="gznl" long_name="gznl"/> 186 <domain id="ptr" domain_ref="gznl" > 187 <zoom_domain id="ptr" ibegin="0000" jbegin="0" ni="1" nj="0000" /> 188 </domain> 189 </domain_group> 190 191 192 <!-- other grids --> 193 <domain id="scalarpoint" long_name="scalar"/> 194 195 196 </domain_definition> -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/field_def_nemo-ice.xml
r14017 r14021 51 51 <field id="icehlid" long_name="melt pond lid depth" standard_name="sea_ice_meltpondlid_depth" unit="m" /> 52 52 <field id="icevlid" long_name="melt pond lid volume" standard_name="sea_ice_meltpondlid_volume" unit="m" /> 53 <field id="dvpn_mlt" long_name="pond volume tendency due to surface melt" standard_name="sea_ice_pondvolume_tendency_melt" unit="kg/m2/s" /> 54 <field id="dvpn_lid" long_name="pond volume tendency due to exchanges with lid" standard_name="sea_ice_pondvolume_tendency_lids" unit="kg/m2/s" /> 55 <field id="dvpn_rnf" long_name="pond volume tendency due to runoff" standard_name="sea_ice_pondvolume_tendency_runoff" unit="kg/m2/s" /> 56 <field id="dvpn_drn" long_name="pond volume tendency due to drainage" standard_name="sea_ice_pondvolume_tendency_drainage" unit="kg/m2/s" /> 53 57 54 58 <!-- heat --> … … 309 313 <field id="snwtemp_cat" long_name="Snow temperature per category" unit="degC" detect_missing_value="true" /> 310 314 <field id="icettop_cat" long_name="Ice/snow surface temperature per category" unit="degC" detect_missing_value="true" /> 311 <field id="iceapnd_cat" long_name="Ice melt pond concentration per category" unit="" /> 315 <field id="iceapnd_cat" long_name="Ice melt pond grid fraction per category" unit="" /> 316 <field id="icevpnd_cat" long_name="Ice melt pond volume per grid area per category" unit="m" /> 312 317 <field id="icehpnd_cat" long_name="Ice melt pond thickness per category" unit="m" detect_missing_value="true" /> 313 318 <field id="icehlid_cat" long_name="Ice melt pond lid thickness per category" unit="m" detect_missing_value="true" /> 314 <field id="iceafpnd_cat" long_name="Ice melt pond fraction per category"unit="" />319 <field id="iceafpnd_cat" long_name="Ice melt pond ice fraction per category" unit="" /> 315 320 <field id="iceaepnd_cat" long_name="Ice melt pond effective fraction per category" unit="" /> 316 321 <field id="icemask_cat" long_name="Fraction of time step with sea ice (per category)" unit="" /> -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/field_def_nemo-innerttrc.xml
r9539 r14021 1 <?xml version="1.0"?> 2 3 4 <!-- 1 <?xml version="1.0"?> 2 <!-- $id$ --> 3 4 <!-- 5 5 ============================================================================================================ 6 6 = definition of all existing variables = 7 7 = DO NOT CHANGE = 8 8 ============================================================================================================ 9 10 9 --> 10 <field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined --> 11 11 12 <!--13 ============================================================================================================14 15 ============================================================================================================16 12 <!-- 13 ============================================================================================================ 14 Inert tracers variables 15 ============================================================================================================ 16 --> 17 17 18 18 19 19 <field_group id="inerttrc" grid_ref="grid_T_2D"> 20 20 21 22 23 24 25 21 <!-- CFC11 : variables available with ln_cfc11 --> 22 <field id="CFC11" long_name="Chlorofluoro carbon11 Concentration" unit="umol/m3" grid_ref="grid_T_3D" /> 23 <field id="CFC11_e3t" long_name="CFC11 * e3t" unit="umol/m2" grid_ref="grid_T_3D" > CFC11 * e3t </field > 24 <field id="qtr_CFC11" long_name="Air-sea flux of CFC-11" unit="mol/m2/s" /> 25 <field id="qint_CFC11" long_name="Cumulative air-sea flux of CFC-11" unit="mol/m2" /> 26 26 27 28 29 30 31 27 <!-- CFC12 : variables available with ln_cfc12 --> 28 <field id="CFC12" long_name="Chlorofluoro carbon12 Concentration" unit="umol/m3" grid_ref="grid_T_3D" /> 29 <field id="CFC12_e3t" long_name="CFC12 * e3t" unit="umol/m2" grid_ref="grid_T_3D" > CFC12 * e3t </field > 30 <field id="qtr_CFC12" long_name="Air-sea flux of CFC12" unit="mol/m2/s" /> 31 <field id="qint_CFC12" long_name="Cumulative air-sea flux of CFC12" unit="mol/m2" /> 32 32 33 34 35 36 37 33 <!-- SF6 : variables available with ln_sf6 --> 34 <field id="SF6" long_name="Sulfur hexafluoride Concentration" unit="umol/m3" grid_ref="grid_T_3D" /> 35 <field id="SF6_e3t" long_name="SF6 * e3t" unit="umol/m2" grid_ref="grid_T_3D" > SF6 * e3t </field > 36 <field id="qtr_SF6" long_name="Air-sea flux of SF6" unit="mol/m2/s" /> 37 <field id="qint_SF6" long_name="Cumulative air-sea flux of SF6" unit="mol/m2" /> 38 38 39 40 41 42 43 44 45 46 47 48 49 50 51 39 <!-- C14 : variables available with ln_c14 --> 40 <field id="RC14" long_name="Radiocarbon ratio" unit="-" grid_ref="grid_T_3D" /> 41 <field id="RC14_e3t" long_name="RC14 * e3t" unit="m" grid_ref="grid_T_3D" > RC14 * e3t </field > 42 <field id="DeltaC14" long_name="Delta C14" unit="permil" grid_ref="grid_T_3D" /> 43 <field id="C14Age" long_name="Radiocarbon age" unit="yr" grid_ref="grid_T_3D" /> 44 <field id="RAge" long_name="Reservoir Age" unit="yr" /> 45 <field id="qtr_C14" long_name="Air-sea flux of C14" unit="1/m2/s" /> 46 <field id="qint_C14" long_name="Cumulative air-sea flux of C14" unit="1/m2" /> 47 <field id="AtmCO2" long_name="Global atmospheric CO2" unit="ppm" /> 48 <field id="AtmC14" long_name="Global atmospheric DeltaC14" unit="permil" /> 49 <field id="K_C14" long_name="Global 14C/C exchange velocity" unit="m/yr" /> 50 <field id="K_CO2" long_name="Global CO2 piston velocity" unit="cm/h" /> 51 <field id="C14Inv" long_name="global Radiocarbon ocean inventory" unit="10^26 atoms" /> 52 52 53 54 55 53 <!-- AGE : variables available with ln_age --> 54 <field id="Age" long_name="Sea water age since surface contact" unit="yr" grid_ref="grid_T_3D" /> 55 <field id="Age_e3t" long_name="Age * e3t" unit="yr * m" grid_ref="grid_T_3D" > Age * e3t </field > 56 56 57 57 </field_group> 58 58 59 59 </field_definition> -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/field_def_nemo-oce.xml
r13981 r14021 234 234 <field id="cfl_cw" long_name="w-courant number" unit="#" /> 235 235 236 <!-- variables available with ln_zdfmfc=.true. --> 237 <field id="mf_Tp" long_name="plume_temperature" standard_name="plume_temperature" unit="degC" grid_ref="grid_T_3D" /> 238 <field id="mf_Sp" long_name="plume_salinity" standard_name="plume_salinity" unit="1e-3" grid_ref="grid_T_3D" /> 239 <field id="mf_mf" long_name="mass flux" standard_name="mf_mass_flux" unit="m" grid_ref="grid_T_3D" /> 240 236 241 </field_group> <!-- grid_T --> 237 242 … … 651 656 <field id="avm_evd" long_name="convective enhancement of vertical viscosity" standard_name="ocean_vertical_momentum_diffusivity_due_to_convection" unit="m2/s" /> 652 657 658 <!-- mf_app and mf_wp: available with ln_zdfmfc --> 659 <field id="mf_app" long_name="convective area" standard_name="mf_convective_area" unit="%" grid_ref="grid_W_3D" /> 660 <field id="mf_wp" long_name="convective velocity" standard_name="mf_convective_velo" unit="m/s" grid_ref="grid_W_3D" /> 661 662 653 663 <!-- avt_tide: available with ln_zdfiwm=T --> 654 664 <field id="av_ratio" long_name="S over T diffusivity ratio" standard_name="salinity_over_temperature_diffusivity_ratio" unit="1" /> -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/field_def_nemo-pisces.xml
r12377 r14021 1 <?xml version="1.0"?> 2 3 4 <!-- 1 <?xml version="1.0"?> 2 <!-- $id$ --> 3 4 <!-- 5 5 ============================================================================================================ 6 6 = definition of all existing variables = 7 7 = DO NOT CHANGE = 8 8 ============================================================================================================ 9 10 11 12 <!--13 ============================================================================================================14 15 ============================================================================================================16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 </field_group>160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 <field id="INTPPPHYD" long_name="Vertically integrated primary production by diatom" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > PPPHYD * e3t </field >273 <field id="INTPPPHYP" long_name="Vertically integrated primary production by picophy" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > PPPHYP * e3t </field >274 <field id="INTPP" long_name="Vertically integrated primary production by phyto" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > TPP * e3t </field >275 <field id="INTPNEW" long_name="Vertically integrated new primary production" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > TPNEW * e3t </field >276 <field id="INTPBFE" long_name="Vertically integrated of biogenic iron production" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > TPBFE * e3t </field >277 <field id="INTPBSI" long_name="Vertically integrated of biogenic Si production" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > PBSi * e3t </field >278 279 280 <field id="FNO3PHY" long_name="FNO3PHY" unit="" grid_ref="grid_T_3D" />281 <field id="FNH4PHY" long_name="FNH4PHY" unit="" grid_ref="grid_T_3D" />282 <field id="FNH4NO3" long_name="FNH4NO3" unit="" grid_ref="grid_T_3D" />283 <field id="TNO3PHY" long_name="TNO3PHY" unit="" />284 <field id="TNH4PHY" long_name="TNH4PHY" unit="" />285 <field id="TPHYDOM" long_name="TPHYDOM" unit="" />286 <field id="TPHYNH4" long_name="TPHYNH4" unit="" />287 <field id="TPHYZOO" long_name="TPHYZOO" unit="" />288 <field id="TPHYDET" long_name="TPHYDET" unit="" />289 <field id="TDETZOO" long_name="TDETZOO" unit="" />290 <field id="TZOODET" long_name="TZOODET" unit="" />291 <field id="TZOOBOD" long_name="TZOOBOD" unit="" />292 <field id="TZOONH4" long_name="TZOONH4" unit="" />293 <field id="TZOODOM" long_name="TZOODOM" unit="" />294 <field id="TNH4NO3" long_name="TNH4NO3" unit="" />295 <field id="TDOMNH4" long_name="TDOMNH4" unit="" />296 <field id="TDETNH4" long_name="TDETNH4" unit="" />297 <field id="TPHYTOT" long_name="TPHYTOT" unit="" />298 <field id="TZOOTOT" long_name="TZOOTOT" unit="" />299 <field id="SEDPOC" long_name="SEDPOC" unit="" />300 <field id="TDETSED" long_name="TDETSED" unit="" />301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 9 --> 10 <field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined --> 11 12 <!-- 13 ============================================================================================================ 14 Biogeochemistry model variables 15 ============================================================================================================ 16 --> 17 18 <!-- ptrc on T grid --> 19 20 <field_group id="ptrc_T" grid_ref="grid_T_3D"> 21 <!-- PISCES standard : variables available with ln_p4z --> 22 <field id="DIC" long_name="Dissolved inorganic Concentration" unit="mmol/m3" /> 23 <field id="DIC_e3t" long_name="DIC * e3t" unit="mmol/m2" > DIC * e3t </field > 24 <field id="Alkalini" long_name="Total Alkalinity Concentration" unit="mmol/m3" /> 25 <field id="Alkalini_e3t" long_name="Alkalini * e3t" unit="mmol/m2" > Alkalini * e3t </field > 26 <field id="O2" long_name="Oxygen Concentration" unit="mmol/m3" /> 27 <field id="O2_e3t" long_name="O2 * e3t" unit="mmol/m2" > O2 * e3t </field > 28 <field id="CaCO3" long_name="Calcite Concentration" unit="mmol/m3" /> 29 <field id="CaCO3_e3t" long_name="CaCO3 * e3t" unit="mmol/m2" > CaCO3 * e3t </field > 30 <field id="PO4" long_name="Phosphate Concentration" unit="mmol/m3" /> 31 <field id="PO4_e3t" long_name="PO4 * e3t" unit="mmol/m2" > PO4 * e3t </field > 32 <field id="POC" long_name="Small organic carbon Concentration" unit="mmol/m3" /> 33 <field id="POC_e3t" long_name="POC * e3t" unit="mmol/m2" > POC * e3t </field > 34 <field id="Si" long_name="Silicate Concentration" unit="mmol/m3" /> 35 <field id="Si_e3t" long_name="Si * e3t" unit="mmol/m2" > Si * e3t </field > 36 <field id="PHY" long_name="(Nano)Phytoplankton Concentration" unit="mmol/m3" /> 37 <field id="PHY_e3t" long_name="PHY * e3t" unit="mmol/m2" > PHY * e3t </field > 38 <field id="ZOO" long_name="(Micro)Zooplankton Concentration" unit="mmol/m3" /> 39 <field id="ZOO_e3t" long_name="ZOO2 * e3t" unit="mmol/m2" > ZOO * e3t </field > 40 <field id="DOC" long_name="Dissolved organic Concentration" unit="mmol/m3" /> 41 <field id="DOC_e3t" long_name="DOC * e3t" unit="mmol/m2" > DOC * e3t </field > 42 <field id="PHY2" long_name="Diatoms Concentration" unit="mmol/m3" /> 43 <field id="PHY2_e3t" long_name="PHY2 * e3t" unit="mmol/m2" > PHY2 * e3t </field > 44 <field id="ZOO2" long_name="Mesozooplankton Concentration" unit="mmol/m3" /> 45 <field id="ZOO2_e3t" long_name="ZOO2 * e3t" unit="mmol/m2" > ZOO2 * e3t </field > 46 <field id="DSi" long_name="Diatoms Silicate Concentration" unit="mmol/m3" /> 47 <field id="DSi_e3t" long_name="Dsi * e3t" unit="mmol/m2" > DSi * e3t </field > 48 <field id="Fer" long_name="Dissolved Iron Concentration" unit="mmol/m3" /> 49 <field id="Fer_e3t" long_name="Fer * e3t" unit="mmol/m2" > Fer * e3t </field > 50 <field id="BFe" long_name="Big iron particles Concentration" unit="mmol/m3" /> 51 <field id="BFe_e3t" long_name="BFe * e3t" unit="mmol/m2" > BFe * e3t </field > 52 <field id="GOC" long_name="Big organic carbon Concentration" unit="mmol/m3" /> 53 <field id="GOC_e3t" long_name="GOC * e3t" unit="mmol/m2" > GOC * e3t </field > 54 <field id="SFe" long_name="Small iron particles Concentration" unit="mmol/m3" /> 55 <field id="SFe_e3t" long_name="SFe * e3t" unit="mmol/m2" > SFe * e3t </field > 56 <field id="DFe" long_name="Diatoms iron Concentration" unit="mmol/m3" /> 57 <field id="DFe_e3t" long_name="DFe * e3t" unit="mmol/m2" > DFe * e3t </field > 58 <field id="GSi" long_name="Sinking biogenic Silicate Concentration" unit="mmol/m3" /> 59 <field id="GSi_e3t" long_name="GSi * e3t" unit="mmol/m2" > GSi * e3t </field > 60 <field id="NFe" long_name="Nano iron Concentration" unit="mmol/m3" /> 61 <field id="NFe_e3t" long_name="NFe * e3t" unit="mmol/m2" > NFe * e3t </field > 62 <field id="NCHL" long_name="Nano chlorophyl Concentration" unit="gChl/m3" /> 63 <field id="NCHL_e3t" long_name="NCHL * e3t" unit="mmol/m2" > NCHL * e3t </field > 64 <field id="DCHL" long_name="Diatoms chlorophyl Concentration" unit="gChl/m3" /> 65 <field id="DCHL_e3t" long_name="DCHL * e3t" unit="mmol/m2" > DCHL * e3t </field > 66 <field id="NO3" long_name="Nitrate Concentration" unit="mmol/m3" /> 67 <field id="NO3_e3t" long_name="NO3 * e3t" unit="mmol/m2" > NO3 * e3t </field > 68 <field id="NH4" long_name="Ammonium Concentration" unit="mmol/m3" /> 69 <field id="NH4_e3t" long_name="NH4 * e3t" unit="mmol/m2" > NH4 * e3t </field > 70 71 <!-- PISCES quota : variables available with ln_p5z --> 72 73 <field id="DON" long_name="Dissolved organic N Concentration" unit="mmol/m3" /> 74 <field id="DON_e3t" long_name="DON * e3t" unit="mmol/m2" > DON * e3t </field > 75 <field id="DOP" long_name="Dissolved organic P Concentration" unit="mmol/m3" /> 76 <field id="DOP_e3t" long_name="DOP * e3t" unit="mmol/m2" > DOP * e3t </field > 77 <field id="PON" long_name="Small PON Concentration" unit="mmol/m3" /> 78 <field id="PON_e3t" long_name="PON * e3t" unit="mmol/m2" > PON * e3t </field > 79 <field id="POP" long_name="Small POP Concentration" unit="mmol/m3" /> 80 <field id="POP_e3t" long_name="POP * e3t" unit="mmol/m2" > POP * e3t </field > 81 <field id="GON" long_name="Big PON Concentration" unit="mmol/m3" /> 82 <field id="GON_e3t" long_name="GON * e3t" unit="mmol/m2" > GON * e3t </field > 83 <field id="GOP" long_name="Big POP Concentration" unit="mmol/m3" /> 84 <field id="GOP_e3t" long_name="GOP * e3t" unit="mmol/m2" > GOP * e3t </field > 85 <field id="PHYN" long_name="Nanophytoplankton N biomass" unit="mmol/m3" /> 86 <field id="PHYN_e3t" long_name="PHYN * e3t" unit="mmol/m2" > PHYN * e3t </field > 87 <field id="PHYP" long_name="Nanophytoplankton P biomass" unit="mmol/m3" /> 88 <field id="PHYP_e3t" long_name="PHYP * e3t" unit="mmol/m2" > PHYP * e3t </field > 89 <field id="DIAN" long_name="Diatoms N biomass" unit="mmol/m3" /> 90 <field id="DIAN_e3t" long_name="DIAN * e3t" unit="mmol/m2" > DIAN * e3t </field > 91 <field id="DIAP" long_name="Diatoms P biomass" unit="mmol/m3" /> 92 <field id="DIAP_e3t" long_name="DIAP * e3t" unit="mmol/m2" > DIAP * e3t </field > 93 <field id="PIC" long_name="Picophytoplankton C biomass" unit="mmol/m3" /> 94 <field id="PIC_e3t" long_name="PIC * e3t" unit="mmol/m2" > PIC * e3t </field > 95 <field id="PICN" long_name="Picophytoplankton N biomass" unit="mmol/m3" /> 96 <field id="PICN_e3t" long_name="PICN * e3t" unit="mmol/m2" > PICN * e3t </field > 97 <field id="PICP" long_name="Picophytoplankton P biomass" unit="mmol/m3" /> 98 <field id="PICP_e3t" long_name="PICP * e3t" unit="mmol/m2" > PICP * e3t </field > 99 <field id="PFe" long_name="Picophytoplankton Fe biomass" unit="mmol/m3" /> 100 <field id="PFe_e3t" long_name="PFe * e3t" unit="mmol/m2" > PFe * e3t </field > 101 <field id="PCHL" long_name="Picophytoplankton Chl biomass" unit="gChl/m3" /> 102 <field id="PCHL_e3t" long_name="PCHL * e3t" unit="mmol/m2" > PCHL * e3t </field > 103 104 <!-- PISCES with ligand parametisation : variables available namelist paramter ln_ligand --> 105 <field id="LGW" long_name="Weak ligands concentration" unit="mmol/m3" /> 106 <field id="LGW_e3t" long_name="LGW * e3t" unit="mmol/m2" > LGW * e3t </field > 107 108 <!-- PISCES light : variables available with ln_p2z --> 109 <field id="DET" long_name="Detritus" unit="mmol-N/m3" /> 110 <field id="DET_e3t" long_name="DET * e3t" unit="mmol-N/m2" > DET * e3t </field > 111 <field id="DOM" long_name="Dissolved Organic Matter" unit="mmol-N/m3" /> 112 <field id="DOM_e3t" long_name="DOM * e3t" unit="mmol-N/m2" > DOM * e3t </field > 113 114 </field_group> 115 116 <!-- SEDIMENT variables on T sediment grid --> 117 <field_group id="sed_T" grid_ref="grid_T_3DS"> 118 <field id="SedDIC" long_name="Dissolved inorganic Concentration" unit="mmol/m3" /> 119 <field id="SedAlkalini" long_name="Total Alkalinity Concentration" unit="mmol/m3" /> 120 <field id="SedO2" long_name="Oxygen Concentration" unit="mmol/m3" /> 121 <field id="SedCaCO3" long_name="Calcite Concentration" unit="%" /> 122 <field id="SedPOS" long_name="Semi-ref POC Concentration" unit="%" /> 123 <field id="SedPOR" long_name="Refractory POC Concentration" unit="%" /> 124 <field id="SedPO4" long_name="Phosphate Concentration" unit="mmol/m3" /> 125 <field id="SedPOC" long_name="Labile POC Concentration" unit="%" /> 126 <field id="SedSil" long_name="Silicate Concentration" unit="mmol/m3" /> 127 <field id="SedFe2" long_name="Fe2+ Concentration" unit="mmol/m3" /> 128 <field id="SedBSi" long_name="Biogenic Silicate Concentration" unit="%" /> 129 <field id="SedNO3" long_name="Nitrate Concentration" unit="mmol/m3" /> 130 <field id="SedNH4" long_name="Ammonium Concentration" unit="mmol/m3" /> 131 <field id="SedH2S" long_name="H2S Concentration" unit="mmol/m3" /> 132 <field id="SedSO4" long_name="SO4 Concentration" unit="mmol/m3" /> 133 <field id="SedClay" long_name="Clay Concentration" unit="%" /> 134 <field id="SedFeO" long_name="Fe(OH)3 Concentration" unit="%" /> 135 <field id="SedFeS" long_name="FeS Concentration" unit="%" /> 136 <field id="SedpH" long_name="PH" unit="1" /> 137 <field id="SedCO3por" long_name="Bicarbonates" unit="mol/m3" /> 138 </field_group> 139 140 <!-- SEDIMENT additional variables on T sediment grid --> 141 <field_group id="Diag_S" grid_ref="grid_T_2D"> 142 <field id="FlxSi" long_name="Si sediment flux" unit="mol/cm2/s" /> 143 <field id="FlxO2" long_name="O2 sediment flux" unit="mol/cm2/s" /> 144 <field id="FlxDIC" long_name="DIC sediment flux" unit="mol/cm2/s" /> 145 <field id="FlxNO3" long_name="NO3 sediment flux" unit="mol/cm2/s" /> 146 <field id="FlxPO4" long_name="PO4 sediment flux" unit="mol/cm2/s" /> 147 <field id="FlxAlkalini" long_name="Alkalinity sediment flux" unit="mol/cm2/s" /> 148 <field id="FlxNH4" long_name="Ammonium sediment flux" unit="mol/cm2/s" /> 149 <field id="FlxH2S" long_name="H2S sediment flux" unit="mol/cm2/s" /> 150 <field id="FlxSO4" long_name="SO4 sediment flux" unit="mol/cm2/s" /> 151 <field id="FlxFe2" long_name="Fe2+ sediment flux" unit="mol/cm2/s" /> 152 <field id="Flxtot" long_name="Sediment net burial rate" unit="cm/s" /> 153 <field id="dzdep" long_name="Sedimentation rate" unit="cm/s" /> 154 <field id="sflxclay" long_name="Clay sedimentation rate" unit="g/m2/s" /> 155 <field id="sflxcal" long_name="Calcite sedimentation rate" unit="mol/m2/s" /> 156 <field id="sflxbsi" long_name="BSi Sedimentation rate" unit="mol/m2/s" /> 157 <field id="sflxpoc" long_name="POC Sedimentation rate" unit="mol/m2/s" /> 158 <field id="sflxfeo" long_name="Fe(OH)3 Sedimentation rate" unit="mol/m2/s" /> 159 </field_group> 160 161 <!-- PISCES additional diagnostics on T grid --> 162 163 <field_group id="diad_T" grid_ref="grid_T_2D"> 164 <field id="PH" long_name="PH" unit="1" grid_ref="grid_T_3D" /> 165 <field id="CO3" long_name="Bicarbonates" unit="mol/m3" grid_ref="grid_T_3D" /> 166 <field id="CO3sat" long_name="CO3 saturation" unit="mol/m3" grid_ref="grid_T_3D" /> 167 <field id="PAR" long_name="Photosynthetically Available Radiation" unit="W/m2" grid_ref="grid_T_3D" /> 168 <field id="PARDM" long_name="Daily mean PAR" unit="W/m2" grid_ref="grid_T_3D" /> 169 <field id="PPPHYN" long_name="Primary production of nanophyto" unit="molC/m3/s" grid_ref="grid_T_3D" /> 170 <field id="PPPHYP" long_name="Primary production of picophyto" unit="molC/m3/s" grid_ref="grid_T_3D" /> 171 <field id="PPPHYD" long_name="Primary production of diatoms" unit="molC/m3/s" grid_ref="grid_T_3D" /> 172 <field id="PPNEWN" long_name="New Primary production of nanophyto" unit="molC/m3/s" grid_ref="grid_T_3D" /> 173 <field id="PPNEWP" long_name="New Primary production of picophyto" unit="molC/m3/s" grid_ref="grid_T_3D" /> 174 <field id="PPNEWD" long_name="New Primary production of diatoms" unit="molC/m3/s" grid_ref="grid_T_3D" /> 175 <field id="PBSi" long_name="Primary production of Si diatoms" unit="molC/m3/s" grid_ref="grid_T_3D" /> 176 <field id="PFeN" long_name="Primary production of nano iron" unit="molC/m3/s" grid_ref="grid_T_3D" /> 177 <field id="PFeP" long_name="Primary production of pico iron" unit="molC/m3/s" grid_ref="grid_T_3D" /> 178 <field id="PFeD" long_name="Primary production of diatoms iron" unit="mol/m3/s" grid_ref="grid_T_3D" /> 179 <field id="xfracal" long_name="Calcifying fraction" unit="1" grid_ref="grid_T_3D" /> 180 <field id="PCAL" long_name="Calcite production" unit="mol/m3/s" grid_ref="grid_T_3D" /> 181 <field id="DCAL" long_name="Calcite dissolution" unit="mol/m3/s" grid_ref="grid_T_3D" /> 182 <field id="GRAZ1" long_name="Grazing by microzooplankton" unit="mol/m3/s" grid_ref="grid_T_3D" /> 183 <field id="GRAZ2" long_name="Grazing by mesozooplankton" unit="mol/m3/s" grid_ref="grid_T_3D" /> 184 <field id="REMIN" long_name="Oxic remineralization of OM" unit="mol/m3/s" grid_ref="grid_T_3D" /> 185 <field id="DENIT" long_name="Anoxic remineralization of OM" unit="mol/m3/s" grid_ref="grid_T_3D" /> 186 <field id="REMINP" long_name="Oxic remineralization rate of POC" unit="d-1" grid_ref="grid_T_3D" /> 187 <field id="REMING" long_name="Oxic remineralization rate of GOC" unit="d-1" grid_ref="grid_T_3D" /> 188 <field id="Nfix" long_name="Nitrogen fixation" unit="mol/m3/s" grid_ref="grid_T_3D" /> 189 <field id="Mumax" long_name="Maximum growth rate" unit="s-1" grid_ref="grid_T_3D" /> 190 <field id="MuN" long_name="Realized growth rate for nanophyto" unit="s-1" grid_ref="grid_T_3D" /> 191 <field id="MuP" long_name="Realized growth rate for picophyto" unit="s-1" grid_ref="grid_T_3D" /> 192 <field id="MuD" long_name="Realized growth rate for diatomes" unit="s-1" grid_ref="grid_T_3D" /> 193 <field id="MunetN" long_name="Net growth rate for nanophyto" unit="s-1" grid_ref="grid_T_3D" /> 194 <field id="MunetP" long_name="Net growth rate for picophyto" unit="s-1" grid_ref="grid_T_3D" /> 195 <field id="MunetD" long_name="Net growth rate for diatomes" unit="s-1" grid_ref="grid_T_3D" /> 196 <field id="LNnut" long_name="Nutrient limitation term in Nanophyto" unit="" grid_ref="grid_T_3D" /> 197 <field id="LPnut" long_name="Nutrient limitation term in Picophyto" unit="-" grid_ref="grid_T_3D" /> 198 <field id="LDnut" long_name="Nutrient limitation term in Diatoms" unit="" grid_ref="grid_T_3D" /> 199 <field id="LNFe" long_name="Iron limitation term in Nanophyto" unit="" grid_ref="grid_T_3D" /> 200 <field id="LPFe" long_name="Iron limitation term in Picophyto" unit="-" grid_ref="grid_T_3D" /> 201 <field id="LDFe" long_name="Iron limitation term in Diatoms" unit="" grid_ref="grid_T_3D" /> 202 <field id="LNlight" long_name="Light limitation term in Nanophyto" unit="" grid_ref="grid_T_3D" /> 203 <field id="LPlight" long_name="Light limitation term in Picophyto" unit="-" grid_ref="grid_T_3D" /> 204 <field id="LDlight" long_name="Light limitation term in Diatoms" unit="" grid_ref="grid_T_3D" /> 205 <field id="SIZEN" long_name="Mean relative size of nanophyto." unit="-" grid_ref="grid_T_3D" /> 206 <field id="SIZEP" long_name="Mean relative size of picophyto." unit="-" grid_ref="grid_T_3D" /> 207 <field id="SIZED" long_name="Mean relative size of diatoms" unit="-" grid_ref="grid_T_3D" /> 208 <field id="Fe3" long_name="Iron III concentration" unit="nmol/m3" grid_ref="grid_T_3D" /> 209 <field id="FeL1" long_name="Complexed Iron concentration with L1" unit="nmol/m3" grid_ref="grid_T_3D" /> 210 <field id="TL1" long_name="Total L1 concentration" unit="nmol/m3" grid_ref="grid_T_3D" /> 211 <field id="pdust" long_name="dust concentration" unit="g/m3" /> 212 <field id="Totlig" long_name="Total ligand concentation" unit="nmol/m3" grid_ref="grid_T_3D" /> 213 <field id="Biron" long_name="Bioavailable iron" unit="nmol/m3" grid_ref="grid_T_3D" /> 214 <field id="Sdenit" long_name="Nitrate reduction in the sediments" unit="mol/m2/s" /> 215 <field id="Ironice" long_name="Iron input/uptake due to sea ice" unit="mol/m2/s" /> 216 <field id="SedCal" long_name="Calcite burial in the sediments" unit="molC/m2/s" /> 217 <field id="SedSi" long_name="Silicon burial in the sediments" unit="molSi/m2/s" /> 218 <field id="SedC" long_name="Organic C burial in the sediments" unit="molC/m2/s" /> 219 <field id="HYDR" long_name="Iron input from hydrothemal vents" unit="mol/m2/s" grid_ref="grid_T_3D" /> 220 <field id="EPC100" long_name="Export of carbon particles at 100 m" unit="mol/m2/s" /> 221 <field id="EPFE100" long_name="Export of biogenic iron at 100 m" unit="mol/m2/s" /> 222 <field id="EPSI100" long_name="Export of Silicate at 100 m" unit="mol/m2/s" /> 223 <field id="EPCAL100" long_name="Export of Calcite at 100 m" unit="mol/m2/s" /> 224 <field id="EXPC" long_name="Export of carbon" unit="mol/m2/s" grid_ref="grid_T_3D" /> 225 <field id="EXPFE" long_name="Export of biogenic iron" unit="mol/m2/s" grid_ref="grid_T_3D" /> 226 <field id="EXPSI" long_name="Export of Silicate" unit="mol/m2/s" grid_ref="grid_T_3D" /> 227 <field id="EXPCAL" long_name="Export of Calcite" unit="mol/m2/s" grid_ref="grid_T_3D" /> 228 <field id="Cflx" long_name="DIC flux" unit="mol/m2/s" /> 229 <field id="Oflx" long_name="Oxygen flux" unit="mol/m2/s" /> 230 <field id="Kg" long_name="Gas transfer" unit="mol/m2/s/uatm" /> 231 <field id="Dpco2" long_name="Delta CO2" unit="uatm" /> 232 <field id="pCO2sea" long_name="surface ocean pCO2" unit="uatm" /> 233 <field id="Dpo2" long_name="Delta O2" unit="uatm" /> 234 <field id="Heup" long_name="Euphotic layer depth" unit="m" /> 235 <field id="AtmCo2" long_name="Atmospheric CO2 concentration" unit="ppm" /> 236 <field id="Irondep" long_name="Iron deposition from dust" unit="mol/m2/s" /> 237 <field id="Ironsed" long_name="Iron deposition from sediment" unit="mol/m2/s" grid_ref="grid_T_3D" /> 238 <field id="FESCAV" long_name="Scavenging of Iron" unit="mmol-Fe/m3/s" grid_ref="grid_T_3D" /> 239 <field id="FECOLL" long_name="Colloidal Pumping of FeL" unit="mmol-FeL/m3/s" grid_ref="grid_T_3D" /> 240 <field id="LGWCOLL" long_name="Coagulation loss of ligands" unit="mmol-L/m3/s" grid_ref="grid_T_3D" /> 241 <field id="REMINF" long_name="Oxic remineralization suppy of Fe" unit="mmol-Fe/m3/s" grid_ref="grid_T_3D" /> 242 <field id="BACT" long_name="Bacterial Biomass" unit="mmol/m3" grid_ref="grid_T_3D" /> 243 <field id="FEBACT" long_name="Bacterial uptake of Fe" unit="molFe/m3/s" grid_ref="grid_T_3D" /> 244 <field id="LPRODR" long_name="OM remineralisation ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D" /> 245 <field id="LPRODP" long_name="phytoplankton ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D" /> 246 <field id="LIGREM" long_name="Remineralisation loss of ligands" unit="nmol-L/m3/s" grid_ref="grid_T_3D" /> 247 <field id="LIGPR" long_name="Photochemical loss of ligands" unit="nmol-L/m3/s" grid_ref="grid_T_3D" /> 248 <field id="LDETP" long_name="Ligand destruction during phytoplankton uptake" unit="nmol-L/m3/s" grid_ref="grid_T_3D" /> 249 <field id="LPRODZ2" long_name="mesozooplankton ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D" /> 250 <field id="LPRODZ" long_name="microzooplankton ligand production rate" unit="nmol-L/m3/s" grid_ref="grid_T_3D" /> 251 <field id="FEZOO" long_name="microzooplankton iron recycling rate" unit="nmol-FeL/m3/s" grid_ref="grid_T_3D" /> 252 <field id="FEZOO2" long_name="mesozooplankton iron recycling rate" unit="nmol-FeL/m3/s" grid_ref="grid_T_3D" /> 253 254 <!-- PISCES tracers trends --> 255 <field id="INTdtAlk" long_name="Vertically int. of change of alkalinity" unit="mol/m2/s" /> 256 <field id="INTdtDIC" long_name="Vertically int. of change of dissic " unit="mol/m2/s" /> 257 <field id="INTdtFer" long_name="Vertically int. of change of iron " unit="mol/m2/s" /> 258 <field id="INTdtDIN" long_name="Vertically int. of change of nitrogen " unit="mol/m2/s" /> 259 <field id="INTdtDIP" long_name="Vertically int. of change of phophate " unit="mol/m2/s" /> 260 <field id="INTdtSil" long_name="Vertically int. of change of silicon " unit="mol/m2/s" /> 261 262 263 <!-- dbio_T on T grid : variables available with diaar5 --> 264 <field id="TPP" long_name="Total Primary production of phyto" unit="mol/m3/s" grid_ref="grid_T_3D" /> 265 <field id="TPNEW" long_name="New Primary production of phyto" unit="mol/m3/s" grid_ref="grid_T_3D" /> 266 <field id="TPBFE" long_name="Total biogenic iron production" unit="mol/m3/s" grid_ref="grid_T_3D" /> 267 <field id="INTDIC" long_name="DIC content" unit="kg/m2" /> 268 <field id="O2MIN" long_name="Oxygen minimum concentration" unit="mol/m3" /> 269 <field id="ZO2MIN" long_name="Depth of oxygen minimum concentration" unit="m" /> 270 <field id="INTNFIX" long_name="Nitrogen fixation rate : vert. integrated" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > Nfix * e3t </field > 271 <field id="INTPPPHYN" long_name="Vertically integrated primary production by nanophy" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > PPPHYN * e3t </field > 272 <field id="INTPPPHYD" long_name="Vertically integrated primary production by diatom" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > PPPHYD * e3t </field > 273 <field id="INTPPPHYP" long_name="Vertically integrated primary production by picophy" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > PPPHYP * e3t </field > 274 <field id="INTPP" long_name="Vertically integrated primary production by phyto" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > TPP * e3t </field > 275 <field id="INTPNEW" long_name="Vertically integrated new primary production" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > TPNEW * e3t </field > 276 <field id="INTPBFE" long_name="Vertically integrated of biogenic iron production" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > TPBFE * e3t </field > 277 <field id="INTPBSI" long_name="Vertically integrated of biogenic Si production" unit="mol/m2/s" grid_ref="grid_T_vsum" detect_missing_value="true" > PBSi * e3t </field > 278 279 <!-- PISCES light : variables available with key_pisces_reduced --> 280 <field id="FNO3PHY" long_name="FNO3PHY" unit="" grid_ref="grid_T_3D" /> 281 <field id="FNH4PHY" long_name="FNH4PHY" unit="" grid_ref="grid_T_3D" /> 282 <field id="FNH4NO3" long_name="FNH4NO3" unit="" grid_ref="grid_T_3D" /> 283 <field id="TNO3PHY" long_name="TNO3PHY" unit="" /> 284 <field id="TNH4PHY" long_name="TNH4PHY" unit="" /> 285 <field id="TPHYDOM" long_name="TPHYDOM" unit="" /> 286 <field id="TPHYNH4" long_name="TPHYNH4" unit="" /> 287 <field id="TPHYZOO" long_name="TPHYZOO" unit="" /> 288 <field id="TPHYDET" long_name="TPHYDET" unit="" /> 289 <field id="TDETZOO" long_name="TDETZOO" unit="" /> 290 <field id="TZOODET" long_name="TZOODET" unit="" /> 291 <field id="TZOOBOD" long_name="TZOOBOD" unit="" /> 292 <field id="TZOONH4" long_name="TZOONH4" unit="" /> 293 <field id="TZOODOM" long_name="TZOODOM" unit="" /> 294 <field id="TNH4NO3" long_name="TNH4NO3" unit="" /> 295 <field id="TDOMNH4" long_name="TDOMNH4" unit="" /> 296 <field id="TDETNH4" long_name="TDETNH4" unit="" /> 297 <field id="TPHYTOT" long_name="TPHYTOT" unit="" /> 298 <field id="TZOOTOT" long_name="TZOOTOT" unit="" /> 299 <field id="SEDPOC" long_name="SEDPOC" unit="" /> 300 <field id="TDETSED" long_name="TDETSED" unit="" /> 301 </field_group> 302 303 <field_group id="tracer_scalar" grid_ref="grid_scalar" > 304 <!-- PISCES scalar --> 305 <field id="pno3tot" long_name="Global mean nitrate concentration" unit="mol/m3" /> 306 <field id="ppo4tot" long_name="global mean phosphorus concentration" unit="mol/m3" /> 307 <field id="psiltot" long_name="Global mean silicate concentration" unit="mol/m3" /> 308 <field id="palktot" long_name="Global mean alkalinity concentration" unit="mol/m3" /> 309 <field id="pfertot" long_name="Global mean iron concentration" unit="mol/m3" /> 310 <field id="tcflx" long_name="Total Flux of Carbon out of the ocean" unit="mol/s" /> 311 <field id="tcflxcum" long_name="Cumulative total Flux of Carbon out of the ocean" unit="mol/s" /> 312 <field id="tcexp" long_name="Total Carbon export at 100m" unit="mol/s" /> 313 <field id="tintpp" long_name="Global total integrated primary production" unit="mol/s" /> 314 <field id="tnfix" long_name="Global total nitrogen fixation" unit="mol/s" /> 315 <field id="tdenit" long_name="Total denitrification" unit="mol/s" /> 316 </field_group> 317 318 </field_definition> -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/grid_def_nemo.xml
r12377 r14021 4 4 = grid definition = = DO NOT CHANGE = 5 5 ============================================================================================================ 6 7 8 <grid_definition> 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 6 --> 7 8 <grid_definition> 9 10 <!-- --> 11 <grid id="grid_T_2D" > 12 <domain domain_ref="grid_T" /> 13 </grid> 14 <!-- --> 15 <grid id="grid_T_ncatice" > 16 <domain domain_ref="grid_T" /> 17 <axis axis_ref="ncatice" /> 18 </grid> 19 <!-- --> 20 <grid id="grid_T_3D" > 21 <domain domain_ref="grid_T" /> 22 <axis axis_ref="deptht" /> 23 </grid> 24 <!-- --> 25 <grid id="grid_T_3DS" > 26 <domain domain_ref="grid_T" /> 27 <axis axis_ref="profsed" /> 28 </grid> 29 <!-- --> 30 <grid id="grid_U_2D" > 31 <domain domain_ref="grid_U" /> 32 </grid> 33 <!-- --> 34 <grid id="grid_U_3D" > 35 <domain domain_ref="grid_U" /> 36 <axis axis_ref="depthu" /> 37 </grid> 38 <!-- --> 39 <grid id="grid_V_2D" > 40 <domain domain_ref="grid_V" /> 41 </grid> 42 <!-- --> 43 <grid id="grid_V_3D" > 44 <domain domain_ref="grid_V" /> 45 <axis axis_ref="depthv" /> 46 </grid> 47 <!-- --> 48 <grid id="grid_W_2D" > 49 <domain domain_ref="grid_W" /> 50 </grid> 51 <!-- --> 52 <grid id="grid_W_3D" > 53 <domain domain_ref="grid_W" /> 54 <axis axis_ref="depthw" /> 55 </grid> 56 <!-- --> 57 <grid id="grid_1point" > 58 <domain domain_ref="1point"/> 59 </grid> 60 <!-- --> 61 <grid id="grid_T_nfloat" > 62 <domain domain_ref="grid_T" /> 63 <axis axis_ref="nfloat" /> 64 </grid> 65 <!-- --> 66 <grid id="grid_EqT" > 67 <domain domain_ref="EqT" /> 68 </grid> 69 <!-- --> 70 71 72 <grid id="grid_znl_T_2D"> 73 <domain domain_ref="gznl" /> 74 <axis axis_ref="basin" /> 75 </grid> 76 77 <grid id="grid_znl_T_3D"> 78 <domain domain_ref="gznl" /> 79 <axis axis_ref="deptht" /> 80 <axis axis_ref="basin" /> 81 </grid> 82 83 <grid id="grid_znl_W_3D"> 84 <domain domain_ref="gznl" /> 85 <axis axis_ref="depthw" /> 86 <axis axis_ref="basin" /> 87 </grid> 88 89 <grid id="grid_ptr_T_2D"> 90 <domain domain_ref="ptr" /> 91 <axis axis_ref="basin" /> 92 </grid> 93 94 <grid id="grid_ptr_T_3D"> 95 <domain domain_ref="ptr" /> 96 <axis axis_ref="deptht" /> 97 <axis axis_ref="basin" /> 98 </grid> 99 100 <grid id="grid_ptr_W_3D"> 101 <domain domain_ref="ptr" /> 102 <axis axis_ref="depthw" /> 103 <axis axis_ref="basin" /> 104 </grid> 105 106 <grid id="grid_ptr_W_GLO"> 107 <domain domain_ref="ptr" /> 108 <axis axis_ref="depthw" /> 109 <scalar> 110 <extract_axis position="0" /> 111 </scalar> 112 </grid> 113 114 <grid id="grid_ptr_W_ATL"> 115 <domain domain_ref="ptr" /> 116 <axis axis_ref="depthw" /> 117 <scalar> 118 <extract_axis position="1" /> 119 </scalar> 120 </grid> 121 122 <grid id="grid_ptr_W_IND"> 123 <domain domain_ref="ptr" /> 124 <axis axis_ref="depthw" /> 125 <scalar> 126 <extract_axis position="2" /> 127 </scalar> 128 </grid> 129 130 <grid id="grid_T_SFC"> 131 <domain domain_ref="grid_T" /> 132 <scalar> 133 <extract_axis position="0" /> 134 </scalar> 135 </grid> 136 137 <grid id="grid_T_vsum"> 138 <domain domain_ref="grid_T"/> 139 <scalar> 140 <reduce_axis operation="sum" /> 141 </scalar> 142 </grid> 143 144 <grid id="grid_U_vsum"> 145 <domain domain_ref="grid_U"/> 146 <scalar> 147 <reduce_axis operation="sum" /> 148 </scalar> 149 </grid> 150 151 <grid id="grid_V_vsum"> 152 <domain domain_ref="grid_V"/> 153 <scalar> 154 <reduce_axis operation="sum" /> 155 </scalar> 156 </grid> 157 158 <!-- for ORCA2 grid --> 159 <grid id="cumul_U"> 160 <axis axis_ref="cumul_U" n_glo="182" > 161 <reduce_domain local="true" operation="sum" direction="jDir" /> 162 <reduce_axis operation="sum" /> 163 </axis> 164 <axis axis_ref="depthu" /> 165 </grid> 166 167 <!-- for eORCA1 grid 168 169 <grid id="cumul_U"> 170 <axis axis_ref="cumul_U" n_glo="362" > 171 <reduce_domain local="true" operation="sum" direction="jDir" /> 172 <reduce_axis operation="sum" /> 173 </axis> 174 <axis axis_ref="depthu" /> 175 </grid> 176 177 --> 178 179 180 <grid id="grid_T_zoom_300"> 181 <domain domain_ref="grid_T" /> 182 <axis axis_ref="deptht300" /> 183 </grid> 184 185 <grid id="grid_U_scalar" > 186 <domain domain_ref="grid_U" /> 187 <scalar/> 188 </grid> 189 190 <grid id="grid_V_scalar" > 191 <domain domain_ref="grid_V" /> 192 <scalar/> 193 </grid> 194 195 <grid id="grid_U_4strait"> 196 <domain domain_ref="grid_U" /> 197 <axis axis_ref="section"> 198 <duplicate_scalar/> 199 </axis> 200 </grid> 201 202 <grid id="grid_V_4strait"> 203 <domain domain_ref="grid_V" /> 204 <axis axis_ref="section"> 205 <duplicate_scalar/> 206 </axis> 207 </grid> 208 209 <grid id="grid_U_4strait_hsum"> 210 <scalar > 211 <reduce_domain operation="sum" local="true"/> 212 <reduce_scalar operation="sum" /> 213 </scalar> 214 <axis axis_ref="section"/> 215 </grid> 216 217 <grid id="grid_V_4strait_hsum"> 218 <scalar > 219 <reduce_domain operation="sum" local="true"/> 220 <reduce_scalar operation="sum" /> 221 </scalar> 222 <axis axis_ref="section"/> 223 </grid> 224 225 <grid id="grid_4strait"> 226 <axis axis_ref="section"/> 227 </grid> 228 229 <grid id="grid_U_4strait_ice"> 230 <domain domain_ref="grid_U" /> 231 <axis axis_ref="section_ice"> 232 <duplicate_scalar/> 233 </axis> 234 </grid> 235 236 <grid id="grid_V_4strait_ice"> 237 <domain domain_ref="grid_V" /> 238 <axis axis_ref="section_ice"> 239 <duplicate_scalar/> 240 </axis> 241 </grid> 242 243 <grid id="grid_U_4strait_ice_hsum"> 244 <scalar > 245 <reduce_domain operation="sum" local="true"/> 246 <reduce_scalar operation="sum" /> 247 </scalar> 248 <axis axis_ref="section_ice"/> 249 </grid> 250 251 <grid id="grid_V_4strait_ice_hsum"> 252 <scalar > 253 <reduce_domain operation="sum" local="true"/> 254 <reduce_scalar operation="sum" /> 255 </scalar> 256 <axis axis_ref="section_ice"/> 257 </grid> 258 259 <grid id="grid_4strait_ice"> 260 <axis axis_ref="section_ice"/> 261 </grid> 262 263 <!-- scalars --> 264 <grid id="grid_scalar" > 265 <scalar/> 266 </grid> 267 268 <!-- ABL grid definition --> 269 <grid id="grid_TA_2D"> 270 <domain domain_ref="grid_T" /> 271 </grid> 272 <grid id="grid_TA_3D"> 273 <domain domain_ref="grid_T" /> 274 <axis id="ght_abl" /> 275 </grid> 276 <grid id="grid_WA_3D"> 277 <domain domain_ref="grid_T" /> 278 <axis id="ghw_abl" /> 279 </grid> 280 <!-- --> 281 282 <!-- grid definitions for multiple-linear-regression analysis (diamlr) --> 283 <grid id="diamlr_grid_scalar" > 284 <scalar /> 285 <scalar /> 286 </grid> 287 <grid id="diamlr_grid_T_2D" > 288 <domain domain_ref="grid_T" /> 289 <scalar /> 290 </grid> 291 <grid id="diamlr_grid_U_2D" > 292 <domain domain_ref="grid_U" /> 293 <scalar /> 294 </grid> 295 <grid id="diamlr_grid_V_2D" > 296 <domain domain_ref="grid_V" /> 297 <scalar /> 298 </grid> 299 <grid id="diamlr_grid_W_2D" > 300 <domain domain_ref="grid_W" /> 301 <scalar /> 302 </grid> 303 <grid id="diamlr_grid_2D_to_grid_T_3D" > 304 <domain domain_ref="grid_T" /> 305 <axis axis_ref="deptht"> 306 <duplicate_scalar /> 307 </axis> 308 </grid> 309 <grid id="diamlr_grid_2D_to_grid_U_3D" > 310 <domain domain_ref="grid_U" /> 311 <axis axis_ref="depthu"> 312 <duplicate_scalar /> 313 </axis> 314 </grid> 315 <grid id="diamlr_grid_2D_to_grid_V_3D" > 316 <domain domain_ref="grid_V" /> 317 <axis axis_ref="depthv"> 318 <duplicate_scalar /> 319 </axis> 320 </grid> 321 <grid id="diamlr_grid_2D_to_grid_W_3D" > 322 <domain domain_ref="grid_W" /> 323 <axis axis_ref="depthw"> 324 <duplicate_scalar /> 325 </axis> 326 </grid> 327 <grid id="diamlr_grid_2D_to_scalar" > 328 <scalar> 329 <reduce_domain operation="average" /> 330 </scalar> 331 <scalar /> 332 </grid> 333 <!-- grid definitions for the computation of daily detided model diagnostics (diadetide) --> 334 <grid id="diadetide_grid_T_2D" > 335 <domain domain_ref="grid_T" /> 336 <scalar /> 337 </grid> 338 <grid id="diadetide_grid_U_2D" > 339 <domain domain_ref="grid_U" /> 340 <scalar /> 341 </grid> 342 <grid id="diadetide_grid_V_2D" > 343 <domain domain_ref="grid_V" /> 344 <scalar /> 345 </grid> 346 <grid id="diadetide_grid_2D_to_grid_T_3D" > 347 <domain domain_ref="grid_T" /> 348 <axis axis_ref="deptht"> 349 <duplicate_scalar /> 350 </axis> 351 </grid> 352 <grid id="diadetide_grid_2D_to_grid_U_3D" > 353 <domain domain_ref="grid_U" /> 354 <axis axis_ref="depthu"> 355 <duplicate_scalar /> 356 </axis> 357 </grid> 358 <grid id="diadetide_grid_2D_to_grid_V_3D" > 359 <domain domain_ref="grid_V" /> 360 <axis axis_ref="depthv"> 361 <duplicate_scalar /> 362 </axis> 363 </grid> 364 <grid id="diadetide_grid_2D_to_grid_W_3D" > 365 <domain domain_ref="grid_W" /> 366 <axis axis_ref="depthw"> 367 <duplicate_scalar /> 368 </axis> 369 </grid> 370 371 </grid_definition> -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/namelist_ref
r14017 r14021 237 237 ln_apr_dyn = .false. ! Patm gradient added in ocean & ice Eqs. (T => fill namsbc_apr ) 238 238 ln_wave = .false. ! Activate coupling with wave (T => fill namsbc_wave) 239 ln_cdgw = .false. ! Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave)240 ln_sdw = .false. ! Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave)241 nn_sdrift = 0 ! Parameterization for the calculation of 3D-Stokes drift from the surface Stokes drift242 ! ! = 0 Breivik 2015 parameterization: v_z=v_0*[exp(2*k*z)/(1-8*k*z)]243 ! ! = 1 Phillips: v_z=v_o*[exp(2*k*z)-beta*sqrt(-2*k*pi*z)*erfc(sqrt(-2*k*z))]244 ! ! = 2 Phillips as (1) but using the wave frequency from a wave model245 ln_tauwoc = .false. ! Activate ocean stress modified by external wave induced stress (T => ln_wave=.true. & fill namsbc_wave)246 ln_tauw = .false. ! Activate ocean stress components from wave model247 ln_stcor = .false. ! Activate Stokes Coriolis term (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave)248 239 nn_lsm = 0 ! =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 249 240 ! =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) … … 386 377 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 387 378 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 388 sn_rcv_hsig = 'none' , 'no' , '' , '' , ''389 379 sn_rcv_iceflx = 'none' , 'no' , '' , '' , '' 390 380 sn_rcv_mslp = 'none' , 'no' , '' , '' , '' 391 sn_rcv_phioc = 'none' , 'no' , '' , '' , ''392 sn_rcv_sdrfx = 'none' , 'no' , '' , '' , ''393 sn_rcv_sdrfy = 'none' , 'no' , '' , '' , ''394 sn_rcv_wper = 'none' , 'no' , '' , '' , ''395 sn_rcv_wnum = 'none' , 'no' , '' , '' , ''396 sn_rcv_wfreq = 'none' , 'no' , '' , '' , ''397 sn_rcv_wdrag = 'none' , 'no' , '' , '' , ''398 381 sn_rcv_ts_ice = 'none' , 'no' , '' , '' , '' 399 382 sn_rcv_isf = 'none' , 'no' , '' , '' , '' 400 383 sn_rcv_icb = 'none' , 'no' , '' , '' , '' 401 sn_rcv_tauwoc = 'none' , 'no' , '' , '' , '' 402 sn_rcv_tauw = 'none' , 'no' , '' , '' , '' 403 sn_rcv_wdrag = 'none' , 'no' , '' , '' , '' 384 sn_rcv_hsig = 'none' , 'no' , '' ' '' , 'T' 385 sn_rcv_phioc = 'none' , 'no' , '' , '' , 'T' 386 sn_rcv_sdrfx = 'none' , 'no' , '' , '' , 'T' 387 sn_rcv_sdrfy = 'none' , 'no' , '' ' '' , 'T' 388 sn_rcv_wper = 'none' , 'no' , '' ' '' , 'T' 389 sn_rcv_wnum = 'none' , 'no' , '' ' '' , 'T' 390 sn_rcv_wstrf = 'none' , 'no' , '' ' '' , 'T' 391 sn_rcv_wdrag = 'none' , 'no' , '' ' '' , 'T' 392 sn_rcv_charn = 'none' , 'no' , '' , '' , 'T' 393 sn_rcv_taw = 'none' , 'no' , '' , '' , 'U,V' 394 sn_rcv_bhd = 'none' , 'no' , '' ' '' , 'T' 395 sn_rcv_tusd = 'none' , 'no' , '' ' '' , 'T' 396 sn_rcv_tvsd = 'none' , 'no' , '' ' '' , 'T' 404 397 / 405 398 !----------------------------------------------------------------------- … … 586 579 &namsbc_wave ! External fields from wave model (ln_wave=T) 587 580 !----------------------------------------------------------------------- 581 ln_sdw = .false. ! get the 2D Surf Stokes Drift & Compute the 3D stokes drift 582 ln_stcor = .false. ! add Stokes Coriolis and tracer advection terms 583 ln_cdgw = .false. ! Neutral drag coefficient read from wave model 584 ln_tauoc = .false. ! ocean stress is modified by wave induced stress 585 ln_wave_test= .false. ! Test case with constant wave fields 586 ! 587 ln_charn = .false. ! Charnock coefficient read from wave model (IFS only) 588 ln_taw = .false. ! ocean stress is modified by wave induced stress (coupled mode) 589 ln_phioc = .false. ! TKE flux from wave model 590 ln_bern_srfc= .false. ! wave induced pressure. Bernoulli head J term 591 ln_breivikFV_2016 = .false. ! breivik 2016 vertical stokes profile 592 ln_vortex_force = .false. ! Vortex Force term 593 ln_stshear = .false. ! include stokes shear in EKE computation 594 ! 588 595 cn_dir = './' ! root directory for the waves data location 589 596 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! … … 595 602 sn_hsw = 'sdw_ecwaves_orca2' , 6. , 'hs' , .true. , .true. , 'yearly' , '' , '' , '' 596 603 sn_wmp = 'sdw_ecwaves_orca2' , 6. , 'wmp' , .true. , .true. , 'yearly' , '' , '' , '' 597 sn_wfr = 'sdw_ecwaves_orca2' , 6. , 'wfr' , .true. , .true. , 'yearly' , '' , '' , ''598 604 sn_wnum = 'sdw_ecwaves_orca2' , 6. , 'wave_num' , .true. , .true. , 'yearly' , '' , '' , '' 599 sn_tauwoc = 'sdw_ecwaves_orca2' , 6. , 'wave_stress', .true. , .true. , 'yearly' , '' , '' , '' 600 sn_tauwx = 'sdw_ecwaves_orca2' , 6. , 'wave_stress', .true. , .true. , 'yearly' , '' , '' , '' 601 sn_tauwy = 'sdw_ecwaves_orca2' , 6. , 'wave_stress', .true. , .true. , 'yearly' , '' , '' , '' 605 sn_tauoc = 'sdw_ecwaves_orca2' , 6. , 'wave_stress', .true. , .true. , 'yearly' , '' , '' , '' 602 606 / 603 607 !----------------------------------------------------------------------- … … 1126 1130 nn_npc = 1 ! frequency of application of npc 1127 1131 nn_npcp = 365 ! npc control print frequency 1132 ln_zdfmfc = .false. ! Mass Flux Convection 1128 1133 ! 1129 1134 ln_zdfddm = .false. ! double diffusive mixing … … 1176 1181 rn_mxlice = 10. ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 1177 1182 rn_mxl0 = 0.04 ! surface buoyancy lenght scale minimum value 1183 ln_mxhsw = .false. ! surface mixing length scale = F(wave height) 1178 1184 ln_lc = .true. ! Langmuir cell parameterisation (Axell 2002) 1179 1185 rn_lc = 0.15 ! coef. associated to Langmuir cells … … 1191 1197 ! ! = 2 weighted by 1-fr_i 1192 1198 ! ! = 3 weighted by 1-MIN(1,4*fr_i) 1199 nn_bc_surf = 1 ! surface condition (0/1=Dir/Neum) ! Only applicable for wave coupling (ln_cplwave=1) 1200 nn_bc_bot = 1 ! bottom condition (0/1=Dir/Neum) ! Only applicable for wave coupling (ln_cplwave=1) 1193 1201 / 1194 1202 !----------------------------------------------------------------------- … … 1235 1243 ! ! = 1: Pierson Moskowitz wave spectrum 1236 1244 ! ! = 0: Constant La# = 0.3 1245 / 1246 !----------------------------------------------------------------------- 1247 &namzdf_mfc ! Mass Flux Convection 1248 !----------------------------------------------------------------------- 1249 ln_edmfuv = .false. ! Activate on velocity fields (Not available yet) 1250 rn_cemf = 1. ! entrain/detrain coef. (<0 => cte; >0 % depending on dW/dz 1251 rn_cwmf = -0. ! entrain/detrain coef. (<0 => cte; >0 % depending on dW/dz 1252 rn_cent = 2.e-5 ! entrain of convective area 1253 rn_cdet = 3.e-5 ! detrain of convective area 1254 rn_cap = 0.9 ! Coef. for CAP estimation 1255 App_max = 0.1 ! Maximum convection area (% of the cell) 1237 1256 / 1238 1257 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/ice.F90
r14017 r14021 150 150 ! 151 151 ! !!** ice-rheology namelist (namdyn_rhg) ** 152 ! -- evp 152 153 LOGICAL , PUBLIC :: ln_rhg_EVP ! EVP rheology switch, used for rdgrft and rheology 153 154 LOGICAL , PUBLIC :: ln_rhg_EAP ! EAP rheology switch, used for rdgrft and rheology 154 155 LOGICAL , PUBLIC :: ln_aEVP !: using adaptive EVP (T or F) 155 REAL(wp), PUBLIC :: rn_creepl !: creep limit : has to be under 1.0e-9156 REAL(wp), PUBLIC :: rn_creepl !: creep limit (has to be low enough, circa 10-9 m/s, depending on rheology) 156 157 REAL(wp), PUBLIC :: rn_ecc !: eccentricity of the elliptical yield curve 157 158 INTEGER , PUBLIC :: nn_nevp !: number of iterations for subcycling 158 159 REAL(wp), PUBLIC :: rn_relast !: ratio => telast/rDt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 159 160 INTEGER , PUBLIC :: nn_rhg_chkcvg !: check ice rheology convergence 161 ! -- vp 162 LOGICAL , PUBLIC :: ln_rhg_VP !: VP rheology 163 INTEGER , PUBLIC :: nn_vp_nout !: Number of outer iterations 164 INTEGER , PUBLIC :: nn_vp_ninn !: Number of inner iterations (linear system solver) 165 INTEGER , PUBLIC :: nn_vp_chkcvg !: Number of iterations every each convergence is checked 160 166 ! 161 167 ! !!** ice-advection namelist (namdyn_adv) ** … … 210 216 ! !!** ice-ponds namelist (namthd_pnd) 211 217 LOGICAL , PUBLIC :: ln_pnd !: Melt ponds (T) or not (F) 212 LOGICAL , PUBLIC :: ln_pnd_LEV !: Melt ponds scheme from Holland et al (2012), Flocco et al (2007, 2010) 213 REAL(wp), PUBLIC :: rn_apnd_min !: Minimum ice fraction that contributes to melt ponds 214 REAL(wp), PUBLIC :: rn_apnd_max !: Maximum ice fraction that contributes to melt ponds 218 LOGICAL , PUBLIC :: ln_pnd_TOPO !: Topographic Melt ponds scheme (Flocco et al 2007, 2010) 219 LOGICAL , PUBLIC :: ln_pnd_LEV !: Simple melt pond scheme 220 REAL(wp), PUBLIC :: rn_apnd_min !: Minimum fraction of melt water contributing to ponds 221 REAL(wp), PUBLIC :: rn_apnd_max !: Maximum fraction of melt water contributing to ponds 222 REAL(wp), PUBLIC :: rn_pnd_flush !: Pond flushing efficiency (tuning parameter) 215 223 LOGICAL , PUBLIC :: ln_pnd_CST !: Melt ponds scheme with constant fraction and depth 216 224 REAL(wp), PUBLIC :: rn_apnd !: prescribed pond fraction (0<rn_apnd<1) … … 345 353 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: om_i !: mean ice age over all categories (s) 346 354 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_icebfr !: ice friction on ocean bottom (landfast param activated) 355 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: icb_mask !: mask of grounded icebergs if landfast [0-1] 347 356 348 357 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] … … 366 375 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_il !: total melt pond lid volume per gridcell area [m] 367 376 377 ! meltwater arrays to save for melt ponds (mv - could be grouped in a single meltwater volume array) 378 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dh_i_sum_2d !: surface melt (2d arrays for ponds) [m] 379 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dh_s_mlt_2d !: snow surf melt (2d arrays for ponds) [m] 380 368 381 !!---------------------------------------------------------------------- 369 382 !! * Global variables at before time step 370 383 !!---------------------------------------------------------------------- 371 384 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s_b, v_i_b, h_s_b, h_i_b !: snow and ice volumes/thickness 385 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip_b, v_il_b !: ponds and lids volumes 372 386 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_b, sv_i_b !: 373 387 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s_b !: snow heat content … … 396 410 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vsnw !: snw volume variation [m/s] 397 411 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_aice !: ice conc. variation [s-1] 412 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vpnd !: pond volume variation [m/s] 398 413 ! 399 414 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_adv_mass !: advection of mass (kg/m2/s) … … 473 488 & et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s(jpi,jpj) , & 474 489 & sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) , & 475 & om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj) 490 & om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj), icb_mask(jpi,jpj), STAT=ierr(ii) ) 476 491 477 492 ii = ii + 1 … … 483 498 ii = ii + 1 484 499 ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl), & 485 & v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) , STAT = ierr(ii) ) 500 & v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) , & 501 & dh_i_sum_2d(jpi,jpj,jpl) , dh_s_mlt_2d(jpi,jpj,jpl) , STAT = ierr(ii) ) 486 502 487 503 ii = ii + 1 … … 491 507 ii = ii + 1 492 508 ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , h_s_b(jpi,jpj,jpl) , h_i_b(jpi,jpj,jpl), & 509 & v_ip_b(jpi,jpj,jpl) , v_il_b(jpi,jpj,jpl) , & 493 510 & a_i_b (jpi,jpj,jpl) , sv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , & 494 511 & STAT=ierr(ii) ) … … 505 522 ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj), & 506 523 & diag_trp_es(jpi,jpj) , diag_trp_sv (jpi,jpj) , diag_heat (jpi,jpj), & 507 & diag_sice (jpi,jpj) , diag_vice (jpi,jpj) , diag_vsnw (jpi,jpj), diag_aice(jpi,jpj), &524 & diag_sice (jpi,jpj) , diag_vice (jpi,jpj) , diag_vsnw (jpi,jpj), diag_aice(jpi,jpj), diag_vpnd(jpi,jpj), & 508 525 & diag_adv_mass(jpi,jpj), diag_adv_salt(jpi,jpj), diag_adv_heat(jpi,jpj), STAT=ierr(ii) ) 509 526 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icectl.F90
r13601 r14021 12 12 !! 'key_si3' SI3 sea-ice model 13 13 !!---------------------------------------------------------------------- 14 !! ice_cons_hsm : conservation tests on heat, salt and mass during a time step (global) 14 !! ice_cons_hsm : conservation tests on heat, salt and mass during a time step (global) 15 15 !! ice_cons_final : conservation tests on heat, salt and mass at end of time step (global) 16 16 !! ice_cons2D : conservation tests on heat, salt and mass at each gridcell … … 55 55 CHARACTER(LEN=50) :: clname="icedrift_diagnostics.ascii" ! ascii filename 56 56 INTEGER :: numicedrift ! outfile unit 57 REAL(wp) :: rdiag_icemass, rdiag_icesalt, rdiag_iceheat 58 REAL(wp) :: rdiag_adv_icemass, rdiag_adv_icesalt, rdiag_adv_iceheat 59 57 REAL(wp) :: rdiag_icemass, rdiag_icesalt, rdiag_iceheat 58 REAL(wp) :: rdiag_adv_icemass, rdiag_adv_icesalt, rdiag_adv_iceheat 59 60 60 !! * Substitutions 61 61 # include "do_loop_substitute.h90" … … 77 77 !! It prints in ocean.output if there is a violation of conservation at each time-step 78 78 !! The thresholds (zchk_m, zchk_s, zchk_t) determine violations 79 !! For salt and heat thresholds, ice is considered to have a salinity of 10 80 !! and a heat content of 3e5 J/kg (=latent heat of fusion) 79 !! For salt and heat thresholds, ice is considered to have a salinity of 10 80 !! and a heat content of 3e5 J/kg (=latent heat of fusion) 81 81 !!------------------------------------------------------------------- 82 82 INTEGER , INTENT(in) :: icount ! called at: =0 the begining of the routine, =1 the end … … 85 85 !! 86 86 REAL(wp) :: zdiag_mass, zdiag_salt, zdiag_heat, & 87 & zdiag_vmin, zdiag_amin, zdiag_amax, zdiag_eimin, zdiag_esmin, zdiag_smin 87 & zdiag_vimin, zdiag_vsmin, zdiag_vpmin, zdiag_vlmin, zdiag_aimin, zdiag_aimax, & 88 & zdiag_eimin, zdiag_esmin, zdiag_simin 88 89 REAL(wp) :: zvtrp, zetrp 89 90 REAL(wp) :: zarea … … 92 93 IF( icount == 0 ) THEN 93 94 94 pdiag_v = glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos , dim=3 ) * e1e2t )95 pdiag_v = glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) * e1e2t ) 95 96 pdiag_s = glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) 96 97 pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t ) … … 112 113 113 114 ! -- mass diag -- ! 114 zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_Dt_ice & 115 zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) * e1e2t ) & 116 & - pdiag_v ) * r1_Dt_ice & 115 117 & + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + & 116 118 & wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + & … … 132 134 133 135 ! -- min/max diag -- ! 134 zdiag_amax = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 135 zdiag_vmin = glob_min( 'icectl', v_i ) 136 zdiag_amin = glob_min( 'icectl', a_i ) 137 zdiag_smin = glob_min( 'icectl', sv_i ) 136 zdiag_aimax = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 137 zdiag_vimin = glob_min( 'icectl', v_i ) 138 zdiag_vsmin = glob_min( 'icectl', v_s ) 139 zdiag_vpmin = glob_min( 'icectl', v_ip ) 140 zdiag_vlmin = glob_min( 'icectl', v_il ) 141 zdiag_aimin = glob_min( 'icectl', a_i ) 142 zdiag_simin = glob_min( 'icectl', sv_i ) 138 143 zdiag_eimin = glob_min( 'icectl', SUM( e_i, dim=3 ) ) 139 144 zdiag_esmin = glob_min( 'icectl', SUM( e_s, dim=3 ) ) … … 143 148 zetrp = glob_sum( 'icectl', diag_adv_heat * e1e2t ) 144 149 145 ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 150 ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 146 151 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 147 152 … … 155 160 & WRITE(numout,*) cd_routine,' : violation heat cons. [J] = ',zdiag_heat * rDt_ice 156 161 ! check negative values 157 IF( zdiag_vmin < 0. ) WRITE(numout,*) cd_routine,' : violation v_i < 0 = ',zdiag_vmin 158 IF( zdiag_amin < 0. ) WRITE(numout,*) cd_routine,' : violation a_i < 0 = ',zdiag_amin 159 IF( zdiag_smin < 0. ) WRITE(numout,*) cd_routine,' : violation s_i < 0 = ',zdiag_smin 160 IF( zdiag_eimin < 0. ) WRITE(numout,*) cd_routine,' : violation e_i < 0 = ',zdiag_eimin 161 IF( zdiag_esmin < 0. ) WRITE(numout,*) cd_routine,' : violation e_s < 0 = ',zdiag_esmin 162 IF( zdiag_vimin < 0. ) WRITE(numout,*) cd_routine,' : violation v_i < 0 = ',zdiag_vimin 163 IF( zdiag_vsmin < 0. ) WRITE(numout,*) cd_routine,' : violation v_s < 0 = ',zdiag_vsmin 164 IF( zdiag_vpmin < 0. ) WRITE(numout,*) cd_routine,' : violation v_ip < 0 = ',zdiag_vpmin 165 IF( zdiag_vlmin < 0. ) WRITE(numout,*) cd_routine,' : violation v_il < 0 = ',zdiag_vlmin 166 IF( zdiag_aimin < 0. ) WRITE(numout,*) cd_routine,' : violation a_i < 0 = ',zdiag_aimin 167 IF( zdiag_simin < 0. ) WRITE(numout,*) cd_routine,' : violation s_i < 0 = ',zdiag_simin 168 IF( zdiag_eimin < 0. ) WRITE(numout,*) cd_routine,' : violation e_i < 0 = ',zdiag_eimin 169 IF( zdiag_esmin < 0. ) WRITE(numout,*) cd_routine,' : violation e_s < 0 = ',zdiag_esmin 162 170 ! check maximum ice concentration 163 IF( zdiag_a max >MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) &164 & WRITE(numout,*) cd_routine,' : violation a_i > amax = ',zdiag_a max171 IF( zdiag_aimax>MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 172 & WRITE(numout,*) cd_routine,' : violation a_i > amax = ',zdiag_aimax 165 173 ! check if advection scheme is conservative 166 174 IF( ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 167 & WRITE(numout,*) cd_routine,' : violation adv scheme [kg] = ',zvtrp * r dt_ice175 & WRITE(numout,*) cd_routine,' : violation adv scheme [kg] = ',zvtrp * rDt_ice 168 176 IF( ABS(zetrp) > zchk_t * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 169 & WRITE(numout,*) cd_routine,' : violation adv scheme [J] = ',zetrp * r dt_ice177 & WRITE(numout,*) cd_routine,' : violation adv scheme [J] = ',zetrp * rDt_ice 170 178 ENDIF 171 179 ! … … 183 191 !! It prints in ocean.output if there is a violation of conservation at each time-step 184 192 !! The thresholds (zchk_m, zchk_s, zchk_t) determine the violations 185 !! For salt and heat thresholds, ice is considered to have a salinity of 10 186 !! and a heat content of 3e5 J/kg (=latent heat of fusion) 193 !! For salt and heat thresholds, ice is considered to have a salinity of 10 194 !! and a heat content of 3e5 J/kg (=latent heat of fusion) 187 195 !!------------------------------------------------------------------- 188 196 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine … … 193 201 ! water flux 194 202 ! -- mass diag -- ! 195 zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub&196 & + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t )203 zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + wfx_pnd & 204 & + diag_vice + diag_vsnw + diag_vpnd - diag_adv_mass ) * e1e2t ) 197 205 198 206 ! -- salt diag -- ! … … 200 208 201 209 ! -- heat diag -- ! 202 zdiag_heat 210 zdiag_heat = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ) 203 211 ! equivalent to this: 204 212 !!zdiag_heat = glob_sum( 'icectl', ( -diag_heat + hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & … … 206 214 !! & ) * e1e2t ) 207 215 208 ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 216 ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 209 217 zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 210 218 … … 235 243 !! 236 244 REAL(wp), DIMENSION(jpi,jpj) :: zdiag_mass, zdiag_salt, zdiag_heat, & 237 & zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax 245 & zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax 238 246 INTEGER :: jl, jk 239 247 LOGICAL :: ll_stop_m = .FALSE. … … 245 253 IF( icount == 0 ) THEN 246 254 247 pdiag_v = SUM( v_i * rhoi + v_s * rhos , dim=3 )248 pdiag_s = SUM( sv_i * rhoi 255 pdiag_v = SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) 256 pdiag_s = SUM( sv_i * rhoi , dim=3 ) 249 257 pdiag_t = SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) 250 258 … … 253 261 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr 254 262 ! salt flux 255 pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam 263 pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam 256 264 ! heat flux 257 pdiag_ft = hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 265 pdiag_ft = hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 258 266 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr 259 267 … … 261 269 262 270 ! -- mass diag -- ! 263 zdiag_mass = ( SUM( v_i * rhoi + v_s * rhos , dim=3 ) - pdiag_v ) * r1_Dt_ice&271 zdiag_mass = ( SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) - pdiag_v ) * r1_Dt_ice & 264 272 & + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 265 273 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) & … … 275 283 ! -- heat diag -- ! 276 284 zdiag_heat = ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_Dt_ice & 277 & + ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 285 & + ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 278 286 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) & 279 287 & - pdiag_ft … … 316 324 IF( ll_stop_s ) CALL ctl_stop( 'STOP', cd_routine//': ice salt conservation issue' ) 317 325 IF( ll_stop_t ) CALL ctl_stop( 'STOP', cd_routine//': ice heat conservation issue' ) 318 326 319 327 ENDIF 320 328 … … 324 332 !!--------------------------------------------------------------------- 325 333 !! *** ROUTINE ice_cons_wri *** 326 !! 327 !! ** Purpose : create a NetCDF file named cdfile_name which contains 334 !! 335 !! ** Purpose : create a NetCDF file named cdfile_name which contains 328 336 !! the instantaneous fields when conservation issue occurs 329 337 !! … … 332 340 CHARACTER(len=*), INTENT( in ) :: cdfile_name ! name of the file created 333 341 REAL(wp), DIMENSION(:,:), INTENT( in ) :: pdiag_mass, pdiag_salt, pdiag_heat, & 334 & pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax 342 & pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax 335 343 !! 336 344 INTEGER :: inum 337 345 !!---------------------------------------------------------------------- 338 ! 346 ! 339 347 IF(lwp) WRITE(numout,*) 340 348 IF(lwp) WRITE(numout,*) 'ice_cons_wri : single instantaneous ice state' 341 349 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ named :', cdfile_name, '...nc' 342 IF(lwp) WRITE(numout,*) 350 IF(lwp) WRITE(numout,*) 343 351 344 352 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 345 353 346 354 CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 ) ! ice mass spurious lost/gain 347 355 CALL iom_rstput( 0, 0, inum, 'cons_salt', pdiag_salt(:,:) , ktype = jp_r8 ) ! ice salt spurious lost/gain 348 356 CALL iom_rstput( 0, 0, inum, 'cons_heat', pdiag_heat(:,:) , ktype = jp_r8 ) ! ice heat spurious lost/gain 349 357 ! other diags 350 CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 ) ! 351 CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 ) ! 352 CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 ) ! 353 CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 ) ! 354 358 CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 ) ! 359 CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 ) ! 360 CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 ) ! 361 CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 ) ! 362 ! mean state 363 CALL iom_rstput( 0, 0, inum, 'icecon' , SUM(a_i ,dim=3) , ktype = jp_r8 ) ! 364 CALL iom_rstput( 0, 0, inum, 'icevol' , SUM(v_i ,dim=3) , ktype = jp_r8 ) ! 365 CALL iom_rstput( 0, 0, inum, 'snwvol' , SUM(v_s ,dim=3) , ktype = jp_r8 ) ! 366 CALL iom_rstput( 0, 0, inum, 'pndvol' , SUM(v_ip,dim=3) , ktype = jp_r8 ) ! 367 CALL iom_rstput( 0, 0, inum, 'lidvol' , SUM(v_il,dim=3) , ktype = jp_r8 ) ! 368 355 369 CALL iom_close( inum ) 356 370 357 371 END SUBROUTINE ice_cons_wri 358 372 359 373 SUBROUTINE ice_ctl( kt ) 360 374 !!------------------------------------------------------------------- 361 !! *** ROUTINE ice_ctl *** 362 !! 375 !! *** ROUTINE ice_ctl *** 376 !! 363 377 !! ** Purpose : control checks 364 378 !!------------------------------------------------------------------- … … 372 386 inb_alp(:) = 0 373 387 ialert_id = 0 374 388 375 389 ! Alert if very high salinity 376 390 ialert_id = ialert_id + 1 ! reference number of this alert … … 416 430 END_3D 417 431 END DO 418 432 419 433 ! Alert if very warm ice 420 434 ialert_id = ialert_id + 1 ! reference number of this alert … … 430 444 END_3D 431 445 END DO 432 446 433 447 ! Alerte if very thick ice 434 448 ialert_id = ialert_id + 1 ! reference number of this alert 435 449 cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 436 jl = jpl 450 jl = jpl 437 451 DO_2D( 1, 1, 1, 1 ) 438 452 IF( h_i(ji,jj,jl) > 50._wp ) THEN … … 446 460 ialert_id = ialert_id + 1 ! reference number of this alert 447 461 cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert 448 jl = 1 462 jl = 1 449 463 DO_2D( 1, 1, 1, 1 ) 450 464 IF( h_i(ji,jj,jl) < rn_himin ) THEN … … 470 484 cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 471 485 DO_2D( 1, 1, 1, 1 ) 472 IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN 486 IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN 473 487 WRITE(numout,*) ' ALERTE : Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 474 488 WRITE(numout,*) ' at i,j = ',ji,jj … … 482 496 DO_2D( 1, 1, 1, 1 ) 483 497 IF( ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. & 484 & ( vt_i(ji,jj) > 0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN 498 & ( vt_i(ji,jj) > 0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN 485 499 WRITE(numout,*) ' ALERTE : Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj) 486 500 WRITE(numout,*) ' at i,j = ',ji,jj … … 506 520 ! 507 521 END SUBROUTINE ice_ctl 508 522 509 523 SUBROUTINE ice_prt( kt, ki, kj, kn, cd1 ) 510 524 !!------------------------------------------------------------------- 511 !! *** ROUTINE ice_prt *** 512 !! 513 !! ** Purpose : Writes global ice state on the (i,j) point 514 !! in ocean.ouput 515 !! 3 possibilities exist 525 !! *** ROUTINE ice_prt *** 526 !! 527 !! ** Purpose : Writes global ice state on the (i,j) point 528 !! in ocean.ouput 529 !! 3 possibilities exist 516 530 !! n = 1/-1 -> simple ice state 517 531 !! n = 2 -> exhaustive state 518 532 !! n = 3 -> ice/ocean salt fluxes 519 533 !! 520 !! ** input : point coordinates (i,j) 534 !! ** input : point coordinates (i,j) 521 535 !! n : number of the option 522 536 !!------------------------------------------------------------------- … … 536 550 ! Simple state 537 551 !---------------- 538 552 539 553 IF ( kn == 1 .OR. kn == -1 ) THEN 540 554 WRITE(numout,*) ' ice_prt - Point : ',ji,jj … … 552 566 WRITE(numout,*) ' - Cell values ' 553 567 WRITE(numout,*) ' ~~~~~~~~~~~ ' 554 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 555 WRITE(numout,*) ' ato_i : ', ato_i(ji,jj) 556 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) 557 WRITE(numout,*) ' vt_s : ', vt_s(ji,jj) 568 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 569 WRITE(numout,*) ' ato_i : ', ato_i(ji,jj) 570 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) 571 WRITE(numout,*) ' vt_s : ', vt_s(ji,jj) 558 572 DO jl = 1, jpl 559 573 WRITE(numout,*) ' - Category (', jl,')' … … 578 592 ! Exhaustive state 579 593 !-------------------- 580 594 581 595 IF ( kn .EQ. 2 ) THEN 582 596 WRITE(numout,*) ' ice_prt - Point : ',ji,jj … … 584 598 WRITE(numout,*) ' Exhaustive state ' 585 599 WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 586 WRITE(numout,*) 600 WRITE(numout,*) 587 601 WRITE(numout,*) ' - Cell values ' 588 602 WRITE(numout,*) ' ~~~~~~~~~~~ ' 589 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 590 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) 591 WRITE(numout,*) ' vt_s : ', vt_s(ji,jj) 603 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 604 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) 605 WRITE(numout,*) ' vt_s : ', vt_s(ji,jj) 592 606 WRITE(numout,*) ' u_ice(i-1,j) : ', u_ice(ji-1,jj) 593 607 WRITE(numout,*) ' u_ice(i ,j) : ', u_ice(ji,jj) … … 596 610 WRITE(numout,*) ' strength : ', strength(ji,jj) 597 611 WRITE(numout,*) 598 612 599 613 DO jl = 1, jpl 600 614 WRITE(numout,*) ' - Category (',jl,')' 601 WRITE(numout,*) ' ~~~~~~~~ ' 615 WRITE(numout,*) ' ~~~~~~~~ ' 602 616 WRITE(numout,*) ' h_i : ', h_i(ji,jj,jl) , ' h_s : ', h_s(ji,jj,jl) 603 617 WRITE(numout,*) ' t_i : ', t_i(ji,jj,1:nlay_i,jl) 604 618 WRITE(numout,*) ' t_su : ', t_su(ji,jj,jl) , ' t_s : ', t_s(ji,jj,1:nlay_s,jl) 605 619 WRITE(numout,*) ' s_i : ', s_i(ji,jj,jl) , ' o_i : ', o_i(ji,jj,jl) 606 WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) , ' a_i_b : ', a_i_b(ji,jj,jl) 607 WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) , ' v_i_b : ', v_i_b(ji,jj,jl) 608 WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl) , ' v_s_b : ', v_s_b(ji,jj,jl) 609 WRITE(numout,*) ' e_i1 : ', e_i(ji,jj,1,jl) , ' ei1 : ', e_i_b(ji,jj,1,jl) 610 WRITE(numout,*) ' e_i2 : ', e_i(ji,jj,2,jl) , ' ei2_b : ', e_i_b(ji,jj,2,jl) 611 WRITE(numout,*) ' e_snow : ', e_s(ji,jj,1,jl) , ' e_snow_b : ', e_s_b(ji,jj,1,jl) 612 WRITE(numout,*) ' sv_i : ', sv_i(ji,jj,jl) , ' sv_i_b : ', sv_i_b(ji,jj,jl) 620 WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) , ' a_i_b : ', a_i_b(ji,jj,jl) 621 WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) , ' v_i_b : ', v_i_b(ji,jj,jl) 622 WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl) , ' v_s_b : ', v_s_b(ji,jj,jl) 623 WRITE(numout,*) ' e_i1 : ', e_i(ji,jj,1,jl) , ' ei1 : ', e_i_b(ji,jj,1,jl) 624 WRITE(numout,*) ' e_i2 : ', e_i(ji,jj,2,jl) , ' ei2_b : ', e_i_b(ji,jj,2,jl) 625 WRITE(numout,*) ' e_snow : ', e_s(ji,jj,1,jl) , ' e_snow_b : ', e_s_b(ji,jj,1,jl) 626 WRITE(numout,*) ' sv_i : ', sv_i(ji,jj,jl) , ' sv_i_b : ', sv_i_b(ji,jj,jl) 613 627 END DO !jl 614 628 615 629 WRITE(numout,*) 616 630 WRITE(numout,*) ' - Heat / FW fluxes ' … … 620 634 WRITE(numout,*) ' qns_ini : ', (1._wp-at_i_b(ji,jj)) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) ) 621 635 WRITE(numout,*) 622 WRITE(numout,*) 623 WRITE(numout,*) ' sst : ', sst_m(ji,jj) 624 WRITE(numout,*) ' sss : ', sss_m(ji,jj) 625 WRITE(numout,*) 636 WRITE(numout,*) 637 WRITE(numout,*) ' sst : ', sst_m(ji,jj) 638 WRITE(numout,*) ' sss : ', sss_m(ji,jj) 639 WRITE(numout,*) 626 640 WRITE(numout,*) ' - Stresses ' 627 641 WRITE(numout,*) ' ~~~~~~~~ ' 628 WRITE(numout,*) ' utau_ice : ', utau_ice(ji,jj) 642 WRITE(numout,*) ' utau_ice : ', utau_ice(ji,jj) 629 643 WRITE(numout,*) ' vtau_ice : ', vtau_ice(ji,jj) 630 WRITE(numout,*) ' utau : ', utau (ji,jj) 644 WRITE(numout,*) ' utau : ', utau (ji,jj) 631 645 WRITE(numout,*) ' vtau : ', vtau (ji,jj) 632 646 ENDIF 633 647 634 648 !--------------------- 635 649 ! Salt / heat fluxes 636 650 !--------------------- 637 651 638 652 IF ( kn .EQ. 3 ) THEN 639 653 WRITE(numout,*) ' ice_prt - Point : ',ji,jj … … 650 664 WRITE(numout,*) ' qt_atm_oi : ', qt_atm_oi(ji,jj) 651 665 WRITE(numout,*) ' qt_oce_ai : ', qt_oce_ai(ji,jj) 652 WRITE(numout,*) ' dhc : ', diag_heat(ji,jj) 666 WRITE(numout,*) ' dhc : ', diag_heat(ji,jj) 653 667 WRITE(numout,*) 654 668 WRITE(numout,*) ' hfx_dyn : ', hfx_dyn(ji,jj) 655 669 WRITE(numout,*) ' hfx_thd : ', hfx_thd(ji,jj) 656 670 WRITE(numout,*) ' hfx_res : ', hfx_res(ji,jj) 657 WRITE(numout,*) ' qsb_ice_bot : ', qsb_ice_bot(ji,jj) 671 WRITE(numout,*) ' qsb_ice_bot : ', qsb_ice_bot(ji,jj) 658 672 WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_Dt_ice 659 673 WRITE(numout,*) … … 666 680 WRITE(numout,*) 667 681 WRITE(numout,*) ' - Momentum fluxes ' 668 WRITE(numout,*) ' utau : ', utau(ji,jj) 682 WRITE(numout,*) ' utau : ', utau(ji,jj) 669 683 WRITE(numout,*) ' vtau : ', vtau(ji,jj) 670 ENDIF 684 ENDIF 671 685 WRITE(numout,*) ' ' 672 686 ! … … 680 694 !! *** ROUTINE ice_prt3D *** 681 695 !! 682 !! ** Purpose : CTL prints of ice arrays in case sn_cfctl%prtctl is activated 696 !! ** Purpose : CTL prints of ice arrays in case sn_cfctl%prtctl is activated 683 697 !! 684 698 !!------------------------------------------------------------------- 685 699 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 686 700 INTEGER :: jk, jl ! dummy loop indices 687 701 688 702 CALL prt_ctl_info(' ========== ') 689 703 CALL prt_ctl_info( cd_routine ) … … 704 718 CALL prt_ctl(tab2d_1=delta_i , clinfo1=' delta_i :') 705 719 CALL prt_ctl(tab2d_1=u_ice , clinfo1=' u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 706 720 707 721 DO jl = 1, jpl 708 722 CALL prt_ctl_info(' ') … … 721 735 CALL prt_ctl(tab2d_1=sv_i (:,:,jl) , clinfo1= ' sv_i : ') 722 736 CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' oa_i : ') 723 737 724 738 DO jk = 1, nlay_i 725 739 CALL prt_ctl_info(' - Layer : ', ivar=jk) … … 728 742 END DO 729 743 END DO 730 744 731 745 CALL prt_ctl_info(' ') 732 746 CALL prt_ctl_info(' - Stresses : ') … … 734 748 CALL prt_ctl(tab2d_1=utau , clinfo1= ' utau : ', tab2d_2=vtau , clinfo2= ' vtau : ') 735 749 CALL prt_ctl(tab2d_1=utau_ice , clinfo1= ' utau_ice : ', tab2d_2=vtau_ice , clinfo2= ' vtau_ice : ') 736 750 737 751 END SUBROUTINE ice_prt3D 738 752 … … 776 790 ! -- mass diag -- ! 777 791 zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub & 778 & + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) * r dt_ice792 & + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) * rDt_ice 779 793 zdiag_adv_mass = glob_sum( 'icectl', diag_adv_mass * e1e2t ) * rDt_ice 780 794 781 795 ! -- salt diag -- ! 782 zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) * r dt_ice * 1.e-3796 zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) * rDt_ice * 1.e-3 783 797 zdiag_adv_salt = glob_sum( 'icectl', diag_adv_salt * e1e2t ) * rDt_ice * 1.e-3 784 798 … … 839 853 !!---------------------------------------------------------------------- 840 854 !! *** ROUTINE ice_drift_init *** 841 !! 855 !! 842 856 !! ** Purpose : create output file, initialise arrays 843 857 !!---------------------------------------------------------------------- … … 865 879 ! 866 880 END SUBROUTINE ice_drift_init 867 881 868 882 #else 869 883 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn.F90
r13472 r14021 2 2 !!====================================================================== 3 3 !! *** MODULE icedyn *** 4 !! Sea-Ice dynamics : master routine for sea ice dynamics 4 !! Sea-Ice dynamics : master routine for sea ice dynamics 5 5 !!====================================================================== 6 6 !! history : 4.0 ! 2018 (C. Rousset) original code SI3 [aka Sea Ice cube] … … 29 29 USE lbclnk ! lateral boundary conditions (or mpp links) 30 30 USE timing ! Timing 31 USE fldread ! read input fields 31 32 32 33 IMPLICIT NONE … … 35 36 PUBLIC ice_dyn ! called by icestp.F90 36 37 PUBLIC ice_dyn_init ! called by icestp.F90 37 38 38 39 INTEGER :: nice_dyn ! choice of the type of dynamics 39 40 ! ! associated indices: 40 41 INTEGER, PARAMETER :: np_dynALL = 1 ! full ice dynamics (rheology + advection + ridging/rafting + correction) 41 INTEGER, PARAMETER :: np_dynRHGADV = 2 ! pure dynamics (rheology + advection) 42 INTEGER, PARAMETER :: np_dynRHGADV = 2 ! pure dynamics (rheology + advection) 42 43 INTEGER, PARAMETER :: np_dynADV1D = 3 ! only advection 1D - test case from Schar & Smolarkiewicz 1996 43 44 INTEGER, PARAMETER :: np_dynADV2D = 4 ! only advection 2D w prescribed vel.(rn_uvice + advection) … … 50 51 REAL(wp) :: rn_uice ! prescribed u-vel (case np_dynADV1D & np_dynADV2D) 51 52 REAL(wp) :: rn_vice ! prescribed v-vel (case np_dynADV1D & np_dynADV2D) 52 53 54 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_icbmsk ! structure of input grounded icebergs mask (file informations, fields read) 55 53 56 !! * Substitutions 54 57 # include "do_loop_substitute.h90" … … 63 66 !!------------------------------------------------------------------- 64 67 !! *** ROUTINE ice_dyn *** 65 !! 68 !! 66 69 !! ** Purpose : this routine manages sea ice dynamics 67 70 !! … … 81 84 ! 82 85 ! controls 83 IF( ln_timing ) CALL timing_start('ice dyn')86 IF( ln_timing ) CALL timing_start('ice_dyn') 84 87 ! 85 88 IF( kt == nit000 .AND. lwp ) THEN … … 88 91 WRITE(numout,*)'~~~~~~~' 89 92 ENDIF 90 ! 93 ! 91 94 ! retrieve thickness from volume for landfast param. and UMx advection scheme 92 95 WHERE( a_i(:,:,:) >= epsi20 ) … … 106 109 END WHERE 107 110 ! 111 IF( ln_landfast_L16 ) THEN 112 CALL fld_read( kt, 1, sf_icbmsk ) 113 icb_mask(:,:) = sf_icbmsk(1)%fnow(:,:,1) 114 ENDIF 108 115 ! 109 116 SELECT CASE( nice_dyn ) !-- Set which dynamics is running … … 111 118 CASE ( np_dynALL ) !== all dynamical processes ==! 112 119 ! 113 CALL ice_dyn_rhg ( kt, Kmm ) ! -- rheology 120 CALL ice_dyn_rhg ( kt, Kmm ) ! -- rheology 114 121 CALL ice_dyn_adv ( kt ) ! -- advection of ice 115 CALL ice_dyn_rdgrft( kt ) ! -- ridging/rafting 122 CALL ice_dyn_rdgrft( kt ) ! -- ridging/rafting 116 123 CALL ice_cor ( kt , 1 ) ! -- Corrections 117 124 ! 118 125 CASE ( np_dynRHGADV ) !== no ridge/raft & no corrections ==! 119 126 ! 120 CALL ice_dyn_rhg ( kt, Kmm ) ! -- rheology 127 CALL ice_dyn_rhg ( kt, Kmm ) ! -- rheology 121 128 CALL ice_dyn_adv ( kt ) ! -- advection of ice 122 129 CALL Hpiling ! -- simple pile-up (replaces ridging/rafting) … … 127 134 ! --- monotonicity test from Schar & Smolarkiewicz 1996 --- ! 128 135 ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length 129 ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s 136 ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s 130 137 DO_2D( 1, 1, 1, 1 ) 131 138 zcoefu = ( REAL(jpiglo+1)*0.5_wp - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5_wp - 1._wp ) … … 149 156 ! 150 157 ! 151 ! diagnostics: divergence at T points 158 ! diagnostics: divergence at T points 152 159 IF( iom_use('icediv') ) THEN 153 160 ! … … 172 179 ! 173 180 ! controls 174 IF( ln_timing ) CALL timing_stop ('ice dyn')181 IF( ln_timing ) CALL timing_stop ('ice_dyn') 175 182 ! 176 183 END SUBROUTINE ice_dyn … … 216 223 !! ** input : Namelist namdyn 217 224 !!------------------------------------------------------------------- 218 INTEGER :: ios, ioptio ! Local integer output status for namelist read 225 INTEGER :: ios, ioptio, ierror ! Local integer output status for namelist read 226 ! 227 CHARACTER(len=256) :: cn_dir ! Root directory for location of ice files 228 TYPE(FLD_N) :: sn_icbmsk ! informations about the grounded icebergs field to be read 219 229 !! 220 230 NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice, & 221 231 & rn_ishlat , & 222 & ln_landfast_L16, rn_lf_depfra, rn_lf_bfr, rn_lf_relax, rn_lf_tensile 232 & ln_landfast_L16, rn_lf_depfra, rn_lf_bfr, rn_lf_relax, rn_lf_tensile, & 233 & sn_icbmsk, cn_dir 223 234 !!------------------------------------------------------------------- 224 235 ! … … 248 259 ENDIF 249 260 ! !== set the choice of ice dynamics ==! 250 ioptio = 0 261 ioptio = 0 251 262 ! !--- full dynamics (rheology + advection + ridging/rafting + correction) 252 263 IF( ln_dynALL ) THEN ; ioptio = ioptio + 1 ; nice_dyn = np_dynALL ; ENDIF … … 269 280 IF( .NOT.ln_landfast_L16 ) tau_icebfr(:,:) = 0._wp 270 281 ! 282 ! !--- allocate and fill structure for grounded icebergs mask 283 IF( ln_landfast_L16 ) THEN 284 ALLOCATE( sf_icbmsk(1), STAT=ierror ) 285 IF( ierror > 0 ) THEN 286 CALL ctl_stop( 'ice_dyn_init: unable to allocate sf_icbmsk structure' ) ; RETURN 287 ENDIF 288 ! 289 CALL fld_fill( sf_icbmsk, (/ sn_icbmsk /), cn_dir, 'ice_dyn_init', & 290 & 'landfast ice is a function of read grounded icebergs', 'icedyn' ) 291 ! 292 ALLOCATE( sf_icbmsk(1)%fnow(jpi,jpj,1) ) 293 IF( sf_icbmsk(1)%ln_tint ) ALLOCATE( sf_icbmsk(1)%fdta(jpi,jpj,1,2) ) 294 IF( TRIM(sf_icbmsk(1)%clrootname) == 'NOT USED' ) sf_icbmsk(1)%fnow(:,:,1) = 0._wp ! not used field (set to 0) 295 ELSE 296 icb_mask(:,:) = 0._wp 297 ENDIF 298 ! !--- other init 271 299 CALL ice_dyn_rdgrft_init ! set ice ridging/rafting parameters 272 300 CALL ice_dyn_rhg_init ! set ice rheology parameters … … 279 307 !! Default option Empty module NO SI3 sea-ice model 280 308 !!---------------------------------------------------------------------- 281 #endif 309 #endif 282 310 283 311 !!====================================================================== -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_adv_pra.F90
r14017 r14021 156 156 157 157 ! diagnostics 158 zdiag_adv_mass(:,:) = SUM( pv_i(:,:,:) , dim=3 ) * rhoi + SUM( pv_s(:,:,:) , dim=3 ) * rhos 158 zdiag_adv_mass(:,:) = SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 159 & + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow 159 160 zdiag_adv_salt(:,:) = SUM( psv_i(:,:,:) , dim=3 ) * rhoi 160 161 zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) & … … 178 179 z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 179 180 END DO 180 IF ( ln_pnd_LEV ) THEN181 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 181 182 z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:) ! Melt pond fraction 182 183 z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:) ! Melt pond volume … … 214 215 END DO 215 216 ! 216 IF ( ln_pnd_LEV ) THEN217 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 217 218 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction 218 219 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) … … 249 250 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 250 251 END DO 251 IF ( ln_pnd_LEV ) THEN252 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 252 253 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction 253 254 CALL adv_x( zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) … … 278 279 CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ei , 'T', 1._wp, sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy 279 280 & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp ) 280 IF ( ln_pnd_LEV ) THEN281 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 281 282 CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp & ! melt pond fraction 282 283 & , sxxap, 'T', 1._wp, syyap, 'T', 1._wp, sxyap, 'T', 1._wp & … … 302 303 pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 303 304 END DO 304 IF ( ln_pnd_LEV ) THEN305 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 305 306 pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 306 307 pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) … … 320 321 ! 321 322 ! --- diagnostics --- ! 322 diag_adv_mass(:,:) = diag_adv_mass(:,:) + ( SUM( pv_i(:,:,:) , dim=3 ) * rhoi + SUM( pv_s(:,:,:) , dim=3 ) * rhos & 323 diag_adv_mass(:,:) = diag_adv_mass(:,:) + ( SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 324 & + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow & 323 325 & - zdiag_adv_mass(:,:) ) * z1_dt 324 326 diag_adv_salt(:,:) = diag_adv_salt(:,:) + ( SUM( psv_i(:,:,:) , dim=3 ) * rhoi & … … 769 771 ! ! -- check h_ip -- ! 770 772 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 771 IF( ln_pnd_LEV . AND. pv_ip(ji,jj,jl) > 0._wp ) THEN773 IF( ln_pnd_LEV .OR. ln_pnd_TOPO .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 772 774 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 773 775 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN … … 1015 1017 END DO 1016 1018 ! 1017 IF( ln_pnd_LEV ) THEN ! melt pond fraction1019 IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN ! melt pond fraction 1018 1020 IF( iom_varid( numrir, 'sxap', ldstop = .FALSE. ) > 0 ) THEN 1019 1021 CALL iom_get( numrir, jpdom_auto, 'sxap' , sxap , psgn = -1._wp ) … … 1057 1059 sxc0 = 0._wp ; syc0 = 0._wp ; sxxc0 = 0._wp ; syyc0 = 0._wp ; sxyc0 = 0._wp ! snow layers heat content 1058 1060 sxe = 0._wp ; sye = 0._wp ; sxxe = 0._wp ; syye = 0._wp ; sxye = 0._wp ! ice layers heat content 1059 IF( ln_pnd_LEV ) THEN1061 IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 1060 1062 sxap = 0._wp ; syap = 0._wp ; sxxap = 0._wp ; syyap = 0._wp ; sxyap = 0._wp ! melt pond fraction 1061 1063 sxvp = 0._wp ; syvp = 0._wp ; sxxvp = 0._wp ; syyvp = 0._wp ; sxyvp = 0._wp ! melt pond volume … … 1135 1137 END DO 1136 1138 ! 1137 IF( ln_pnd_LEV ) THEN ! melt pond fraction1139 IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN ! melt pond fraction 1138 1140 CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap ) 1139 1141 CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap ) -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_adv_umx.F90
r13633 r14021 14 14 !! ultimate_x(_y) : compute a tracer value at velocity points using ULTIMATE scheme at various orders 15 15 !! macho : compute the fluxes 16 !! nonosc_ice : limit the fluxes using a non-oscillatory algorithm 16 !! nonosc_ice : limit the fluxes using a non-oscillatory algorithm 17 17 !!---------------------------------------------------------------------- 18 18 USE phycst ! physical constant … … 63 63 !!---------------------------------------------------------------------- 64 64 !! *** ROUTINE ice_dyn_adv_umx *** 65 !! 66 !! ** Purpose : Compute the now trend due to total advection of 65 !! 66 !! ** Purpose : Compute the now trend due to total advection of 67 67 !! tracers and add it to the general trend of tracer equations 68 68 !! using an "Ultimate-Macho" scheme 69 69 !! 70 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 70 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 71 71 !!---------------------------------------------------------------------- 72 72 INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2) … … 103 103 REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) :: ze_s, zes_max 104 104 ! 105 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs 105 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs 106 106 !! diagnostics 107 REAL(wp), DIMENSION(jpi,jpj) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat 107 REAL(wp), DIMENSION(jpi,jpj) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat 108 108 !!---------------------------------------------------------------------- 109 109 ! … … 131 131 ELSEWHERE ; ze_s(:,:,jk,:) = 0._wp 132 132 END WHERE 133 END DO 133 END DO 134 134 CALL icemax4D( ze_i , zei_max ) 135 135 CALL icemax4D( ze_s , zes_max ) … … 143 143 zcflnow(1) = MAXVAL( ABS( pu_ice(:,:) ) * rDt_ice * r1_e1u(:,:) ) 144 144 zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rDt_ice * r1_e2v(:,:) ) ) 145 145 146 146 ! non-blocking global communication send zcflnow and receive zcflprv 147 147 CALL mpp_delay_max( 'icedyn_adv_umx', 'cflice', zcflnow(:), zcflprv(:), kt == nitend - nn_fsbc + 1 ) … … 157 157 zvdx(:,:) = pv_ice(:,:) * e1v(:,:) 158 158 ! 159 ! setup transport for each ice cat 159 ! setup transport for each ice cat 160 160 DO jl = 1, jpl 161 161 zu_cat(:,:,jl) = zudy(:,:) … … 182 182 183 183 ! diagnostics 184 zdiag_adv_mass(:,:) = SUM( pv_i(:,:,:) , dim=3 ) * rhoi + SUM( pv_s(:,:,:) , dim=3 ) * rhos 184 zdiag_adv_mass(:,:) = SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 185 & + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow 185 186 zdiag_adv_salt(:,:) = SUM( psv_i(:,:,:) , dim=3 ) * rhoi 186 187 zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) & … … 189 190 ! record at_i before advection (for open water) 190 191 zati1(:,:) = SUM( pa_i(:,:,:), dim=3 ) 191 192 192 193 ! inverse of A and Ap 193 194 WHERE( pa_i(:,:,:) >= epsi20 ) ; z1_ai(:,:,:) = 1._wp / pa_i(:,:,:) … … 200 201 ! setup a mask where advection will be upstream 201 202 IF( ll_neg ) THEN 202 IF( .NOT. ALLOCATED(imsk_small) ) ALLOCATE( imsk_small(jpi,jpj,jpl) ) 203 IF( .NOT. ALLOCATED(jmsk_small) ) ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 203 IF( .NOT. ALLOCATED(imsk_small) ) ALLOCATE( imsk_small(jpi,jpj,jpl) ) 204 IF( .NOT. ALLOCATED(jmsk_small) ) ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 204 205 DO jl = 1, jpl 205 206 DO_2D( 1, 0, 1, 0 ) … … 231 232 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 232 233 & zhvar, pv_i, zua_ups, zva_ups ) 233 !== Snw volume ==! 234 !== Snw volume ==! 234 235 zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:) 235 236 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & … … 259 260 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 260 261 & zhvar, pv_i, zua_ups, zva_ups ) 261 !== Snw volume ==! 262 !== Snw volume ==! 262 263 zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:) 263 264 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & … … 315 316 & zhvar, pe_i(:,:,jk,:), zuv_ups, zvv_ups ) 316 317 END DO 317 !== Snow volume ==! 318 !== Snow volume ==! 318 319 zuv_ups = zua_ups 319 320 zvv_ups = zva_ups … … 338 339 ! 339 340 !== melt ponds ==! 340 IF ( ln_pnd_LEV ) THEN341 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 341 342 ! concentration 342 343 zamsk = 1._wp … … 358 359 359 360 ! --- Lateral boundary conditions --- ! 360 IF ( ln_pnd_LEV.AND. ln_pnd_lids ) THEN361 IF ( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. ln_pnd_lids ) THEN 361 362 CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 362 363 & , pa_ip,'T',1._wp, pv_ip,'T',1._wp, pv_il,'T',1._wp ) 363 ELSEIF( ln_pnd_LEV.AND. .NOT.ln_pnd_lids ) THEN364 ELSEIF( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. .NOT.ln_pnd_lids ) THEN 364 365 CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 365 366 & , pa_ip,'T',1._wp, pv_ip,'T',1._wp ) … … 373 374 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 374 375 DO_2D( 0, 0, 0, 0 ) 375 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 376 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 376 377 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 377 378 END_2D … … 379 380 ! 380 381 ! --- diagnostics --- ! 381 diag_adv_mass(:,:) = diag_adv_mass(:,:) + ( SUM( pv_i(:,:,:) , dim=3 ) * rhoi + SUM( pv_s(:,:,:) , dim=3 ) * rhos & 382 diag_adv_mass(:,:) = diag_adv_mass(:,:) + ( SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 383 & + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow & 382 384 & - zdiag_adv_mass(:,:) ) * z1_dt 383 385 diag_adv_salt(:,:) = diag_adv_salt(:,:) + ( SUM( psv_i(:,:,:) , dim=3 ) * rhoi & … … 404 406 END SUBROUTINE ice_dyn_adv_umx 405 407 406 408 407 409 SUBROUTINE adv_umx( pamsk, kn_umx, jt, kt, pdt, pu, pv, puc, pvc, pubox, pvbox, & 408 410 & pt, ptc, pua_ups, pva_ups, pua_ho, pva_ho ) 409 411 !!---------------------------------------------------------------------- 410 412 !! *** ROUTINE adv_umx *** 411 !! 412 !! ** Purpose : Compute the now trend due to total advection of 413 !! 414 !! ** Purpose : Compute the now trend due to total advection of 413 415 !! tracers and add it to the general trend of tracer equations 414 416 !! … … 432 434 !! 433 435 !! in eq. c), one can solve the equation for S (ln_advS=T), then dVS/dt = -div(uV * uS / u) 434 !! or for HS (ln_advS=F), then dVS/dt = -div(uA * uHS / u) 436 !! or for HS (ln_advS=F), then dVS/dt = -div(uA * uHS / u) 435 437 !! 436 438 !! ** Note : - this method can lead to tiny negative V (-1.e-20) => set it to 0 while conserving mass etc. … … 460 462 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out), OPTIONAL :: pua_ho, pva_ho ! high order u*a fluxes 461 463 ! 462 INTEGER :: ji, jj, jl ! dummy loop indices 464 INTEGER :: ji, jj, jl ! dummy loop indices 463 465 REAL(wp) :: ztra ! local scalar 464 466 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zfu_ho , zfv_ho , zpt … … 466 468 !!---------------------------------------------------------------------- 467 469 ! 468 ! Upstream (_ups) fluxes 470 ! Upstream (_ups) fluxes 469 471 ! ----------------------- 470 472 CALL upstream( pamsk, jt, kt, pdt, pt, pu, pv, zt_ups, zfu_ups, zfv_ups ) 471 472 ! High order (_ho) fluxes 473 474 ! High order (_ho) fluxes 473 475 ! ----------------------- 474 476 SELECT CASE( kn_umx ) … … 504 506 zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj) 505 507 ELSE 506 zfv_ho (ji,jj,jl) = 0._wp 507 zfv_ups(ji,jj,jl) = 0._wp 508 zfv_ho (ji,jj,jl) = 0._wp 509 zfv_ups(ji,jj,jl) = 0._wp 508 510 ENDIF 509 511 END_2D … … 549 551 DO jl = 1, jpl 550 552 DO_2D( 0, 0, 0, 0 ) 551 ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) ) 552 ! 553 ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 553 ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) ) 554 ! 555 ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 554 556 END_2D 555 557 END DO … … 561 563 !!--------------------------------------------------------------------- 562 564 !! *** ROUTINE upstream *** 563 !! 565 !! 564 566 !! ** Purpose : compute the upstream fluxes and upstream guess of tracer 565 567 !!---------------------------------------------------------------------- … … 570 572 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt ! tracer fields 571 573 REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pu, pv ! 2 ice velocity components 572 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pt_ups ! upstream guess of tracer 573 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfu_ups, pfv_ups ! upstream fluxes 574 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pt_ups ! upstream guess of tracer 575 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfu_ups, pfv_ups ! upstream fluxes 574 576 ! 575 577 INTEGER :: ji, jj, jl ! dummy loop indices … … 636 638 ! 637 639 ENDIF 638 640 639 641 ENDIF 640 642 ! … … 653 655 END SUBROUTINE upstream 654 656 655 657 656 658 SUBROUTINE cen2( pamsk, jt, kt, pdt, pt, pu, pv, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 657 659 !!--------------------------------------------------------------------- 658 660 !! *** ROUTINE cen2 *** 659 !! 661 !! 660 662 !! ** Purpose : compute the high order fluxes using a centered 661 !! second order scheme 663 !! second order scheme 662 664 !!---------------------------------------------------------------------- 663 665 REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0) … … 667 669 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt ! tracer fields 668 670 REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pu, pv ! 2 ice velocity components 669 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt_ups ! upstream guess of tracer 670 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pfu_ups, pfv_ups ! upstream fluxes 671 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfu_ho, pfv_ho ! high order fluxes 671 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt_ups ! upstream guess of tracer 672 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pfu_ups, pfv_ups ! upstream fluxes 673 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfu_ho, pfv_ho ! high order fluxes 672 674 ! 673 675 INTEGER :: ji, jj, jl ! dummy loop indices … … 748 750 ENDIF 749 751 IF( np_limiter == 1 ) CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 750 752 751 753 ENDIF 752 754 753 755 END SUBROUTINE cen2 754 756 755 757 756 758 SUBROUTINE macho( pamsk, kn_umx, jt, kt, pdt, pt, pu, pv, pubox, pvbox, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 757 759 !!--------------------------------------------------------------------- 758 760 !! *** ROUTINE macho *** 759 !! 760 !! ** Purpose : compute the high order fluxes using Ultimate-Macho scheme 761 !! 762 !! ** Purpose : compute the high order fluxes using Ultimate-Macho scheme 761 763 !! 762 764 !! ** Method : ... 763 765 !! 764 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 766 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 765 767 !!---------------------------------------------------------------------- 766 768 REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0) … … 772 774 REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pu, pv ! 2 ice velocity components 773 775 REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pubox, pvbox ! upstream velocity 774 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt_ups ! upstream guess of tracer 775 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pfu_ups, pfv_ups ! upstream fluxes 776 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfu_ho, pfv_ho ! high order fluxes 776 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt_ups ! upstream guess of tracer 777 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pfu_ups, pfv_ups ! upstream fluxes 778 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfu_ho, pfv_ho ! high order fluxes 777 779 ! 778 780 INTEGER :: ji, jj, jl ! dummy loop indices … … 805 807 ! !-- limiter in y --! 806 808 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 807 ! 809 ! 808 810 ! 809 811 ELSE !== even ice time step: adv_y then adv_x ==! … … 819 821 & + pt (ji,jj,jl) * ( pv (ji,jj ) - pv (ji,jj-1 ) ) * r1_e1e2t(ji,jj) & 820 822 & * pamsk & 821 & ) * pdt ) * tmask(ji,jj,1) 823 & ) * pdt ) * tmask(ji,jj,1) 822 824 END_2D 823 825 END DO … … 843 845 !!--------------------------------------------------------------------- 844 846 !! *** ROUTINE ultimate_x *** 845 !! 846 !! ** Purpose : compute tracer at u-points 847 !! 848 !! ** Purpose : compute tracer at u-points 847 849 !! 848 850 !! ** Method : ... 849 851 !! 850 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 852 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 851 853 !!---------------------------------------------------------------------- 852 854 REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0) … … 855 857 REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pu ! ice i-velocity component 856 858 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt ! tracer fields 857 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pt_u ! tracer at u-point 858 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfu_ho ! high order flux 859 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pt_u ! tracer at u-point 860 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfu_ho ! high order flux 859 861 ! 860 862 INTEGER :: ji, jj, jl ! dummy loop indices … … 895 897 ! 896 898 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 897 ! 899 ! 898 900 DO jl = 1, jpl 899 901 DO_2D( 0, 0, 1, 0 ) … … 909 911 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 910 912 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 911 & - zcu * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 912 END_2D 913 END DO 914 ! 913 & - zcu * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 914 END_2D 915 END DO 916 ! 915 917 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 916 918 ! … … 981 983 ! 982 984 END SUBROUTINE ultimate_x 983 984 985 986 985 987 SUBROUTINE ultimate_y( pamsk, kn_umx, pdt, pt, pv, pt_v, pfv_ho ) 986 988 !!--------------------------------------------------------------------- 987 989 !! *** ROUTINE ultimate_y *** 988 !! 989 !! ** Purpose : compute tracer at v-points 990 !! 991 !! ** Purpose : compute tracer at v-points 990 992 !! 991 993 !! ** Method : ... 992 994 !! 993 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 995 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 994 996 !!---------------------------------------------------------------------- 995 997 REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0) … … 998 1000 REAL(wp), DIMENSION(:,: ) , INTENT(in ) :: pv ! ice j-velocity component 999 1001 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pt ! tracer fields 1000 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pt_v ! tracer at v-point 1001 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfv_ho ! high order flux 1002 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pt_v ! tracer at v-point 1003 REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT( out) :: pfv_ho ! high order flux 1002 1004 ! 1003 1005 INTEGER :: ji, jj, jl ! dummy loop indices … … 1113 1115 ! 1114 1116 END SUBROUTINE ultimate_y 1115 1117 1116 1118 1117 1119 SUBROUTINE nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 1118 1120 !!--------------------------------------------------------------------- 1119 1121 !! *** ROUTINE nonosc_ice *** 1120 !! 1121 !! ** Purpose : compute monotonic tracer fluxes from the upstream 1122 !! scheme and the before field by a non-oscillatory algorithm 1122 !! 1123 !! ** Purpose : compute monotonic tracer fluxes from the upstream 1124 !! scheme and the before field by a non-oscillatory algorithm 1123 1125 !! 1124 1126 !! ** Method : ... … … 1139 1141 !!---------------------------------------------------------------------- 1140 1142 zbig = 1.e+40_wp 1141 1143 1142 1144 ! antidiffusive flux : high order minus low order 1143 1145 ! -------------------------------------------------- … … 1155 1157 ! pfu_ho 1156 1158 ! * ---> 1157 ! | | * | | 1158 ! | | | * | 1159 ! | | * | | 1160 ! | | | * | 1159 1161 ! | | | | * 1160 ! t_ups : i-1 i i+1 i+2 1162 ! t_ups : i-1 i i+1 i+2 1161 1163 IF( ll_prelim ) THEN 1162 1164 1163 1165 DO jl = 1, jpl 1164 1166 DO_2D( 0, 0, 0, 0 ) … … 1198 1200 z1_dt = 1._wp / pdt 1199 1201 DO jl = 1, jpl 1200 1202 1201 1203 DO_2D( 1, 1, 1, 1 ) 1202 1204 IF ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN … … 1242 1244 ! if all the points are outside ice cover 1243 1245 IF( zup == -zbig ) zbetup(ji,jj,jl) = 0._wp ! zbig 1244 IF( zdo == zbig ) zbetdo(ji,jj,jl) = 0._wp ! zbig 1246 IF( zdo == zbig ) zbetdo(ji,jj,jl) = 0._wp ! zbig 1245 1247 ! 1246 1248 END_2D … … 1248 1250 CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1.0_wp, zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign) 1249 1251 1250 1252 1251 1253 ! monotonic flux in the y direction 1252 1254 ! --------------------------------- … … 1278 1280 END SUBROUTINE nonosc_ice 1279 1281 1280 1282 1281 1283 SUBROUTINE limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 1282 1284 !!--------------------------------------------------------------------- 1283 1285 !! *** ROUTINE limiter_x *** 1284 !! 1285 !! ** Purpose : compute flux limiter 1286 !! 1287 !! ** Purpose : compute flux limiter 1286 1288 !!---------------------------------------------------------------------- 1287 1289 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step … … 1293 1295 REAL(wp) :: Cr, Rjm, Rj, Rjp, uCFL, zpsi, zh3, zlimiter, Rr 1294 1296 INTEGER :: ji, jj, jl ! dummy loop indices 1295 REAL(wp), DIMENSION (jpi,jpj,jpl) :: zslpx ! tracer slopes 1297 REAL(wp), DIMENSION (jpi,jpj,jpl) :: zslpx ! tracer slopes 1296 1298 !!---------------------------------------------------------------------- 1297 1299 ! … … 1302 1304 END DO 1303 1305 CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp) ! lateral boundary cond. 1304 1306 1305 1307 DO jl = 1, jpl 1306 1308 DO_2D( 0, 0, 0, 0 ) 1307 1309 uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 1308 1310 1309 1311 Rjm = zslpx(ji-1,jj,jl) 1310 1312 Rj = zslpx(ji ,jj,jl) … … 1317 1319 ENDIF 1318 1320 1319 zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1321 zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1320 1322 IF( Rj > 0. ) THEN 1321 1323 zlimiter = MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)), & … … 1369 1371 END SUBROUTINE limiter_x 1370 1372 1371 1373 1372 1374 SUBROUTINE limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 1373 1375 !!--------------------------------------------------------------------- 1374 1376 !! *** ROUTINE limiter_y *** 1375 !! 1376 !! ** Purpose : compute flux limiter 1377 !! 1378 !! ** Purpose : compute flux limiter 1377 1379 !!---------------------------------------------------------------------- 1378 1380 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step … … 1384 1386 REAL(wp) :: Cr, Rjm, Rj, Rjp, vCFL, zpsi, zh3, zlimiter, Rr 1385 1387 INTEGER :: ji, jj, jl ! dummy loop indices 1386 REAL(wp), DIMENSION (jpi,jpj,jpl) :: zslpy ! tracer slopes 1388 REAL(wp), DIMENSION (jpi,jpj,jpl) :: zslpy ! tracer slopes 1387 1389 !!---------------------------------------------------------------------- 1388 1390 ! … … 1408 1410 ENDIF 1409 1411 1410 zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1412 zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1411 1413 IF( Rj > 0. ) THEN 1412 1414 zlimiter = MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)), & … … 1497 1499 ! ! -- check h_ip -- ! 1498 1500 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 1499 IF( ln_pnd_LEV.AND. pv_ip(ji,jj,jl) > 0._wp ) THEN1501 IF( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 1500 1502 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 1501 1503 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN … … 1522 1524 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1523 1525 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 1524 ENDIF 1525 ! 1526 ENDIF 1527 ! 1526 1528 ! ! -- check s_i -- ! 1527 1529 ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean … … 1535 1537 ENDIF 1536 1538 END_2D 1537 END DO 1539 END DO 1538 1540 ! 1539 1541 ! ! -- check e_i/v_i -- ! … … 1622 1624 SUBROUTINE icemax3D( pice , pmax ) 1623 1625 !!--------------------------------------------------------------------- 1624 !! *** ROUTINE icemax3D *** 1626 !! *** ROUTINE icemax3D *** 1625 1627 !! ** Purpose : compute the max of the 9 points around 1626 1628 !!---------------------------------------------------------------------- … … 1631 1633 !!---------------------------------------------------------------------- 1632 1634 DO jl = 1, jpl 1633 DO jj = Njs0-1, Nje0+1 1635 DO jj = Njs0-1, Nje0+1 1634 1636 DO ji = Nis0, Nie0 1635 1637 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) 1636 1638 END DO 1637 1639 END DO 1638 DO jj = Njs0, Nje0 1640 DO jj = Njs0, Nje0 1639 1641 DO ji = Nis0, Nie0 1640 1642 pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) … … 1646 1648 SUBROUTINE icemax4D( pice , pmax ) 1647 1649 !!--------------------------------------------------------------------- 1648 !! *** ROUTINE icemax4D *** 1650 !! *** ROUTINE icemax4D *** 1649 1651 !! ** Purpose : compute the max of the 9 points around 1650 1652 !!---------------------------------------------------------------------- … … 1657 1659 DO jl = 1, jpl 1658 1660 DO jk = 1, jlay 1659 DO jj = Njs0-1, Nje0+1 1661 DO jj = Njs0-1, Nje0+1 1660 1662 DO ji = Nis0, Nie0 1661 1663 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) 1662 1664 END DO 1663 1665 END DO 1664 DO jj = Njs0, Nje0 1666 DO jj = Njs0, Nje0 1665 1667 DO ji = Nis0, Nie0 1666 1668 pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_rdgrft.F90
r14017 r14021 186 186 ! closing_net = rate at which open water area is removed + ice area removed by ridging 187 187 ! - ice area added in new ridges 188 IF( ln_rhg_EVP ) closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 189 IF( ln_rhg_EAP ) closing_net(ji) = zconv(ji) 188 IF( ln_rhg_EVP .OR. ln_rhg_VP ) & 189 & closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 190 IF( ln_rhg_EAP ) closing_net(ji) = zconv(ji) 190 191 ! 191 192 IF( zdivu(ji) < 0._wp ) closing_net(ji) = MAX( closing_net(ji), -zdivu(ji) ) ! make sure the closing rate is large enough … … 578 579 oirft2(ji) = oa_i_2d(ji,jl1) * afrft * hi_hrft 579 580 580 IF ( ln_pnd_LEV ) THEN581 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 581 582 aprdg1 = a_ip_2d(ji,jl1) * afrdg 582 583 aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) … … 615 616 sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1 - sirft(ji) 616 617 oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1 - oirft1 617 IF ( ln_pnd_LEV ) THEN618 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 618 619 a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1 - aprft1 619 620 v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) … … 712 713 v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji) + & 713 714 & vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 714 IF ( ln_pnd_LEV ) THEN715 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 715 716 v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + ( vprdg (ji) * rn_fpndrdg * fvol (ji) & 716 717 & + vprft (ji) * rn_fpndrft * zswitch(ji) ) -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_rhg.F90
r14017 r14021 18 18 USE icedyn_rhg_evp ! sea-ice: EVP rheology 19 19 USE icedyn_rhg_eap ! sea-ice: EAP rheology 20 USE icedyn_rhg_vp ! sea-ice: VP rheology 20 21 USE icectl ! sea-ice: control prints 21 22 ! … … 35 36 INTEGER, PARAMETER :: np_rhgEVP = 1 ! EVP rheology 36 37 INTEGER, PARAMETER :: np_rhgEAP = 2 ! EAP rheology 38 INTEGER, PARAMETER :: np_rhgVP = 3 ! VP rheology 37 39 38 ! ** namelist (namrhg) **39 40 ! 40 41 !!---------------------------------------------------------------------- … … 78 79 CALL ice_dyn_rhg_evp( kt, Kmm, stress1_i, stress2_i, stress12_i, shear_i, divu_i, delta_i ) 79 80 ! 81 ! !------------------------! 82 CASE( np_rhgVP ) ! Viscous-Plastic ! 83 ! !------------------------! 84 CALL ice_dyn_rhg_vp ( kt, shear_i, divu_i, delta_i ) 85 ! 80 86 ! !----------------------------! 81 87 CASE( np_rhgEAP ) ! Elasto-Anisotropic-Plastic ! … … 84 90 END SELECT 85 91 ! 86 IF( lrst_ice ) THEN !* write EVP fields in the restart file87 IF( ln_rhg_EVP ) CALL rhg_evp_rst( 'WRITE', kt ) 92 IF( lrst_ice ) THEN 93 IF( ln_rhg_EVP ) CALL rhg_evp_rst( 'WRITE', kt ) !* write EVP fields in the restart file 88 94 IF( ln_rhg_EAP ) CALL rhg_eap_rst( 'WRITE', kt ) !* write EAP fields in the restart file 95 ! MV note: no restart needed for VP as there is no time equation for stress tensor 89 96 ENDIF 90 97 ! … … 113 120 INTEGER :: ios, ioptio ! Local integer output status for namelist read 114 121 !! 115 NAMELIST/namdyn_rhg/ ln_rhg_EVP, ln_aEVP, ln_rhg_EAP, rn_creepl, rn_ecc , nn_nevp, rn_relast, nn_rhg_chkcvg 122 NAMELIST/namdyn_rhg/ ln_rhg_EVP, ln_aEVP, ln_rhg_EAP, rn_creepl, rn_ecc , nn_nevp, rn_relast, nn_rhg_chkcvg, & !-- evp 123 & ln_rhg_VP, nn_vp_nout, nn_vp_ninn, nn_vp_chkcvg !-- vp 116 124 !!------------------------------------------------------------------- 117 125 ! … … 129 137 WRITE(numout,*) ' rheology EVP (icedyn_rhg_evp) ln_rhg_EVP = ', ln_rhg_EVP 130 138 WRITE(numout,*) ' use adaptive EVP (aEVP) ln_aEVP = ', ln_aEVP 131 WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl 132 WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc 139 WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl ! also used by vp 140 WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc ! also used by vp 133 141 WRITE(numout,*) ' number of iterations for subcycling nn_nevp = ', nn_nevp 134 142 WRITE(numout,*) ' ratio of elastic timescale over ice time step rn_relast = ', rn_relast 135 WRITE(numout,*) ' check convergence of rheology nn_rhg_chkcvg = ', nn_rhg_chkcvg 136 IF ( nn_rhg_chkcvg == 0 ) THEN ; WRITE(numout,*) ' no check' 137 ELSEIF( nn_rhg_chkcvg == 1 ) THEN ; WRITE(numout,*) ' check cvg at the main time step' 138 ELSEIF( nn_rhg_chkcvg == 2 ) THEN ; WRITE(numout,*) ' check cvg at both main and rheology time steps' 143 WRITE(numout,*) ' check convergence of rheology nn_rhg_chkcvg = ', nn_rhg_chkcvg 144 WRITE(numout,*) ' rheology VP (icedyn_rhg_VP) ln_rhg_VP = ', ln_rhg_VP 145 WRITE(numout,*) ' number of outer iterations nn_vp_nout = ', nn_vp_nout 146 WRITE(numout,*) ' number of inner iterations nn_vp_ninn = ', nn_vp_ninn 147 WRITE(numout,*) ' iteration step for convergence check nn_vp_chkcvg = ', nn_vp_chkcvg 148 IF( ln_rhg_EVP ) THEN 149 IF ( nn_rhg_chkcvg == 0 ) THEN ; WRITE(numout,*) ' no check cvg' 150 ELSEIF( nn_rhg_chkcvg == 1 ) THEN ; WRITE(numout,*) ' check cvg at the main time step' 151 ELSEIF( nn_rhg_chkcvg == 2 ) THEN ; WRITE(numout,*) ' check cvg at both main and rheology time steps' 152 ENDIF 139 153 ENDIF 140 154 WRITE(numout,*) ' rheology EAP (icedyn_rhg_eap) ln_rhg_EAP = ', ln_rhg_EAP … … 145 159 IF( ln_rhg_EVP ) THEN ; ioptio = ioptio + 1 ; nice_rhg = np_rhgEVP ; ENDIF 146 160 IF( ln_rhg_EAP ) THEN ; ioptio = ioptio + 1 ; nice_rhg = np_rhgEAP ; ENDIF 161 IF( ln_rhg_VP ) THEN ; ioptio = ioptio + 1 ; nice_rhg = np_rhgVP ; ENDIF 147 162 IF( ioptio /= 1 ) CALL ctl_stop( 'ice_dyn_rhg_init: choose one and only one ice rheology' ) 148 163 ! 149 164 IF( ln_rhg_EVP ) CALL rhg_evp_rst( 'READ' ) !* read or initialize all required files 150 165 IF( ln_rhg_EAP ) CALL rhg_eap_rst( 'READ' ) !* read or initialize all required files 166 ! no restart for VP as there is no explicit time dependency in the equation 151 167 ! 152 168 END SUBROUTINE ice_dyn_rhg_init -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_rhg_evp.F90
r14017 r14021 326 326 zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 327 327 ! ice-bottom stress at U points 328 zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) 328 zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0 329 329 ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 330 330 ! ice-bottom stress at V points 331 zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) 331 zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0 332 332 ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 333 333 ! ice_bottom stress at T points 334 zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) 334 zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0 335 335 tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 336 336 END_2D -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/iceistate.F90
r13472 r14021 18 18 USE oce ! dynamics and tracers variables 19 19 USE dom_oce ! ocean domain 20 USE sbc_oce , ONLY : sst_m, sss_m, ln_ice_embd 20 USE sbc_oce , ONLY : sst_m, sss_m, ln_ice_embd 21 21 USE sbc_ice , ONLY : tn_ice, snwice_mass, snwice_mass_b 22 22 USE eosbn2 ! equation of state … … 36 36 USE agrif_oce 37 37 USE agrif_ice 38 USE agrif_ice_interp 39 # endif 38 USE agrif_ice_interp 39 # endif 40 40 41 41 IMPLICIT NONE … … 87 87 !! 88 88 !! ** Method : This routine will put some ice where ocean 89 !! is at the freezing point, then fill in ice 90 !! state variables using prescribed initial 91 !! values in the namelist 89 !! is at the freezing point, then fill in ice 90 !! state variables using prescribed initial 91 !! values in the namelist 92 92 !! 93 93 !! ** Steps : 1) Set initial surface and basal temperatures … … 99 99 !! where there is no ice 100 100 !!-------------------------------------------------------------------- 101 INTEGER, INTENT(in) :: kt ! time step 101 INTEGER, INTENT(in) :: kt ! time step 102 102 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 103 103 ! … … 125 125 ! basal temperature (considered at freezing point) [Kelvin] 126 126 CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 127 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 127 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 128 128 ! 129 129 ! surface temperature and conductivity … … 150 150 e_i (:,:,:,:) = 0._wp 151 151 e_s (:,:,:,:) = 0._wp 152 152 153 153 ! general fields 154 154 a_i (:,:,:) = 0._wp … … 225 225 IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 226 226 & 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. 227 & * si(jp_ati)%fnow(:,:,1) 227 & * si(jp_ati)%fnow(:,:,1) 228 228 ! 229 229 ! pond depth … … 244 244 ! 245 245 ! change the switch for the following 246 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 246 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 247 247 ELSEWHERE ; zswitch(:,:) = 0._wp 248 248 END WHERE … … 252 252 ! !---------------! 253 253 ! no ice if (sst - Tfreez) >= thresold 254 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 254 WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp 255 255 ELSEWHERE ; zswitch(:,:) = tmask(:,:,1) 256 256 END WHERE … … 265 265 zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 266 266 ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 267 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 267 zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 268 268 zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 269 269 zhlid_ini(:,:) = rn_hld_ini_n * zswitch(:,:) … … 291 291 zhlid_ini(:,:) = 0._wp 292 292 ENDIF 293 293 294 294 IF ( .NOT.ln_pnd_lids ) THEN 295 295 zhlid_ini(:,:) = 0._wp 296 296 ENDIF 297 297 298 298 !----------------! 299 299 ! 3) fill fields ! … … 319 319 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti) , zhpnd_ini ) 320 320 CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d(1:npti) , zhlid_ini ) 321 321 322 322 ! allocate temporary arrays 323 323 ALLOCATE( zhi_2d (npti,jpl), zhs_2d (npti,jpl), zai_2d (npti,jpl), & … … 373 373 DO jl = 1, jpl 374 374 DO_3D( 1, 1, 1, 1, 1, nlay_i ) 375 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 375 t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 376 376 ztmelts = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 377 377 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & … … 381 381 END_3D 382 382 END DO 383 383 384 384 #if defined key_agrif 385 385 ELSE 386 386 387 387 Agrif_SpecialValue = -9999. 388 388 Agrif_UseSpecialValue = .TRUE. … … 395 395 use_sign_north = .FALSE. 396 396 Agrif_UseSpecialValue = .FALSE. 397 ! lbc ???? 397 ! lbc ???? 398 398 ! Here we know : a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, v_il, t_su, e_s, e_i 399 399 CALL ice_var_glo2eqv … … 409 409 v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 410 410 v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 411 411 412 412 ! specific temperatures for coupled runs 413 413 tn_ice(:,:,:) = t_su(:,:,:) … … 426 426 ! 4) Snow-ice mass (case ice is fully embedded) 427 427 !---------------------------------------------- 428 snwice_mass (:,:) = tmask(:,:,1) * SUM( rhos * v_s (:,:,:) + rhoi * v_i(:,:,:), dim=3 ) ! snow+ice mass428 snwice_mass (:,:) = tmask(:,:,1) * SUM( rhos * v_s + rhoi * v_i + rhow * ( v_ip + v_il ), dim=3 ) ! snow+ice mass 429 429 snwice_mass_b(:,:) = snwice_mass(:,:) 430 430 ! … … 487 487 !!------------------------------------------------------------------- 488 488 !! *** ROUTINE ice_istate_init *** 489 !! 490 !! ** Purpose : Definition of initial state of the ice 491 !! 492 !! ** Method : Read the namini namelist and check the parameter 489 !! 490 !! ** Purpose : Definition of initial state of the ice 491 !! 492 !! ** Method : Read the namini namelist and check the parameter 493 493 !! values called at the first timestep (nit000) 494 494 !! … … 531 531 WRITE(numout,*) ' max ocean temp. above Tfreeze with initial ice rn_thres_sst = ', rn_thres_sst 532 532 IF( ln_iceini .AND. nn_iceini_file == 0 ) THEN 533 WRITE(numout,*) ' initial snw thickness in the north-south rn_hts_ini = ', rn_hts_ini_n,rn_hts_ini_s 533 WRITE(numout,*) ' initial snw thickness in the north-south rn_hts_ini = ', rn_hts_ini_n,rn_hts_ini_s 534 534 WRITE(numout,*) ' initial ice thickness in the north-south rn_hti_ini = ', rn_hti_ini_n,rn_hti_ini_s 535 535 WRITE(numout,*) ' initial ice concentr in the north-south rn_ati_ini = ', rn_ati_ini_n,rn_ati_ini_s -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/iceitd.F90
r13618 r14021 18 18 !!---------------------------------------------------------------------- 19 19 USE dom_oce ! ocean domain 20 USE phycst ! physical constants 20 USE phycst ! physical constants 21 21 USE ice1D ! sea-ice: thermodynamic variables 22 22 USE ice ! sea-ice: variables … … 29 29 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) 30 30 USE prtctl ! Print control 31 USE timing ! Timing 31 32 32 33 IMPLICIT NONE … … 65 66 !! after thermodynamic growth of ice thickness 66 67 !! 67 !! ** Method : Linear remapping 68 !! ** Method : Linear remapping 68 69 !! 69 70 !! References : W.H. Lipscomb, JGR 2001 70 71 !!------------------------------------------------------------------ 71 INTEGER , INTENT (in) :: kt ! Ocean time step 72 INTEGER , INTENT (in) :: kt ! Ocean time step 72 73 ! 73 74 INTEGER :: ji, jj, jl, jcat ! dummy loop index … … 75 76 REAL(wp) :: zx1, zwk1, zdh0, zetamin, zdamax ! local scalars 76 77 REAL(wp) :: zx2, zwk2, zda0, zetamax ! - - 77 REAL(wp) :: zx3 78 REAL(wp) :: zx3 78 79 REAL(wp) :: zslope ! used to compute local thermodynamic "speeds" 79 80 ! … … 87 88 REAL(wp), DIMENSION(jpij,0:jpl) :: zhbnew ! new boundaries of ice categories 88 89 !!------------------------------------------------------------------ 89 90 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_itd_rem: remapping ice thickness distribution' 90 IF( ln_timing ) CALL timing_start('iceitd_rem') 91 92 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_itd_rem: remapping ice thickness distribution' 91 93 92 94 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) … … 105 107 ENDIF 106 108 END_2D 107 109 108 110 !----------------------------------------------------------------------------------------------- 109 111 ! 2) Compute new category boundaries … … 141 143 ELSEIF( a_ib_2d(ji,jl) <= epsi10 .AND. a_ib_2d(ji,jl+1) > epsi10 ) THEN ! a(jl)=0 => Hn* = Hn + fn+1*dt 142 144 zhbnew(ji,jl) = hi_max(jl) + zdhice(ji,jl+1) 143 ELSE ! a(jl+1) & a(jl) = 0 145 ELSE ! a(jl+1) & a(jl) = 0 144 146 zhbnew(ji,jl) = hi_max(jl) 145 147 ENDIF 146 148 ! 147 149 ! --- 2 conditions for remapping --- ! 148 ! 1) hn(t+1)+espi < Hn* < hn+1(t+1)-epsi 149 ! Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 150 ! 1) hn(t+1)+espi < Hn* < hn+1(t+1)-epsi 151 ! Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 150 152 ! in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 151 153 # if defined key_single … … 157 159 # endif 158 160 ! 159 ! 2) Hn-1 < Hn* < Hn+1 161 ! 2) Hn-1 < Hn* < Hn+1 160 162 IF( zhbnew(ji,jl) < hi_max(jl-1) ) nptidx(ji) = 0 161 163 IF( zhbnew(ji,jl) > hi_max(jl+1) ) nptidx(ji) = 0 … … 169 171 zhbnew(ji,jpl) = MAX( hi_max(jpl-1), 3._wp * h_i_2d(ji,jpl) - 2._wp * zhbnew(ji,jpl-1) ) 170 172 ELSE 171 zhbnew(ji,jpl) = hi_max(jpl) 173 zhbnew(ji,jpl) = hi_max(jpl) 172 174 ENDIF 173 175 ! 174 176 ! --- 1 additional condition for remapping (1st category) --- ! 175 ! H0+epsi < h1(t) < H1-epsi 176 ! h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 177 ! H0+epsi < h1(t) < H1-epsi 178 ! h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 177 179 ! in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 178 180 # if defined key_single … … 200 202 ! 201 203 ENDIF 202 204 203 205 !----------------------------------------------------------------------------------------------- 204 ! 4) Compute g(h) 206 ! 4) Compute g(h) 205 207 !----------------------------------------------------------------------------------------------- 206 208 IF( npti > 0 ) THEN 207 209 ! 208 210 zhb0(:) = hi_max(0) ; zhb1(:) = hi_max(1) 209 g0(:,:) = 0._wp ; g1(:,:) = 0._wp 210 hL(:,:) = 0._wp ; hR(:,:) = 0._wp 211 g0(:,:) = 0._wp ; g1(:,:) = 0._wp 212 hL(:,:) = 0._wp ; hR(:,:) = 0._wp 211 213 ! 212 214 DO jl = 1, jpl … … 218 220 ! 219 221 IF( jl == 1 ) THEN 220 ! 222 ! 221 223 ! --- g(h) for category 1 --- ! 222 224 CALL itd_glinear( zhb0(1:npti) , zhb1(1:npti) , h_ib_1d(1:npti) , a_i_1d(1:npti) , & ! in … … 228 230 IF( a_i_1d(ji) > epsi10 ) THEN 229 231 ! 230 zdh0 = h_i_1d(ji) - h_ib_1d(ji) 232 zdh0 = h_i_1d(ji) - h_ib_1d(ji) 231 233 IF( zdh0 < 0.0 ) THEN ! remove area from category 1 232 234 zdh0 = MIN( -zdh0, hi_max(1) ) … … 236 238 IF( zetamax > 0.0 ) THEN 237 239 zx1 = zetamax 238 zx2 = 0.5 * zetamax * zetamax 240 zx2 = 0.5 * zetamax * zetamax 239 241 zda0 = g1(ji,1) * zx2 + g0(ji,1) * zx1 ! ice area removed 240 zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i 242 zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i 241 243 zda0 = MIN( zda0, zdamax ) ! ice area lost due to melting of thin ice (zdamax > 0) 242 244 ! Remove area, conserving volume … … 248 250 ELSE ! if ice accretion zdh0 > 0 249 251 ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1) 250 zhbnew(ji,0) = MIN( zdh0, hi_max(1) ) 252 zhbnew(ji,0) = MIN( zdh0, hi_max(1) ) 251 253 ENDIF 252 254 ! … … 261 263 ENDIF ! jl=1 262 264 ! 263 ! --- g(h) for each thickness category --- ! 265 ! --- g(h) for each thickness category --- ! 264 266 CALL itd_glinear( zhbnew(1:npti,jl-1), zhbnew(1:npti,jl), h_i_1d(1:npti) , a_i_1d(1:npti) , & ! in 265 267 & g0 (1:npti,jl ), g1 (1:npti,jl), hL (1:npti,jl), hR (1:npti,jl) ) ! out 266 268 ! 267 269 END DO 268 270 269 271 !----------------------------------------------------------------------------------------------- 270 272 ! 5) Compute area and volume to be shifted across each boundary (Eq. 18) … … 276 278 ! left and right integration limits in eta space 277 279 IF (zhbnew(ji,jl) > hi_max(jl)) THEN ! Hn* > Hn => transfer from jl to jl+1 278 zetamin = MAX( hi_max(jl) , hL(ji,jl) ) - hL(ji,jl) ! hi_max(jl) - hL 280 zetamin = MAX( hi_max(jl) , hL(ji,jl) ) - hL(ji,jl) ! hi_max(jl) - hL 279 281 zetamax = MIN( zhbnew(ji,jl), hR(ji,jl) ) - hL(ji,jl) ! hR - hL 280 282 jdonor(ji,jl) = jl … … 299 301 END DO 300 302 END DO 301 303 302 304 !---------------------------------------------------------------------------------------------- 303 305 ! 6) Shift ice between categories 304 306 !---------------------------------------------------------------------------------------------- 305 307 CALL itd_shiftice ( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) ) 306 308 307 309 !---------------------------------------------------------------------------------------------- 308 310 ! 7) Make sure h_i >= minimum ice thickness hi_min … … 314 316 DO ji = 1, npti 315 317 IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN 316 a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin 317 IF( ln_pnd_LEV ) a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin318 a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin 319 IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 318 320 h_i_1d(ji) = rn_himin 319 321 ENDIF … … 328 330 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 329 331 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 332 IF( ln_timing ) CALL timing_stop ('iceitd_rem') 330 333 ! 331 334 END SUBROUTINE ice_itd_rem … … 381 384 pg1(ji) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5_wp ) ! Eq. 14 382 385 ! 383 ELSE ! remap_flag = .false. or a_i < epsi10 386 ELSE ! remap_flag = .false. or a_i < epsi10 384 387 phL(ji) = 0._wp 385 388 phR(ji) = 0._wp … … 412 415 REAL(wp), DIMENSION(jpij,nlay_s,jpl) :: ze_s_2d 413 416 !!------------------------------------------------------------------ 414 417 415 418 CALL tab_3d_2d( npti, nptidx(1:npti), h_i_2d (1:npti,1:jpl), h_i ) 416 419 CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i ) … … 442 445 END DO 443 446 END DO 444 447 445 448 !------------------------------------------------------------------------------- 446 449 ! 2) Transfer volume and energy between categories … … 454 457 ! 455 458 IF ( jl1 == jl ) THEN ; jl2 = jl1+1 456 ELSE ; jl2 = jl 459 ELSE ; jl2 = jl 457 460 ENDIF 458 461 ! … … 472 475 ztrans = v_s_2d(ji,jl1) * zworkv(ji) ! Snow volumes 473 476 v_s_2d(ji,jl1) = v_s_2d(ji,jl1) - ztrans 474 v_s_2d(ji,jl2) = v_s_2d(ji,jl2) + ztrans 477 v_s_2d(ji,jl2) = v_s_2d(ji,jl2) + ztrans 475 478 ! 476 479 ztrans = oa_i_2d(ji,jl1) * zworka(ji) ! Ice age … … 485 488 zaTsfn(ji,jl1) = zaTsfn(ji,jl1) - ztrans 486 489 zaTsfn(ji,jl2) = zaTsfn(ji,jl2) + ztrans 487 ! 488 IF ( ln_pnd_LEV ) THEN490 ! 491 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 489 492 ztrans = a_ip_2d(ji,jl1) * zworka(ji) ! Pond fraction 490 493 a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - ztrans 491 494 a_ip_2d(ji,jl2) = a_ip_2d(ji,jl2) + ztrans 492 ! 493 ztrans = v_ip_2d(ji,jl1) * zwork a(ji) ! Pond volume (also proportional to da/a)495 ! 496 ztrans = v_ip_2d(ji,jl1) * zworkv(ji) ! Pond volume 494 497 v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans 495 498 v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans 496 499 ! 497 500 IF ( ln_pnd_lids ) THEN ! Pond lid volume 498 ztrans = v_il_2d(ji,jl1) * zwork a(ji)501 ztrans = v_il_2d(ji,jl1) * zworkv(ji) 499 502 v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - ztrans 500 503 v_il_2d(ji,jl2) = v_il_2d(ji,jl2) + ztrans … … 552 555 & a_i_2d(1:npti,jl) = a_i_2d(1:npti,jl) * rn_amax_1d(1:npti) / zworka(1:npti) 553 556 END DO 554 557 555 558 !------------------------------------------------------------------------------- 556 559 ! 4) Update ice thickness and temperature … … 561 564 WHERE( a_i_2d(1:npti,:) >= epsi20 ) 562 565 # endif 563 h_i_2d (1:npti,:) = v_i_2d(1:npti,:) / a_i_2d(1:npti,:) 564 t_su_2d(1:npti,:) = zaTsfn(1:npti,:) / a_i_2d(1:npti,:) 566 h_i_2d (1:npti,:) = v_i_2d(1:npti,:) / a_i_2d(1:npti,:) 567 t_su_2d(1:npti,:) = zaTsfn(1:npti,:) / a_i_2d(1:npti,:) 565 568 ELSEWHERE 566 569 h_i_2d (1:npti,:) = 0._wp … … 588 591 ! 589 592 END SUBROUTINE itd_shiftice 590 593 591 594 592 595 SUBROUTINE ice_itd_reb( kt ) … … 600 603 !! to the neighboring category 601 604 !!------------------------------------------------------------------ 602 INTEGER , INTENT (in) :: kt ! Ocean time step 605 INTEGER , INTENT (in) :: kt ! Ocean time step 603 606 INTEGER :: ji, jj, jl ! dummy loop indices 604 607 ! … … 606 609 REAL(wp), DIMENSION(jpij,jpl-1) :: zdaice, zdvice ! ice area and volume transferred 607 610 !!------------------------------------------------------------------ 608 ! 609 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution' 611 IF( ln_timing ) CALL timing_start('iceitd_reb') 612 ! 613 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution' 610 614 ! 611 615 IF( ln_icediachk ) CALL ice_cons_hsm(0, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) … … 623 627 IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 624 628 npti = npti + 1 625 nptidx( npti ) = (jj - 1) * jpi + ji 629 nptidx( npti ) = (jj - 1) * jpi + ji 626 630 ENDIF 627 631 END_2D 628 632 ! 629 IF( npti > 0 ) THEN 633 IF( npti > 0 ) THEN 630 634 !!clem CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) ) 631 635 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl) ) … … 633 637 ! 634 638 DO ji = 1, npti 635 jdonor(ji,jl) = jl 639 jdonor(ji,jl) = jl 636 640 ! how much of a_i you send in cat sup is somewhat arbitrary 637 !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 638 !! zdaice(ji,jl) = a_i_1d(ji) * ( h_i_1d(ji) - hi_max(jl) + epsi10 ) / h_i_1d(ji) 639 !! zdvice(ji,jl) = v_i_1d(ji) - ( a_i_1d(ji) - zdaice(ji,jl) ) * ( hi_max(jl) - epsi10 ) 640 !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 641 !! zdaice(ji,jl) = a_i_1d(ji) 642 !! zdvice(ji,jl) = v_i_1d(ji) 643 !!clem: these are from UCL and work ok 644 zdaice(ji,jl) = a_i_1d(ji) * 0.5_wp 645 zdvice(ji,jl) = v_i_1d(ji) - zdaice(ji,jl) * ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 641 ! these are from CICE => transfer everything 642 !!zdaice(ji,jl) = a_i_1d(ji) 643 !!zdvice(ji,jl) = v_i_1d(ji) 644 ! these are from LLN => transfer only half of the category 645 zdaice(ji,jl) = 0.5_wp * a_i_1d(ji) 646 zdvice(ji,jl) = v_i_1d(ji) - (1._wp - 0.5_wp) * a_i_1d(ji) * hi_mean(jl) 646 647 END DO 647 648 ! … … 662 663 IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN 663 664 npti = npti + 1 664 nptidx( npti ) = (jj - 1) * jpi + ji 665 nptidx( npti ) = (jj - 1) * jpi + ji 665 666 ENDIF 666 667 END_2D … … 671 672 DO ji = 1, npti 672 673 jdonor(ji,jl) = jl + 1 673 zdaice(ji,jl) = a_i_1d(ji) 674 zdaice(ji,jl) = a_i_1d(ji) 674 675 zdvice(ji,jl) = v_i_1d(ji) 675 676 END DO … … 686 687 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 687 688 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 689 IF( ln_timing ) CALL timing_stop ('iceitd_reb') 688 690 ! 689 691 END SUBROUTINE ice_itd_reb … … 719 721 WRITE(numout,*) ' mean ice thickness in the domain rn_himean = ', rn_himean 720 722 WRITE(numout,*) ' Ice categories are defined by rn_catbnd ln_cat_usr = ', ln_cat_usr 721 WRITE(numout,*) ' minimum ice thickness allowed rn_himin = ', rn_himin 722 WRITE(numout,*) ' maximum ice thickness allowed rn_himax = ', rn_himax 723 WRITE(numout,*) ' minimum ice thickness allowed rn_himin = ', rn_himin 724 WRITE(numout,*) ' maximum ice thickness allowed rn_himax = ', rn_himax 723 725 ENDIF 724 726 ! … … 727 729 !-----------------------------------! 728 730 ! !== set the choice of ice categories ==! 729 ioptio = 0 731 ioptio = 0 730 732 IF( ln_cat_hfn ) THEN ; ioptio = ioptio + 1 ; nice_catbnd = np_cathfn ; ENDIF 731 733 IF( ln_cat_usr ) THEN ; ioptio = ioptio + 1 ; nice_catbnd = np_catusr ; ENDIF -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icesbc.F90
r13719 r14021 62 62 !!------------------------------------------------------------------- 63 63 ! 64 IF( ln_timing ) CALL timing_start('ice _sbc')64 IF( ln_timing ) CALL timing_start('icesbc') 65 65 ! 66 66 IF( kt == nit000 .AND. lwp ) THEN … … 90 90 ENDIF 91 91 ! 92 IF( ln_timing ) CALL timing_stop('ice _sbc')92 IF( ln_timing ) CALL timing_stop('icesbc') 93 93 ! 94 94 END SUBROUTINE ice_sbc_tau … … 123 123 !!-------------------------------------------------------------------- 124 124 ! 125 IF( ln_timing ) CALL timing_start('ice _sbc_flx')125 IF( ln_timing ) CALL timing_start('icesbc') 126 126 127 127 IF( kt == nit000 .AND. lwp ) THEN … … 179 179 ENDIF 180 180 ! 181 IF( ln_timing ) CALL timing_stop('ice _sbc_flx')181 IF( ln_timing ) CALL timing_stop('icesbc') 182 182 ! 183 183 END SUBROUTINE ice_sbc_flx -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icestp.F90
r14017 r14021 121 121 !!---------------------------------------------------------------------- 122 122 ! 123 IF( ln_timing ) CALL timing_start('ice _stp')123 IF( ln_timing ) CALL timing_start('icestp') 124 124 ! 125 125 ! !-----------------------! … … 215 215 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! 216 216 ! 217 IF( ln_timing ) CALL timing_stop('ice _stp')217 IF( ln_timing ) CALL timing_stop('icestp') 218 218 ! 219 219 END SUBROUTINE ice_stp … … 373 373 v_i_b (:,:,:) = v_i (:,:,:) ! ice volume 374 374 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 375 v_ip_b(:,:,:) = v_ip(:,:,:) ! pond volume 376 v_il_b(:,:,:) = v_il(:,:,:) ! pond lid volume 375 377 sv_i_b(:,:,:) = sv_i(:,:,:) ! salt content 376 378 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy … … 432 434 diag_heat(ji,jj) = 0._wp ; diag_sice(ji,jj) = 0._wp 433 435 diag_vice(ji,jj) = 0._wp ; diag_vsnw(ji,jj) = 0._wp 436 diag_aice(ji,jj) = 0._wp ; diag_vpnd(ji,jj) = 0._wp 434 437 435 438 tau_icebfr (ji,jj) = 0._wp ! landfast ice param only (clem: important to keep the init here) … … 457 460 qcn_ice (ji,jj,jl) = 0._wp ! conductive flux (ln_cndflx=T & ln_cndemule=T) 458 461 qtr_ice_bot(ji,jj,jl) = 0._wp ! part of solar radiation transmitted through the ice needed at least for outputs 462 ! Melt pond surface melt diagnostics (mv - more efficient: grouped into one water volume flux) 463 dh_i_sum_2d(ji,jj,jl) = 0._wp 464 dh_s_mlt_2d(ji,jj,jl) = 0._wp 459 465 END_2D 460 466 ENDDO … … 485 491 diag_vsnw(:,:) = diag_vsnw(:,:) & 486 492 & + SUM( v_s (:,:,:) - v_s_b (:,:,:) , dim=3 ) * r1_Dt_ice * rhos 493 diag_vpnd(:,:) = diag_vpnd(:,:) & 494 & + SUM( v_ip + v_il - v_ip_b - v_il_b , dim=3 ) * r1_Dt_ice * rhow 487 495 ! 488 496 IF( kn == 2 ) CALL iom_put ( 'hfxdhc' , diag_heat ) ! output of heat trend -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icethd.F90
r13643 r14021 69 69 SUBROUTINE ice_thd( kt ) 70 70 !!------------------------------------------------------------------- 71 !! *** ROUTINE ice_thd *** 72 !! 71 !! *** ROUTINE ice_thd *** 72 !! 73 73 !! ** Purpose : This routine manages ice thermodynamics 74 !! 74 !! 75 75 !! ** Action : - computation of oceanic sensible heat flux at the ice base 76 76 !! energy budget in the leads … … 114 114 ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp 115 115 ENDIF 116 116 117 117 !---------------------------------------------! 118 118 ! computation of friction velocity at T points … … 157 157 ! --- Sensible ocean-to-ice heat flux (W/m2) --- ! 158 158 ! (mostly>0 but <0 if supercooling) 159 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 159 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 160 160 qsb_ice_bot(ji,jj) = rswitch * rho0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) 161 162 ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 161 162 ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 163 163 ! the freezing point, so that we do not have SST < T_freeze 164 164 ! This implies: qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice <= - zqfr_neg … … 166 166 qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ) 167 167 168 ! If conditions are always supercooled (such as at the mouth of ice-shelves), then ice grows continuously 169 ! ==> stop ice formation by artificially setting up the turbulent fluxes to 0 when volume > 20m (arbitrary) 170 IF( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) > 0._wp .AND. vt_i(ji,jj) >= 20._wp ) THEN 171 zqfr = 0._wp 172 zqfr_pos = 0._wp 173 qsb_ice_bot(ji,jj) = 0._wp 174 ENDIF 175 ! 168 176 ! --- Energy Budget of the leads (qlead, J.m-2) --- ! 169 177 ! qlead is the energy received from the atm. in the leads. … … 202 210 ! 203 211 END_2D 204 212 205 213 ! In case we bypass open-water ice formation 206 214 IF( .NOT. ln_icedO ) qlead(:,:) = 0._wp … … 219 227 npti = 0 ; nptidx(:) = 0 220 228 DO_2D( 1, 1, 1, 1 ) 221 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 229 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 222 230 npti = npti + 1 223 231 nptidx(npti) = (jj - 1) * jpi + ji … … 226 234 227 235 IF( npti > 0 ) THEN ! If there is no ice, do nothing. 228 ! 236 ! 229 237 CALL ice_thd_1d2d( jl, 1 ) ! --- Move to 1D arrays --- ! 230 238 ! ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- ! 231 239 ! 232 s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here) 233 dh_i_sum (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm (1:npti) = 0._wp 240 s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here) 241 dh_i_sum (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm (1:npti) = 0._wp 234 242 dh_i_sub (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp 235 243 dh_snowice(1:npti) = 0._wp ; dh_s_mlt(1:npti) = 0._wp 236 ! 244 ! 237 245 CALL ice_thd_zdf ! --- Ice-Snow temperature --- ! 238 246 ! 239 247 IF( ln_icedH ) THEN ! --- Growing/Melting --- ! 240 CALL ice_thd_dh ! Ice-Snow thickness 241 CALL ice_thd_pnd ! Melt ponds formation 248 CALL ice_thd_dh ! Ice-Snow thickness 242 249 CALL ice_thd_ent( e_i_1d(1:npti,:) ) ! Ice enthalpy remapping 243 250 ENDIF 244 CALL ice_thd_sal( ln_icedS ) ! --- Ice salinity --- ! 251 CALL ice_thd_sal( ln_icedS ) ! --- Ice salinity --- ! 245 252 ! 246 253 CALL ice_thd_temp ! --- Temperature update --- ! … … 259 266 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 260 267 IF( ln_icediachk ) CALL ice_cons2D (1, 'icethd', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 261 ! 268 ! 269 IF ( ln_pnd .AND. ln_icedH ) & 270 & CALL ice_thd_pnd ! --- Melt ponds 271 ! 262 272 IF( jpl > 1 ) CALL ice_itd_rem( kt ) ! --- Transport ice between thickness categories --- ! 263 273 ! … … 266 276 CALL ice_cor( kt , 2 ) ! --- Corrections --- ! 267 277 ! 268 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * r dt_ice ! ice natural aging incrementation278 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice ! ice natural aging incrementation 269 279 ! 270 280 ! convergence tests … … 280 290 IF( ln_timing ) CALL timing_stop('icethd') ! timing 281 291 ! 282 END SUBROUTINE ice_thd 283 284 292 END SUBROUTINE ice_thd 293 294 285 295 SUBROUTINE ice_thd_temp 286 296 !!----------------------------------------------------------------------- 287 !! *** ROUTINE ice_thd_temp *** 288 !! 297 !! *** ROUTINE ice_thd_temp *** 298 !! 289 299 !! ** Purpose : Computes sea ice temperature (Kelvin) from enthalpy 290 300 !! … … 292 302 !!------------------------------------------------------------------- 293 303 INTEGER :: ji, jk ! dummy loop indices 294 REAL(wp) :: ztmelts, zbbb, zccc ! local scalar 304 REAL(wp) :: ztmelts, zbbb, zccc ! local scalar 295 305 !!------------------------------------------------------------------- 296 306 ! Recover ice temperature … … 302 312 zccc = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts, 0._wp ) ) 303 313 t_i_1d(ji,jk) = rt0 - ( zbbb + zccc ) * 0.5_wp * r1_rcpi 304 314 305 315 ! mask temperature 306 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) ) 316 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) ) 307 317 t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0 308 END DO 309 END DO 318 END DO 319 END DO 310 320 ! 311 321 END SUBROUTINE ice_thd_temp … … 314 324 SUBROUTINE ice_thd_mono 315 325 !!----------------------------------------------------------------------- 316 !! *** ROUTINE ice_thd_mono *** 317 !! 326 !! *** ROUTINE ice_thd_mono *** 327 !! 318 328 !! ** Purpose : Lateral melting in case virtual_itd 319 329 !! ( dA = A/2h dh ) … … 322 332 REAL(wp) :: zhi_bef ! ice thickness before thermo 323 333 REAL(wp) :: zdh_mel, zda_mel ! net melting 324 REAL(wp) :: zvi, zvs ! ice/snow volumes 334 REAL(wp) :: zvi, zvs ! ice/snow volumes 325 335 !!----------------------------------------------------------------------- 326 336 ! … … 334 344 rswitch = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) ) 335 345 zda_mel = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 336 a_i_1d(ji) = MAX( epsi20, a_i_1d(ji) + zda_mel ) 346 a_i_1d(ji) = MAX( epsi20, a_i_1d(ji) + zda_mel ) 337 347 ! adjust thickness 338 h_i_1d(ji) = zvi / a_i_1d(ji) 339 h_s_1d(ji) = zvs / a_i_1d(ji) 348 h_i_1d(ji) = zvi / a_i_1d(ji) 349 h_s_1d(ji) = zvs / a_i_1d(ji) 340 350 ! retrieve total concentration 341 351 at_i_1d(ji) = a_i_1d(ji) … … 348 358 SUBROUTINE ice_thd_1d2d( kl, kn ) 349 359 !!----------------------------------------------------------------------- 350 !! *** ROUTINE ice_thd_1d2d *** 351 !! 360 !! *** ROUTINE ice_thd_1d2d *** 361 !! 352 362 !! ** Purpose : move arrays from 1d to 2d and the reverse 353 363 !!----------------------------------------------------------------------- 354 INTEGER, INTENT(in) :: kl ! index of the ice category 364 INTEGER, INTENT(in) :: kl ! index of the ice category 355 365 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D ; 2= from 1D to 2D 356 366 ! … … 377 387 CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl) ) 378 388 END DO 379 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip (:,:,kl) )380 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip (:,:,kl) )381 CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il (:,:,kl) )382 389 ! 383 390 CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d (1:npti), qprec_ice ) … … 387 394 CALL tab_2d_1d( npti, nptidx(1:npti), dqns_ice_1d (1:npti), dqns_ice(:,:,kl) ) 388 395 CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d (1:npti), t_bo ) 389 CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d (1:npti), sprecip ) 396 CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d (1:npti), sprecip ) 390 397 CALL tab_2d_1d( npti, nptidx(1:npti), qsb_ice_bot_1d(1:npti), qsb_ice_bot ) 391 398 CALL tab_2d_1d( npti, nptidx(1:npti), fhld_1d (1:npti), fhld ) 392 399 393 400 CALL tab_2d_1d( npti, nptidx(1:npti), qml_ice_1d (1:npti), qml_ice (:,:,kl) ) 394 401 CALL tab_2d_1d( npti, nptidx(1:npti), qcn_ice_1d (1:npti), qcn_ice (:,:,kl) ) … … 409 416 CALL tab_2d_1d( npti, nptidx(1:npti), wfx_spr_1d (1:npti), wfx_spr ) 410 417 CALL tab_2d_1d( npti, nptidx(1:npti), wfx_lam_1d (1:npti), wfx_lam ) 411 CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d (1:npti), wfx_pnd )412 418 ! 413 419 CALL tab_2d_1d( npti, nptidx(1:npti), sfx_bog_1d (1:npti), sfx_bog ) … … 464 470 v_s_1d (1:npti) = h_s_1d (1:npti) * a_i_1d (1:npti) 465 471 sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 466 v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_1d(1:npti)467 v_il_1d(1:npti) = h_il_1d(1:npti) * a_ip_1d(1:npti)468 472 oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 469 473 470 474 CALL tab_1d_2d( npti, nptidx(1:npti), at_i_1d(1:npti), at_i ) 471 475 CALL tab_1d_2d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i (:,:,kl) ) … … 483 487 CALL tab_1d_2d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl) ) 484 488 END DO 485 CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip (:,:,kl) )486 CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip (:,:,kl) )487 CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il (:,:,kl) )488 489 ! 489 490 CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) … … 501 502 CALL tab_1d_2d( npti, nptidx(1:npti), wfx_spr_1d (1:npti), wfx_spr ) 502 503 CALL tab_1d_2d( npti, nptidx(1:npti), wfx_lam_1d (1:npti), wfx_lam ) 503 CALL tab_1d_2d( npti, nptidx(1:npti), wfx_pnd_1d (1:npti), wfx_pnd )504 504 ! 505 505 CALL tab_1d_2d( npti, nptidx(1:npti), sfx_bog_1d (1:npti), sfx_bog ) … … 529 529 CALL tab_1d_2d( npti, nptidx(1:npti), cnd_ice_1d(1:npti), cnd_ice(:,:,kl) ) 530 530 CALL tab_1d_2d( npti, nptidx(1:npti), t1_ice_1d (1:npti), t1_ice (:,:,kl) ) 531 ! SIMIP diagnostics 531 ! Melt ponds 532 CALL tab_1d_2d( npti, nptidx(1:npti), dh_i_sum (1:npti) , dh_i_sum_2d(:,:,kl) ) 533 CALL tab_1d_2d( npti, nptidx(1:npti), dh_s_mlt (1:npti) , dh_s_mlt_2d(:,:,kl) ) 534 ! SIMIP diagnostics 532 535 CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d (1:npti), t_si (:,:,kl) ) 533 536 CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_bot_1d(1:npti), qcn_ice_bot(:,:,kl) ) … … 537 540 CALL tab_1d_2d( npti, nptidx(1:npti), v_s_1d (1:npti), v_s (:,:,kl) ) 538 541 CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 539 CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) )540 CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,kl) )541 542 CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 542 543 ! check convergence of heat diffusion scheme … … 553 554 SUBROUTINE ice_thd_init 554 555 !!------------------------------------------------------------------- 555 !! *** ROUTINE ice_thd_init *** 556 !! 556 !! *** ROUTINE ice_thd_init *** 557 !! 557 558 !! ** Purpose : Physical constants and parameters associated with 558 559 !! ice thermodynamics -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icethd_dh.F90
r13643 r14021 2 2 !!====================================================================== 3 3 !! *** MODULE icethd_dh *** 4 !! seaice : thermodynamic growth and melt 4 !! seaice : thermodynamic growth and melt 5 5 !!====================================================================== 6 6 !! History : ! 2003-05 (M. Vancoppenolle) Original code in 1D 7 !! ! 2005-06 (M. Vancoppenolle) 3D version 7 !! ! 2005-06 (M. Vancoppenolle) 3D version 8 8 !! 4.0 ! 2018 (many people) SI3 [aka Sea Ice cube] 9 9 !!---------------------------------------------------------------------- … … 24 24 USE lib_mpp ! MPP library 25 25 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) 26 26 27 27 IMPLICIT NONE 28 28 PRIVATE … … 55 55 !! - Snow ice formation 56 56 !! 57 !! ** Note : h=max(0,h+dh) are often used to ensure positivity of h. 58 !! very small negative values can occur otherwise (e.g. -1.e-20) 59 !! 57 60 !! References : Bitz and Lipscomb, 1999, J. Geophys. Res. 58 !! Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646 59 !! Vancoppenolle, Fichefet and Bitz, 2005, Geophys. Res. Let. 61 !! Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646 62 !! Vancoppenolle, Fichefet and Bitz, 2005, Geophys. Res. Let. 60 63 !! Vancoppenolle et al.,2009, Ocean Modelling 61 64 !!------------------------------------------------------------------ … … 64 67 65 68 REAL(wp) :: ztmelts ! local scalar 66 REAL(wp) :: zdum 69 REAL(wp) :: zdum 67 70 REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment 68 71 REAL(wp) :: zswi1 ! switch for computation of bottom salinity … … 79 82 REAL(wp) :: zfmdt ! exchange mass flux x time step (J/m2), >0 towards the ocean 80 83 81 REAL(wp), DIMENSION(jpij) :: zqprec ! energy of fallen snow (J.m-3)82 84 REAL(wp), DIMENSION(jpij) :: zq_top ! heat for surface ablation (J.m-2) 83 85 REAL(wp), DIMENSION(jpij) :: zq_bot ! heat for bottom ablation (J.m-2) … … 85 87 REAL(wp), DIMENSION(jpij) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) 86 88 REAL(wp), DIMENSION(jpij) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2) 87 88 REAL(wp), DIMENSION(jpij) :: zdh_s_mel ! snow melt 89 REAL(wp), DIMENSION(jpij) :: zdh_s_pre ! snow precipitation 90 REAL(wp), DIMENSION(jpij) :: zdh_s_sub ! snow sublimation 91 92 REAL(wp), DIMENSION(jpij,nlay_s) :: zh_s ! snw layer thickness 93 REAL(wp), DIMENSION(jpij,nlay_i) :: zh_i ! ice layer thickness 94 REAL(wp), DIMENSION(jpij,nlay_i) :: zdeltah 95 INTEGER , DIMENSION(jpij,nlay_i) :: icount ! number of layers vanished by melting 96 89 REAL(wp), DIMENSION(jpij) :: zdeltah 97 90 REAL(wp), DIMENSION(jpij) :: zsnw ! distribution of snow after wind blowing 98 91 92 INTEGER , DIMENSION(jpij,nlay_i) :: icount ! number of layers vanishing by melting 93 REAL(wp), DIMENSION(jpij,0:nlay_i+1) :: zh_i ! ice layer thickness (m) 94 REAL(wp), DIMENSION(jpij,0:nlay_s ) :: zh_s ! snw layer thickness (m) 95 REAL(wp), DIMENSION(jpij,0:nlay_s ) :: ze_s ! snw layer enthalpy (J.m-3) 96 99 97 REAL(wp) :: zswitch_sal 100 98 101 INTEGER :: num_iter_max ! Heat conservation 99 INTEGER :: num_iter_max ! Heat conservation 102 100 !!------------------------------------------------------------------ 103 101 … … 108 106 END SELECT 109 107 110 ! initialize layer thicknesses and enthalpies 108 ! initialize ice layer thicknesses and enthalpies 109 eh_i_old(1:npti,0:nlay_i+1) = 0._wp 111 110 h_i_old (1:npti,0:nlay_i+1) = 0._wp 112 eh_i_old(1:npti,0:nlay_i+1) = 0._wp111 zh_i (1:npti,0:nlay_i+1) = 0._wp 113 112 DO jk = 1, nlay_i 114 113 DO ji = 1, npti 114 eh_i_old(ji,jk) = h_i_1d(ji) * r1_nlay_i * e_i_1d(ji,jk) 115 115 h_i_old (ji,jk) = h_i_1d(ji) * r1_nlay_i 116 eh_i_old(ji,jk) = e_i_1d(ji,jk) * h_i_old(ji,jk) 116 zh_i (ji,jk) = h_i_1d(ji) * r1_nlay_i 117 END DO 118 END DO 119 ! 120 ! initialize snw layer thicknesses and enthalpies 121 zh_s(1:npti,0) = 0._wp 122 ze_s(1:npti,0) = 0._wp 123 DO jk = 1, nlay_s 124 DO ji = 1, npti 125 zh_s(ji,jk) = h_s_1d(ji) * r1_nlay_s 126 ze_s(ji,jk) = e_s_1d(ji,jk) 117 127 END DO 118 128 END DO … … 139 149 ! 140 150 DO ji = 1, npti 141 zf_tt(ji) = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji) + qtr_ice_bot_1d(ji) * frq_m_1d(ji) 151 zf_tt(ji) = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji) + qtr_ice_bot_1d(ji) * frq_m_1d(ji) 142 152 zq_bot(ji) = MAX( 0._wp, zf_tt(ji) * rDt_ice ) 143 END DO144 145 ! Ice and snow layer thicknesses146 !-------------------------------147 DO jk = 1, nlay_i148 DO ji = 1, npti149 zh_i(ji,jk) = h_i_1d(ji) * r1_nlay_i150 END DO151 END DO152 153 DO jk = 1, nlay_s154 DO ji = 1, npti155 zh_s(ji,jk) = h_s_1d(ji) * r1_nlay_s156 END DO157 153 END DO 158 154 … … 167 163 DO ji = 1, npti 168 164 IF( t_s_1d(ji,jk) > rt0 ) THEN 169 hfx_res_1d (ji) = hfx_res_1d (ji) + e_s_1d(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice ! heat flux to the ocean [W.m-2], < 0170 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos 165 hfx_res_1d (ji) = hfx_res_1d (ji) - ze_s(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice ! heat flux to the ocean [W.m-2], < 0 166 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice ! mass flux 171 167 ! updates 172 dh_s_mlt(ji) = dh_s_mlt(ji) - zh_s(ji,jk)173 h_s_1d (ji) = h_s_1d(ji) - zh_s(ji,jk)168 dh_s_mlt(ji) = dh_s_mlt(ji) - zh_s(ji,jk) 169 h_s_1d (ji) = MAX( 0._wp, h_s_1d (ji) - zh_s(ji,jk) ) 174 170 zh_s (ji,jk) = 0._wp 175 e_s_1d (ji,jk) = 0._wp 176 t_s_1d (ji,jk) = rt0 171 ze_s (ji,jk) = 0._wp 177 172 END IF 178 173 END DO 179 END DO 174 END DO 180 175 181 176 ! Snow precipitation 182 177 !------------------- 183 CALL ice_var_snwblow( 1.0_wp - at_i_1d(1:npti), zsnw(1:npti) ) ! snow distribution over ice after wind blowing 184 185 zdeltah(1:npti,:) = 0._wp 178 CALL ice_var_snwblow( 1._wp - at_i_1d(1:npti), zsnw(1:npti) ) ! snow distribution over ice after wind blowing 179 186 180 DO ji = 1, npti 187 181 IF( sprecip_1d(ji) > 0._wp ) THEN 182 zh_s(ji,0) = zsnw(ji) * sprecip_1d(ji) * rDt_ice * r1_rhos / at_i_1d(ji) ! thickness of precip 183 ze_s(ji,0) = MAX( 0._wp, - qprec_ice_1d(ji) ) ! enthalpy of the precip (>0, J.m-3) 188 184 ! 189 ! --- precipitation --- 190 zdh_s_pre (ji) = zsnw(ji) * sprecip_1d(ji) * rDt_ice * r1_rhos / at_i_1d(ji) ! thickness change 191 zqprec (ji) = - qprec_ice_1d(ji) ! enthalpy of the precip (>0, J.m-3) 185 hfx_spr_1d(ji) = hfx_spr_1d(ji) + ze_s(ji,0) * zh_s(ji,0) * a_i_1d(ji) * r1_Dt_ice ! heat flux from snow precip (>0, W.m-2) 186 wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhos * zh_s(ji,0) * a_i_1d(ji) * r1_Dt_ice ! mass flux, <0 192 187 ! 193 hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji) * r1_Dt_ice ! heat flux from snow precip (>0, W.m-2)194 wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhos * a_i_1d(ji) * zdh_s_pre(ji) * r1_Dt_ice ! mass flux, <0195 196 ! --- melt of falling snow ---197 rswitch = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) )198 zdeltah (ji,1) = - rswitch * zq_top(ji) / MAX( zqprec(ji) , epsi20 ) ! thickness change199 zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting200 hfx_snw_1d (ji) = hfx_snw_1d (ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_Dt_ice ! heat used to melt snow (W.m-2, >0)201 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos * a_i_1d(ji) * zdeltah(ji,1) * r1_Dt_ice ! snow melting only = water into the ocean (then without snow precip), >0202 203 ! updates available heat + precipitations after melting204 dh_s_mlt (ji) = dh_s_mlt(ji) + zdeltah(ji,1)205 zq_top (ji) = MAX( 0._wp , zq_top (ji) + zdeltah(ji,1) * zqprec(ji) )206 zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1)207 208 188 ! update thickness 209 h_s_1d(ji) = MAX( 0._wp , h_s_1d(ji) + zdh_s_pre(ji) ) 210 ! 211 ELSE 212 ! 213 zdh_s_pre(ji) = 0._wp 214 zqprec (ji) = 0._wp 215 ! 189 h_s_1d(ji) = h_s_1d(ji) + zh_s(ji,0) 216 190 ENDIF 217 END DO218 219 ! recalculate snow layers220 DO jk = 1, nlay_s221 DO ji = 1, npti222 zh_s(ji,jk) = h_s_1d(ji) * r1_nlay_s223 END DO224 191 END DO 225 192 226 193 ! Snow melting 227 194 ! ------------ 228 ! If heat still available (zq_top > 0), then melt more snow 229 zdeltah(1:npti,:) = 0._wp 230 zdh_s_mel(1:npti) = 0._wp 231 DO jk = 1, nlay_s 195 ! If heat still available (zq_top > 0) 196 ! then all snw precip has been melted and we need to melt more snow 197 DO jk = 0, nlay_s 232 198 DO ji = 1, npti 233 199 IF( zh_s(ji,jk) > 0._wp .AND. zq_top(ji) > 0._wp ) THEN 234 200 ! 235 rswitch = MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,jk) - epsi20 ) ) 236 zdeltah (ji,jk) = - rswitch * zq_top(ji) / MAX( e_s_1d(ji,jk), epsi20 ) ! thickness change 237 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji,jk) ) ! bound melting 238 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,jk) 239 240 hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_1d(ji) * e_s_1d (ji,jk) * r1_Dt_ice ! heat used to melt snow(W.m-2, >0) 241 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice ! snow melting only = water into the ocean (then without snow precip) 242 201 rswitch = MAX( 0._wp , SIGN( 1._wp , ze_s(ji,jk) - epsi20 ) ) 202 zdum = - rswitch * zq_top(ji) / MAX( ze_s(ji,jk), epsi20 ) ! thickness change 203 zdum = MAX( zdum , - zh_s(ji,jk) ) ! bound melting 204 205 hfx_snw_1d (ji) = hfx_snw_1d (ji) - ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice ! heat used to melt snow(W.m-2, >0) 206 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos * zdum * a_i_1d(ji) * r1_Dt_ice ! snow melting only = water into the ocean 207 243 208 ! updates available heat + thickness 244 dh_s_mlt(ji) = dh_s_mlt(ji) + zdeltah(ji,jk) 245 zq_top (ji) = MAX( 0._wp , zq_top(ji) + zdeltah(ji,jk) * e_s_1d(ji,jk) ) 246 h_s_1d (ji) = MAX( 0._wp , h_s_1d(ji) + zdeltah(ji,jk) ) 247 zh_s (ji,jk) = MAX( 0._wp , zh_s(ji,jk) + zdeltah(ji,jk) ) 209 dh_s_mlt(ji) = dh_s_mlt(ji) + zdum 210 zq_top (ji) = MAX( 0._wp , zq_top (ji) + zdum * ze_s(ji,jk) ) 211 h_s_1d (ji) = MAX( 0._wp , h_s_1d (ji) + zdum ) 212 zh_s (ji,jk) = MAX( 0._wp , zh_s (ji,jk) + zdum ) 213 !!$ IF( zh_s(ji,jk) == 0._wp ) ze_s(ji,jk) = 0._wp 248 214 ! 249 215 ENDIF … … 251 217 END DO 252 218 253 ! Snow sublimation 219 ! Snow sublimation 254 220 !----------------- 255 221 ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 256 222 ! comment: not counted in mass/heat exchange in iceupdate.F90 since this is an exchange with atm. (not ocean) 257 zdeltah(1:npti,:) = 0._wp 223 zdeltah (1:npti) = 0._wp ! total snow thickness that sublimates, < 0 224 zevap_rema(1:npti) = 0._wp 258 225 DO ji = 1, npti 259 226 IF( evap_ice_1d(ji) > 0._wp ) THEN 227 zdeltah (ji) = MAX( - evap_ice_1d(ji) * r1_rhos * rDt_ice, - h_s_1d(ji) ) ! amount of snw that sublimates, < 0 228 zevap_rema(ji) = MAX( 0._wp, evap_ice_1d(ji) * rDt_ice + zdeltah(ji) * rhos ) ! remaining evap in kg.m-2 (used for ice sublimation later on) 229 ENDIF 230 END DO 231 232 DO jk = 0, nlay_s 233 DO ji = 1, npti 234 zdum = MAX( -zh_s(ji,jk), zdeltah(ji) ) ! snow layer thickness that sublimates, < 0 260 235 ! 261 zdh_s_sub (ji) = MAX( - h_s_1d(ji) , - evap_ice_1d(ji) * r1_rhos * rDt_ice ) 262 zevap_rema(ji) = evap_ice_1d(ji) * rDt_ice + zdh_s_sub(ji) * rhos ! remaining evap in kg.m-2 (used for ice melting later on) 263 zdeltah (ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 264 265 hfx_sub_1d (ji) = hfx_sub_1d(ji) + & ! Heat flux by sublimation [W.m-2], < 0 (sublimate snow that had fallen, then pre-existing snow) 266 & ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * e_s_1d(ji,1) ) & 267 & * a_i_1d(ji) * r1_Dt_ice 268 wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos * a_i_1d(ji) * zdh_s_sub(ji) * r1_Dt_ice ! Mass flux by sublimation 269 270 ! new snow thickness 271 h_s_1d(ji) = MAX( 0._wp , h_s_1d(ji) + zdh_s_sub(ji) ) 272 ! update precipitations after sublimation and correct sublimation 273 zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 274 zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 275 ! 276 ELSE 277 ! 278 zdh_s_sub (ji) = 0._wp 279 zevap_rema(ji) = 0._wp 280 ! 281 ENDIF 282 END DO 283 284 ! --- Update snow diags --- ! 285 DO ji = 1, npti 286 dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 287 END DO 288 289 ! Update temperature, energy 290 !--------------------------- 291 ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 292 DO jk = 1, nlay_s 293 DO ji = 1,npti 294 rswitch = MAX( 0._wp , SIGN( 1._wp, h_s_1d(ji) - epsi20 ) ) 295 e_s_1d(ji,jk) = rswitch / MAX( h_s_1d(ji), epsi20 ) * & 296 & ( ( zdh_s_pre(ji) ) * zqprec(ji) + & 297 & ( h_s_1d(ji) - zdh_s_pre(ji) ) * rhos * ( rcpi * ( rt0 - t_s_1d(ji,jk) ) + rLfus ) ) 298 END DO 299 END DO 300 236 hfx_sub_1d (ji) = hfx_sub_1d (ji) + ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice ! Heat flux of snw that sublimates [W.m-2], < 0 237 wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux by sublimation 238 239 ! update thickness 240 h_s_1d(ji) = MAX( 0._wp , h_s_1d(ji) + zdum ) 241 zh_s (ji,jk) = MAX( 0._wp , zh_s (ji,jk) + zdum ) 242 !!$ IF( zh_s(ji,jk) == 0._wp ) ze_s(ji,jk) = 0._wp 243 244 ! update sublimation left 245 zdeltah(ji) = MIN( zdeltah(ji) - zdum, 0._wp ) 246 END DO 247 END DO 248 249 ! 301 250 ! ! ============ ! 302 251 ! ! Ice ! 303 252 ! ! ============ ! 304 253 305 ! Surface ice melting 254 ! Surface ice melting 306 255 !-------------------- 307 zdeltah(1:npti,:) = 0._wp ! important308 256 DO jk = 1, nlay_i 309 257 DO ji = 1, npti 310 258 ztmelts = - rTmlt * sz_i_1d(ji,jk) ! Melting point of layer k [C] 311 259 312 260 IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN !-- Internal melting 313 261 314 zEi = - e_i_1d(ji,jk) * r1_rhoi ! Specific enthalpy of layer k [J/kg, <0] 315 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) 316 ! set up at 0 since no energy is needed to melt water...(it is already melted) 317 zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing 318 ! this should normally not happen, but sometimes, heat diffusion leads to this 319 zfmdt = - zdeltah(ji,jk) * rhoi ! Mass flux x time step > 0 320 321 dh_i_itm(ji) = dh_i_itm(ji) + zdeltah(ji,jk) ! Cumulate internal melting 322 323 zfmdt = - rhoi * zdeltah(ji,jk) ! Recompute mass flux [kg/m2, >0] 324 325 hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 326 ! ice enthalpy zEi is "sent" to the ocean 327 sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice ! Salt flux 328 ! using s_i_1d and not sz_i_1d(jk) is ok 329 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice ! Mass flux 330 262 zEi = - e_i_1d(ji,jk) * r1_rhoi ! Specific enthalpy of layer k [J/kg, <0] 263 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) 264 ! set up at 0 since no energy is needed to melt water...(it is already melted) 265 zdum = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing 266 ! this should normally not happen, but sometimes, heat diffusion leads to this 267 zfmdt = - zdum * rhoi ! Recompute mass flux [kg/m2, >0] 268 ! 269 dh_i_itm(ji) = dh_i_itm(ji) + zdum ! Cumulate internal melting 270 ! 271 hfx_res_1d(ji) = hfx_res_1d(ji) + zEi * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 272 ! ice enthalpy zEi is "sent" to the ocean 273 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux 274 sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux 275 ! using s_i_1d and not sz_i_1d(jk) is ok 331 276 ELSE !-- Surface melting 332 277 333 278 zEi = - e_i_1d(ji,jk) * r1_rhoi ! Specific enthalpy of layer k [J/kg, <0] 334 279 zEw = rcp * ztmelts ! Specific enthalpy of resulting meltwater [J/kg, <0] 335 280 zdE = zEi - zEw ! Specific enthalpy difference < 0 336 281 337 282 zfmdt = - zq_top(ji) / zdE ! Mass flux to the ocean [kg/m2, >0] 338 339 zd eltah(ji,jk)= - zfmdt * r1_rhoi ! Melt of layer jk [m, <0]340 341 zd eltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! Melt of layer jk cannot exceed the layer thickness [m, <0]342 343 zq_top(ji) = MAX( 0._wp , zq_top(ji) - zdeltah(ji,jk)* rhoi * zdE ) ! update available heat344 345 dh_i_sum(ji) = dh_i_sum(ji) + zd eltah(ji,jk)! Cumulate surface melt346 347 zfmdt = - rhoi * zd eltah(ji,jk)! Recompute mass flux [kg/m2, >0]348 283 284 zdum = - zfmdt * r1_rhoi ! Melt of layer jk [m, <0] 285 286 zdum = MIN( 0._wp , MAX( zdum , - zh_i(ji,jk) ) ) ! Melt of layer jk cannot exceed the layer thickness [m, <0] 287 288 zq_top(ji) = MAX( 0._wp , zq_top(ji) - zdum * rhoi * zdE ) ! update available heat 289 290 dh_i_sum(ji) = dh_i_sum(ji) + zdum ! Cumulate surface melt 291 292 zfmdt = - rhoi * zdum ! Recompute mass flux [kg/m2, >0] 293 349 294 zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0] 350 351 sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice ! Salt flux >0 352 ! using s_i_1d and not sz_i_1d(jk) is ok) 353 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice ! Heat flux [W.m-2], < 0 354 hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice ! Heat flux used in this process [W.m-2], > 0 355 ! 356 wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice ! Mass flux 357 295 296 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0 297 hfx_sum_1d(ji) = hfx_sum_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux used in this process [W.m-2], > 0 298 wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux 299 sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0 300 ! using s_i_1d and not sz_i_1d(jk) is ok) 358 301 END IF 359 302 ! update thickness 303 zh_i(ji,jk) = MAX( 0._wp, zh_i(ji,jk) + zdum ) 304 h_i_1d(ji) = MAX( 0._wp, h_i_1d(ji) + zdum ) 305 ! 306 ! update heat content (J.m-2) and layer thickness 307 eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdum * e_i_1d(ji,jk) 308 h_i_old (ji,jk) = h_i_old (ji,jk) + zdum 309 ! 310 ! 360 311 ! Ice sublimation 361 312 ! --------------- 362 zdum = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoi ) 363 zdeltah (ji,jk) = zdeltah (ji,jk) + zdum 364 dh_i_sub(ji) = dh_i_sub(ji) + zdum 365 366 sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * s_i_1d(ji) * r1_Dt_ice ! Salt flux >0 367 ! clem: flux is sent to the ocean for simplicity 368 ! but salt should remain in the ice except 369 ! if all ice is melted. => must be corrected 370 hfx_sub_1d(ji) = hfx_sub_1d(ji) + zdum * e_i_1d(ji,jk) * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0 371 372 wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * r1_Dt_ice ! Mass flux > 0 373 374 ! update remaining mass flux 375 zevap_rema(ji) = zevap_rema(ji) + zdum * rhoi 376 377 ! record which layers have disappeared (for bottom melting) 313 zdum = MAX( - zh_i(ji,jk) , - zevap_rema(ji) * r1_rhoi ) 314 ! 315 hfx_sub_1d(ji) = hfx_sub_1d(ji) + e_i_1d(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0 316 wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux > 0 317 sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0 318 ! clem: flux is sent to the ocean for simplicity 319 ! but salt should remain in the ice except 320 ! if all ice is melted. => must be corrected 321 ! update remaining mass flux and thickness 322 zevap_rema(ji) = zevap_rema(ji) + zdum * rhoi 323 zh_i(ji,jk) = MAX( 0._wp, zh_i(ji,jk) + zdum ) 324 h_i_1d(ji) = MAX( 0._wp, h_i_1d(ji) + zdum ) 325 dh_i_sub(ji) = dh_i_sub(ji) + zdum 326 327 ! update heat content (J.m-2) and layer thickness 328 eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdum * e_i_1d(ji,jk) 329 h_i_old (ji,jk) = h_i_old (ji,jk) + zdum 330 331 ! record which layers have disappeared (for bottom melting) 378 332 ! => icount=0 : no layer has vanished 379 333 ! => icount=5 : 5 layers have vanished 380 rswitch = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) )334 rswitch = MAX( 0._wp , SIGN( 1._wp , - zh_i(ji,jk) ) ) 381 335 icount(ji,jk) = NINT( rswitch ) 382 zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 383 384 ! update heat content (J.m-2) and layer thickness 385 eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk) 386 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 387 END DO 388 END DO 389 390 ! update ice thickness 391 DO ji = 1, npti 392 h_i_1d(ji) = MAX( 0._wp , h_i_1d(ji) + dh_i_sum(ji) + dh_i_itm(ji) + dh_i_sub(ji) ) 336 337 END DO 393 338 END DO 394 339 … … 399 344 400 345 401 ! Ice Basal growth 346 ! Ice Basal growth 402 347 !------------------ 403 348 ! Basal growth is driven by heat imbalance at the ice-ocean interface, 404 ! between the inner conductive flux (qcn_ice_bot), from the open water heat flux 405 ! (fhld) and the sensible ice-ocean flux (qsb_ice_bot). 406 ! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice 349 ! between the inner conductive flux (qcn_ice_bot), from the open water heat flux 350 ! (fhld) and the sensible ice-ocean flux (qsb_ice_bot). 351 ! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice 407 352 408 353 ! If salinity varies in time, an iterative procedure is required, because … … 414 359 num_iter_max = 1 415 360 IF( nn_icesal == 2 ) num_iter_max = 5 ! salinity varying in time 416 361 417 362 DO ji = 1, npti 418 363 IF( zf_tt(ji) < 0._wp ) THEN … … 421 366 ! New bottom ice salinity (Cox & Weeks, JGR88 ) 422 367 !--- zswi1 if dh/dt < 2.0e-8 423 !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 368 !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 424 369 !--- zswi2 if dh/dt > 3.6e-7 425 370 zgrr = MIN( 1.0e-3, MAX ( dh_i_bog(ji) * r1_Dt_ice , epsi10 ) ) … … 430 375 & + zswi2 * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) ) , 0.5 ) 431 376 432 s_i_new(ji) = zswitch_sal * zfracs * sss_1d(ji) + ( 1. - zswitch_sal ) * s_i_1d(ji) ! New ice salinity433 434 ztmelts = - rTmlt * s_i_new(ji) ! New ice melting point (C)435 436 zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)437 438 zEi = rcpi * ( zt_i_new - (ztmelts+rt0) ) & ! Specific enthalpy of forming ice (J/kg, <0)439 & - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp* ztmelts440 441 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0)442 443 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0)444 445 dh_i_bog(ji) = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) )446 377 s_i_new(ji) = zswitch_sal * zfracs * sss_1d(ji) + ( 1. - zswitch_sal ) * s_i_1d(ji) ! New ice salinity 378 379 ztmelts = - rTmlt * s_i_new(ji) ! New ice melting point (C) 380 381 zt_i_new = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 382 383 zEi = rcpi * ( zt_i_new - (ztmelts+rt0) ) & ! Specific enthalpy of forming ice (J/kg, <0) 384 & - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts 385 386 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) 387 388 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 389 390 dh_i_bog(ji) = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) ) 391 447 392 END DO 448 ! Contribution to Energy and Salt Fluxes 449 zfmdt = - rhoi * dh_i_bog(ji) ! Mass flux x time step (kg/m2, < 0) 450 451 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice ! Heat flux to the ocean [W.m-2], >0 452 hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice ! Heat flux used in this process [W.m-2], <0 453 454 sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * s_i_new(ji) * r1_Dt_ice ! Salt flux, <0 455 456 wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * r1_Dt_ice ! Mass flux, <0 393 ! Contribution to Energy and Salt Fluxes 394 zfmdt = - rhoi * dh_i_bog(ji) ! Mass flux x time step (kg/m2, < 0) 395 396 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], >0 397 hfx_bog_1d(ji) = hfx_bog_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux used in this process [W.m-2], <0 398 wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * a_i_1d(ji) * r1_Dt_ice ! Mass flux, <0 399 sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * s_i_new(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux, <0 400 401 ! update thickness 402 zh_i(ji,nlay_i+1) = zh_i(ji,nlay_i+1) + dh_i_bog(ji) 403 h_i_1d(ji) = h_i_1d(ji) + dh_i_bog(ji) 457 404 458 405 ! update heat content (J.m-2) and layer thickness … … 466 413 ! Ice Basal melt 467 414 !--------------- 468 zdeltah(1:npti,:) = 0._wp ! important469 415 DO jk = nlay_i, 1, -1 470 416 DO ji = 1, npti 471 IF( zf_tt(ji) > 0._wp .AND. jk > icount(ji,jk) ) THEN ! do not calculate where layer has already disappeared by surface melting 417 IF( zf_tt(ji) > 0._wp .AND. jk > icount(ji,jk) ) THEN ! do not calculate where layer has already disappeared by surface melting 472 418 473 419 ztmelts = - rTmlt * sz_i_1d(ji,jk) ! Melting point of layer jk (C) … … 475 421 IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN !-- Internal melting 476 422 477 zEi = - e_i_1d(ji,jk) * r1_rhoi ! Specific enthalpy of melting ice (J/kg, <0) 478 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) 479 ! set up at 0 since no energy is needed to melt water...(it is already melted) 480 zdeltah (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing 481 ! this should normally not happen, but sometimes, heat diffusion leads to this 482 483 dh_i_itm (ji) = dh_i_itm(ji) + zdeltah(ji,jk) 484 485 zfmdt = - zdeltah(ji,jk) * rhoi ! Mass flux x time step > 0 486 487 hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 488 ! ice enthalpy zEi is "sent" to the ocean 489 sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice ! Salt flux 490 ! using s_i_1d and not sz_i_1d(jk) is ok 491 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice ! Mass flux 492 493 ! update heat content (J.m-2) and layer thickness 494 eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk) 495 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 496 423 zEi = - e_i_1d(ji,jk) * r1_rhoi ! Specific enthalpy of melting ice (J/kg, <0) 424 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) 425 ! set up at 0 since no energy is needed to melt water...(it is already melted) 426 zdum = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing 427 ! this should normally not happen, but sometimes, heat diffusion leads to this 428 dh_i_itm (ji) = dh_i_itm(ji) + zdum 429 ! 430 zfmdt = - zdum * rhoi ! Mass flux x time step > 0 431 ! 432 hfx_res_1d(ji) = hfx_res_1d(ji) + zEi * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 433 ! ice enthalpy zEi is "sent" to the ocean 434 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux 435 sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux 436 ! using s_i_1d and not sz_i_1d(jk) is ok 497 437 ELSE !-- Basal melting 498 438 499 zEi = - e_i_1d(ji,jk) * r1_rhoi ! Specific enthalpy of melting ice (J/kg, <0) 500 zEw = rcp * ztmelts ! Specific enthalpy of meltwater (J/kg, <0) 501 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 502 503 zfmdt = - zq_bot(ji) / zdE ! Mass flux x time step (kg/m2, >0) 504 505 zdeltah(ji,jk) = - zfmdt * r1_rhoi ! Gross thickness change 506 507 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 508 509 zq_bot(ji) = MAX( 0._wp , zq_bot(ji) - zdeltah(ji,jk) * rhoi * zdE ) ! update available heat. MAX is necessary for roundup errors 510 511 dh_i_bom(ji) = dh_i_bom(ji) + zdeltah(ji,jk) ! Update basal melt 512 513 zfmdt = - zdeltah(ji,jk) * rhoi ! Mass flux x time step > 0 514 515 zQm = zfmdt * zEw ! Heat exchanged with ocean 516 517 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 518 hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice ! Heat used in this process [W.m-2], >0 519 520 sfx_bom_1d(ji) = sfx_bom_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice ! Salt flux 521 ! using s_i_1d and not sz_i_1d(jk) is ok 522 523 wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice ! Mass flux 524 525 ! update heat content (J.m-2) and layer thickness 526 eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk) 527 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 439 zEi = - e_i_1d(ji,jk) * r1_rhoi ! Specific enthalpy of melting ice (J/kg, <0) 440 zEw = rcp * ztmelts ! Specific enthalpy of meltwater (J/kg, <0) 441 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 442 443 zfmdt = - zq_bot(ji) / zdE ! Mass flux x time step (kg/m2, >0) 444 445 zdum = - zfmdt * r1_rhoi ! Gross thickness change 446 447 zdum = MIN( 0._wp , MAX( zdum, - zh_i(ji,jk) ) ) ! bound thickness change 448 449 zq_bot(ji) = MAX( 0._wp , zq_bot(ji) - zdum * rhoi * zdE ) ! update available heat. MAX is necessary for roundup errors 450 451 dh_i_bom(ji) = dh_i_bom(ji) + zdum ! Update basal melt 452 453 zfmdt = - zdum * rhoi ! Mass flux x time step > 0 454 455 zQm = zfmdt * zEw ! Heat exchanged with ocean 456 457 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux to the ocean [W.m-2], <0 458 hfx_bom_1d(ji) = hfx_bom_1d(ji) - zdE * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat used in this process [W.m-2], >0 459 wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoi * zdum * a_i_1d(ji) * r1_Dt_ice ! Mass flux 460 sfx_bom_1d(ji) = sfx_bom_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux 461 ! using s_i_1d and not sz_i_1d(jk) is ok 528 462 ENDIF 529 463 ! update thickness 464 zh_i(ji,jk) = MAX( 0._wp, zh_i(ji,jk) + zdum ) 465 h_i_1d(ji) = MAX( 0._wp, h_i_1d(ji) + zdum ) 466 ! 467 ! update heat content (J.m-2) and layer thickness 468 eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdum * e_i_1d(ji,jk) 469 h_i_old (ji,jk) = h_i_old (ji,jk) + zdum 530 470 ENDIF 531 471 END DO 532 472 END DO 533 473 534 ! Update temperature, energy 535 ! -------------------------- 536 DO ji = 1, npti 537 h_i_1d(ji) = MAX( 0._wp , h_i_1d(ji) + dh_i_bog(ji) + dh_i_bom(ji) ) 538 END DO 539 540 ! If heat still available then melt more snow 541 !------------------------------------------- 542 zdeltah(1:npti,:) = 0._wp ! important 543 DO ji = 1, npti 544 zq_rema (ji) = zq_top(ji) + zq_bot(ji) 545 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - h_s_1d(ji) ) ) ! =1 if snow 546 rswitch = rswitch * MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,1) - epsi20 ) ) 547 zdeltah (ji,1) = - rswitch * zq_rema(ji) / MAX( e_s_1d(ji,1), epsi20 ) 548 zdeltah (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - h_s_1d(ji) ) ) ! bound melting 549 dh_s_tot(ji) = dh_s_tot(ji) + zdeltah(ji,1) 550 h_s_1d (ji) = h_s_1d (ji) + zdeltah(ji,1) 551 552 zq_rema(ji) = zq_rema(ji) + zdeltah(ji,1) * e_s_1d(ji,1) ! update available heat (J.m-2) 553 hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * e_s_1d(ji,1) * r1_Dt_ice ! Heat used to melt snow, W.m-2 (>0) 554 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos * a_i_1d(ji) * zdeltah(ji,1) * r1_Dt_ice ! Mass flux 555 dh_s_mlt(ji) = dh_s_mlt(ji) + zdeltah(ji,1) 556 ! 557 ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 558 !!hfx_res_1d(ji) = hfx_res_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_Dt_ice 559 560 IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 561 END DO 562 563 ! 474 ! Remove snow if ice has melted entirely 475 ! -------------------------------------- 476 DO jk = 0, nlay_s 477 DO ji = 1,npti 478 IF( h_i_1d(ji) == 0._wp ) THEN 479 ! mass & energy loss to the ocean 480 hfx_res_1d(ji) = hfx_res_1d(ji) - ze_s(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice ! heat flux to the ocean [W.m-2], < 0 481 wfx_res_1d(ji) = wfx_res_1d(ji) + rhos * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice ! mass flux 482 483 ! update thickness and energy 484 h_s_1d(ji) = 0._wp 485 ze_s (ji,jk) = 0._wp 486 zh_s (ji,jk) = 0._wp 487 ENDIF 488 END DO 489 END DO 490 491 ! Snow load on ice 492 ! ----------------- 493 ! When snow load exceeds Archimede's limit and sst is positive, 494 ! snow-ice formation (next bloc) can lead to negative ice enthalpy. 495 ! Therefore we consider here that this excess of snow falls into the ocean 496 zdeltah(1:npti) = h_s_1d(1:npti) + h_i_1d(1:npti) * (rhoi-rho0) * r1_rhos 497 DO jk = 0, nlay_s 498 DO ji = 1, npti 499 IF( zdeltah(ji) > 0._wp .AND. sst_1d(ji) > 0._wp ) THEN 500 ! snow layer thickness that falls into the ocean 501 zdum = MIN( zdeltah(ji) , zh_s(ji,jk) ) 502 ! mass & energy loss to the ocean 503 hfx_res_1d(ji) = hfx_res_1d(ji) - ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice ! heat flux to the ocean [W.m-2], < 0 504 wfx_res_1d(ji) = wfx_res_1d(ji) + rhos * zdum * a_i_1d(ji) * r1_Dt_ice ! mass flux 505 ! update thickness and energy 506 h_s_1d(ji) = MAX( 0._wp, h_s_1d(ji) - zdum ) 507 zh_s (ji,jk) = MAX( 0._wp, zh_s(ji,jk) - zdum ) 508 ! update snow thickness that still has to fall 509 zdeltah(ji) = MAX( 0._wp, zdeltah(ji) - zdum ) 510 ENDIF 511 END DO 512 END DO 513 564 514 ! Snow-Ice formation 565 515 ! ------------------ 566 ! When snow load exce sses Archimede's limit, snow-ice interface goes down under sea-level,567 ! flooding of seawater transforms snow into ice dh_snowice is positive for the ice516 ! When snow load exceeds Archimede's limit, snow-ice interface goes down under sea-level, 517 ! flooding of seawater transforms snow into ice. Thickness that is transformed is dh_snowice (positive for the ice) 568 518 z1_rho = 1._wp / ( rhos+rho0-rhoi ) 519 zdeltah(1:npti) = 0._wp 569 520 DO ji = 1, npti 570 521 ! 571 dh_snowice(ji) = MAX( 522 dh_snowice(ji) = MAX( 0._wp , ( rhos * h_s_1d(ji) + (rhoi-rho0) * h_i_1d(ji) ) * z1_rho ) 572 523 573 524 h_i_1d(ji) = h_i_1d(ji) + dh_snowice(ji) … … 577 528 zfmdt = ( rhos - rhoi ) * dh_snowice(ji) ! <0 578 529 zEw = rcp * sst_1d(ji) 579 zQm = zfmdt * zEw 580 581 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice ! Heat flux 582 583 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * a_i_1d(ji) * zfmdt * r1_Dt_ice ! Salt flux 530 zQm = zfmdt * zEw 531 532 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux 533 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Salt flux 584 534 585 535 ! Case constant salinity in time: virtual salt flux to keep salinity constant 586 536 IF( nn_icesal /= 2 ) THEN 587 sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d (ji) * a_i_1d(ji) * zfmdt * r1_Dt_ice &! put back sss_m into the ocean588 & - s_i_1d(ji) * a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_Dt_ice ! and get rn_icesal from the ocean537 sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d(ji) * zfmdt * a_i_1d(ji) * r1_Dt_ice & ! put back sss_m into the ocean 538 & - s_i_1d(ji) * dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice ! and get rn_icesal from the ocean 589 539 ENDIF 590 540 591 541 ! Mass flux: All snow is thrown in the ocean, and seawater is taken to replace the volume 592 wfx_sni_1d(ji) = wfx_sni_1d(ji) - a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_Dt_ice 593 wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhos * r1_Dt_ice 542 wfx_sni_1d (ji) = wfx_sni_1d (ji) - dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice 543 wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + dh_snowice(ji) * rhos * a_i_1d(ji) * r1_Dt_ice 544 545 ! update thickness 546 zh_i(ji,0) = zh_i(ji,0) + dh_snowice(ji) 547 zdeltah(ji) = dh_snowice(ji) 594 548 595 549 ! update heat content (J.m-2) and layer thickness 596 eh_i_old(ji,0) = eh_i_old(ji,0) + dh_snowice(ji) * e_s_1d(ji,1) + zfmdt * zEw597 550 h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji) 598 599 END DO 600 601 ! 602 ! Update temperature, energy 603 ! -------------------------- 604 DO ji = 1, npti 605 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) ) 606 t_su_1d(ji) = rswitch * t_su_1d(ji) + ( 1._wp - rswitch ) * rt0 607 END DO 608 551 eh_i_old(ji,0) = eh_i_old(ji,0) + zfmdt * zEw ! 1st part (sea water enthalpy) 552 553 END DO 554 ! 555 DO jk = nlay_s, 0, -1 ! flooding of snow starts from the base 556 DO ji = 1, npti 557 zdum = MIN( zdeltah(ji), zh_s(ji,jk) ) ! amount of snw that floods, > 0 558 zh_s(ji,jk) = MAX( 0._wp, zh_s(ji,jk) - zdum ) ! remove some snow thickness 559 eh_i_old(ji,0) = eh_i_old(ji,0) + zdum * ze_s(ji,jk) ! 2nd part (snow enthalpy) 560 ! update dh_snowice 561 zdeltah(ji) = MAX( 0._wp, zdeltah(ji) - zdum ) 562 END DO 563 END DO 564 ! 565 ! 566 !!$ ! --- Update snow diags --- ! 567 !!$ !!clem: this is wrong. dh_s_tot is not used anyway 568 !!$ DO ji = 1, npti 569 !!$ dh_s_tot(ji) = dh_s_tot(ji) + dh_s_mlt(ji) + zdeltah(ji) + zdh_s_sub(ji) - dh_snowice(ji) 570 !!$ END DO 571 ! 572 ! 573 ! Remapping of snw enthalpy on a regular grid 574 !-------------------------------------------- 575 CALL snw_ent( zh_s, ze_s, e_s_1d ) 576 577 ! recalculate t_s_1d from e_s_1d 609 578 DO jk = 1, nlay_s 610 579 DO ji = 1,npti 611 ! where there is no ice or no snow 612 rswitch = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - h_s_1d(ji) ) ) ) * ( 1._wp - MAX( 0._wp, SIGN(1._wp, - h_i_1d(ji) ) ) ) 613 ! mass & energy loss to the ocean 614 hfx_res_1d(ji) = hfx_res_1d(ji) + ( 1._wp - rswitch ) * & 615 & ( e_s_1d(ji,jk) * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_Dt_ice ) ! heat flux to the ocean [W.m-2], < 0 616 wfx_res_1d(ji) = wfx_res_1d(ji) + ( 1._wp - rswitch ) * & 617 & ( rhos * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_Dt_ice ) ! mass flux 618 ! update energy (mass is updated in the next loop) 619 e_s_1d(ji,jk) = rswitch * e_s_1d(ji,jk) 620 ! recalculate t_s_1d from e_s_1d 621 t_s_1d(ji,jk) = rt0 + rswitch * ( - e_s_1d(ji,jk) * r1_rhos * r1_rcpi + rLfus * r1_rcpi ) 622 END DO 623 END DO 580 IF( h_s_1d(ji) > 0._wp ) THEN 581 t_s_1d(ji,jk) = rt0 + ( - e_s_1d(ji,jk) * r1_rhos * r1_rcpi + rLfus * r1_rcpi ) 582 ELSE 583 t_s_1d(ji,jk) = rt0 584 ENDIF 585 END DO 586 END DO 587 588 ! Note: remapping of ice enthalpy is done in icethd.F90 624 589 625 590 ! --- ensure that a_i = 0 & h_s = 0 where h_i = 0 --- 626 WHERE( h_i_1d(1:npti) == 0._wp ) 627 a_i_1d(1:npti) = 0._wp 628 h_s_1d(1:npti) = 0._wp 591 WHERE( h_i_1d(1:npti) == 0._wp ) 592 a_i_1d (1:npti) = 0._wp 593 h_s_1d (1:npti) = 0._wp 594 t_su_1d(1:npti) = rt0 629 595 END WHERE 630 ! 596 631 597 END SUBROUTINE ice_thd_dh 598 599 SUBROUTINE snw_ent( ph_old, pe_old, pe_new ) 600 !!------------------------------------------------------------------- 601 !! *** ROUTINE snw_ent *** 602 !! 603 !! ** Purpose : 604 !! This routine computes new vertical grids in the snow, 605 !! and consistently redistributes temperatures. 606 !! Redistribution is made so as to ensure to energy conservation 607 !! 608 !! 609 !! ** Method : linear conservative remapping 610 !! 611 !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses 612 !! 2) linear remapping on the new layers 613 !! 614 !! ------------ cum0(0) ------------- cum1(0) 615 !! NEW ------------- 616 !! ------------ cum0(1) ==> ------------- 617 !! ... ------------- 618 !! ------------ ------------- 619 !! ------------ cum0(nlay_s+1) ------------- cum1(nlay_s) 620 !! 621 !! 622 !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 623 !!------------------------------------------------------------------- 624 REAL(wp), DIMENSION(jpij,0:nlay_s), INTENT(in ) :: ph_old ! old thicknesses (m) 625 REAL(wp), DIMENSION(jpij,0:nlay_s), INTENT(in ) :: pe_old ! old enthlapies (J.m-3) 626 REAL(wp), DIMENSION(jpij,1:nlay_s), INTENT(inout) :: pe_new ! new enthlapies (J.m-3, remapped) 627 ! 628 INTEGER :: ji ! dummy loop indices 629 INTEGER :: jk0, jk1 ! old/new layer indices 630 ! 631 REAL(wp), DIMENSION(jpij,0:nlay_s+1) :: zeh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces 632 REAL(wp), DIMENSION(jpij,0:nlay_s) :: zeh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces 633 REAL(wp), DIMENSION(jpij) :: zhnew ! new layers thicknesses 634 !!------------------------------------------------------------------- 635 636 !-------------------------------------------------------------------------- 637 ! 1) Cumulative integral of old enthalpy * thickness and layers interfaces 638 !-------------------------------------------------------------------------- 639 zeh_cum0(1:npti,0) = 0._wp 640 zh_cum0 (1:npti,0) = 0._wp 641 DO jk0 = 1, nlay_s+1 642 DO ji = 1, npti 643 zeh_cum0(ji,jk0) = zeh_cum0(ji,jk0-1) + pe_old(ji,jk0-1) * ph_old(ji,jk0-1) 644 zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + ph_old(ji,jk0-1) 645 END DO 646 END DO 647 648 !------------------------------------ 649 ! 2) Interpolation on the new layers 650 !------------------------------------ 651 ! new layer thickesses 652 DO ji = 1, npti 653 zhnew(ji) = SUM( ph_old(ji,0:nlay_s) ) * r1_nlay_s 654 END DO 655 656 ! new layers interfaces 657 zh_cum1(1:npti,0) = 0._wp 658 DO jk1 = 1, nlay_s 659 DO ji = 1, npti 660 zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji) 661 END DO 662 END DO 663 664 zeh_cum1(1:npti,0:nlay_s) = 0._wp 665 ! new cumulative q*h => linear interpolation 666 DO jk0 = 1, nlay_s+1 667 DO jk1 = 1, nlay_s-1 668 DO ji = 1, npti 669 IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN 670 zeh_cum1(ji,jk1) = ( zeh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1 ) ) + & 671 & zeh_cum0(ji,jk0 ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) ) & 672 & / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) ) 673 ENDIF 674 END DO 675 END DO 676 END DO 677 ! to ensure that total heat content is strictly conserved, set: 678 zeh_cum1(1:npti,nlay_s) = zeh_cum0(1:npti,nlay_s+1) 679 680 ! new enthalpies 681 DO jk1 = 1, nlay_s 682 DO ji = 1, npti 683 rswitch = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) ) 684 pe_new(ji,jk1) = rswitch * ( zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 ) 685 END DO 686 END DO 687 688 END SUBROUTINE snw_ent 689 632 690 633 691 #else -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icethd_pnd.F90
r13472 r14021 1 MODULE icethd_pnd 1 MODULE icethd_pnd 2 2 !!====================================================================== 3 3 !! *** MODULE icethd_pnd *** … … 20 20 USE ice1D ! sea-ice: thermodynamics variables 21 21 USE icetab ! sea-ice: 1D <==> 2D transformation 22 USE sbc_ice ! surface energy budget 22 23 ! 23 24 USE in_out_manager ! I/O manager 25 USE iom ! I/O manager library 24 26 USE lib_mpp ! MPP library 25 27 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) … … 34 36 INTEGER :: nice_pnd ! choice of the type of pond scheme 35 37 ! ! associated indices: 36 INTEGER, PARAMETER :: np_pndNO = 0 ! No pond scheme 37 INTEGER, PARAMETER :: np_pndCST = 1 ! Constant ice pond scheme 38 INTEGER, PARAMETER :: np_pndLEV = 2 ! Level ice pond scheme 39 38 INTEGER, PARAMETER :: np_pndNO = 0 ! No pond scheme 39 INTEGER, PARAMETER :: np_pndCST = 1 ! Constant ice pond scheme 40 INTEGER, PARAMETER :: np_pndLEV = 2 ! Level ice pond scheme 41 INTEGER, PARAMETER :: np_pndTOPO = 3 ! Level ice pond scheme 42 43 !-------------------------------------------------------------------------- 44 ! Diagnostics for pond volume per area 45 ! 46 ! dV/dt = mlt + drn + lid + rnf 47 ! mlt = input from surface melting 48 ! drn = drainage through brine network 49 ! lid = lid growth & melt 50 ! rnf = runoff (water directly removed out of surface melting + overflow) 51 ! 52 ! In topo mode, the pond water lost because it is in the snow is not included in the budget 53 ! In level mode, all terms are incorporated 54 ! 55 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: diag_dvpn_mlt ! meltwater pond volume input [kg/m2/s] 56 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: diag_dvpn_drn ! pond volume lost by drainage [-] 57 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: diag_dvpn_lid ! exchange with lid / refreezing [-] 58 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: diag_dvpn_rnf ! meltwater pond lost to runoff [-] 59 REAL(wp), ALLOCATABLE, DIMENSION(:) :: diag_dvpn_mlt_1d ! meltwater pond volume input [-] 60 REAL(wp), ALLOCATABLE, DIMENSION(:) :: diag_dvpn_drn_1d ! pond volume lost by drainage [-] 61 REAL(wp), ALLOCATABLE, DIMENSION(:) :: diag_dvpn_lid_1d ! exchange with lid / refreezing [-] 62 REAL(wp), ALLOCATABLE, DIMENSION(:) :: diag_dvpn_rnf_1d ! meltwater pond lost to runoff [-] 63 64 !! * Substitutions 65 # include "do_loop_substitute.h90" 40 66 !!---------------------------------------------------------------------- 41 67 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 46 72 47 73 SUBROUTINE ice_thd_pnd 74 48 75 !!------------------------------------------------------------------- 49 76 !! *** ROUTINE ice_thd_pnd *** 50 !! 77 !! 51 78 !! ** Purpose : change melt pond fraction and thickness 52 !! 79 !! 80 !! ** Note : Melt ponds affect only radiative transfer for now 81 !! No heat, no salt. 82 !! The current diagnostics lacks a contribution from drainage 53 83 !!------------------------------------------------------------------- 84 INTEGER :: ji, jj, jl ! loop indices 85 !!------------------------------------------------------------------- 86 87 ALLOCATE( diag_dvpn_mlt(jpi,jpj), diag_dvpn_lid(jpi,jpj), diag_dvpn_drn(jpi,jpj), diag_dvpn_rnf(jpi,jpj) ) 88 ALLOCATE( diag_dvpn_mlt_1d(jpij), diag_dvpn_lid_1d(jpij), diag_dvpn_drn_1d(jpij), diag_dvpn_rnf_1d(jpij) ) 54 89 ! 55 SELECT CASE ( nice_pnd ) 90 diag_dvpn_mlt (:,:) = 0._wp ; diag_dvpn_drn (:,:) = 0._wp 91 diag_dvpn_lid (:,:) = 0._wp ; diag_dvpn_rnf (:,:) = 0._wp 92 diag_dvpn_mlt_1d(:) = 0._wp ; diag_dvpn_drn_1d(:) = 0._wp 93 diag_dvpn_lid_1d(:) = 0._wp ; diag_dvpn_rnf_1d(:) = 0._wp 94 95 !------------------------------------- 96 ! Remove ponds where ice has vanished 97 !------------------------------------- 98 at_i(:,:) = SUM( a_i, dim=3 ) 56 99 ! 57 CASE (np_pndCST) ; CALL pnd_CST !== Constant melt ponds ==! 58 ! 59 CASE (np_pndLEV) ; CALL pnd_LEV !== Level ice melt ponds ==! 60 ! 61 END SELECT 100 DO jl = 1, jpl 101 DO_2D( 1, 1, 1, 1 ) 102 IF( v_i(ji,jj,jl) < epsi10 .OR. at_i(ji,jj) < epsi10 ) THEN 103 wfx_pnd (ji,jj) = wfx_pnd(ji,jj) + ( v_ip(ji,jj,jl) + v_il(ji,jj,jl) ) * rhow * r1_Dt_ice 104 a_ip (ji,jj,jl) = 0._wp 105 v_ip (ji,jj,jl) = 0._wp 106 v_il (ji,jj,jl) = 0._wp 107 h_ip (ji,jj,jl) = 0._wp 108 h_il (ji,jj,jl) = 0._wp 109 a_ip_frac(ji,jj,jl) = 0._wp 110 ENDIF 111 END_2D 112 END DO 113 114 !------------------------------ 115 ! Identify grid cells with ice 116 !------------------------------ 117 npti = 0 ; nptidx(:) = 0 118 DO_2D( 1, 1, 1, 1 ) 119 IF( at_i(ji,jj) >= epsi10 ) THEN 120 npti = npti + 1 121 nptidx( npti ) = (jj - 1) * jpi + ji 122 ENDIF 123 END_2D 124 125 !------------------------------------ 126 ! Select melt pond scheme to be used 127 !------------------------------------ 128 IF( npti > 0 ) THEN 129 SELECT CASE ( nice_pnd ) 130 ! 131 CASE (np_pndCST) ; CALL pnd_CST !== Constant melt ponds ==! 132 ! 133 CASE (np_pndLEV) ; CALL pnd_LEV !== Level ice melt ponds ==! 134 ! 135 CASE (np_pndTOPO) ; CALL pnd_TOPO !== Topographic melt ponds ==! 136 ! 137 END SELECT 138 ENDIF 139 140 !------------------------------------ 141 ! Diagnostics 142 !------------------------------------ 143 CALL iom_put( 'dvpn_mlt', diag_dvpn_mlt ) ! input from melting 144 CALL iom_put( 'dvpn_lid', diag_dvpn_lid ) ! exchanges with lid 145 CALL iom_put( 'dvpn_drn', diag_dvpn_drn ) ! vertical drainage 146 CALL iom_put( 'dvpn_rnf', diag_dvpn_rnf ) ! runoff + overflow 62 147 ! 63 END SUBROUTINE ice_thd_pnd 64 65 66 SUBROUTINE pnd_CST 148 DEALLOCATE( diag_dvpn_mlt , diag_dvpn_lid , diag_dvpn_drn , diag_dvpn_rnf ) 149 DEALLOCATE( diag_dvpn_mlt_1d, diag_dvpn_lid_1d, diag_dvpn_drn_1d, diag_dvpn_rnf_1d ) 150 151 END SUBROUTINE ice_thd_pnd 152 153 154 SUBROUTINE pnd_CST 67 155 !!------------------------------------------------------------------- 68 156 !! *** ROUTINE pnd_CST *** … … 70 158 !! ** Purpose : Compute melt pond evolution 71 159 !! 72 !! ** Method : Melt pond fraction and thickness are prescribed 160 !! ** Method : Melt pond fraction and thickness are prescribed 73 161 !! to non-zero values when t_su = 0C 74 162 !! 75 163 !! ** Tunable parameters : pond fraction (rn_apnd), pond depth (rn_hpnd) 76 !! 164 !! 77 165 !! ** Note : Coupling with such melt ponds is only radiative 78 166 !! Advection, ridging, rafting... are bypassed … … 80 168 !! ** References : Bush, G.W., and Trump, D.J. (2017) 81 169 !!------------------------------------------------------------------- 82 INTEGER :: ji ! loop indices 170 INTEGER :: ji, jl ! loop indices 171 REAL(wp) :: zdv_pnd ! Amount of water going into the ponds & lids 83 172 !!------------------------------------------------------------------- 84 DO ji = 1, npti 85 ! 86 IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN 87 h_ip_1d(ji) = rn_hpnd 88 a_ip_1d(ji) = rn_apnd * a_i_1d(ji) 89 h_il_1d(ji) = 0._wp ! no pond lids whatsoever 90 ELSE 91 h_ip_1d(ji) = 0._wp 92 a_ip_1d(ji) = 0._wp 93 h_il_1d(ji) = 0._wp 94 ENDIF 95 ! 173 DO jl = 1, jpl 174 175 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i (:,:,jl) ) 176 CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d (1:npti), t_su (:,:,jl) ) 177 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip (:,:,jl) ) 178 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip (:,:,jl) ) 179 CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il (:,:,jl) ) 180 CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd(:,:) ) 181 182 DO ji = 1, npti 183 ! 184 zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) 185 ! 186 IF( a_i_1d(ji) >= 0.01_wp .AND. t_su_1d(ji) >= rt0 ) THEN 187 h_ip_1d(ji) = rn_hpnd 188 a_ip_1d(ji) = rn_apnd * a_i_1d(ji) 189 h_il_1d(ji) = 0._wp ! no pond lids whatsoever 190 ELSE 191 h_ip_1d(ji) = 0._wp 192 a_ip_1d(ji) = 0._wp 193 h_il_1d(ji) = 0._wp 194 ENDIF 195 ! 196 v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji) 197 v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 198 ! 199 zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) - zdv_pnd 200 wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zdv_pnd * rhow * r1_Dt_ice 201 ! 202 END DO 203 204 CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip (:,:,jl) ) 205 CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip (:,:,jl) ) 206 CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il (:,:,jl) ) 207 CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d (1:npti), v_ip (:,:,jl) ) 208 CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d (1:npti), v_il (:,:,jl) ) 209 CALL tab_1d_2d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd(:,:) ) 210 96 211 END DO 97 212 ! … … 107 222 !! ** Method : A fraction of meltwater is accumulated in ponds and sent to ocean when surface is freezing 108 223 !! We work with volumes and then redistribute changes into thickness and concentration 109 !! assuming linear relationship between the two. 224 !! assuming linear relationship between the two. 110 225 !! 111 226 !! ** Action : - pond growth: Vp = Vp + dVmelt --- from Holland et al 2012 --- … … 122 237 !! dH = lid thickness change. Retrieved from this eq.: --- from Flocco et al 2010 --- 123 238 !! 124 !! rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H 239 !! rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H 125 240 !! H = lid thickness 126 241 !! Lf = latent heat of fusion … … 132 247 !! if no lids: Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp) --- from Holland et al 2012 --- 133 248 !! 134 !! - Flushing: w = -perm/visc * rho_oce * grav * Hp / Hi 135 !! perm = permability of sea-ice 249 !! - Flushing: w = -perm/visc * rho_oce * grav * Hp / Hi * flush --- from Flocco et al 2007 --- 250 !! perm = permability of sea-ice + correction from Hunke et al 2012 (flush) 136 251 !! visc = water viscosity 137 252 !! Hp = height of top of the pond above sea-level 138 253 !! Hi = ice thickness thru which there is flushing 254 !! flush= correction otherwise flushing is excessive 139 255 !! 140 256 !! - Corrections: remove melt ponds when lid thickness is 10 times the pond thickness … … 143 259 !! a_ip/a_i = a_ip_frac = h_ip / zaspect 144 260 !! 145 !! ** Tunable parameters : ln_pnd_lids, rn_apnd_max, rn_apnd_min146 !! 147 !! ** Note : mostly stolen from CICE261 !! ** Tunable parameters : rn_apnd_max, rn_apnd_min, rn_pnd_flush 262 !! 263 !! ** Note : Mostly stolen from CICE but not only. These are between level-ice ponds and CESM ponds. 148 264 !! 149 265 !! ** References : Flocco and Feltham (JGR, 2007) 150 266 !! Flocco et al (JGR, 2010) 151 267 !! Holland et al (J. Clim, 2012) 268 !! Hunke et al (OM 2012) 152 269 !!------------------------------------------------------------------- 153 270 REAL(wp), DIMENSION(nlay_i) :: ztmp ! temporary array … … 157 274 REAL(wp), PARAMETER :: zvisc = 1.79e-3_wp ! water viscosity 158 275 !! 159 REAL(wp) :: zfr_mlt, zdv_mlt 276 REAL(wp) :: zfr_mlt, zdv_mlt, zdv_avail ! fraction and volume of available meltwater retained for melt ponding 160 277 REAL(wp) :: zdv_frz, zdv_flush ! Amount of melt pond that freezes, flushes 278 REAL(wp) :: zdv_pnd ! Amount of water going into the ponds & lids 161 279 REAL(wp) :: zhp ! heigh of top of pond lid wrt ssh 162 280 REAL(wp) :: zv_ip_max ! max pond volume allowed 163 281 REAL(wp) :: zdT ! zTp-t_su 164 REAL(wp) :: zsbr 282 REAL(wp) :: zsbr, ztmelts ! Brine salinity 165 283 REAL(wp) :: zperm ! permeability of sea ice 166 284 REAL(wp) :: zfac, zdum ! temporary arrays 167 285 REAL(wp) :: z1_rhow, z1_aspect, z1_Tp ! inverse 168 286 !! 169 INTEGER :: ji, jk 287 INTEGER :: ji, jk, jl ! loop indices 170 288 !!------------------------------------------------------------------- 171 z1_rhow = 1._wp / rhow 289 z1_rhow = 1._wp / rhow 172 290 z1_aspect = 1._wp / zaspect 173 z1_Tp = 1._wp / zTp 174 175 DO ji = 1, npti 176 ! !----------------------------------------------------! 177 IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < epsi10 ) THEN ! Case ice thickness < rn_himin or tiny ice fraction ! 178 ! !----------------------------------------------------! 179 !--- Remove ponds on thin ice or tiny ice fractions 180 a_ip_1d(ji) = 0._wp 181 h_ip_1d(ji) = 0._wp 182 h_il_1d(ji) = 0._wp 183 ! !--------------------------------! 184 ELSE ! Case ice thickness >= rn_himin ! 185 ! !--------------------------------! 186 v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji) ! retrieve volume from thickness 291 z1_Tp = 1._wp / zTp 292 293 CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d (1:npti), at_i ) 294 CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d (1:npti), wfx_pnd ) 295 296 CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_mlt_1d (1:npti), diag_dvpn_mlt ) 297 CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_drn_1d (1:npti), diag_dvpn_drn ) 298 CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_lid_1d (1:npti), diag_dvpn_lid ) 299 CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_rnf_1d (1:npti), diag_dvpn_rnf ) 300 301 DO jl = 1, jpl 302 303 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i (:,:,jl) ) 304 CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti), h_i (:,:,jl) ) 305 CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d (1:npti), t_su(:,:,jl) ) 306 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip(:,:,jl) ) 307 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip(:,:,jl) ) 308 CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il(:,:,jl) ) 309 310 CALL tab_2d_1d( npti, nptidx(1:npti), dh_i_sum(1:npti), dh_i_sum_2d(:,:,jl) ) 311 CALL tab_2d_1d( npti, nptidx(1:npti), dh_s_mlt(1:npti), dh_s_mlt_2d(:,:,jl) ) 312 313 DO jk = 1, nlay_i 314 CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,jl) ) 315 CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,jl) ) 316 END DO 317 318 !----------------------- 319 ! Melt pond calculations 320 !----------------------- 321 DO ji = 1, npti 322 ! 323 zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) 324 ! !----------------------------------------------------! 325 IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < 0.01_wp ) THEN ! Case ice thickness < rn_himin or tiny ice fraction ! 326 ! !----------------------------------------------------! 327 !--- Remove ponds on thin ice or tiny ice fractions 328 a_ip_1d(ji) = 0._wp 329 h_ip_1d(ji) = 0._wp 330 h_il_1d(ji) = 0._wp 331 ! !--------------------------------! 332 ELSE ! Case ice thickness >= rn_himin ! 333 ! !--------------------------------! 334 v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji) ! retrieve volume from thickness 335 v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 336 ! 337 !------------------! 338 ! case ice melting ! 339 !------------------! 340 ! 341 !--- available meltwater for melt ponding (zdv_avail) ---! 342 zdv_avail = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) ! > 0 343 zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) ! = ( 1 - r ) = fraction of melt water that is not flushed 344 zdv_mlt = MAX( 0._wp, zfr_mlt * zdv_avail ) ! max for roundoff errors? 345 ! 346 !--- overflow ---! 347 ! 348 ! area driven overflow 349 ! If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume 350 ! a_ip_max = zfr_mlt * a_i 351 ! => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as: 352 zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect 353 zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 354 355 ! depth driven overflow 356 ! If pond depth exceeds half the ice thickness then reduce the pond volume 357 ! h_ip_max = 0.5 * h_i 358 ! => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as: 359 zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) 360 zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 361 362 !--- Pond growing ---! 363 v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt 364 ! 365 !--- Lid melting ---! 366 IF( ln_pnd_lids ) v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0 367 ! 368 !-------------------! 369 ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0) 370 !-------------------! 371 ! 372 zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) 373 ! 374 !--- Pond contraction (due to refreezing) ---! 375 IF( ln_pnd_lids ) THEN 376 ! 377 !--- Lid growing and subsequent pond shrinking ---! 378 zdv_frz = - 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0 379 & SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rDt_ice / (rLfus * rhow) ) ) ! max for roundoff errors 380 381 ! Lid growing 382 v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_frz ) 383 384 ! Pond shrinking 385 v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zdv_frz ) 386 387 ELSE 388 zdv_frz = v_ip_1d(ji) * ( EXP( 0.01_wp * zdT * z1_Tp ) - 1._wp ) ! Holland 2012 (eq. 6) 389 ! Pond shrinking 390 v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zdv_frz ) 391 ENDIF 392 ! 393 !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 394 ! v_ip = h_ip * a_ip 395 ! a_ip/a_i = a_ip_frac = h_ip / zaspect (cf Holland 2012, fitting SHEBA so that knowing v_ip we can distribute it to a_ip and h_ip) 396 a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 397 h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 398 ! 399 400 !------------------------------------------------! 401 ! Pond drainage through brine network (flushing) ! 402 !------------------------------------------------! 403 ! height of top of the pond above sea-level 404 zhp = ( h_i_1d(ji) * ( rho0 - rhoi ) + h_ip_1d(ji) * ( rho0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rho0 405 406 ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010) 407 DO jk = 1, nlay_i 408 ! MV Assur is inconsistent with SI3 409 !!zsbr = - 1.2_wp & 410 !! & - 21.8_wp * ( t_i_1d(ji,jk) - rt0 ) & 411 !! & - 0.919_wp * ( t_i_1d(ji,jk) - rt0 )**2 & 412 !! & - 0.0178_wp * ( t_i_1d(ji,jk) - rt0 )**3 413 !!ztmp(jk) = sz_i_1d(ji,jk) / zsbr 414 ! MV linear expression more consistent & simpler: zsbr = - ( t_i_1d(ji,jk) - rt0 ) / rTmlt 415 ztmelts = -rTmlt * sz_i_1d(ji,jk) 416 ztmp(jk) = ztmelts / MIN( ztmelts, t_i_1d(ji,jk) - rt0 ) 417 END DO 418 zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 419 420 ! Do the drainage using Darcy's law 421 zdv_flush = -zperm * rho0 * grav * zhp * rDt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) * rn_pnd_flush ! zflush comes from Hunke et al. (2012) 422 zdv_flush = MAX( zdv_flush, -v_ip_1d(ji) ) ! < 0 423 v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 424 425 !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 426 a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 427 h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 428 429 !--- Corrections and lid thickness ---! 430 IF( ln_pnd_lids ) THEN 431 !--- retrieve lid thickness from volume ---! 432 IF( a_ip_1d(ji) > 0.01_wp ) THEN ; h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji) 433 ELSE ; h_il_1d(ji) = 0._wp 434 ENDIF 435 !--- remove ponds if lids are much larger than ponds ---! 436 IF ( h_il_1d(ji) > h_ip_1d(ji) * 10._wp ) THEN 437 a_ip_1d(ji) = 0._wp 438 h_ip_1d(ji) = 0._wp 439 h_il_1d(ji) = 0._wp 440 ENDIF 441 ENDIF 442 443 ! diagnostics: dvpnd = mlt+rnf+lid+drn 444 diag_dvpn_mlt_1d(ji) = diag_dvpn_mlt_1d(ji) + rhow * zdv_avail * r1_Dt_ice ! > 0, surface melt input 445 diag_dvpn_rnf_1d(ji) = diag_dvpn_rnf_1d(ji) + rhow * ( zdv_mlt - zdv_avail ) * r1_Dt_ice ! < 0, runoff 446 diag_dvpn_lid_1d(ji) = diag_dvpn_lid_1d(ji) + rhow * zdv_frz * r1_Dt_ice ! < 0, shrinking 447 diag_dvpn_drn_1d(ji) = diag_dvpn_drn_1d(ji) + rhow * zdv_flush * r1_Dt_ice ! < 0, drainage 448 ! 449 ENDIF 450 ! 451 v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji) 187 452 v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 188 453 ! 189 !------------------! 190 ! case ice melting ! 191 !------------------! 454 zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) - zdv_pnd 455 wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zdv_pnd * rhow * r1_Dt_ice 192 456 ! 193 !--- available meltwater for melt ponding ---! 194 zdum = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 195 zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) ! = ( 1 - r ) = fraction of melt water that is not flushed 196 zdv_mlt = MAX( 0._wp, zfr_mlt * zdum ) ! max for roundoff errors? 197 ! 198 !--- overflow ---! 199 ! If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume 200 ! a_ip_max = zfr_mlt * a_i 201 ! => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as: 202 zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect 203 zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 204 205 ! If pond depth exceeds half the ice thickness then reduce the pond volume 206 ! h_ip_max = 0.5 * h_i 207 ! => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as: 208 zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) 209 zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 210 211 !--- Pond growing ---! 212 v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt 213 ! 214 !--- Lid melting ---! 215 IF( ln_pnd_lids ) v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0 216 ! 217 !--- mass flux ---! 218 IF( zdv_mlt > 0._wp ) THEN 219 zfac = zdv_mlt * rhow * r1_Dt_ice ! melt pond mass flux < 0 [kg.m-2.s-1] 220 wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 221 ! 222 zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) ) ! adjust ice/snow melting flux > 0 to balance melt pond flux 223 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) * (1._wp + zdum) 224 wfx_sum_1d(ji) = wfx_sum_1d(ji) * (1._wp + zdum) 225 ENDIF 226 227 !-------------------! 228 ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0) 229 !-------------------! 230 ! 231 zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) 232 ! 233 !--- Pond contraction (due to refreezing) ---! 234 IF( ln_pnd_lids ) THEN 235 ! 236 !--- Lid growing and subsequent pond shrinking ---! 237 zdv_frz = 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0 238 & SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rdt_ice / (rLfus * rhow) ) ) ! max for roundoff errors 239 240 ! Lid growing 241 v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) + zdv_frz ) 242 243 ! Pond shrinking 244 v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) - zdv_frz ) 245 246 ELSE 247 ! Pond shrinking 248 v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * zdT * z1_Tp ) ! Holland 2012 (eq. 6) 249 ENDIF 250 ! 251 !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 252 ! v_ip = h_ip * a_ip 253 ! a_ip/a_i = a_ip_frac = h_ip / zaspect (cf Holland 2012, fitting SHEBA so that knowing v_ip we can distribute it to a_ip and h_ip) 254 a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 255 h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 256 257 !---------------! 258 ! Pond flushing ! 259 !---------------! 260 ! height of top of the pond above sea-level 261 zhp = ( h_i_1d(ji) * ( rho0 - rhoi ) + h_ip_1d(ji) * ( rho0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rho0 262 263 ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010) 264 DO jk = 1, nlay_i 265 zsbr = - 1.2_wp & 266 & - 21.8_wp * ( t_i_1d(ji,jk) - rt0 ) & 267 & - 0.919_wp * ( t_i_1d(ji,jk) - rt0 )**2 & 268 & - 0.0178_wp * ( t_i_1d(ji,jk) - rt0 )**3 269 ztmp(jk) = sz_i_1d(ji,jk) / zsbr 270 END DO 271 zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 272 273 ! Do the drainage using Darcy's law 274 zdv_flush = -zperm * rho0 * grav * zhp * rdt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) 275 zdv_flush = MAX( zdv_flush, -v_ip_1d(ji) ) 276 v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 277 278 !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 279 a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 280 h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 281 282 !--- Corrections and lid thickness ---! 283 IF( ln_pnd_lids ) THEN 284 !--- retrieve lid thickness from volume ---! 285 IF( a_ip_1d(ji) > epsi10 ) THEN ; h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji) 286 ELSE ; h_il_1d(ji) = 0._wp 287 ENDIF 288 !--- remove ponds if lids are much larger than ponds ---! 289 IF ( h_il_1d(ji) > h_ip_1d(ji) * 10._wp ) THEN 290 a_ip_1d(ji) = 0._wp 291 h_ip_1d(ji) = 0._wp 292 h_il_1d(ji) = 0._wp 293 ENDIF 294 ENDIF 295 ! 296 ENDIF 297 457 END DO 458 459 !-------------------------------------------------------------------- 460 ! Retrieve 2D arrays 461 !-------------------------------------------------------------------- 462 CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d(1:npti), a_ip(:,:,jl) ) 463 CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d(1:npti), h_ip(:,:,jl) ) 464 CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d(1:npti), h_il(:,:,jl) ) 465 CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,jl) ) 466 CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,jl) ) 467 ! 298 468 END DO 299 469 ! 470 CALL tab_1d_2d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd ) 471 ! 472 CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_mlt_1d (1:npti), diag_dvpn_mlt ) 473 CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_drn_1d (1:npti), diag_dvpn_drn ) 474 CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_lid_1d (1:npti), diag_dvpn_lid ) 475 CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_rnf_1d (1:npti), diag_dvpn_rnf ) 476 ! 300 477 END SUBROUTINE pnd_LEV 301 478 302 479 303 SUBROUTINE ice_thd_pnd_init 480 481 SUBROUTINE pnd_TOPO 482 483 !!------------------------------------------------------------------- 484 !! *** ROUTINE pnd_TOPO *** 485 !! 486 !! ** Purpose : Compute melt pond evolution based on the ice 487 !! topography inferred from the ice thickness distribution 488 !! 489 !! ** Method : This code is initially based on Flocco and Feltham 490 !! (2007) and Flocco et al. (2010). 491 !! 492 !! - Calculate available pond water base on surface meltwater 493 !! - Redistribute water as a function of topography, drain water 494 !! - Exchange water with the lid 495 !! 496 !! ** Tunable parameters : 497 !! 498 !! ** Note : 499 !! 500 !! ** References 501 !! 502 !! Flocco, D. and D. L. Feltham, 2007. A continuum model of melt pond 503 !! evolution on Arctic sea ice. J. Geophys. Res. 112, C08016, doi: 504 !! 10.1029/2006JC003836. 505 !! 506 !! Flocco, D., D. L. Feltham and A. K. Turner, 2010. Incorporation of 507 !! a physically based melt pond scheme into the sea ice component of a 508 !! climate model. J. Geophys. Res. 115, C08012, 509 !! doi: 10.1029/2009JC005568. 510 !! 511 !!------------------------------------------------------------------- 512 REAL(wp), PARAMETER :: & ! shared parameters for topographic melt ponds 513 zTd = 0.15_wp , & ! temperature difference for freeze-up (C) 514 zvp_min = 1.e-4_wp ! minimum pond volume (m) 515 516 517 ! local variables 518 REAL(wp) :: & 519 zdHui, & ! change in thickness of ice lid (m) 520 zomega, & ! conduction 521 zdTice, & ! temperature difference across ice lid (C) 522 zdvice, & ! change in ice volume (m) 523 zTavg, & ! mean surface temperature across categories (C) 524 zfsurf, & ! net heat flux, excluding conduction and transmitted radiation (W/m2) 525 zTp, & ! pond freezing temperature (C) 526 zrhoi_L, & ! volumetric latent heat of sea ice (J/m^3) 527 zfr_mlt, & ! fraction and volume of available meltwater retained for melt ponding 528 z1_rhow, & ! inverse water density 529 zv_pnd , & ! volume of meltwater contributing to ponds 530 zv_mlt ! total amount of meltwater produced 531 532 REAL(wp), DIMENSION(jpi,jpj) :: zvolp, & !! total melt pond water available before redistribution and drainage 533 zvolp_res !! remaining melt pond water available after drainage 534 535 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_a_i 536 537 INTEGER :: ji, jj, jk, jl ! loop indices 538 539 INTEGER :: i_test 540 541 ! Note 542 ! equivalent for CICE translation 543 ! a_ip -> apond 544 ! a_ip_frac -> apnd 545 546 CALL ctl_stop( 'STOP', 'icethd_pnd : topographic melt ponds are still an ongoing work' ) 547 548 !--------------------------------------------------------------- 549 ! Initialise 550 !--------------------------------------------------------------- 551 552 ! Parameters & constants (move to parameters) 553 zrhoi_L = rhoi * rLfus ! volumetric latent heat (J/m^3) 554 zTp = rt0 - 0.15_wp ! pond freezing point, slightly below 0C (ponds are bid saline) 555 z1_rhow = 1._wp / rhow 556 557 ! Set required ice variables (hard-coded here for now) 558 ! zfpond(:,:) = 0._wp ! contributing freshwater flux (?) 559 560 at_i (:,:) = SUM( a_i (:,:,:), dim=3 ) ! ice fraction 561 vt_i (:,:) = SUM( v_i (:,:,:), dim=3 ) ! volume per grid area 562 vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 ) ! pond volume per grid area 563 vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) ! lid volume per grid area 564 565 ! thickness 566 WHERE( a_i(:,:,:) > epsi20 ) ; z1_a_i(:,:,:) = 1._wp / a_i(:,:,:) 567 ELSEWHERE ; z1_a_i(:,:,:) = 0._wp 568 END WHERE 569 h_i(:,:,:) = v_i (:,:,:) * z1_a_i(:,:,:) 570 571 !--------------------------------------------------------------- 572 ! Change 2D to 1D 573 !--------------------------------------------------------------- 574 ! MV 575 ! a less computing-intensive version would have 2D-1D passage here 576 ! use what we have in iceitd.F90 (incremental remapping) 577 578 !-------------------------------------------------------------- 579 ! Collect total available pond water volume 580 !-------------------------------------------------------------- 581 ! Assuming that meltwater (+rain in principle) runsoff the surface 582 ! Holland et al (2012) suggest that the fraction of runoff decreases with total ice fraction 583 ! I cite her words, they are very talkative 584 ! "grid cells with very little ice cover (and hence more open water area) 585 ! have a higher runoff fraction to rep- resent the greater proximity of ice to open water." 586 ! "This results in the same runoff fraction r for each ice category within a grid cell" 587 588 zvolp(:,:) = 0._wp 589 590 DO jl = 1, jpl 591 DO_2D( 1, 1, 1, 1 ) 592 593 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 594 595 !--- Available and contributing meltwater for melt ponding ---! 596 zv_mlt = - ( dh_i_sum_2d(ji,jj,jl) * rhoi + dh_s_mlt_2d(ji,jj,jl) * rhos ) & ! available volume of surface melt water per grid area 597 & * z1_rhow * a_i(ji,jj,jl) 598 ! MV -> could move this directly in ice_thd_dh and get an array (ji,jj,jl) for surface melt water volume per grid area 599 zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i(ji,jj) ! fraction of surface meltwater going to ponds 600 zv_pnd = zfr_mlt * zv_mlt ! contributing meltwater volume for category jl 601 602 diag_dvpn_mlt(ji,jj) = diag_dvpn_mlt(ji,jj) + zv_mlt * r1_Dt_ice ! diags 603 diag_dvpn_rnf(ji,jj) = diag_dvpn_rnf(ji,jj) + ( 1. - zfr_mlt ) * zv_mlt * r1_Dt_ice 604 605 !--- Create possible new ponds 606 ! if pond does not exist, create new pond over full ice area 607 !IF ( a_ip_frac(ji,jj,jl) < epsi10 ) THEN 608 IF ( a_ip(ji,jj,jl) < epsi10 ) THEN 609 a_ip(ji,jj,jl) = a_i(ji,jj,jl) 610 a_ip_frac(ji,jj,jl) = 1.0_wp ! pond fraction of sea ice (apnd for CICE) 611 ENDIF 612 613 !--- Deepen existing ponds with no change in pond fraction, before redistribution and drainage 614 v_ip(ji,jj,jl) = v_ip(ji,jj,jl) + zv_pnd ! use pond water to increase thickness 615 h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) 616 617 !--- Total available pond water volume (pre-existing + newly produced)j 618 zvolp(ji,jj) = zvolp(ji,jj) + v_ip(ji,jj,jl) 619 ! zfpond(ji,jj) = zfpond(ji,jj) + zpond * a_ip_frac(ji,jj,jl) ! useless for now 620 621 ENDIF ! a_i 622 623 END_2D 624 END DO ! ji 625 626 !-------------------------------------------------------------- 627 ! Redistribute and drain water from ponds 628 !-------------------------------------------------------------- 629 CALL ice_thd_pnd_area( zvolp, zvolp_res ) 630 631 !-------------------------------------------------------------- 632 ! Melt pond lid growth and melt 633 !-------------------------------------------------------------- 634 635 IF( ln_pnd_lids ) THEN 636 637 DO_2D( 1, 1, 1, 1 ) 638 639 IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. vt_ip(ji,jj) > zvp_min * at_i(ji,jj) ) THEN 640 641 !-------------------------- 642 ! Pond lid growth and melt 643 !-------------------------- 644 ! Mean surface temperature 645 zTavg = 0._wp 646 DO jl = 1, jpl 647 zTavg = zTavg + t_su(ji,jj,jl)*a_i(ji,jj,jl) 648 END DO 649 zTavg = zTavg / a_i(ji,jj,jl) !!! could get a division by zero here 650 651 DO jl = 1, jpl-1 652 653 IF ( v_il(ji,jj,jl) > epsi10 ) THEN 654 655 !---------------------------------------------------------------- 656 ! Lid melting: floating upper ice layer melts in whole or part 657 !---------------------------------------------------------------- 658 ! Use Tsfc for each category 659 IF ( t_su(ji,jj,jl) > zTp ) THEN 660 661 zdvice = MIN( dh_i_sum_2d(ji,jj,jl)*a_ip(ji,jj,jl), v_il(ji,jj,jl) ) 662 663 IF ( zdvice > epsi10 ) THEN 664 665 v_il (ji,jj,jl) = v_il (ji,jj,jl) - zdvice 666 v_ip(ji,jj,jl) = v_ip(ji,jj,jl) + zdvice ! MV: not sure i understand dh_i_sum seems counted twice - 667 ! as it is already counted in surface melt 668 ! zvolp(ji,jj) = zvolp(ji,jj) + zdvice ! pointless to calculate total volume (done in icevar) 669 ! zfpond(ji,jj) = fpond(ji,jj) + zdvice ! pointless to follow fw budget (ponds have no fw) 670 671 IF ( v_il(ji,jj,jl) < epsi10 .AND. v_ip(ji,jj,jl) > epsi10) THEN 672 ! ice lid melted and category is pond covered 673 v_ip(ji,jj,jl) = v_ip(ji,jj,jl) + v_il(ji,jj,jl) 674 ! zfpond(ji,jj) = zfpond (ji,jj) + v_il(ji,jj,jl) 675 v_il(ji,jj,jl) = 0._wp 676 ENDIF 677 h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) !!! could get a division by zero here 678 679 diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) + zdvice ! diag 680 681 ENDIF 682 683 !---------------------------------------------------------------- 684 ! Freeze pre-existing lid 685 !---------------------------------------------------------------- 686 687 ELSE IF ( v_ip(ji,jj,jl) > epsi10 ) THEN ! Tsfcn(i,j,n) <= Tp 688 689 ! differential growth of base of surface floating ice layer 690 zdTice = MAX( - t_su(ji,jj,jl) - zTd , 0._wp ) ! > 0 691 zomega = rcnd_i * zdTice / zrhoi_L 692 zdHui = SQRT( 2._wp * zomega * rDt_ice + ( v_il(ji,jj,jl) / a_i(ji,jj,jl) )**2 ) & 693 - v_il(ji,jj,jl) / a_i(ji,jj,jl) 694 zdvice = min( zdHui*a_ip(ji,jj,jl) , v_ip(ji,jj,jl) ) 695 696 IF ( zdvice > epsi10 ) THEN 697 v_il (ji,jj,jl) = v_il(ji,jj,jl) + zdvice 698 v_ip(ji,jj,jl) = v_ip(ji,jj,jl) - zdvice 699 ! zvolp(ji,jj) = zvolp(ji,jj) - zdvice 700 ! zfpond(ji,jj) = zfpond(ji,jj) - zdvice 701 h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) 702 703 diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) - zdvice ! diag 704 705 ENDIF 706 707 ENDIF ! Tsfcn(i,j,n) 708 709 !---------------------------------------------------------------- 710 ! Freeze new lids 711 !---------------------------------------------------------------- 712 ! upper ice layer begins to form 713 ! note: albedo does not change 714 715 ELSE ! v_il < epsi10 716 717 ! thickness of newly formed ice 718 ! the surface temperature of a meltpond is the same as that 719 ! of the ice underneath (0C), and the thermodynamic surface 720 ! flux is the same 721 722 !!! we need net surface energy flux, excluding conduction 723 !!! fsurf is summed over categories in CICE 724 !!! we have the category-dependent flux, let us use it ? 725 zfsurf = qns_ice(ji,jj,jl) + qsr_ice(ji,jj,jl) 726 zdHui = MAX ( -zfsurf * rDt_ice/zrhoi_L , 0._wp ) 727 zdvice = MIN ( zdHui * a_ip(ji,jj,jl) , v_ip(ji,jj,jl) ) 728 IF ( zdvice > epsi10 ) THEN 729 v_il (ji,jj,jl) = v_il(ji,jj,jl) + zdvice 730 v_ip(ji,jj,jl) = v_ip(ji,jj,jl) - zdvice 731 732 diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) - zdvice ! diag 733 ! zvolp(ji,jj) = zvolp(ji,jj) - zdvice 734 ! zfpond(ji,jj) = zfpond(ji,jj) - zdvice 735 h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) ! MV - in principle, this is useless as h_ip is computed in icevar 736 ENDIF 737 738 ENDIF ! v_il 739 740 END DO ! jl 741 742 ELSE ! remove ponds on thin ice 743 744 v_ip(ji,jj,:) = 0._wp 745 v_il(ji,jj,:) = 0._wp 746 ! zfpond(ji,jj) = zfpond(ji,jj)- zvolp(ji,jj) 747 ! zvolp(ji,jj) = 0._wp 748 749 ENDIF 750 751 END_2D 752 753 ENDIF ! ln_pnd_lids 754 755 !--------------------------------------------------------------- 756 ! Clean-up variables (probably duplicates what icevar would do) 757 !--------------------------------------------------------------- 758 ! MV comment 759 ! In the ideal world, the lines above should update only v_ip, a_ip, v_il 760 ! icevar should recompute all other variables (if needed at all) 761 762 DO jl = 1, jpl 763 764 DO_2D( 1, 1, 1, 1 ) 765 766 ! ! zap lids on small ponds 767 ! IF ( a_i(ji,jj,jl) > epsi10 .AND. v_ip(ji,jj,jl) < epsi10 & 768 ! .AND. v_il(ji,jj,jl) > epsi10) THEN 769 ! v_il(ji,jj,jl) = 0._wp ! probably uselesss now since we get zap_small 770 ! ENDIF 771 772 ! recalculate equivalent pond variables 773 IF ( a_ip(ji,jj,jl) > epsi10) THEN 774 h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_i(ji,jj,jl) 775 a_ip_frac(ji,jj,jl) = a_ip(ji,jj,jl) / a_i(ji,jj,jl) ! MV in principle, useless as computed in icevar 776 h_il(ji,jj,jl) = v_il(ji,jj,jl) / a_ip(ji,jj,jl) ! MV in principle, useless as computed in icevar 777 ENDIF 778 ! h_ip(ji,jj,jl) = 0._wp ! MV in principle, useless as computed in icevar 779 ! h_il(ji,jj,jl) = 0._wp ! MV in principle, useless as omputed in icevar 780 ! ENDIF 781 782 END_2D 783 784 END DO ! jl 785 786 787 END SUBROUTINE pnd_TOPO 788 789 790 SUBROUTINE ice_thd_pnd_area( zvolp , zdvolp ) 791 792 !!------------------------------------------------------------------- 793 !! *** ROUTINE ice_thd_pnd_area *** 794 !! 795 !! ** Purpose : Given the total volume of available pond water, 796 !! redistribute and drain water 797 !! 798 !! ** Method 799 !! 800 !-----------| 801 ! | 802 ! |-----------| 803 !___________|___________|______________________________________sea-level 804 ! | | 805 ! | |---^--------| 806 ! | | | | 807 ! | | | |-----------| |------- 808 ! | | | alfan | | | 809 ! | | | | |--------------| 810 ! | | | | | | 811 !---------------------------v------------------------------------------- 812 ! | | ^ | | | 813 ! | | | | |--------------| 814 ! | | | betan | | | 815 ! | | | |-----------| |------- 816 ! | | | | 817 ! | |---v------- | 818 ! | | 819 ! |-----------| 820 ! | 821 !-----------| 822 ! 823 !! 824 !!------------------------------------------------------------------ 825 826 REAL (wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: & 827 zvolp, & ! total available pond water 828 zdvolp ! remaining meltwater after redistribution 829 830 INTEGER :: & 831 ns, & 832 m_index, & 833 permflag 834 835 REAL (wp), DIMENSION(jpl) :: & 836 hicen, & 837 hsnon, & 838 asnon, & 839 alfan, & 840 betan, & 841 cum_max_vol, & 842 reduced_aicen 843 844 REAL (wp), DIMENSION(0:jpl) :: & 845 cum_max_vol_tmp 846 847 REAL (wp) :: & 848 hpond, & 849 drain, & 850 floe_weight, & 851 pressure_head, & 852 hsl_rel, & 853 deltah, & 854 perm, & 855 msno 856 857 REAL (wp), parameter :: & 858 viscosity = 1.79e-3_wp ! kinematic water viscosity in kg/m/s 859 860 REAL(wp), PARAMETER :: & ! shared parameters for topographic melt ponds 861 zvp_min = 1.e-4_wp ! minimum pond volume (m) 862 863 INTEGER :: ji, jj, jk, jl ! loop indices 864 865 a_ip(:,:,:) = 0._wp 866 h_ip(:,:,:) = 0._wp 867 868 DO_2D( 1, 1, 1, 1 ) 869 870 IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp(ji,jj) > zvp_min * at_i(ji,jj) ) THEN 871 872 !------------------------------------------------------------------- 873 ! initialize 874 !------------------------------------------------------------------- 875 876 DO jl = 1, jpl 877 878 !---------------------------------------- 879 ! compute the effective snow fraction 880 !---------------------------------------- 881 882 IF (a_i(ji,jj,jl) < epsi10) THEN 883 hicen(jl) = 0._wp 884 hsnon(jl) = 0._wp 885 reduced_aicen(jl) = 0._wp 886 asnon(jl) = 0._wp !js: in CICE 5.1.2: make sense as the compiler may not initiate the variables 887 ELSE 888 hicen(jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 889 hsnon(jl) = v_s(ji,jj,jl) / a_i(ji,jj,jl) 890 reduced_aicen(jl) = 1._wp ! n=jpl 891 892 !js: initial code in NEMO_DEV 893 !IF (n < jpl) reduced_aicen(jl) = aicen(jl) & 894 ! * (-0.024_wp*hicen(jl) + 0.832_wp) 895 896 !js: from CICE 5.1.2: this limit reduced_aicen to 0.2 when hicen is too large 897 IF (jl < jpl) reduced_aicen(jl) = a_i(ji,jj,jl) & 898 * max(0.2_wp,(-0.024_wp*hicen(jl) + 0.832_wp)) 899 900 asnon(jl) = reduced_aicen(jl) ! effective snow fraction (empirical) 901 ! MV should check whether this makes sense to have the same effective snow fraction in here 902 ! OLI: it probably doesn't 903 END IF 904 905 ! This choice for alfa and beta ignores hydrostatic equilibium of categories. 906 ! Hydrostatic equilibium of the entire ITD is accounted for below, assuming 907 ! a surface topography implied by alfa=0.6 and beta=0.4, and rigidity across all 908 ! categories. alfa and beta partition the ITD - they are areas not thicknesses! 909 ! Multiplying by hicen, alfan and betan (below) are thus volumes per unit area. 910 ! Here, alfa = 60% of the ice area (and since hice is constant in a category, 911 ! alfan = 60% of the ice volume) in each category lies above the reference line, 912 ! and 40% below. Note: p6 is an arbitrary choice, but alfa+beta=1 is required. 913 914 ! MV: 915 ! Note that this choice is not in the original FF07 paper and has been adopted in CICE 916 ! No reason why is explained in the doc, but I guess there is a reason. I'll try to investigate, maybe 917 918 ! Where does that choice come from ? => OLI : Coz' Chuck Norris said so... 919 920 alfan(jl) = 0.6 * hicen(jl) 921 betan(jl) = 0.4 * hicen(jl) 922 923 cum_max_vol(jl) = 0._wp 924 cum_max_vol_tmp(jl) = 0._wp 925 926 END DO ! jpl 927 928 cum_max_vol_tmp(0) = 0._wp 929 drain = 0._wp 930 zdvolp(ji,jj) = 0._wp 931 932 !---------------------------------------------------------- 933 ! Drain overflow water, update pond fraction and volume 934 !---------------------------------------------------------- 935 936 !-------------------------------------------------------------------------- 937 ! the maximum amount of water that can be contained up to each ice category 938 !-------------------------------------------------------------------------- 939 ! If melt ponds are too deep to be sustainable given the ITD (OVERFLOW) 940 ! Then the excess volume cum_max_vol(jl) drains out of the system 941 ! It should be added to wfx_pnd_out 942 943 DO jl = 1, jpl-1 ! last category can not hold any volume 944 945 IF (alfan(jl+1) >= alfan(jl) .AND. alfan(jl+1) > 0._wp ) THEN 946 947 ! total volume in level including snow 948 cum_max_vol_tmp(jl) = cum_max_vol_tmp(jl-1) + & 949 (alfan(jl+1) - alfan(jl)) * sum(reduced_aicen(1:jl)) 950 951 ! subtract snow solid volumes from lower categories in current level 952 DO ns = 1, jl 953 cum_max_vol_tmp(jl) = cum_max_vol_tmp(jl) & 954 - rhos/rhow * & ! free air fraction that can be filled by water 955 asnon(ns) * & ! effective areal fraction of snow in that category 956 max(min(hsnon(ns)+alfan(ns)-alfan(jl), alfan(jl+1)-alfan(jl)), 0._wp) 957 END DO 958 959 ELSE ! assume higher categories unoccupied 960 cum_max_vol_tmp(jl) = cum_max_vol_tmp(jl-1) 961 END IF 962 !IF (cum_max_vol_tmp(jl) < z0) THEN 963 ! CALL abort_ice('negative melt pond volume') 964 !END IF 965 END DO 966 cum_max_vol_tmp(jpl) = cum_max_vol_tmp(jpl-1) ! last category holds no volume 967 cum_max_vol (1:jpl) = cum_max_vol_tmp(1:jpl) 968 969 !---------------------------------------------------------------- 970 ! is there more meltwater than can be held in the floe? 971 !---------------------------------------------------------------- 972 IF (zvolp(ji,jj) >= cum_max_vol(jpl)) THEN 973 drain = zvolp(ji,jj) - cum_max_vol(jpl) + epsi10 974 zvolp(ji,jj) = zvolp(ji,jj) - drain ! update meltwater volume available 975 976 diag_dvpn_rnf(ji,jj) = - drain ! diag - overflow counted in the runoff part (arbitrary choice) 977 978 zdvolp(ji,jj) = drain ! this is the drained water 979 IF (zvolp(ji,jj) < epsi10) THEN 980 zdvolp(ji,jj) = zdvolp(ji,jj) + zvolp(ji,jj) 981 zvolp(ji,jj) = 0._wp 982 END IF 983 END IF 984 985 ! height and area corresponding to the remaining volume 986 ! routine leaves zvolp unchanged 987 CALL ice_thd_pnd_depth(reduced_aicen, asnon, hsnon, alfan, zvolp(ji,jj), cum_max_vol, hpond, m_index) 988 989 DO jl = 1, m_index 990 !h_ip(jl) = hpond - alfan(jl) + alfan(1) ! here oui choulde update 991 ! ! volume instead, no ? 992 h_ip(ji,jj,jl) = max((hpond - alfan(jl) + alfan(1)), 0._wp) !js: from CICE 5.1.2 993 a_ip(ji,jj,jl) = reduced_aicen(jl) 994 ! in practise, pond fraction depends on the empirical snow fraction 995 ! so in turn on ice thickness 996 END DO 997 !zapond = sum(a_ip(1:m_index)) !js: from CICE 5.1.2; not in Icepack1.1.0-6-gac6195d 998 999 !------------------------------------------------------------------------ 1000 ! Drainage through brine network (permeability) 1001 !------------------------------------------------------------------------ 1002 !!! drainage due to ice permeability - Darcy's law 1003 1004 ! sea water level 1005 msno = 0._wp 1006 DO jl = 1 , jpl 1007 msno = msno + v_s(ji,jj,jl) * rhos 1008 END DO 1009 floe_weight = ( msno + rhoi*vt_i(ji,jj) + rho0*zvolp(ji,jj) ) / at_i(ji,jj) 1010 hsl_rel = floe_weight / rho0 & 1011 - ( ( sum(betan(:)*a_i(ji,jj,:)) / at_i(ji,jj) ) + alfan(1) ) 1012 1013 deltah = hpond - hsl_rel 1014 pressure_head = grav * rho0 * max(deltah, 0._wp) 1015 1016 ! drain if ice is permeable 1017 permflag = 0 1018 1019 IF (pressure_head > 0._wp) THEN 1020 DO jl = 1, jpl-1 1021 IF ( hicen(jl) /= 0._wp ) THEN 1022 1023 !IF (hicen(jl) > 0._wp) THEN !js: from CICE 5.1.2 1024 1025 perm = 0._wp ! MV ugly dummy patch 1026 CALL ice_thd_pnd_perm(t_i(ji,jj,:,jl), sz_i(ji,jj,:,jl), perm) ! bof 1027 IF (perm > 0._wp) permflag = 1 1028 1029 drain = perm*a_ip(ji,jj,jl)*pressure_head*rDt_ice / & 1030 (viscosity*hicen(jl)) 1031 zdvolp(ji,jj) = zdvolp(ji,jj) + min(drain, zvolp(ji,jj)) 1032 zvolp(ji,jj) = max(zvolp(ji,jj) - drain, 0._wp) 1033 1034 diag_dvpn_drn(ji,jj) = - drain ! diag (could be better coded) 1035 1036 IF (zvolp(ji,jj) < epsi10) THEN 1037 zdvolp(ji,jj) = zdvolp(ji,jj) + zvolp(ji,jj) 1038 zvolp(ji,jj) = 0._wp 1039 END IF 1040 END IF 1041 END DO 1042 1043 ! adjust melt pond dimensions 1044 IF (permflag > 0) THEN 1045 ! recompute pond depth 1046 CALL ice_thd_pnd_depth(reduced_aicen, asnon, hsnon, alfan, zvolp(ji,jj), cum_max_vol, hpond, m_index) 1047 DO jl = 1, m_index 1048 h_ip(ji,jj,jl) = hpond - alfan(jl) + alfan(1) 1049 a_ip(ji,jj,jl) = reduced_aicen(jl) 1050 END DO 1051 !zapond = sum(a_ip(1:m_index)) !js: from CICE 5.1.2; not in Icepack1.1.0-6-gac6195d 1052 END IF 1053 END IF ! pressure_head 1054 1055 !------------------------------- 1056 ! remove water from the snow 1057 !------------------------------- 1058 !------------------------------------------------------------------------ 1059 ! total melt pond volume in category does not include snow volume 1060 ! snow in melt ponds is not melted 1061 !------------------------------------------------------------------------ 1062 1063 ! MV here, it seems that we remove some meltwater from the ponds, but I can't really tell 1064 ! how much, so I did not diagnose it 1065 ! so if there is a problem here, nobody is going to see it... 1066 1067 1068 ! Calculate pond volume for lower categories 1069 DO jl = 1,m_index-1 1070 v_ip(ji,jj,jl) = a_ip(ji,jj,jl) * h_ip(ji,jj,jl) & ! what is not in the snow 1071 - (rhos/rhow) * asnon(jl) * min(hsnon(jl), h_ip(ji,jj,jl)) 1072 END DO 1073 1074 ! Calculate pond volume for highest category = remaining pond volume 1075 1076 ! The following is completely unclear to Martin at least 1077 ! Could we redefine properly and recode in a more readable way ? 1078 1079 ! m_index = last category with melt pond 1080 1081 IF (m_index == 1) v_ip(ji,jj,m_index) = zvolp(ji,jj) ! volume of mw in 1st category is the total volume of melt water 1082 1083 IF (m_index > 1) THEN 1084 IF (zvolp(ji,jj) > sum( v_ip(ji,jj,1:m_index-1))) THEN 1085 v_ip(ji,jj,m_index) = zvolp(ji,jj) - sum(v_ip(ji,jj,1:m_index-1)) 1086 ELSE 1087 v_ip(ji,jj,m_index) = 0._wp 1088 h_ip(ji,jj,m_index) = 0._wp 1089 a_ip(ji,jj,m_index) = 0._wp 1090 ! If remaining pond volume is negative reduce pond volume of 1091 ! lower category 1092 IF ( zvolp(ji,jj) + epsi10 < SUM(v_ip(ji,jj,1:m_index-1))) & 1093 v_ip(ji,jj,m_index-1) = v_ip(ji,jj,m_index-1) - sum(v_ip(ji,jj,1:m_index-1)) + zvolp(ji,jj) 1094 END IF 1095 END IF 1096 1097 DO jl = 1,m_index 1098 IF (a_ip(ji,jj,jl) > epsi10) THEN 1099 h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) 1100 ELSE 1101 zdvolp(ji,jj) = zdvolp(ji,jj) + v_ip(ji,jj,jl) 1102 h_ip(ji,jj,jl) = 0._wp 1103 v_ip(ji,jj,jl) = 0._wp 1104 a_ip(ji,jj,jl) = 0._wp 1105 END IF 1106 END DO 1107 DO jl = m_index+1, jpl 1108 h_ip(ji,jj,jl) = 0._wp 1109 a_ip(ji,jj,jl) = 0._wp 1110 v_ip(ji,jj,jl) = 0._wp 1111 END DO 1112 1113 ENDIF 1114 1115 END_2D 1116 1117 END SUBROUTINE ice_thd_pnd_area 1118 1119 1120 SUBROUTINE ice_thd_pnd_depth(aicen, asnon, hsnon, alfan, zvolp, cum_max_vol, hpond, m_index) 1121 !!------------------------------------------------------------------- 1122 !! *** ROUTINE ice_thd_pnd_depth *** 1123 !! 1124 !! ** Purpose : Compute melt pond depth 1125 !!------------------------------------------------------------------- 1126 1127 REAL (wp), DIMENSION(jpl), INTENT(IN) :: & 1128 aicen, & 1129 asnon, & 1130 hsnon, & 1131 alfan, & 1132 cum_max_vol 1133 1134 REAL (wp), INTENT(IN) :: & 1135 zvolp 1136 1137 REAL (wp), INTENT(OUT) :: & 1138 hpond 1139 1140 INTEGER, INTENT(OUT) :: & 1141 m_index 1142 1143 INTEGER :: n, ns 1144 1145 REAL (wp), DIMENSION(0:jpl+1) :: & 1146 hitl, & 1147 aicetl 1148 1149 REAL (wp) :: & 1150 rem_vol, & 1151 area, & 1152 vol, & 1153 tmp, & 1154 z0 = 0.0_wp 1155 1156 !---------------------------------------------------------------- 1157 ! hpond is zero if zvolp is zero - have we fully drained? 1158 !---------------------------------------------------------------- 1159 1160 IF (zvolp < epsi10) THEN 1161 hpond = z0 1162 m_index = 0 1163 ELSE 1164 1165 !---------------------------------------------------------------- 1166 ! Calculate the category where water fills up to 1167 !---------------------------------------------------------------- 1168 1169 !----------| 1170 ! | 1171 ! | 1172 ! |----------| -- -- 1173 !__________|__________|_________________________________________ ^ 1174 ! | | rem_vol ^ | Semi-filled 1175 ! | |----------|-- -- -- - ---|-- ---- -- -- --v layer 1176 ! | | | | 1177 ! | | | |hpond 1178 ! | | |----------| | |------- 1179 ! | | | | | | 1180 ! | | | |---v-----| 1181 ! | | m_index | | | 1182 !------------------------------------------------------------- 1183 1184 m_index = 0 ! 1:m_index categories have water in them 1185 DO n = 1, jpl 1186 IF (zvolp <= cum_max_vol(n)) THEN 1187 m_index = n 1188 IF (n == 1) THEN 1189 rem_vol = zvolp 1190 ELSE 1191 rem_vol = zvolp - cum_max_vol(n-1) 1192 END IF 1193 exit ! to break out of the loop 1194 END IF 1195 END DO 1196 m_index = min(jpl-1, m_index) 1197 1198 !---------------------------------------------------------------- 1199 ! semi-filled layer may have m_index different snow in it 1200 !---------------------------------------------------------------- 1201 1202 !----------------------------------------------------------- ^ 1203 ! | alfan(m_index+1) 1204 ! | 1205 !hitl(3)--> |----------| | 1206 !hitl(2)--> |------------| * * * * *| | 1207 !hitl(1)--> |----------|* * * * * * |* * * * * | | 1208 !hitl(0)-->------------------------------------------------- | ^ 1209 ! various snow from lower categories | |alfa(m_index) 1210 1211 ! hitl - heights of the snow layers from thinner and current categories 1212 ! aicetl - area of each snow depth in this layer 1213 1214 hitl(:) = z0 1215 aicetl(:) = z0 1216 DO n = 1, m_index 1217 hitl(n) = max(min(hsnon(n) + alfan(n) - alfan(m_index), & 1218 alfan(m_index+1) - alfan(m_index)), z0) 1219 aicetl(n) = asnon(n) 1220 1221 aicetl(0) = aicetl(0) + (aicen(n) - asnon(n)) 1222 END DO 1223 1224 hitl(m_index+1) = alfan(m_index+1) - alfan(m_index) 1225 aicetl(m_index+1) = z0 1226 1227 !---------------------------------------------------------------- 1228 ! reorder array according to hitl 1229 ! snow heights not necessarily in height order 1230 !---------------------------------------------------------------- 1231 1232 DO ns = 1, m_index+1 1233 DO n = 0, m_index - ns + 1 1234 IF (hitl(n) > hitl(n+1)) THEN ! swap order 1235 tmp = hitl(n) 1236 hitl(n) = hitl(n+1) 1237 hitl(n+1) = tmp 1238 tmp = aicetl(n) 1239 aicetl(n) = aicetl(n+1) 1240 aicetl(n+1) = tmp 1241 END IF 1242 END DO 1243 END DO 1244 1245 !---------------------------------------------------------------- 1246 ! divide semi-filled layer into set of sublayers each vertically homogenous 1247 !---------------------------------------------------------------- 1248 1249 !hitl(3)---------------------------------------------------------------- 1250 ! | * * * * * * * * 1251 ! |* * * * * * * * * 1252 !hitl(2)---------------------------------------------------------------- 1253 ! | * * * * * * * * | * * * * * * * * 1254 ! |* * * * * * * * * |* * * * * * * * * 1255 !hitl(1)---------------------------------------------------------------- 1256 ! | * * * * * * * * | * * * * * * * * | * * * * * * * * 1257 ! |* * * * * * * * * |* * * * * * * * * |* * * * * * * * * 1258 !hitl(0)---------------------------------------------------------------- 1259 ! aicetl(0) aicetl(1) aicetl(2) aicetl(3) 1260 1261 ! move up over layers incrementing volume 1262 DO n = 1, m_index+1 1263 1264 area = sum(aicetl(:)) - & ! total area of sub-layer 1265 (rhos/rho0) * sum(aicetl(n:jpl+1)) ! area of sub-layer occupied by snow 1266 1267 vol = (hitl(n) - hitl(n-1)) * area ! thickness of sub-layer times area 1268 1269 IF (vol >= rem_vol) THEN ! have reached the sub-layer with the depth within 1270 hpond = rem_vol / area + hitl(n-1) + alfan(m_index) - alfan(1) 1271 1272 exit 1273 ELSE ! still in sub-layer below the sub-layer with the depth 1274 rem_vol = rem_vol - vol 1275 END IF 1276 1277 END DO 1278 1279 END IF 1280 1281 END SUBROUTINE ice_thd_pnd_depth 1282 1283 1284 SUBROUTINE ice_thd_pnd_perm(ticen, salin, perm) 1285 !!------------------------------------------------------------------- 1286 !! *** ROUTINE ice_thd_pnd_perm *** 1287 !! 1288 !! ** Purpose : Determine the liquid fraction of brine in the ice 1289 !! and its permeability 1290 !!------------------------------------------------------------------- 1291 1292 REAL (wp), DIMENSION(nlay_i), INTENT(IN) :: & 1293 ticen, & ! internal ice temperature (K) 1294 salin ! salinity (ppt) !js: ppt according to cice 1295 1296 REAL (wp), INTENT(OUT) :: & 1297 perm ! permeability 1298 1299 REAL (wp) :: & 1300 Sbr ! brine salinity 1301 1302 REAL (wp), DIMENSION(nlay_i) :: & 1303 Tin, & ! ice temperature 1304 phi ! liquid fraction 1305 1306 INTEGER :: k 1307 1308 !----------------------------------------------------------------- 1309 ! Compute ice temperatures from enthalpies using quadratic formula 1310 !----------------------------------------------------------------- 1311 1312 DO k = 1,nlay_i 1313 Tin(k) = ticen(k) - rt0 !js: from K to degC 1314 END DO 1315 1316 !----------------------------------------------------------------- 1317 ! brine salinity and liquid fraction 1318 !----------------------------------------------------------------- 1319 1320 DO k = 1, nlay_i 1321 1322 Sbr = - Tin(k) / rTmlt ! Consistent expression with SI3 (linear liquidus) 1323 ! Best expression to date is that one (Vancoppenolle et al JGR 2019) 1324 ! Sbr = - 18.7 * Tin(k) - 0.519 * Tin(k)**2 - 0.00535 * Tin(k) **3 1325 phi(k) = salin(k) / Sbr 1326 1327 END DO 1328 1329 !----------------------------------------------------------------- 1330 ! permeability 1331 !----------------------------------------------------------------- 1332 1333 perm = 3.0e-08_wp * (minval(phi))**3 ! Golden et al. (2007) 1334 1335 END SUBROUTINE ice_thd_pnd_perm 1336 1337 SUBROUTINE ice_thd_pnd_init 304 1338 !!------------------------------------------------------------------- 305 1339 !! *** ROUTINE ice_thd_pnd_init *** … … 308 1342 !! over sea ice 309 1343 !! 310 !! ** Method : Read the namthd_pnd namelist and check the melt pond 1344 !! ** Method : Read the namthd_pnd namelist and check the melt pond 311 1345 !! parameter values called at the first timestep (nit000) 312 1346 !! 313 !! ** input : Namelist namthd_pnd 1347 !! ** input : Namelist namthd_pnd 314 1348 !!------------------------------------------------------------------- 315 1349 INTEGER :: ios, ioptio ! Local integer 316 1350 !! 317 NAMELIST/namthd_pnd/ ln_pnd, ln_pnd_LEV , rn_apnd_min, rn_apnd_max, &1351 NAMELIST/namthd_pnd/ ln_pnd, ln_pnd_LEV , rn_apnd_min, rn_apnd_max, rn_pnd_flush, & 318 1352 & ln_pnd_CST , rn_apnd, rn_hpnd, & 1353 & ln_pnd_TOPO, & 319 1354 & ln_pnd_lids, ln_pnd_alb 320 1355 !!------------------------------------------------------------------- … … 332 1367 WRITE(numout,*) ' Namelist namicethd_pnd:' 333 1368 WRITE(numout,*) ' Melt ponds activated or not ln_pnd = ', ln_pnd 1369 WRITE(numout,*) ' Topographic melt pond scheme ln_pnd_TOPO = ', ln_pnd_TOPO 334 1370 WRITE(numout,*) ' Level ice melt pond scheme ln_pnd_LEV = ', ln_pnd_LEV 335 1371 WRITE(numout,*) ' Minimum ice fraction that contributes to melt ponds rn_apnd_min = ', rn_apnd_min 336 1372 WRITE(numout,*) ' Maximum ice fraction that contributes to melt ponds rn_apnd_max = ', rn_apnd_max 1373 WRITE(numout,*) ' Pond flushing efficiency rn_pnd_flush = ', rn_pnd_flush 337 1374 WRITE(numout,*) ' Constant ice melt pond scheme ln_pnd_CST = ', ln_pnd_CST 338 1375 WRITE(numout,*) ' Prescribed pond fraction rn_apnd = ', rn_apnd … … 347 1384 IF( ln_pnd_CST ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndCST ; ENDIF 348 1385 IF( ln_pnd_LEV ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndLEV ; ENDIF 1386 IF( ln_pnd_TOPO ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndTOPO ; ENDIF 349 1387 IF( ioptio /= 1 ) & 350 & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_LEV or ln_pnd_CST)' )1388 & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_LEV, ln_pnd_CST or ln_pnd_TOPO)' ) 351 1389 ! 352 1390 SELECT CASE( nice_pnd ) 353 CASE( np_pndNO ) 1391 CASE( np_pndNO ) 354 1392 IF( ln_pnd_alb ) THEN ; ln_pnd_alb = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' ) ; ENDIF 355 1393 IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when no ponds' ) ; ENDIF 356 CASE( np_pndCST ) 1394 CASE( np_pndCST ) 357 1395 IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when constant ponds' ) ; ENDIF 358 1396 END SELECT 359 1397 ! 360 1398 END SUBROUTINE ice_thd_pnd_init 361 1399 362 1400 #else 363 1401 !!---------------------------------------------------------------------- 364 1402 !! Default option Empty module NO SI3 sea-ice model 365 1403 !!---------------------------------------------------------------------- 366 #endif 1404 #endif 367 1405 368 1406 !!====================================================================== 369 END MODULE icethd_pnd 1407 END MODULE icethd_pnd -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icethd_zdf_bl99.F90
r13472 r14021 2 2 !!====================================================================== 3 3 !! *** MODULE icethd_zdf_BL99 *** 4 !! sea-ice: vertical heat diffusion in sea ice (computation of temperatures) 4 !! sea-ice: vertical heat diffusion in sea ice (computation of temperatures) 5 5 !!====================================================================== 6 6 !! History : ! 2003-02 (M. Vancoppenolle) original 1D code … … 15 15 !!---------------------------------------------------------------------- 16 16 USE dom_oce ! ocean space and time domain 17 USE phycst ! physical constants (ocean directory) 17 USE phycst ! physical constants (ocean directory) 18 18 USE ice ! sea-ice: variables 19 19 USE ice1D ! sea-ice: thermodynamics variables … … 44 44 !! 45 45 !! ** Method : solves the heat equation diffusion with a Neumann boundary 46 !! condition at the surface and a Dirichlet one at the bottom. 46 !! condition at the surface and a Dirichlet one at the bottom. 47 47 !! Solar radiation is partially absorbed into the ice. 48 !! The specific heat and thermal conductivities depend on ice 49 !! salinity and temperature to take into account brine pocket 48 !! The specific heat and thermal conductivities depend on ice 49 !! salinity and temperature to take into account brine pocket 50 50 !! melting. The numerical scheme is an iterative Crank-Nicolson 51 51 !! on a non-uniform multilayer grid in the ice and snow system. … … 91 91 REAL(wp) :: zbeta = 0.117_wp ! for thermal conductivity (could be 0.13) 92 92 REAL(wp) :: zkimin = 0.10_wp ! minimum ice thermal conductivity 93 REAL(wp) :: ztsu_err = 1.e-5_wp ! range around which t_su is considered at 0C 94 REAL(wp) :: zdti_bnd = 1.e-4_wp ! maximal authorized error on temperature 95 REAL(wp) :: zhs_ssl = 0.03_wp ! surface scattering layer in the snow 93 REAL(wp) :: ztsu_err = 1.e-5_wp ! range around which t_su is considered at 0C 94 REAL(wp) :: zdti_bnd = 1.e-4_wp ! maximal authorized error on temperature 95 REAL(wp) :: zhs_ssl = 0.03_wp ! surface scattering layer in the snow 96 96 REAL(wp) :: zhi_ssl = 0.10_wp ! surface scattering layer in the ice 97 97 REAL(wp) :: zh_min = 1.e-3_wp ! minimum ice/snow thickness for conduction 98 98 REAL(wp) :: ztmelts ! ice melting temperature 99 REAL(wp) :: zdti_max ! current maximal error on temperature 99 REAL(wp) :: zdti_max ! current maximal error on temperature 100 100 REAL(wp) :: zcpi ! Ice specific heat 101 101 REAL(wp) :: zhfx_err, zdq ! diag errors on heat … … 109 109 REAL(wp), DIMENSION(jpij) :: zdqns_ice_b ! derivative of the surface flux function 110 110 ! 111 REAL(wp), DIMENSION(jpij ) 112 REAL(wp), DIMENSION(jpij,nlay_i) 113 REAL(wp), DIMENSION(jpij,nlay_s) 114 REAL(wp), DIMENSION(jpij,nlay_i) 115 REAL(wp), DIMENSION(jpij,nlay_s) 116 REAL(wp), DIMENSION(jpij,0:nlay_i) 117 REAL(wp), DIMENSION(jpij,0:nlay_i) 118 REAL(wp), DIMENSION(jpij,0:nlay_i) 119 REAL(wp), DIMENSION(jpij,0:nlay_i) 120 REAL(wp), DIMENSION(jpij,0:nlay_i) 121 REAL(wp), DIMENSION(jpij,0:nlay_i) 122 REAL(wp), DIMENSION(jpij,0:nlay_s) 123 REAL(wp), DIMENSION(jpij,0:nlay_s) 124 REAL(wp), DIMENSION(jpij,0:nlay_s) 125 REAL(wp), DIMENSION(jpij,0:nlay_s) 126 REAL(wp), DIMENSION(jpij) 127 REAL(wp), DIMENSION(jpij ,nlay_i+3) :: zindterm ! 'Ind'ependent term128 REAL(wp), DIMENSION(jpij ,nlay_i+3) :: zindtbis ! Temporary 'ind'ependent term129 REAL(wp), DIMENSION(jpij ,nlay_i+3) :: zdiagbis ! Temporary 'dia'gonal term130 REAL(wp), DIMENSION(jpij ,nlay_i+3,3) :: ztrid ! Tridiagonal system terms131 REAL(wp), DIMENSION(jpij) :: zq_ini ! diag errors on heat132 REAL(wp), DIMENSION(jpij ) :: zghe ! G(he), th. conduct enhancement factor, mono-cat133 REAL(wp), DIMENSION(jpij ) :: za_s_fra ! ice fraction covered by snow134 REAL(wp), DIMENSION(jpij ) :: isnow ! snow presence (1) or not (0)135 REAL(wp), DIMENSION(jpij ) :: isnow_comb ! snow presence for met-office111 REAL(wp), DIMENSION(jpij ) :: ztsuold ! Old surface temperature in the ice 112 REAL(wp), DIMENSION(jpij,nlay_i) :: ztiold ! Old temperature in the ice 113 REAL(wp), DIMENSION(jpij,nlay_s) :: ztsold ! Old temperature in the snow 114 REAL(wp), DIMENSION(jpij,nlay_i) :: ztib ! Temporary temperature in the ice to check the convergence 115 REAL(wp), DIMENSION(jpij,nlay_s) :: ztsb ! Temporary temperature in the snow to check the convergence 116 REAL(wp), DIMENSION(jpij,0:nlay_i) :: ztcond_i ! Ice thermal conductivity 117 REAL(wp), DIMENSION(jpij,0:nlay_i) :: ztcond_i_cp ! copy 118 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zradtr_i ! Radiation transmitted through the ice 119 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zradab_i ! Radiation absorbed in the ice 120 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zkappa_i ! Kappa factor in the ice 121 REAL(wp), DIMENSION(jpij,0:nlay_i) :: zeta_i ! Eta factor in the ice 122 REAL(wp), DIMENSION(jpij,0:nlay_s) :: zradtr_s ! Radiation transmited through the snow 123 REAL(wp), DIMENSION(jpij,0:nlay_s) :: zradab_s ! Radiation absorbed in the snow 124 REAL(wp), DIMENSION(jpij,0:nlay_s) :: zkappa_s ! Kappa factor in the snow 125 REAL(wp), DIMENSION(jpij,0:nlay_s) :: zeta_s ! Eta factor in the snow 126 REAL(wp), DIMENSION(jpij) :: zkappa_comb ! Combined snow and ice surface conductivity 127 REAL(wp), DIMENSION(jpij) :: zq_ini ! diag errors on heat 128 REAL(wp), DIMENSION(jpij) :: zghe ! G(he), th. conduct enhancement factor, mono-cat 129 REAL(wp), DIMENSION(jpij) :: za_s_fra ! ice fraction covered by snow 130 REAL(wp), DIMENSION(jpij) :: isnow ! snow presence (1) or not (0) 131 REAL(wp), DIMENSION(jpij) :: isnow_comb ! snow presence for met-office 132 REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1) :: zindterm ! 'Ind'ependent term 133 REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1) :: zindtbis ! Temporary 'ind'ependent term 134 REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1) :: zdiagbis ! Temporary 'dia'gonal term 135 REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1,3) :: ztrid ! Tridiagonal system terms 136 136 ! 137 137 ! Mono-category … … 139 139 REAL(wp) :: zhe ! dummy factor 140 140 REAL(wp) :: zcnd_i ! mean sea ice thermal conductivity 141 !!------------------------------------------------------------------ 141 !!------------------------------------------------------------------ 142 142 143 143 ! --- diag error on heat diffusion - PART 1 --- ! 144 144 DO ji = 1, npti 145 145 zq_ini(ji) = ( SUM( e_i_1d(ji,1:nlay_i) ) * h_i_1d(ji) * r1_nlay_i + & 146 & SUM( e_s_1d(ji,1:nlay_s) ) * h_s_1d(ji) * r1_nlay_s ) 146 & SUM( e_s_1d(ji,1:nlay_s) ) * h_s_1d(ji) * r1_nlay_s ) 147 147 END DO 148 148 149 149 ! calculate ice fraction covered by snow for radiation 150 150 CALL ice_var_snwfra( h_s_1d(1:npti), za_s_fra(1:npti) ) 151 151 152 152 !------------------ 153 153 ! 1) Initialization … … 155 155 ! 156 156 ! extinction radiation in the snow 157 IF ( nn_qtrice == 0 ) THEN ! constant 157 IF ( nn_qtrice == 0 ) THEN ! constant 158 158 zraext_s(1:npti) = rn_kappa_s 159 159 ELSEIF( nn_qtrice == 1 ) THEN ! depends on melting/freezing conditions … … 166 166 DO ji = 1, npti 167 167 ! ice thickness 168 IF( h_i_1d(ji) > 0._wp ) THEN 168 IF( h_i_1d(ji) > 0._wp ) THEN 169 169 zh_i (ji) = MAX( zh_min , h_i_1d(ji) ) * r1_nlay_i ! set a minimum thickness for conduction 170 170 z1_h_i(ji) = 1._wp / zh_i(ji) ! it must be very small … … 198 198 ztsuold (1:npti) = t_su_1d(1:npti) ! surface temperature initial value 199 199 t_su_1d (1:npti) = MIN( t_su_1d(1:npti), rt0 - ztsu_err ) ! required to leave the choice between melting or not 200 zdqns_ice_b(1:npti) = dqns_ice_1d(1:npti) ! derivative of incoming nonsolar flux 200 zdqns_ice_b(1:npti) = dqns_ice_1d(1:npti) ! derivative of incoming nonsolar flux 201 201 zqns_ice_b (1:npti) = qns_ice_1d(1:npti) ! store previous qns_ice_1d value 202 202 ! … … 221 221 ! 222 222 zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * za_s_fra(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - za_s_fra(1:npti) ) 223 DO jk = 1, nlay_i 223 DO jk = 1, nlay_i 224 224 DO ji = 1, npti 225 225 ! ! radiation transmitted below the layer-th ice layer … … 227 227 & * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zh_min ) ) & 228 228 & + ( 1._wp - za_s_fra(ji) ) * qtr_ice_top_1d(ji) & ! part snow free 229 & * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zhi_ssl ) ) 229 & * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zhi_ssl ) ) 230 230 ! ! radiation absorbed by the layer-th ice layer 231 231 zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk) … … 288 288 DO ji = 1, npti 289 289 IF ( .NOT. l_T_converged(ji) ) & 290 ztcond_i(ji,:) = MAX( zkimin, ztcond_i_cp(ji,:) ) 290 ztcond_i(ji,:) = MAX( zkimin, ztcond_i_cp(ji,:) ) 291 291 END DO 292 292 ! … … 401 401 zdiagbis(1:npti,:) = 0._wp 402 402 403 DO jm = nlay_s + 2, nlay_s + nlay_i 403 DO jm = nlay_s + 2, nlay_s + nlay_i 404 404 DO ji = 1, npti 405 405 jk = jm - nlay_s - 1 … … 414 414 DO ji = 1, npti 415 415 ! ice bottom term 416 ztrid (ji,jm,1) = - zeta_i(ji,nlay_i) * zkappa_i(ji,nlay_i-1) 416 ztrid (ji,jm,1) = - zeta_i(ji,nlay_i) * zkappa_i(ji,nlay_i-1) 417 417 ztrid (ji,jm,2) = 1._wp + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i-1) + zkappa_i(ji,nlay_i) * zg1 ) 418 418 ztrid (ji,jm,3) = 0._wp 419 419 zindterm(ji,jm) = ztiold(ji,nlay_i) + zeta_i(ji,nlay_i) * & 420 & ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) ) 420 & ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) ) 421 421 END DO 422 422 … … 433 433 zindterm(ji,jm) = ztsold(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk) 434 434 END DO 435 435 436 436 ! case of only one layer in the ice (ice equation is altered) 437 437 IF( nlay_i == 1 ) THEN 438 438 ztrid (ji,nlay_s+2,3) = 0._wp 439 zindterm(ji,nlay_s+2) = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji) 440 ENDIF 441 439 zindterm(ji,nlay_s+2) = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji) 440 ENDIF 441 442 442 IF( t_su_1d(ji) < rt0 ) THEN !-- case 1 : no surface melting 443 443 444 444 jm_min(ji) = 1 445 445 jm_max(ji) = nlay_i + nlay_s + 1 446 446 447 447 ! surface equation 448 448 ztrid (ji,1,1) = 0._wp … … 450 450 ztrid (ji,1,3) = zg1s * zkappa_s(ji,0) 451 451 zindterm(ji,1) = zdqns_ice_b(ji) * t_su_1d(ji) - zfnet(ji) 452 452 453 453 ! first layer of snow equation 454 454 ztrid (ji,2,1) = - zeta_s(ji,1) * zkappa_s(ji,0) * zg1s … … 456 456 ztrid (ji,2,3) = - zeta_s(ji,1) * zkappa_s(ji,1) 457 457 zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) * zradab_s(ji,1) 458 458 459 459 ELSE !-- case 2 : surface is melting 460 460 ! 461 461 jm_min(ji) = 2 462 462 jm_max(ji) = nlay_i + nlay_s + 1 463 463 464 464 ! first layer of snow equation 465 465 ztrid (ji,2,1) = 0._wp 466 466 ztrid (ji,2,2) = 1._wp + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s ) 467 ztrid (ji,2,3) = - zeta_s(ji,1) * zkappa_s(ji,1) 468 zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) * ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 467 ztrid (ji,2,3) = - zeta_s(ji,1) * zkappa_s(ji,1) 468 zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) * ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 469 469 ENDIF 470 470 ! !---------------------! … … 476 476 jm_min(ji) = nlay_s + 1 477 477 jm_max(ji) = nlay_i + nlay_s + 1 478 479 ! surface equation 478 479 ! surface equation 480 480 ztrid (ji,jm_min(ji),1) = 0._wp 481 ztrid (ji,jm_min(ji),2) = zdqns_ice_b(ji) - zkappa_i(ji,0) * zg1 481 ztrid (ji,jm_min(ji),2) = zdqns_ice_b(ji) - zkappa_i(ji,0) * zg1 482 482 ztrid (ji,jm_min(ji),3) = zkappa_i(ji,0) * zg1 483 483 zindterm(ji,jm_min(ji)) = zdqns_ice_b(ji) * t_su_1d(ji) - zfnet(ji) 484 484 485 485 ! first layer of ice equation 486 486 ztrid (ji,jm_min(ji)+1,1) = - zeta_i(ji,1) * zkappa_i(ji,0) * zg1 487 487 ztrid (ji,jm_min(ji)+1,2) = 1._wp + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 ) 488 ztrid (ji,jm_min(ji)+1,3) = - zeta_i(ji,1) * zkappa_i(ji,1) 489 zindterm(ji,jm_min(ji)+1) = ztiold(ji,1) + zeta_i(ji,1) * zradab_i(ji,1) 490 488 ztrid (ji,jm_min(ji)+1,3) = - zeta_i(ji,1) * zkappa_i(ji,1) 489 zindterm(ji,jm_min(ji)+1) = ztiold(ji,1) + zeta_i(ji,1) * zradab_i(ji,1) 490 491 491 ! case of only one layer in the ice (surface & ice equations are altered) 492 492 IF( nlay_i == 1 ) THEN … … 499 499 zindterm(ji,jm_min(ji)+1) = ztiold(ji,1) + zeta_i(ji,1) * (zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji)) 500 500 ENDIF 501 501 502 502 ELSE !-- case 2 : surface is melting 503 503 504 504 jm_min(ji) = nlay_s + 2 505 505 jm_max(ji) = nlay_i + nlay_s + 1 506 506 507 507 ! first layer of ice equation 508 508 ztrid (ji,jm_min(ji),1) = 0._wp 509 ztrid (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 ) 509 ztrid (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 ) 510 510 ztrid (ji,jm_min(ji),3) = - zeta_i(ji,1) * zkappa_i(ji,1) 511 zindterm(ji,jm_min(ji)) = ztiold(ji,1) + zeta_i(ji,1) * (zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji)) 512 511 zindterm(ji,jm_min(ji)) = ztiold(ji,1) + zeta_i(ji,1) * (zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji)) 512 513 513 ! case of only one layer in the ice (surface & ice equations are altered) 514 514 IF( nlay_i == 1 ) THEN … … 519 519 & + t_su_1d(ji) * zeta_i(ji,1) * zkappa_i(ji,0) * 2._wp 520 520 ENDIF 521 521 522 522 ENDIF 523 523 ENDIF … … 533 533 ! Solve the tridiagonal system with Gauss elimination method. 534 534 ! Thomas algorithm, from Computational fluid Dynamics, J.D. ANDERSON, McGraw-Hill 1984 535 jm_maxt = 0 536 jm_mint = nlay_i+5 537 DO ji = 1, npti 538 jm_mint = MIN(jm_min(ji),jm_mint) 539 jm_maxt = MAX(jm_max(ji),jm_maxt) 540 END DO 541 542 DO jk = jm_mint+1, jm_maxt 543 DO ji = 1, npti 544 jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 535 !!$ jm_maxt = 0 536 !!$ jm_mint = nlay_i+5 537 !!$ DO ji = 1, npti 538 !!$ jm_mint = MIN(jm_min(ji),jm_mint) 539 !!$ jm_maxt = MAX(jm_max(ji),jm_maxt) 540 !!$ END DO 541 !!$ !!clem SNWLAY => check why LIM1D does not get this loop. Is nlay_i+5 correct? 542 !!$ 543 !!$ DO jk = jm_mint+1, jm_maxt 544 !!$ DO ji = 1, npti 545 !!$ jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 546 !!$ zdiagbis(ji,jm) = ztrid (ji,jm,2) - ztrid(ji,jm,1) * ztrid (ji,jm-1,3) / zdiagbis(ji,jm-1) 547 !!$ zindtbis(ji,jm) = zindterm(ji,jm ) - ztrid(ji,jm,1) * zindtbis(ji,jm-1 ) / zdiagbis(ji,jm-1) 548 !!$ END DO 549 !!$ END DO 550 ! clem: maybe one should find a way to reverse this loop for mpi performance 551 DO ji = 1, npti 552 jm_mint = jm_min(ji) 553 jm_maxt = jm_max(ji) 554 DO jm = jm_mint+1, jm_maxt 545 555 zdiagbis(ji,jm) = ztrid (ji,jm,2) - ztrid(ji,jm,1) * ztrid (ji,jm-1,3) / zdiagbis(ji,jm-1) 546 556 zindtbis(ji,jm) = zindterm(ji,jm ) - ztrid(ji,jm,1) * zindtbis(ji,jm-1 ) / zdiagbis(ji,jm-1) … … 564 574 END DO 565 575 576 ! snow temperatures 566 577 DO ji = 1, npti 567 578 ! Variables used after iterations 568 579 ! Value must be frozen after convergence for MPP independance reason 569 IF ( .NOT. l_T_converged(ji) ) THEN 570 ! snow temperatures 571 IF( h_s_1d(ji) > 0._wp ) THEN 572 t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 573 ENDIF 574 ! surface temperature 580 IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 581 & t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 582 END DO 583 !!clem SNWLAY 584 DO jm = nlay_s, 2, -1 585 DO ji = 1, npti 586 jk = jm - 1 587 IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 588 & t_s_1d(ji,jk) = ( zindtbis(ji,jm) - ztrid(ji,jm,3) * t_s_1d(ji,jk+1) ) / zdiagbis(ji,jm) 589 END DO 590 END DO 591 592 ! surface temperature 593 DO ji = 1, npti 594 IF( .NOT. l_T_converged(ji) ) THEN 575 595 ztsub(ji) = t_su_1d(ji) 576 596 IF( t_su_1d(ji) < rt0 ) THEN 577 t_su_1d(ji) = ( 578 & ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) *t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji))597 t_su_1d(ji) = ( zindtbis(ji,jm_min(ji)) - ztrid(ji,jm_min(ji),3) * & 598 & ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji)) 579 599 ENDIF 580 600 ENDIF 581 601 END DO 582 !clem: in order to have several layers of snow, there is a missing loop here for t_s_1d(1:nlay_s-1)583 602 ! 584 603 !-------------------------------------------------------------- … … 609 628 zdti_max = MAX( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) ) 610 629 END DO 611 630 612 631 ! convergence test 613 632 IF( ln_zdf_chkcvg ) THEN … … 646 665 zdiagbis(1:npti,:) = 0._wp 647 666 648 DO jm = nlay_s + 2, nlay_s + nlay_i 667 DO jm = nlay_s + 2, nlay_s + nlay_i 649 668 DO ji = 1, npti 650 669 jk = jm - nlay_s - 1 … … 659 678 DO ji = 1, npti 660 679 ! ice bottom term 661 ztrid (ji,jm,1) = - zeta_i(ji,nlay_i) * zkappa_i(ji,nlay_i-1) 680 ztrid (ji,jm,1) = - zeta_i(ji,nlay_i) * zkappa_i(ji,nlay_i-1) 662 681 ztrid (ji,jm,2) = 1._wp + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i-1) + zkappa_i(ji,nlay_i) * zg1 ) 663 682 ztrid (ji,jm,3) = 0._wp 664 683 zindterm(ji,jm) = ztiold(ji,nlay_i) + zeta_i(ji,nlay_i) * & 665 & ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) ) 684 & ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) ) 666 685 ENDDO 667 686 … … 678 697 zindterm(ji,jm) = ztsold(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk) 679 698 END DO 680 699 681 700 ! case of only one layer in the ice (ice equation is altered) 682 701 IF ( nlay_i == 1 ) THEN 683 702 ztrid (ji,nlay_s+2,3) = 0._wp 684 zindterm(ji,nlay_s+2) = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji) 685 ENDIF 686 703 zindterm(ji,nlay_s+2) = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji) 704 ENDIF 705 687 706 jm_min(ji) = 2 688 707 jm_max(ji) = nlay_i + nlay_s + 1 689 708 690 709 ! first layer of snow equation 691 710 ztrid (ji,2,1) = 0._wp 692 711 ztrid (ji,2,2) = 1._wp + zeta_s(ji,1) * zkappa_s(ji,1) 693 ztrid (ji,2,3) = - zeta_s(ji,1) * zkappa_s(ji,1) 694 zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) * ( zradab_s(ji,1) + qcn_ice_1d(ji) ) 695 712 ztrid (ji,2,3) = - zeta_s(ji,1) * zkappa_s(ji,1) 713 zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) * ( zradab_s(ji,1) + qcn_ice_1d(ji) ) 714 696 715 ! !---------------------! 697 716 ELSE ! cells without snow ! … … 699 718 jm_min(ji) = nlay_s + 2 700 719 jm_max(ji) = nlay_i + nlay_s + 1 701 720 702 721 ! first layer of ice equation 703 722 ztrid (ji,jm_min(ji),1) = 0._wp 704 ztrid (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * zkappa_i(ji,1) 723 ztrid (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * zkappa_i(ji,1) 705 724 ztrid (ji,jm_min(ji),3) = - zeta_i(ji,1) * zkappa_i(ji,1) 706 725 zindterm(ji,jm_min(ji)) = ztiold(ji,1) + zeta_i(ji,1) * ( zradab_i(ji,1) + qcn_ice_1d(ji) ) 707 726 708 727 ! case of only one layer in the ice (surface & ice equations are altered) 709 728 IF( nlay_i == 1 ) THEN … … 714 733 & ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) + qcn_ice_1d(ji) ) 715 734 ENDIF 716 735 717 736 ENDIF 718 737 ! … … 727 746 ! Solve the tridiagonal system with Gauss elimination method. 728 747 ! Thomas algorithm, from Computational fluid Dynamics, J.D. ANDERSON, McGraw-Hill 1984 729 jm_maxt = 0 730 jm_mint = nlay_i+5 731 DO ji = 1, npti 732 jm_mint = MIN(jm_min(ji),jm_mint) 733 jm_maxt = MAX(jm_max(ji),jm_maxt) 734 END DO 735 736 DO jk = jm_mint+1, jm_maxt 737 DO ji = 1, npti 738 jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 748 !!$ jm_maxt = 0 749 !!$ jm_mint = nlay_i+5 750 !!$ DO ji = 1, npti 751 !!$ jm_mint = MIN(jm_min(ji),jm_mint) 752 !!$ jm_maxt = MAX(jm_max(ji),jm_maxt) 753 !!$ END DO 754 !!$ 755 !!$ DO jk = jm_mint+1, jm_maxt 756 !!$ DO ji = 1, npti 757 !!$ jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 758 !!$ zdiagbis(ji,jm) = ztrid (ji,jm,2) - ztrid(ji,jm,1) * ztrid (ji,jm-1,3) / zdiagbis(ji,jm-1) 759 !!$ zindtbis(ji,jm) = zindterm(ji,jm) - ztrid(ji,jm,1) * zindtbis(ji,jm-1) / zdiagbis(ji,jm-1) 760 !!$ END DO 761 !!$ END DO 762 ! clem: maybe one should find a way to reverse this loop for mpi performance 763 DO ji = 1, npti 764 jm_mint = jm_min(ji) 765 jm_maxt = jm_max(ji) 766 DO jm = jm_mint+1, jm_maxt 739 767 zdiagbis(ji,jm) = ztrid (ji,jm,2) - ztrid(ji,jm,1) * ztrid (ji,jm-1,3) / zdiagbis(ji,jm-1) 740 zindtbis(ji,jm) = zindterm(ji,jm ) - ztrid(ji,jm,1) * zindtbis(ji,jm-1)/ zdiagbis(ji,jm-1)768 zindtbis(ji,jm) = zindterm(ji,jm ) - ztrid(ji,jm,1) * zindtbis(ji,jm-1 ) / zdiagbis(ji,jm-1) 741 769 END DO 742 770 END DO 743 771 744 772 ! ice temperatures 745 773 DO ji = 1, npti … … 758 786 END DO 759 787 END DO 760 761 ! snow temperatures 762 DO ji = 1, npti 763 ! Variable used after iterations788 789 ! snow temperatures 790 DO ji = 1, npti 791 ! Variables used after iterations 764 792 ! Value must be frozen after convergence for MPP independance reason 765 IF ( .NOT. l_T_converged(ji) ) THEN 766 IF( h_s_1d(ji) > 0._wp ) THEN 767 t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 768 ENDIF 769 ENDIF 770 END DO 771 !clem: in order to have several layers of snow, there is a missing loop here for t_s_1d(1:nlay_s-1) 793 IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 794 & t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 795 END DO 796 !!clem SNWLAY 797 DO jm = nlay_s, 2, -1 798 DO ji = 1, npti 799 jk = jm - 1 800 IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 801 & t_s_1d(ji,jk) = ( zindtbis(ji,jm) - ztrid(ji,jm,3) * t_s_1d(ji,jk+1) ) / zdiagbis(ji,jm) 802 END DO 803 END DO 772 804 ! 773 805 !-------------------------------------------------------------- … … 791 823 792 824 DO jk = 1, nlay_i 793 ztmelts = -rTmlt * sz_i_1d(ji,jk) + rt0 825 ztmelts = -rTmlt * sz_i_1d(ji,jk) + rt0 794 826 t_i_1d(ji,jk) = MAX( MIN( t_i_1d(ji,jk), ztmelts ), rt0 - 100._wp ) 795 827 zdti_max = MAX ( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) ) … … 853 885 ! 854 886 DO ji = 1, npti 855 hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji) - zqns_ice_b(ji) ) * a_i_1d(ji) 887 hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji) - zqns_ice_b(ji) ) * a_i_1d(ji) 856 888 END DO 857 889 ! … … 861 893 ! 862 894 IF( k_cnd == np_cnd_OFF .OR. k_cnd == np_cnd_ON ) THEN 863 864 CALL ice_var_enthalpy 865 895 896 CALL ice_var_enthalpy 897 866 898 ! zhfx_err = correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation 867 899 DO ji = 1, npti 868 900 zdq = - zq_ini(ji) + ( SUM( e_i_1d(ji,1:nlay_i) ) * h_i_1d(ji) * r1_nlay_i + & 869 901 & SUM( e_s_1d(ji,1:nlay_s) ) * h_s_1d(ji) * r1_nlay_s ) 870 902 871 903 IF( k_cnd == np_cnd_OFF ) THEN 872 904 873 905 IF( t_su_1d(ji) < rt0 ) THEN ! case T_su < 0degC 874 906 zhfx_err = ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji) & … … 878 910 & + zdq * r1_Dt_ice ) * a_i_1d(ji) 879 911 ENDIF 880 912 881 913 ELSEIF( k_cnd == np_cnd_ON ) THEN 882 914 883 915 zhfx_err = ( qcn_ice_top_1d(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji) & 884 916 & + zdq * r1_Dt_ice ) * a_i_1d(ji) 885 917 886 918 ENDIF 887 919 ! … … 889 921 hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err 890 922 ! 891 ! hfx_dif = Heat flux diagnostic of sensible heat used to warm/cool ice in W.m-2 923 ! hfx_dif = Heat flux diagnostic of sensible heat used to warm/cool ice in W.m-2 892 924 hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_Dt_ice * a_i_1d(ji) 893 925 ! … … 920 952 ! --- SIMIP diagnostics 921 953 ! 922 DO ji = 1, npti 954 DO ji = 1, npti 923 955 !--- Snow-ice interfacial temperature (diagnostic SIMIP) 924 956 IF( h_s_1d(ji) >= zhs_ssl ) THEN 925 t_si_1d(ji) = ( rn_cnd_s * h_i_1d(ji) * r1_nlay_i * t_s_1d(ji, 1) &926 & + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s * t_i_1d(ji,1) ) &957 t_si_1d(ji) = ( rn_cnd_s * h_i_1d(ji) * r1_nlay_i * t_s_1d(ji,nlay_s) & 958 & + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s * t_i_1d(ji,1) ) & 927 959 & / ( rn_cnd_s * h_i_1d(ji) * r1_nlay_i & 928 960 & + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s ) -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/iceupdate.F90
r13643 r14021 67 67 !!------------------------------------------------------------------- 68 68 !! *** ROUTINE ice_update_flx *** 69 !! 70 !! ** Purpose : Update the surface ocean boundary condition for heat 69 !! 70 !! ** Purpose : Update the surface ocean boundary condition for heat 71 71 !! salt and mass over areas where sea-ice is non-zero 72 !! 72 !! 73 73 !! ** Action : - computes the heat and freshwater/salt fluxes 74 74 !! at the ice-ocean interface. 75 75 !! - Update the ocean sbc 76 !! 77 !! ** Outputs : - qsr : sea heat flux: solar 76 !! 77 !! ** Outputs : - qsr : sea heat flux: solar 78 78 !! - qns : sea heat flux: non solar 79 !! - emp : freshwater budget: volume flux 80 !! - sfx : salt flux 79 !! - emp : freshwater budget: volume flux 80 !! - sfx : salt flux 81 81 !! - fr_i : ice fraction 82 82 !! - tn_ice : sea-ice surface temperature … … 94 94 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 95 95 !!--------------------------------------------------------------------- 96 IF( ln_timing ) CALL timing_start('ice _update')96 IF( ln_timing ) CALL timing_start('iceupdate') 97 97 98 98 IF( kt == nit000 .AND. lwp ) THEN … … 104 104 ! Net heat flux on top of the ice-ocean (W.m-2) 105 105 !---------------------------------------------- 106 qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:) 106 qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:) 107 107 108 108 ! --- case we bypass ice thermodynamics --- ! … … 114 114 qevap_ice (:,:,:) = 0._wp 115 115 ENDIF 116 116 117 117 DO_2D( 1, 1, 1, 1 ) 118 118 119 ! Solar heat flux reaching the ocean (max) = zqsr (W.m-2) 119 ! Solar heat flux reaching the ocean (max) = zqsr (W.m-2) 120 120 !--------------------------------------------------- 121 121 zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 122 122 123 ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 123 ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 124 124 !--------------------------------------------------- 125 125 qt_oce_ai(ji,jj) = qt_atm_oi(ji,jj) - hfx_sum(ji,jj) - hfx_bom(ji,jj) - hfx_bog(ji,jj) & 126 126 & - hfx_dif(ji,jj) - hfx_opw(ji,jj) - hfx_snw(ji,jj) & 127 127 & + hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) & 128 & + hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) + hfx_spr(ji,jj) 129 128 & + hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) + hfx_spr(ji,jj) 129 130 130 ! New qsr and qns used to compute the oceanic heat flux at the next time step 131 131 !---------------------------------------------------------------------------- … … 144 144 ! 145 145 ! the non-solar is simply derived from the solar flux 146 qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr 147 148 ! Mass flux at the atm. surface 146 qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr 147 148 ! Mass flux at the atm. surface 149 149 !----------------------------------- 150 150 wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) 151 151 152 ! Mass flux at the ocean surface 152 ! Mass flux at the ocean surface 153 153 !------------------------------------ 154 154 ! ice-ocean mass flux 155 155 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 156 & + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj)157 156 & + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) 157 158 158 ! snw-ocean mass flux 159 159 wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj) 160 160 161 161 ! total mass flux at the ocean/ice interface 162 fmmflx(ji,jj) = - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_ err_sub(ji,jj) ! ice-ocean mass flux saved at least for biogeochemical model163 emp (ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_ err_sub(ji,jj) ! atm-ocean + ice-ocean mass flux164 165 ! Salt flux at the ocean surface 162 fmmflx(ji,jj) = - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_pnd(ji,jj) - wfx_err_sub(ji,jj) ! ice-ocean mass flux saved at least for biogeochemical model 163 emp (ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_pnd(ji,jj) - wfx_err_sub(ji,jj) ! atm-ocean + ice-ocean mass flux 164 165 ! Salt flux at the ocean surface 166 166 !------------------------------------------ 167 167 sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj) & 168 168 & + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) 169 170 ! Mass of snow and ice per unit area 169 170 ! Mass of snow and ice per unit area 171 171 !---------------------------------------- 172 172 snwice_mass_b(ji,jj) = snwice_mass(ji,jj) ! save mass from the previous ice time step 173 173 ! ! new mass per unit area 174 snwice_mass (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) )174 snwice_mass (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) ) 175 175 ! ! time evolution of snow+ice mass 176 176 snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_Dt_ice 177 177 178 178 END_2D 179 179 180 180 ! Storing the transmitted variables 181 181 !---------------------------------- 182 fr_i (:,:) = at_i(:,:) ! Sea-ice fraction 183 tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature 182 fr_i (:,:) = at_i(:,:) ! Sea-ice fraction 183 tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature 184 184 185 185 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) … … 216 216 CALL iom_put( 'vfxice' , wfx_ice ) ! mass flux from total ice growth/melt 217 217 CALL iom_put( 'vfxbog' , wfx_bog ) ! mass flux from bottom growth 218 CALL iom_put( 'vfxbom' , wfx_bom ) ! mass flux from bottom melt 219 CALL iom_put( 'vfxsum' , wfx_sum ) ! mass flux from surface melt 220 CALL iom_put( 'vfxlam' , wfx_lam ) ! mass flux from lateral melt 218 CALL iom_put( 'vfxbom' , wfx_bom ) ! mass flux from bottom melt 219 CALL iom_put( 'vfxsum' , wfx_sum ) ! mass flux from surface melt 220 CALL iom_put( 'vfxlam' , wfx_lam ) ! mass flux from lateral melt 221 221 CALL iom_put( 'vfxsni' , wfx_sni ) ! mass flux from snow-ice formation 222 222 CALL iom_put( 'vfxopw' , wfx_opw ) ! mass flux from growth in open water 223 223 CALL iom_put( 'vfxdyn' , wfx_dyn ) ! mass flux from dynamics (ridging) 224 CALL iom_put( 'vfxres' , wfx_res ) ! mass flux from undiagnosed processes 224 CALL iom_put( 'vfxres' , wfx_res ) ! mass flux from undiagnosed processes 225 225 CALL iom_put( 'vfxpnd' , wfx_pnd ) ! mass flux from melt ponds 226 226 CALL iom_put( 'vfxsub' , wfx_ice_sub ) ! mass flux from ice sublimation (ice-atm.) 227 CALL iom_put( 'vfxsub_err', wfx_err_sub ) ! "excess" of sublimation sent to ocean 228 229 IF ( iom_use( 'vfxthin' ) ) THEN ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations 227 CALL iom_put( 'vfxsub_err', wfx_err_sub ) ! "excess" of sublimation sent to ocean 228 229 IF ( iom_use( 'vfxthin' ) ) THEN ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations 230 230 WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog 231 231 ELSEWHERE ; z2d = 0._wp … … 237 237 CALL iom_put( 'vfxsnw' , wfx_snw ) ! mass flux from total snow growth/melt 238 238 CALL iom_put( 'vfxsnw_sum' , wfx_snw_sum ) ! mass flux from snow melt at the surface 239 CALL iom_put( 'vfxsnw_sni' , wfx_snw_sni ) ! mass flux from snow melt during snow-ice formation 240 CALL iom_put( 'vfxsnw_dyn' , wfx_snw_dyn ) ! mass flux from dynamics (ridging) 241 CALL iom_put( 'vfxsnw_sub' , wfx_snw_sub ) ! mass flux from snow sublimation (ice-atm.) 239 CALL iom_put( 'vfxsnw_sni' , wfx_snw_sni ) ! mass flux from snow melt during snow-ice formation 240 CALL iom_put( 'vfxsnw_dyn' , wfx_snw_dyn ) ! mass flux from dynamics (ridging) 241 CALL iom_put( 'vfxsnw_sub' , wfx_snw_sub ) ! mass flux from snow sublimation (ice-atm.) 242 242 CALL iom_put( 'vfxsnw_pre' , wfx_spr ) ! snow precip 243 243 … … 252 252 IF( iom_use('qt_oce' ) ) CALL iom_put( 'qt_oce' , ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) 253 253 IF( iom_use('qt_ice' ) ) CALL iom_put( 'qt_ice' , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 ) + qemp_ice ) 254 IF( iom_use('qt_oce_ai' ) ) CALL iom_put( 'qt_oce_ai' , qt_oce_ai * tmask(:,:,1) ) ! total heat flux at the ocean surface: interface oce-(ice+atm) 255 IF( iom_use('qt_atm_oi' ) ) CALL iom_put( 'qt_atm_oi' , qt_atm_oi * tmask(:,:,1) ) ! total heat flux at the oce-ice surface: interface atm-(ice+oce) 254 IF( iom_use('qt_oce_ai' ) ) CALL iom_put( 'qt_oce_ai' , qt_oce_ai * tmask(:,:,1) ) ! total heat flux at the ocean surface: interface oce-(ice+atm) 255 IF( iom_use('qt_atm_oi' ) ) CALL iom_put( 'qt_atm_oi' , qt_atm_oi * tmask(:,:,1) ) ! total heat flux at the oce-ice surface: interface atm-(ice+oce) 256 256 IF( iom_use('qemp_oce' ) ) CALL iom_put( 'qemp_oce' , qemp_oce ) ! Downward Heat Flux from E-P over ocean 257 257 IF( iom_use('qemp_ice' ) ) CALL iom_put( 'qemp_ice' , qemp_ice ) ! Downward Heat Flux from E-P over ice … … 259 259 ! heat fluxes from ice transformations 260 260 ! ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr ) 261 CALL iom_put ('hfxbog' , hfx_bog ) ! heat flux used for ice bottom growth 261 CALL iom_put ('hfxbog' , hfx_bog ) ! heat flux used for ice bottom growth 262 262 CALL iom_put ('hfxbom' , hfx_bom ) ! heat flux used for ice bottom melt 263 263 CALL iom_put ('hfxsum' , hfx_sum ) ! heat flux used for ice surface melt 264 264 CALL iom_put ('hfxopw' , hfx_opw ) ! heat flux used for ice formation in open water 265 265 CALL iom_put ('hfxdif' , hfx_dif ) ! heat flux used for ice temperature change 266 CALL iom_put ('hfxsnw' , hfx_snw ) ! heat flux used for snow melt 266 CALL iom_put ('hfxsnw' , hfx_snw ) ! heat flux used for snow melt 267 267 CALL iom_put ('hfxerr' , hfx_err_dif ) ! heat flux error after heat diffusion 268 268 269 269 ! heat fluxes associated with mass exchange (freeze/melt/precip...) 270 CALL iom_put ('hfxthd' , hfx_thd ) ! 271 CALL iom_put ('hfxdyn' , hfx_dyn ) ! 272 CALL iom_put ('hfxres' , hfx_res ) ! 273 CALL iom_put ('hfxsub' , hfx_sub ) ! 274 CALL iom_put ('hfxspr' , hfx_spr ) ! Heat flux from snow precip heat content 270 CALL iom_put ('hfxthd' , hfx_thd ) ! 271 CALL iom_put ('hfxdyn' , hfx_dyn ) ! 272 CALL iom_put ('hfxres' , hfx_res ) ! 273 CALL iom_put ('hfxsub' , hfx_sub ) ! 274 CALL iom_put ('hfxspr' , hfx_spr ) ! Heat flux from snow precip heat content 275 275 276 276 ! other heat fluxes … … 286 286 IF( ln_icectl ) CALL ice_prt (kt, iiceprt, jiceprt, 3, 'Final state ice_update') ! prints 287 287 IF( sn_cfctl%l_prtctl ) CALL ice_prt3D ('iceupdate') ! prints 288 IF( ln_timing ) CALL timing_stop ('ice _update')! timing288 IF( ln_timing ) CALL timing_stop ('iceupdate') ! timing 289 289 ! 290 290 END SUBROUTINE ice_update_flx … … 294 294 !!------------------------------------------------------------------- 295 295 !! *** ROUTINE ice_update_tau *** 296 !! 296 !! 297 297 !! ** Purpose : Update the ocean surface stresses due to the ice 298 !! 298 !! 299 299 !! ** Action : * at each ice time step (every nn_fsbc time step): 300 !! - compute the modulus of ice-ocean relative velocity 300 !! - compute the modulus of ice-ocean relative velocity 301 301 !! (*rho*Cd) at T-point (C-grid) or I-point (B-grid) 302 302 !! tmod_io = rhoco * | U_ice-U_oce | 303 303 !! - update the modulus of stress at ocean surface 304 304 !! taum = (1-a) * taum + a * tmod_io * | U_ice-U_oce | 305 !! * at each ocean time step (every kt): 305 !! * at each ocean time step (every kt): 306 306 !! compute linearized ice-ocean stresses as 307 307 !! Utau = tmod_io * | U_ice - pU_oce | … … 310 310 !! NB: - ice-ocean rotation angle no more allowed 311 311 !! - here we make an approximation: taum is only computed every ice time step 312 !! This avoids mutiple average to pass from T -> U,V grids and next from U,V grids 312 !! This avoids mutiple average to pass from T -> U,V grids and next from U,V grids 313 313 !! to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton... 314 314 !! … … 324 324 REAL(wp) :: zflagi ! - - 325 325 !!--------------------------------------------------------------------- 326 IF( ln_timing ) CALL timing_start('ice_update _tau')326 IF( ln_timing ) CALL timing_start('ice_update') 327 327 328 328 IF( kt == nit000 .AND. lwp ) THEN … … 337 337 DO_2D( 0, 0, 0, 0 ) !* update the modulus of stress at ocean surface (T-point) 338 338 ! ! 2*(U_ice-U_oce) at T-point 339 zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) 340 zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 339 zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) 340 zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 341 341 ! ! |U_ice-U_oce|^2 342 342 zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t ) … … 354 354 ! !== every ocean time-step ==! 355 355 IF ( ln_drgice_imp ) THEN 356 ! Save drag with right sign to update top drag in the ocean implicit friction 357 rCdU_ice(:,:) = -r1_rho0 * tmod_io(:,:) * at_i(:,:) * tmask(:,:,1) 356 ! Save drag with right sign to update top drag in the ocean implicit friction 357 rCdU_ice(:,:) = -r1_rho0 * tmod_io(:,:) * at_i(:,:) * tmask(:,:,1) 358 358 zflagi = 0._wp 359 359 ELSE … … 362 362 ! 363 363 DO_2D( 0, 0, 0, 0 ) !* update the stress WITHOUT an ice-ocean rotation angle 364 ! ice area at u and v-points 364 ! ice area at u and v-points 365 365 zat_u = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj ) * tmask(ji+1,jj ,1) ) & 366 366 & / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj ,1) ) … … 376 376 CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp ) ! lateral boundary condition 377 377 ! 378 IF( ln_timing ) CALL timing_stop('ice_update _tau')379 ! 378 IF( ln_timing ) CALL timing_stop('ice_update') 379 ! 380 380 END SUBROUTINE ice_update_tau 381 381 … … 384 384 !!------------------------------------------------------------------- 385 385 !! *** ROUTINE ice_update_init *** 386 !! 386 !! 387 387 !! ** Purpose : allocate ice-ocean stress fields and read restarts 388 388 !! containing the snow & ice mass … … 408 408 !!--------------------------------------------------------------------- 409 409 !! *** ROUTINE rhg_evp_rst *** 410 !! 410 !! 411 411 !! ** Purpose : Read or write RHG file in restart file 412 412 !! … … 456 456 !! Default option Dummy module NO SI3 sea-ice model 457 457 !!---------------------------------------------------------------------- 458 #endif 458 #endif 459 459 460 460 !!====================================================================== -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icevar.F90
r13472 r14021 34 34 !! - st_i(jpi,jpj) 35 35 !! - et_s(jpi,jpj) total snow heat content 36 !! - et_i(jpi,jpj) total ice thermal content 36 !! - et_i(jpi,jpj) total ice thermal content 37 37 !! - sm_i(jpi,jpj) mean ice salinity 38 38 !! - tm_i(jpi,jpj) mean ice temperature … … 55 55 !!---------------------------------------------------------------------- 56 56 USE dom_oce ! ocean space and time domain 57 USE phycst ! physical constants (ocean directory) 57 USE phycst ! physical constants (ocean directory) 58 58 USE sbc_oce , ONLY : sss_m, ln_ice_embd, nn_fsbc 59 59 USE ice ! sea-ice: variables … … 67 67 PRIVATE 68 68 69 PUBLIC ice_var_agg 70 PUBLIC ice_var_glo2eqv 71 PUBLIC ice_var_eqv2glo 72 PUBLIC ice_var_salprof 73 PUBLIC ice_var_salprof1d 69 PUBLIC ice_var_agg 70 PUBLIC ice_var_glo2eqv 71 PUBLIC ice_var_eqv2glo 72 PUBLIC ice_var_salprof 73 PUBLIC ice_var_salprof1d 74 74 PUBLIC ice_var_zapsmall 75 75 PUBLIC ice_var_zapneg 76 76 PUBLIC ice_var_roundoff 77 PUBLIC ice_var_bv 78 PUBLIC ice_var_enthalpy 77 PUBLIC ice_var_bv 78 PUBLIC ice_var_enthalpy 79 79 PUBLIC ice_var_sshdyn 80 80 PUBLIC ice_var_itd … … 108 108 !! *** ROUTINE ice_var_agg *** 109 109 !! 110 !! ** Purpose : aggregates ice-thickness-category variables to 110 !! ** Purpose : aggregates ice-thickness-category variables to 111 111 !! all-ice variables, i.e. it turns VGLO into VAGG 112 112 !!------------------------------------------------------------------- … … 130 130 vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) 131 131 ! 132 ato_i(:,:) = 1._wp - at_i(:,:) ! open water fraction 132 ato_i(:,:) = 1._wp - at_i(:,:) ! open water fraction 133 133 ! 134 134 !!GS: tm_su always needed by ABL over sea-ice … … 155 155 hm_i(:,:) = vt_i(:,:) * z1_at_i(:,:) 156 156 hm_s(:,:) = vt_s(:,:) * z1_at_i(:,:) 157 ! 157 ! 158 158 ! ! mean temperature (K), salinity and age 159 159 tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) … … 182 182 WHERE( at_ip(:,:) > epsi20 ) ; hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) ; hm_il(:,:) = vt_il(:,:) / at_ip(:,:) 183 183 ELSEWHERE ; hm_ip(:,:) = 0._wp ; hm_il(:,:) = 0._wp 184 END WHERE 184 END WHERE 185 185 ! 186 186 DEALLOCATE( z1_vt_i , z1_vt_s ) … … 197 197 !! *** ROUTINE ice_var_glo2eqv *** 198 198 !! 199 !! ** Purpose : computes equivalent variables as function of 199 !! ** Purpose : computes equivalent variables as function of 200 200 !! global variables, i.e. it turns VGLO into VEQV 201 201 !!------------------------------------------------------------------- … … 210 210 !!------------------------------------------------------------------- 211 211 212 !!gm Question 2: It is possible to define existence of sea-ice in a common way between 212 !!gm Question 2: It is possible to define existence of sea-ice in a common way between 213 213 !! ice area and ice volume ? 214 214 !! the idea is to be able to define one for all at the begining of this routine … … 234 234 235 235 zhmax = hi_max(jpl) 236 z1_zhmax = 1._wp / hi_max(jpl) 236 z1_zhmax = 1._wp / hi_max(jpl) 237 237 WHERE( h_i(:,:,jpl) > zhmax ) ! bound h_i by hi_max (i.e. 99 m) with associated update of ice area 238 h_i (:,:,jpl) = zhmax239 a_i (:,:,jpl) = v_i(:,:,jpl) * z1_zhmax 238 h_i (:,:,jpl) = zhmax 239 a_i (:,:,jpl) = v_i(:,:,jpl) * z1_zhmax 240 240 z1_a_i(:,:,jpl) = zhmax * z1_v_i(:,:,jpl) 241 241 END WHERE 242 242 ! !--- snow thickness 243 243 h_s(:,:,:) = v_s (:,:,:) * z1_a_i(:,:,:) 244 ! !--- ice age 244 ! !--- ice age 245 245 o_i(:,:,:) = oa_i(:,:,:) * z1_a_i(:,:,:) 246 ! !--- pond and lid thickness 246 ! !--- pond and lid thickness 247 247 h_ip(:,:,:) = v_ip(:,:,:) * z1_a_ip(:,:,:) 248 248 h_il(:,:,:) = v_il(:,:,:) * z1_a_ip(:,:,:) … … 252 252 ELSEWHERE( h_il(:,:,:) >= zhl_max ) ; a_ip_eff(:,:,:) = 0._wp ! lid is very thick. Cover all the pond up with ice and snow 253 253 ELSEWHERE ; a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * & ! lid is in between. Expose part of the pond 254 & ( h_il(:,:,:) - zhl_min) / ( zhl_max - zhl_min )254 & ( zhl_max - h_il(:,:,:) ) / ( zhl_max - zhl_min ) 255 255 END WHERE 256 256 ! … … 258 258 a_ip_eff = MIN( a_ip_eff, 1._wp - za_s_fra ) ! make sure (a_ip_eff + a_s_fra) <= 1 259 259 ! 260 ! !--- salinity (with a minimum value imposed everywhere) 260 ! !--- salinity (with a minimum value imposed everywhere) 261 261 IF( nn_icesal == 2 ) THEN 262 262 WHERE( v_i(:,:,:) > epsi20 ) ; s_i(:,:,:) = MAX( rn_simin , MIN( rn_simax, sv_i(:,:,:) * z1_v_i(:,:,:) ) ) … … 272 272 DO jl = 1, jpl 273 273 DO_3D( 1, 1, 1, 1, 1, nlay_i ) 274 IF ( v_i(ji,jj,jl) > epsi20 ) THEN !--- icy area 274 IF ( v_i(ji,jj,jl) > epsi20 ) THEN !--- icy area 275 275 ! 276 276 ze_i = e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i ! Energy of melting e(S,T) [J.m-3] … … 300 300 END DO 301 301 ! 302 ! integrated values 302 ! integrated values 303 303 vt_i (:,:) = SUM( v_i , dim=3 ) 304 304 vt_s (:,:) = SUM( v_s , dim=3 ) … … 312 312 !! *** ROUTINE ice_var_eqv2glo *** 313 313 !! 314 !! ** Purpose : computes global variables as function of 314 !! ** Purpose : computes global variables as function of 315 315 !! equivalent variables, i.e. it turns VEQV into VGLO 316 316 !!------------------------------------------------------------------- … … 329 329 !! *** ROUTINE ice_var_salprof *** 330 330 !! 331 !! ** Purpose : computes salinity profile in function of bulk salinity 332 !! 333 !! ** Method : If bulk salinity greater than zsi1, 331 !! ** Purpose : computes salinity profile in function of bulk salinity 332 !! 333 !! ** Method : If bulk salinity greater than zsi1, 334 334 !! the profile is assumed to be constant (S_inf) 335 335 !! If bulk salinity lower than zsi0, … … 348 348 !!------------------------------------------------------------------- 349 349 350 !!gm Question: Remove the option 3 ? How many years since it last use ? 350 !!gm Question: Remove the option 3 ? How many years since it last use ? 351 351 352 352 SELECT CASE ( nn_icesal ) … … 369 369 END DO 370 370 END DO 371 ! ! Slope of the linear profile 371 ! ! Slope of the linear profile 372 372 WHERE( h_i(:,:,:) > epsi20 ) ; z_slope_s(:,:,:) = 2._wp * s_i(:,:,:) / h_i(:,:,:) 373 373 ELSEWHERE ; z_slope_s(:,:,:) = 0._wp … … 379 379 zalpha(ji,jj,jl) = MAX( 0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp ) ) 380 380 ! ! force a constant profile when SSS too low (Baltic Sea) 381 IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) ) zalpha(ji,jj,jl) = 0._wp 381 IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) ) zalpha(ji,jj,jl) = 0._wp 382 382 END_2D 383 383 END DO … … 448 448 ALLOCATE( z_slope_s(jpij), zalpha(jpij) ) 449 449 ! 450 ! ! Slope of the linear profile 450 ! ! Slope of the linear profile 451 451 WHERE( h_i_1d(1:npti) > epsi20 ) ; z_slope_s(1:npti) = 2._wp * s_i_1d(1:npti) / h_i_1d(1:npti) 452 452 ELSEWHERE ; z_slope_s(1:npti) = 0._wp 453 453 END WHERE 454 454 455 455 z1_dS = 1._wp / ( zsi1 - zsi0 ) 456 456 DO ji = 1, npti … … 534 534 DO_2D( 1, 1, 1, 1 ) 535 535 ! update exchanges with ocean 536 sfx_res(ji,jj) = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl) * rhoi * r1_Dt_ice 537 wfx_res(ji,jj) = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl) * rhoi * r1_Dt_ice 538 wfx_res(ji,jj) = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl) * rhos * r1_Dt_ice 536 sfx_res(ji,jj) = sfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl) * rhoi * r1_Dt_ice 537 wfx_res(ji,jj) = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl) * rhoi * r1_Dt_ice 538 wfx_res(ji,jj) = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl) * rhos * r1_Dt_ice 539 wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * ( v_ip(ji,jj,jl)+v_il(ji,jj,jl) ) * rhow * r1_Dt_ice 539 540 ! 540 541 a_i (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj) … … 551 552 v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 552 553 v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 554 h_ip (ji,jj,jl) = h_ip (ji,jj,jl) * zswitch(ji,jj) 555 h_il (ji,jj,jl) = h_il (ji,jj,jl) * zswitch(ji,jj) 553 556 ! 554 557 END_2D 555 558 ! 556 END DO 559 END DO 557 560 558 561 ! to be sure that at_i is the sum of a_i(jl) … … 635 638 psv_i (ji,jj,jl) = 0._wp 636 639 ENDIF 640 IF( pv_ip(ji,jj,jl) < 0._wp .OR. pv_il(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN 641 wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + pv_il(ji,jj,jl) * rhow * z1_dt 642 pv_il (ji,jj,jl) = 0._wp 643 ENDIF 644 IF( pv_ip(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN 645 wfx_pnd(ji,jj) = wfx_pnd(ji,jj) + pv_ip(ji,jj,jl) * rhow * z1_dt 646 pv_ip (ji,jj,jl) = 0._wp 647 ENDIF 637 648 END_2D 638 649 ! 639 END DO 650 END DO 640 651 ! 641 652 WHERE( pato_i(:,:) < 0._wp ) pato_i(:,:) = 0._wp … … 643 654 WHERE( pa_i (:,:,:) < 0._wp ) pa_i (:,:,:) = 0._wp 644 655 WHERE( pa_ip (:,:,:) < 0._wp ) pa_ip (:,:,:) = 0._wp 645 WHERE( pv_ip (:,:,:) < 0._wp ) pv_ip (:,:,:) = 0._wp ! in theory one should change wfx_pnd(-) and wfx_sum(+)646 WHERE( pv_il (:,:,:) < 0._wp ) pv_il (:,:,:) = 0._wp ! but it does not change conservation, so keep it this way is ok647 656 ! 648 657 END SUBROUTINE ice_var_zapneg … … 675 684 WHERE( pe_i (1:npti,:,:) < 0._wp ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0 676 685 WHERE( pe_s (1:npti,:,:) < 0._wp ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0 677 IF( ln_pnd_LEV ) THEN686 IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 678 687 WHERE( pa_ip(1:npti,:) < 0._wp ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0 679 688 WHERE( pv_ip(1:npti,:) < 0._wp ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0 … … 684 693 ! 685 694 END SUBROUTINE ice_var_roundoff 686 695 687 696 688 697 SUBROUTINE ice_var_bv … … 704 713 DO jl = 1, jpl 705 714 DO jk = 1, nlay_i 706 WHERE( t_i(:,:,jk,jl) < rt0 - epsi10 ) 715 WHERE( t_i(:,:,jk,jl) < rt0 - epsi10 ) 707 716 bv_i(:,:,jl) = bv_i(:,:,jl) - rTmlt * sz_i(:,:,jk,jl) * r1_nlay_i / ( t_i(:,:,jk,jl) - rt0 ) 708 717 END WHERE … … 718 727 SUBROUTINE ice_var_enthalpy 719 728 !!------------------------------------------------------------------- 720 !! *** ROUTINE ice_var_enthalpy *** 721 !! 729 !! *** ROUTINE ice_var_enthalpy *** 730 !! 722 731 !! ** Purpose : Computes sea ice energy of melting q_i (J.m-3) from temperature 723 732 !! … … 725 734 !!------------------------------------------------------------------- 726 735 INTEGER :: ji, jk ! dummy loop indices 727 REAL(wp) :: ztmelts ! local scalar 736 REAL(wp) :: ztmelts ! local scalar 728 737 !!------------------------------------------------------------------- 729 738 ! … … 732 741 ztmelts = - rTmlt * sz_i_1d(ji,jk) 733 742 t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts + rt0 ) ! Force t_i_1d to be lower than melting point => likely conservation issue 734 ! (sometimes zdf scheme produces abnormally high temperatures) 743 ! (sometimes zdf scheme produces abnormally high temperatures) 735 744 e_i_1d(ji,jk) = rhoi * ( rcpi * ( ztmelts - ( t_i_1d(ji,jk) - rt0 ) ) & 736 745 & + rLfus * ( 1._wp - ztmelts / ( t_i_1d(ji,jk) - rt0 ) ) & … … 746 755 END SUBROUTINE ice_var_enthalpy 747 756 748 757 749 758 FUNCTION ice_var_sshdyn(pssh, psnwice_mass, psnwice_mass_b) 750 759 !!--------------------------------------------------------------------- 751 760 !! *** ROUTINE ice_var_sshdyn *** 752 !! 761 !! 753 762 !! ** Purpose : compute the equivalent ssh in lead when sea ice is embedded 754 763 !! … … 756 765 !! 757 766 !! ** Reference : Jean-Michel Campin, John Marshall, David Ferreira, 758 !! Sea ice-ocean coupling using a rescaled vertical coordinate z*, 767 !! Sea ice-ocean coupling using a rescaled vertical coordinate z*, 759 768 !! Ocean Modelling, Volume 24, Issues 1-2, 2008 760 769 !!---------------------------------------------------------------------- … … 774 783 ! compute ice load used to define the equivalent ssh in lead 775 784 IF( ln_ice_embd ) THEN 776 ! 785 ! 777 786 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 778 787 ! = (1/nn_fsbc)^2 * {SUM[n] , n=0,nn_fsbc-1} … … 793 802 END FUNCTION ice_var_sshdyn 794 803 795 804 796 805 !!------------------------------------------------------------------- 797 806 !! *** INTERFACE ice_var_itd *** … … 822 831 ph_ip(:) = phtip(:) 823 832 ph_il(:) = phtil(:) 824 833 825 834 END SUBROUTINE ice_var_itd_1c1c 826 835 … … 837 846 REAL(wp), ALLOCATABLE, DIMENSION(:) :: z1_ai, z1_vi, z1_vs 838 847 ! 839 INTEGER :: idim 848 INTEGER :: idim 840 849 !!------------------------------------------------------------------- 841 850 ! … … 879 888 ! 880 889 END SUBROUTINE ice_var_itd_Nc1c 881 890 882 891 SUBROUTINE ice_var_itd_1cMc( phti, phts, pati , ph_i, ph_s, pa_i, & 883 892 & ptmi, ptms, ptmsu, psmi, patip, phtip, phtil, pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) … … 889 898 !! ** Method: ice thickness distribution follows a gamma function from Abraham et al. (2015) 890 899 !! it has the property of conserving total concentration and volume 891 !! 900 !! 892 901 !! 893 902 !! ** Arguments : phti: 1-cat ice thickness … … 895 904 !! pati: 1-cat ice concentration 896 905 !! 897 !! ** Output : jpl-cat 906 !! ** Output : jpl-cat 898 907 !! 899 908 !! Abraham, C., Steiner, N., Monahan, A. and Michel, C., 2015. 900 909 !! Effects of subgrid‐scale snow thickness variability on radiative transfer in sea ice. 901 !! Journal of Geophysical Research: Oceans, 120(8), pp.5597-5614 910 !! Journal of Geophysical Research: Oceans, 120(8), pp.5597-5614 902 911 !!------------------------------------------------------------------- 903 912 REAL(wp), DIMENSION(:), INTENT(in) :: phti, phts, pati ! input ice/snow variables … … 978 987 ! In case snow load is in excess that would lead to transformation from snow to ice 979 988 ! Then, transfer the snow excess into the ice (different from icethd_dh) 980 zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rho0 ) * ph_i(ji,jl) ) * r1_rho0 ) 989 zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rho0 ) * ph_i(ji,jl) ) * r1_rho0 ) 981 990 ! recompute h_i, h_s avoiding out of bounds values 982 991 ph_i(ji,jl) = MIN( hi_max(jl), ph_i(ji,jl) + zdh ) … … 1038 1047 !! 1039 1048 !! ** Method: Iterative procedure 1040 !! 1049 !! 1041 1050 !! 1) Fill ice cat that correspond to input thicknesses 1042 1051 !! Find the lowest(jlmin) and highest(jlmax) cat that are filled 1043 1052 !! 1044 1053 !! 2) Expand the filling to the cat jlmin-1 and jlmax+1 1045 !! by removing 25% ice area from jlmin and jlmax (resp.) 1046 !! 1047 !! 3) Expand the filling to the empty cat between jlmin and jlmax 1054 !! by removing 25% ice area from jlmin and jlmax (resp.) 1055 !! 1056 !! 3) Expand the filling to the empty cat between jlmin and jlmax 1048 1057 !! by a) removing 25% ice area from the lower cat (ascendant loop jlmin=>jlmax) 1049 1058 !! b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin) … … 1053 1062 !! pati: N-cat ice concentration 1054 1063 !! 1055 !! ** Output : jpl-cat 1056 !! 1057 !! (Example of application: BDY forcings when inputs have N-cat /= jpl) 1064 !! ** Output : jpl-cat 1065 !! 1066 !! (Example of application: BDY forcings when inputs have N-cat /= jpl) 1058 1067 !!------------------------------------------------------------------- 1059 1068 REAL(wp), DIMENSION(:,:), INTENT(in) :: phti, phts, pati ! input ice/snow variables … … 1068 1077 REAL(wp), PARAMETER :: ztrans = 0.25_wp 1069 1078 INTEGER :: ji, jl, jl1, jl2 1070 INTEGER :: idim, icat 1079 INTEGER :: idim, icat 1071 1080 !!------------------------------------------------------------------- 1072 1081 ! … … 1107 1116 ELSE ! input cat /= output cat ! 1108 1117 ! ! ----------------------- ! 1109 1118 1110 1119 ALLOCATE( jlfil(idim,jpl), jlfil2(idim,jpl) ) ! allocate arrays 1111 1120 ALLOCATE( jlmin(idim), jlmax(idim) ) … … 1117 1126 ! 1118 1127 ! --- fill the categories --- ! 1119 ! find where cat-input = cat-output and fill cat-output fields 1128 ! find where cat-input = cat-output and fill cat-output fields 1120 1129 jlmax(:) = 0 1121 1130 jlmin(:) = 999 … … 1138 1147 END DO 1139 1148 ! 1140 ! --- fill the gaps between categories --- ! 1149 ! --- fill the gaps between categories --- ! 1141 1150 ! transfer from categories filled at the previous step to the empty ones in between 1142 1151 DO ji = 1, idim … … 1159 1168 END DO 1160 1169 ! 1161 jlfil2(:,:) = jlfil(:,:) 1170 jlfil2(:,:) = jlfil(:,:) 1162 1171 ! fill categories from low to high 1163 1172 DO jl = 2, jpl-1 … … 1180 1189 ! fill low 1181 1190 pa_i(ji,jl) = pa_i(ji,jl) + ztrans * pa_i(ji,jl+1) 1182 ph_i(ji,jl) = hi_mean(jl) 1191 ph_i(ji,jl) = hi_mean(jl) 1183 1192 jlfil2(ji,jl) = jl 1184 1193 ! remove high … … 1270 1279 !! we argue that snow does not cover the whole ice because 1271 1280 !! of wind blowing... 1272 !! 1281 !! 1273 1282 !! ** Arguments : ph_s: snow thickness 1274 !! 1283 !! 1275 1284 !! ** Output : pa_s_fra: fraction of ice covered by snow 1276 1285 !! … … 1317 1326 ENDIF 1318 1327 END SUBROUTINE ice_var_snwfra_1d 1319 1328 1320 1329 !!-------------------------------------------------------------------------- 1321 1330 !! INTERFACE ice_var_snwblow … … 1327 1336 !! If snow fall was uniform, a fraction (1-at_i) would fall into leads 1328 1337 !! but because of the winds, more snow falls on leads than on sea ice 1329 !! and a greater fraction (1-at_i)^beta of the total mass of snow 1338 !! and a greater fraction (1-at_i)^beta of the total mass of snow 1330 1339 !! (beta < 1) falls in leads. 1331 !! In reality, beta depends on wind speed, 1332 !! and should decrease with increasing wind speed but here, it is 1340 !! In reality, beta depends on wind speed, 1341 !! and should decrease with increasing wind speed but here, it is 1333 1342 !! considered as a constant. an average value is 0.66 1334 1343 !!-------------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icewri.F90
r13472 r14021 10 10 !! 'key_si3' SI3 sea-ice model 11 11 !!---------------------------------------------------------------------- 12 !! ice_wri : write of the diagnostics variables in ouput file 12 !! ice_wri : write of the diagnostics variables in ouput file 13 13 !! ice_wri_state : write for initial state or/and abandon 14 14 !!---------------------------------------------------------------------- … … 33 33 34 34 PUBLIC ice_wri ! called by ice_stp 35 PUBLIC ice_wri_state ! called by dia_wri_state 35 PUBLIC ice_wri_state ! called by dia_wri_state 36 36 37 37 !! * Substitutions … … 52 52 INTEGER :: ji, jj, jk, jl ! dummy loop indices 53 53 REAL(wp) :: z2da, z2db, zrho1, zrho2 54 REAL(wp) :: zmiss_val ! missing value retrieved from xios 54 REAL(wp) :: zmiss_val ! missing value retrieved from xios 55 55 REAL(wp), DIMENSION(jpi,jpj) :: z2d, zfast ! 2D workspace 56 56 REAL(wp), DIMENSION(jpi,jpj) :: zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask … … 59 59 ! Global ice diagnostics (SIMIP) 60 60 REAL(wp) :: zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh ! area, extent, volume 61 REAL(wp) :: zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh 61 REAL(wp) :: zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh 62 62 !!------------------------------------------------------------------- 63 63 ! … … 92 92 CALL iom_put( 'icemask05', zmsk05 ) ! ice mask 5% 93 93 CALL iom_put( 'icemask15', zmsk15 ) ! ice mask 15% 94 CALL iom_put( 'icepres' , zmsk00 ) ! Ice presence (1 or 0) 94 CALL iom_put( 'icepres' , zmsk00 ) ! Ice presence (1 or 0) 95 95 ! 96 96 ! general fields 97 IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 ) ! Ice mass per cell area 97 IF( iom_use('icemass' ) ) CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 ) ! Ice mass per cell area 98 98 IF( iom_use('snwmass' ) ) CALL iom_put( 'snwmass', vt_s * rhos * zmsksn ) ! Snow mass per cell area 99 99 IF( iom_use('iceconc' ) ) CALL iom_put( 'iceconc', at_i * zmsk00 ) ! ice concentration … … 106 106 IF( iom_use('snwvolu' ) ) CALL iom_put( 'snwvolu', vt_s * zmsksn ) ! snow volume 107 107 IF( iom_use('icefrb' ) ) THEN ! Ice freeboard 108 z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) ) 108 z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) ) 109 109 WHERE( z2d < 0._wp ) z2d = 0._wp 110 110 CALL iom_put( 'icefrb' , z2d * zmsk00 ) … … 160 160 IF( iom_use('icebrv_cat' ) ) CALL iom_put( 'icebrv_cat' , bv_i * 100. * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume 161 161 IF( iom_use('iceapnd_cat' ) ) CALL iom_put( 'iceapnd_cat' , a_ip * zmsk00l ) ! melt pond frac for categories 162 IF( iom_use('icevpnd_cat' ) ) CALL iom_put( 'icevpnd_cat' , v_ip * zmsk00l ) ! melt pond volume for categories 162 163 IF( iom_use('icehpnd_cat' ) ) CALL iom_put( 'icehpnd_cat' , h_ip * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories 163 164 IF( iom_use('icehlid_cat' ) ) CALL iom_put( 'icehlid_cat' , h_il * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories 164 IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac * zmsk00l ) ! melt pond frac for categories165 IF( iom_use('iceafpnd_cat') ) CALL iom_put( 'iceafpnd_cat', a_ip_frac * zmsk00l ) ! melt pond frac per ice area for categories 165 166 IF( iom_use('iceaepnd_cat') ) CALL iom_put( 'iceaepnd_cat', a_ip_eff * zmsk00l ) ! melt pond effective frac for categories 166 167 IF( iom_use('icealb_cat' ) ) CALL iom_put( 'icealb_cat' , alb_ice * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories … … 185 186 IF( iom_use('dmsmel') ) CALL iom_put( 'dmsmel', - wfx_snw_sum ) ! Snow mass change through melt 186 187 IF( iom_use('dmsdyn') ) CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs ) ! Snow mass change through dynamics(kg/m2/s) 187 188 188 189 ! Global ice diagnostics 189 190 IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. & … … 220 221 END SUBROUTINE ice_wri 221 222 222 223 223 224 SUBROUTINE ice_wri_state( kid ) 224 225 !!--------------------------------------------------------------------- 225 226 !! *** ROUTINE ice_wri_state *** 226 !! 227 !! ** Purpose : create a NetCDF file named cdfile_name which contains 227 !! 228 !! ** Purpose : create a NetCDF file named cdfile_name which contains 228 229 !! the instantaneous ice state and forcing fields for ice model 229 230 !! Used to find errors in the initial state or save the last … … 232 233 !! History : 4.0 ! 2013-06 (C. Rousset) 233 234 !!---------------------------------------------------------------------- 234 INTEGER, INTENT( in ) :: kid 235 INTEGER, INTENT( in ) :: kid 235 236 !!---------------------------------------------------------------------- 236 237 ! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/C1D/step_c1d.F90
r14017 r14021 104 104 IF( ln_tradmp ) CALL tra_dmp( kstp, Nbb, Nnn, ts, Nrhs ) ! internal damping trends- tracers 105 105 IF(.NOT.ln_linssh)CALL tra_adv( kstp, Nbb, Nnn, ts, Nrhs ) ! horizontal & vertical advection 106 IF( ln_zdfmfc ) CALL tra_mfc( kstp, Nbb , ts, Nrhs ) ! Mass Flux Convection 106 107 IF( ln_zdfosm ) CALL tra_osm( kstp, Nnn , ts, Nrhs ) ! OSMOSIS non-local tracer fluxes 107 108 CALL tra_zdf( kstp, Nbb, Nnn, Nrhs, ts, Naa ) ! vertical mixing -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DYN/dynspg.F90
r13497 r14021 6 6 !! History : 1.0 ! 2005-12 (C. Talandier, G. Madec, V. Garnier) Original code 7 7 !! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option 8 !!---------------------------------------------------------------------- 9 10 !!---------------------------------------------------------------------- 11 !! dyn_spg : update the dynamics trend with surface pressure gradient 8 !! 4.2 ! 2020-12 (G. Madec, E. Clementi) add Bernoulli Head for 9 !! wave coupling 10 !!---------------------------------------------------------------------- 11 12 !!---------------------------------------------------------------------- 13 !! dyn_spg : update the dynamics trend with surface pressure gradient 12 14 !! dyn_spg_init: initialization, namelist read, and parameters control 13 15 !!---------------------------------------------------------------------- … … 19 21 USE sbc_ice , ONLY : snwice_mass, snwice_mass_b 20 22 USE sbcapr ! surface boundary condition: atmospheric pressure 23 USE sbcwave, ONLY : bhd_wave 21 24 USE dynspg_exp ! surface pressure gradient (dyn_spg_exp routine) 22 25 USE dynspg_ts ! surface pressure gradient (dyn_spg_ts routine) … … 36 39 PUBLIC dyn_spg_init ! routine called by opa module 37 40 38 INTEGER :: nspg = 0 ! type of surface pressure gradient scheme defined from lk_dynspg_... 41 INTEGER :: nspg = 0 ! type of surface pressure gradient scheme defined from lk_dynspg_... 39 42 40 43 ! ! Parameter to control the surface pressure gradient scheme … … 49 52 !!---------------------------------------------------------------------- 50 53 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 51 !! $Id$ 54 !! $Id$ 52 55 !! Software governed by the CeCILL license (see ./LICENSE) 53 56 !!---------------------------------------------------------------------- … … 58 61 !! *** ROUTINE dyn_spg *** 59 62 !! 60 !! ** Purpose : compute surface pressure gradient including the 63 !! ** Purpose : compute surface pressure gradient including the 61 64 !! atmospheric pressure forcing (ln_apr_dyn=T). 62 65 !! … … 65 68 !! - split-explicit : a time splitting technique is used 66 69 !! 67 !! ln_apr_dyn=T : the atmospheric pressure forcing is applied 70 !! ln_apr_dyn=T : the atmospheric pressure forcing is applied 68 71 !! as the gradient of the inverse barometer ssh: 69 72 !! apgu = - 1/rho0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb] … … 86 89 ! 87 90 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 88 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 91 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 89 92 ztrdu(:,:,:) = puu(:,:,:,Krhs) 90 93 ztrdv(:,:,:) = pvv(:,:,:,Krhs) … … 140 143 spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 141 144 END_2D 142 DEALLOCATE( zpice ) 145 DEALLOCATE( zpice ) 146 ENDIF 147 ! 148 IF( ln_wave .and. ln_bern_srfc ) THEN !== Add J terms: depth-independent Bernoulli head 149 DO_2D( 0, 0, 0, 0 ) 150 spgu(ji,jj) = spgu(ji,jj) + ( bhd_wave(ji+1,jj) - bhd_wave(ji,jj) ) / e1u(ji,jj) !++ bhd_wave from wave model in m2/s2 [BHD parameters in WW3] 151 spgv(ji,jj) = spgv(ji,jj) + ( bhd_wave(ji,jj+1) - bhd_wave(ji,jj) ) / e2v(ji,jj) 152 END_2D 143 153 ENDIF 144 154 ! … … 149 159 ! 150 160 !!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ???? 151 ! 161 ! 152 162 ENDIF 153 163 ! … … 156 166 CASE ( np_TS ) ; CALL dyn_spg_ts ( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa ) ! time-splitting 157 167 END SELECT 158 ! 168 ! 159 169 IF( l_trddyn ) THEN ! save the surface pressure gradient trends for further diagnostics 160 170 ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 161 171 ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 162 172 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt, Kmm ) 163 DEALLOCATE( ztrdu , ztrdv ) 173 DEALLOCATE( ztrdu , ztrdv ) 164 174 ENDIF 165 175 ! ! print mean trends (used for debugging) … … 175 185 !!--------------------------------------------------------------------- 176 186 !! *** ROUTINE dyn_spg_init *** 177 !! 178 !! ** Purpose : Control the consistency between namelist options for 187 !! 188 !! ** Purpose : Control the consistency between namelist options for 179 189 !! surface pressure gradient schemes 180 190 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DYN/dynvor.F90
r13546 r14021 15 15 !! 3.2 ! 2009-04 (R. Benshila) vvl: correction of een scheme 16 16 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 17 !! 3.7 ! 2014-04 (G. Madec) trend simplification: suppress jpdyn_trd_dat vorticity 17 !! 3.7 ! 2014-04 (G. Madec) trend simplification: suppress jpdyn_trd_dat vorticity 18 18 !! - ! 2014-06 (G. Madec) suppression of velocity curl from in-core memory 19 19 !! - ! 2016-12 (G. Madec, E. Clementi) add Stokes-Coriolis trends (ln_stcor=T) … … 21 21 !! - ! 2018-03 (G. Madec) add two new schemes (ln_dynvor_enT and ln_dynvor_eet) 22 22 !! - ! 2018-04 (G. Madec) add pre-computed gradient for metric term calculation 23 !! 4.2 ! 2020-12 (G. Madec, E. Clementi) add vortex force trends (ln_vortex_force=T) 23 24 !!---------------------------------------------------------------------- 24 25 … … 37 38 USE trddyn ! trend manager: dynamics 38 39 USE sbcwave ! Surface Waves (add Stokes-Coriolis force) 39 USE sbc_oce , ONLY : ln_stcor! use Stoke-Coriolis force40 USE sbc_oce, ONLY : ln_stcor, ln_vortex_force ! use Stoke-Coriolis force 40 41 ! 41 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 70 71 INTEGER, PUBLIC, PARAMETER :: np_MIX = 5 ! MIX scheme 71 72 72 INTEGER :: ncor, nrvm, ntot ! choice of calculated vorticity 73 INTEGER :: ncor, nrvm, ntot ! choice of calculated vorticity 73 74 ! ! associated indices: 74 75 INTEGER, PUBLIC, PARAMETER :: np_COR = 1 ! Coriolis (planetary) … … 79 80 80 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: di_e2u_2 ! = di(e2u)/2 used in T-point metric term calculation 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dj_e1v_2 ! = dj(e1v)/2 - - - - 82 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dj_e1v_2 ! = dj(e1v)/2 - - - - 82 83 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: di_e2v_2e1e2f ! = di(e2v)/(2*e1e2f) used in F-point metric term calculation 83 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dj_e1u_2e1e2f ! = dj(e1u)/(2*e1e2f) - - - - 84 84 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dj_e1u_2e1e2f ! = dj(e1u)/(2*e1e2f) - - - - 85 85 86 REAL(wp) :: r1_4 = 0.250_wp ! =1/4 86 87 REAL(wp) :: r1_8 = 0.125_wp ! =1/8 87 88 REAL(wp) :: r1_12 = 1._wp / 12._wp ! 1/12 88 89 89 90 !! * Substitutions 90 91 # include "do_loop_substitute.h90" … … 105 106 !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now vorticity term trend 106 107 !! - save the trends in (ztrdu,ztrdv) in 2 parts (relative 107 !! and planetary vorticity trends) and send them to trd_dyn 108 !! and planetary vorticity trends) and send them to trd_dyn 108 109 !! for futher diagnostics (l_trddyn=T) 109 110 !!---------------------------------------------------------------------- … … 121 122 ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) ) 122 123 ! 123 ztrdu(:,:,:) = puu(:,:,:,Krhs) !* planetary vorticity trend (including Stokes-Coriolis force)124 ztrdu(:,:,:) = puu(:,:,:,Krhs) !* planetary vorticity trend 124 125 ztrdv(:,:,:) = pvv(:,:,:,Krhs) 125 126 SELECT CASE( nvor_scheme ) 126 127 CASE( np_ENS ) ; CALL vor_ens( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! enstrophy conserving scheme 127 IF( ln_stcor ) CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend128 128 CASE( np_ENE, np_MIX ) ; CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! energy conserving scheme 129 IF( ln_stcor ) CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend130 129 CASE( np_ENT ) ; CALL vor_enT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! energy conserving scheme (T-pts) 131 IF( ln_stcor ) CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend132 130 CASE( np_EET ) ; CALL vor_eeT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! energy conserving scheme (een with e3t) 133 IF( ln_stcor ) CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend134 131 CASE( np_EEN ) ; CALL vor_een( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! energy & enstrophy scheme 135 IF( ln_stcor ) CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend136 132 END SELECT 137 133 ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) … … 161 157 CASE( np_ENT ) !* energy conserving scheme (T-pts) 162 158 CALL vor_enT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend 163 IF( ln_stcor ) CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 159 IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN 160 CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 161 ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN 162 CALL vor_enT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force 163 ENDIF 164 164 CASE( np_EET ) !* energy conserving scheme (een scheme using e3t) 165 165 CALL vor_eeT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend 166 IF( ln_stcor ) CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 166 IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN 167 CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 168 ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN 169 CALL vor_eeT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force 170 ENDIF 167 171 CASE( np_ENE ) !* energy conserving scheme 168 172 CALL vor_ene( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend 169 IF( ln_stcor ) CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 173 IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN 174 CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 175 ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN 176 CALL vor_ene( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force 177 ENDIF 170 178 CASE( np_ENS ) !* enstrophy conserving scheme 171 179 CALL vor_ens( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend 172 IF( ln_stcor ) CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 180 181 IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN 182 CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 183 ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN 184 CALL vor_ens( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force 185 ENDIF 173 186 CASE( np_MIX ) !* mixed ene-ens scheme 174 187 CALL vor_ens( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! relative vorticity or metric trend (ens) 175 188 CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! planetary vorticity trend (ene) 176 IF( ln_stcor ) CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 189 IF( ln_stcor ) CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 190 IF( ln_vortex_force ) CALL vor_ens( kt, Kmm, nrvm, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add vortex force 177 191 CASE( np_EEN ) !* energy and enstrophy conserving scheme 178 192 CALL vor_een( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! total vorticity trend 179 IF( ln_stcor ) CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 193 IF( ln_stcor .AND. .NOT. ln_vortex_force ) THEN 194 CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend 195 ELSE IF( ln_stcor .AND. ln_vortex_force ) THEN 196 CALL vor_een( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) ) ! add the Stokes-Coriolis trend and vortex force 197 ENDIF 180 198 END SELECT 181 199 ! … … 195 213 !! *** ROUTINE vor_enT *** 196 214 !! 197 !! ** Purpose : Compute the now total vorticity trend and add it to 215 !! ** Purpose : Compute the now total vorticity trend and add it to 198 216 !! the general trend of the momentum equation. 199 217 !! 200 !! ** Method : Trend evaluated using now fields (centered in time) 218 !! ** Method : Trend evaluated using now fields (centered in time) 201 219 !! and t-point evaluation of vorticity (planetary and relative). 202 220 !! conserves the horizontal kinetic energy. 203 !! The general trend of momentum is increased due to the vorticity 221 !! The general trend of momentum is increased due to the vorticity 204 222 !! term which is given by: 205 223 !! voru = 1/bu mj[ ( mi(mj(bf*rvor))+bt*f_t)/e3t mj[vn] ] … … 235 253 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 236 254 END_2D 237 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity 255 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity 238 256 DO_2D( 1, 0, 1, 0 ) 239 257 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) … … 250 268 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 251 269 END_2D 252 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity 270 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity 253 271 DO_2D( 1, 0, 1, 0 ) 254 272 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) … … 304 322 ! 305 323 pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) & 306 & * ( zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) ) & 307 & + zwt(ji,jj ) * ( pu(ji,jj ,jk) + pu(ji-1,jj ,jk) ) ) 324 & * ( zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) ) & 325 & + zwt(ji,jj ) * ( pu(ji,jj ,jk) + pu(ji-1,jj ,jk) ) ) 308 326 END_2D 309 327 ! ! =============== … … 317 335 !! *** ROUTINE vor_ene *** 318 336 !! 319 !! ** Purpose : Compute the now total vorticity trend and add it to 337 !! ** Purpose : Compute the now total vorticity trend and add it to 320 338 !! the general trend of the momentum equation. 321 339 !! 322 !! ** Method : Trend evaluated using now fields (centered in time) 340 !! ** Method : Trend evaluated using now fields (centered in time) 323 341 !! and the Sadourny (1975) flux form formulation : conserves the 324 342 !! horizontal kinetic energy. 325 !! The general trend of momentum is increased due to the vorticity 343 !! The general trend of momentum is increased due to the vorticity 326 344 !! term which is given by: 327 345 !! voru = 1/e1u mj-1[ (rvor+f)/e3f mi(e1v*e3v pvv(:,:,:,Kmm)) ] … … 356 374 SELECT CASE( kvor ) !== vorticity considered ==! 357 375 CASE ( np_COR ) !* Coriolis (planetary vorticity) 358 zwz(:,:) = ff_f(:,:) 376 zwz(:,:) = ff_f(:,:) 359 377 CASE ( np_RVO ) !* relative vorticity 360 378 DO_2D( 1, 0, 1, 0 ) … … 402 420 zx2 = zwx(ji ,jj) + zwx(ji ,jj+1) 403 421 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 404 pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 422 pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 405 423 END_2D 406 424 ! ! =============== … … 452 470 SELECT CASE( kvor ) !== vorticity considered ==! 453 471 CASE ( np_COR ) !* Coriolis (planetary vorticity) 454 zwz(:,:) = ff_f(:,:) 472 zwz(:,:) = ff_f(:,:) 455 473 CASE ( np_RVO ) !* relative vorticity 456 474 DO_2D( 1, 0, 1, 0 ) … … 510 528 !! *** ROUTINE vor_een *** 511 529 !! 512 !! ** Purpose : Compute the now total vorticity trend and add it to 530 !! ** Purpose : Compute the now total vorticity trend and add it to 513 531 !! the general trend of the momentum equation. 514 532 !! 515 !! ** Method : Trend evaluated using now fields (centered in time) 516 !! and the Arakawa and Lamb (1980) flux form formulation : conserves 533 !! ** Method : Trend evaluated using now fields (centered in time) 534 !! and the Arakawa and Lamb (1980) flux form formulation : conserves 517 535 !! both the horizontal kinetic energy and the potential enstrophy 518 536 !! when horizontal divergence is zero (see the NEMO documentation) … … 654 672 !! *** ROUTINE vor_eeT *** 655 673 !! 656 !! ** Purpose : Compute the now total vorticity trend and add it to 674 !! ** Purpose : Compute the now total vorticity trend and add it to 657 675 !! the general trend of the momentum equation. 658 676 !! 659 !! ** Method : Trend evaluated using now fields (centered in time) 660 !! and the Arakawa and Lamb (1980) vector form formulation using 677 !! ** Method : Trend evaluated using now fields (centered in time) 678 !! and the Arakawa and Lamb (1980) vector form formulation using 661 679 !! a modified version of Arakawa and Lamb (1980) scheme (see vor_een). 662 !! The change consists in 680 !! The change consists in 663 681 !! Add this trend to the general momentum trend (pu_rhs,pv_rhs). 664 682 !! … … 677 695 REAL(wp) :: zua, zva ! local scalars 678 696 REAL(wp) :: zmsk, z1_e3t ! local scalars 679 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy 697 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy 680 698 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse 681 699 REAL(wp), DIMENSION(jpi,jpj,jpkm1) :: zwz ! 3D workspace, avoid lbc_lnk on jpk that is not defined … … 837 855 ! 838 856 IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' ) 839 ! 857 ! 840 858 IF(lwp) WRITE(numout,*) ! type of calculated vorticity (set ncor, nrvm, ntot) 841 859 ncor = np_COR ! planetary vorticity … … 846 864 ntot = np_COR ! - - 847 865 CASE( np_VEC_c2 ) 848 IF(lwp) WRITE(numout,*) ' ==>>> vector form dynamics : total vorticity = Coriolis + relative vorticity' 866 IF(lwp) WRITE(numout,*) ' ==>>> vector form dynamics : total vorticity = Coriolis + relative vorticity' 849 867 nrvm = np_RVO ! relative vorticity 850 ntot = np_CRV ! relative + planetary vorticity 868 ntot = np_CRV ! relative + planetary vorticity 851 869 CASE( np_FLX_c2 , np_FLX_ubs ) 852 870 IF(lwp) WRITE(numout,*) ' ==>>> flux form dynamics : total vorticity = Coriolis + metric term' … … 873 891 ! 874 892 END SELECT 875 893 876 894 IF(lwp) THEN ! Print the choice 877 895 WRITE(numout,*) … … 883 901 CASE( np_EEN ) ; WRITE(numout,*) ' ==>>> energy and enstrophy conserving scheme (EEN)' 884 902 CASE( np_MIX ) ; WRITE(numout,*) ' ==>>> mixed enstrophy/energy conserving scheme (MIX)' 885 END SELECT 903 END SELECT 886 904 ENDIF 887 905 ! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DYN/dynzad.F90
r13497 r14021 7 7 !! NEMO 0.5 ! 2002-07 (G. Madec) Free form, F90 8 8 !!---------------------------------------------------------------------- 9 9 10 10 !!---------------------------------------------------------------------- 11 11 !! dyn_zad : vertical advection momentum trend … … 16 16 USE trd_oce ! trends: ocean variables 17 17 USE trddyn ! trend manager: dynamics 18 USE sbcwave, ONLY: wsd ! Surface Waves (add vertical Stokes-drift) 18 19 ! 19 20 USE in_out_manager ! I/O manager … … 24 25 IMPLICIT NONE 25 26 PRIVATE 26 27 27 28 PUBLIC dyn_zad ! routine called by dynadv.F90 28 29 … … 40 41 !!---------------------------------------------------------------------- 41 42 !! *** ROUTINE dynzad *** 42 !! 43 !! ** Purpose : Compute the now vertical momentum advection trend and 43 !! 44 !! ** Purpose : Compute the now vertical momentum advection trend and 44 45 !! add it to the general trend of momentum equation. 45 46 !! … … 72 73 73 74 IF( l_trddyn ) THEN ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends 74 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 75 ztrdu(:,:,:) = puu(:,:,:,Krhs) 76 ztrdv(:,:,:) = pvv(:,:,:,Krhs) 75 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 76 ztrdu(:,:,:) = puu(:,:,:,Krhs) 77 ztrdv(:,:,:) = pvv(:,:,:,Krhs) 77 78 ENDIF 78 79 79 80 DO jk = 2, jpkm1 ! Vertical momentum advection at level w and u- and v- vertical 80 81 DO_2D( 0, 1, 0, 1 ) ! vertical fluxes 82 IF( ln_vortex_force ) THEN 83 zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) ) 84 ELSE 81 85 zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 86 ENDIF 82 87 END_2D 83 88 DO_2D( 0, 0, 0, 0 ) ! vertical momentum advection at w-point … … 106 111 ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 107 112 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt, Kmm ) 108 DEALLOCATE( ztrdu, ztrdv ) 113 DEALLOCATE( ztrdu, ztrdv ) 109 114 ENDIF 110 115 ! ! Control print -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/cpl_oasis3.F90
r13415 r14021 14 14 !! 3.6 ! 2014-11 (S. Masson) OASIS3-MCT 15 15 !!---------------------------------------------------------------------- 16 16 17 17 !!---------------------------------------------------------------------- 18 18 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3-MCT … … 63 63 #endif 64 64 65 INTEGER :: nrcv ! total number of fields received 66 INTEGER :: nsnd ! total number of fields sent 65 INTEGER :: nrcv ! total number of fields received 66 INTEGER :: nsnd ! total number of fields sent 67 67 INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 68 INTEGER, PUBLIC, PARAMETER :: nmaxfld=6 0! Maximum number of coupling fields68 INTEGER, PUBLIC, PARAMETER :: nmaxfld=62 ! Maximum number of coupling fields 69 69 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 70 70 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 71 71 72 72 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information 73 73 LOGICAL :: laction ! To be coupled or not 74 CHARACTER(len = 8) :: clname ! Name of the coupling field 75 CHARACTER(len = 1) :: clgrid ! Grid type 74 CHARACTER(len = 8) :: clname ! Name of the coupling field 75 CHARACTER(len = 1) :: clgrid ! Grid type 76 76 REAL(wp) :: nsgn ! Control of the sign change 77 77 INTEGER, DIMENSION(nmaxcat,nmaxcpl) :: nid ! Id of the field (no more than 9 categories and 9 extrena models) … … 98 98 !! exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 99 99 !! 100 !! ** Method : OASIS3 MPI communication 100 !! ** Method : OASIS3 MPI communication 101 101 !!-------------------------------------------------------------------- 102 102 CHARACTER(len = *), INTENT(in ) :: cd_modname ! model name as set in namcouple file … … 132 132 !! exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 133 133 !! 134 !! ** Method : OASIS3 MPI communication 134 !! ** Method : OASIS3 MPI communication 135 135 !!-------------------------------------------------------------------- 136 136 INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields … … 180 180 ! 181 181 ! ----------------------------------------------------------------- 182 ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis 182 ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis 183 183 ! ----------------------------------------------------------------- 184 184 185 185 paral(1) = 2 ! box partitioning 186 paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls) ! NEMO lower left corner global offset, without halos 186 paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls) ! NEMO lower left corner global offset, without halos 187 187 paral(3) = Ni_0 ! local extent in i, excluding halos 188 188 paral(4) = Nj_0 ! local extent in j, excluding halos 189 189 paral(5) = Ni0glo ! global extent in x, excluding halos 190 190 191 191 IF( sn_cfctl%l_oasout ) THEN 192 192 WRITE(numout,*) ' multiexchg: paral (1:5)', paral … … 195 195 WRITE(numout,*) ' multiexchg: Njs0, Nje0, njmpp =', Njs0, Nje0, njmpp 196 196 ENDIF 197 197 198 198 CALL oasis_def_partition ( id_part, paral, nerror, Ni0glo*Nj0glo ) ! global number of points, excluding halos 199 199 ! 200 ! ... Announce send variables. 200 ! ... Announce send variables. 201 201 ! 202 202 ssnd(:)%ncplmodel = kcplmodel … … 210 210 RETURN 211 211 ENDIF 212 212 213 213 DO jc = 1, ssnd(ji)%nct 214 214 DO jm = 1, kcplmodel … … 225 225 ENDIF 226 226 #if defined key_agrif 227 IF( agrif_fixed() /= 0 ) THEN 227 IF( agrif_fixed() /= 0 ) THEN 228 228 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 229 229 ENDIF … … 243 243 END DO 244 244 ! 245 ! ... Announce received variables. 245 ! ... Announce received variables. 246 246 ! 247 247 srcv(:)%ncplmodel = kcplmodel 248 248 ! 249 249 DO ji = 1, krcv 250 IF( srcv(ji)%laction ) THEN 251 250 IF( srcv(ji)%laction ) THEN 251 252 252 IF( srcv(ji)%nct > nmaxcat ) THEN 253 253 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & … … 255 255 RETURN 256 256 ENDIF 257 257 258 258 DO jc = 1, srcv(ji)%nct 259 259 DO jm = 1, kcplmodel 260 260 261 261 IF( srcv(ji)%nct .GT. 1 ) THEN 262 262 WRITE(cli2,'(i2.2)') jc … … 270 270 ENDIF 271 271 #if defined key_agrif 272 IF( agrif_fixed() /= 0 ) THEN 272 IF( agrif_fixed() /= 0 ) THEN 273 273 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 274 274 ENDIF … … 288 288 ENDIF 289 289 END DO 290 290 291 291 !------------------------------------------------------------------ 292 292 ! End of definition phase 293 293 !------------------------------------------------------------------ 294 ! 294 ! 295 295 #if defined key_agrif 296 296 IF( agrif_fixed() == Agrif_Nb_Fine_Grids() ) THEN … … 303 303 ! 304 304 END SUBROUTINE cpl_define 305 306 305 306 307 307 SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 308 308 !!--------------------------------------------------------------------- … … 324 324 DO jc = 1, ssnd(kid)%nct 325 325 DO jm = 1, ssnd(kid)%ncplmodel 326 326 327 327 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN ! exclude halos from data sent to oasis 328 328 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(Nis0:Nie0, Njs0:Nje0,jc), kinfo ) 329 330 IF ( sn_cfctl%l_oasout ) THEN 329 330 IF ( sn_cfctl%l_oasout ) THEN 331 331 IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. & 332 332 & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN … … 342 342 ENDIF 343 343 ENDIF 344 344 345 345 ENDIF 346 346 347 347 ENDDO 348 348 ENDDO … … 379 379 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 380 380 381 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 382 381 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 382 383 383 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 384 384 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 385 385 386 386 IF ( sn_cfctl%l_oasout ) & 387 387 & WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 388 388 389 389 IF( llaction ) THEN ! data received from oasis do not include halos 390 390 391 391 kinfo = OASIS_Rcv 392 IF( ll_1st ) THEN 392 IF( ll_1st ) THEN 393 393 pdata(Nis0:Nie0,Njs0:Nje0,jc) = exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 394 394 ll_1st = .FALSE. … … 397 397 & + exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 398 398 ENDIF 399 400 IF ( sn_cfctl%l_oasout ) THEN 399 400 IF ( sn_cfctl%l_oasout ) THEN 401 401 WRITE(numout,*) '****************' 402 402 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname … … 409 409 WRITE(numout,*) '****************' 410 410 ENDIF 411 411 412 412 ENDIF 413 413 414 414 ENDIF 415 415 416 416 ENDDO 417 417 418 418 !--- we must call lbc_lnk to fill the halos that where not received. 419 419 IF( .NOT. ll_1st ) THEN 420 CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 420 CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 421 421 ENDIF 422 422 423 423 ENDDO 424 424 ! … … 426 426 427 427 428 INTEGER FUNCTION cpl_freq( cdfieldname ) 428 INTEGER FUNCTION cpl_freq( cdfieldname ) 429 429 !!--------------------------------------------------------------------- 430 430 !! *** ROUTINE cpl_freq *** … … 491 491 DEALLOCATE( exfld ) 492 492 IF(nstop == 0) THEN 493 CALL oasis_terminate( nerror ) 493 CALL oasis_terminate( nerror ) 494 494 ELSE 495 495 CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 496 ENDIF 496 ENDIF 497 497 ! 498 498 END SUBROUTINE cpl_finalize … … 544 544 WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 545 545 END SUBROUTINE oasis_enddef 546 546 547 547 SUBROUTINE oasis_put(k1,k2,p1,k3) 548 548 REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1 … … 574 574 WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 575 575 END SUBROUTINE oasis_terminate 576 576 577 577 #endif 578 578 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbc_oce.F90
r14017 r14021 12 12 !! 4.0 ! 2016-06 (L. Brodeau) new unified bulk routine (based on AeroBulk) 13 13 !! 4.0 ! 2019-03 (F. Lemarié, G. Samson) add compatibility with ABL mode 14 !! 4.2 ! 2020-12 (G. Madec, E. Clementi) modified wave parameters in namelist 14 15 !!---------------------------------------------------------------------- 15 16 … … 36 37 LOGICAL , PUBLIC :: ln_blk !: bulk formulation 37 38 LOGICAL , PUBLIC :: ln_abl !: Atmospheric boundary layer model 39 LOGICAL , PUBLIC :: ln_wave !: wave in the system (forced or coupled) 38 40 #if defined key_oasis3 39 41 LOGICAL , PUBLIC :: lk_oasis = .TRUE. !: OASIS used … … 56 58 ! !: = 1 global mean of e-p-r set to zero at each nn_fsbc time step 57 59 ! !: = 2 annual global mean of e-p-r set to zero 58 LOGICAL , PUBLIC :: ln_wave !: true if some coupling with wave model59 LOGICAL , PUBLIC :: ln_cdgw !: true if neutral drag coefficient from wave model60 LOGICAL , PUBLIC :: ln_sdw !: true if 3d stokes drift from wave model61 LOGICAL , PUBLIC :: ln_tauwoc !: true if normalized stress from wave is used62 LOGICAL , PUBLIC :: ln_tauw !: true if ocean stress components from wave is used63 LOGICAL , PUBLIC :: ln_stcor !: true if Stokes-Coriolis term is used64 !65 INTEGER , PUBLIC :: nn_sdrift ! type of parameterization to calculate vertical Stokes drift66 !67 60 LOGICAL , PUBLIC :: ln_icebergs !: Icebergs 68 61 ! … … 71 64 ! !!* namsbc_cpl namelist * 72 65 INTEGER , PUBLIC :: nn_cats_cpl !: Number of sea ice categories over which the coupling is carried out 73 66 ! 67 ! !!* namsbc_wave namelist * 68 LOGICAL , PUBLIC :: ln_sdw !: =T 3d stokes drift from wave model 69 LOGICAL , PUBLIC :: ln_stcor !: =T if Stokes-Coriolis and tracer advection terms are used 70 LOGICAL , PUBLIC :: ln_cdgw !: =T neutral drag coefficient from wave model 71 LOGICAL , PUBLIC :: ln_tauoc !: =T if normalized stress from wave is used 72 LOGICAL , PUBLIC :: ln_wave_test !: =T wave test case (constant Stokes drift) 73 LOGICAL , PUBLIC :: ln_charn !: =T Chranock coefficient from wave model 74 LOGICAL , PUBLIC :: ln_taw !: =T wind stress corrected by wave intake 75 LOGICAL , PUBLIC :: ln_phioc !: =T TKE surface BC from wave model 76 LOGICAL , PUBLIC :: ln_bern_srfc !: Bernoulli head, waves' inuced pressure 77 LOGICAL , PUBLIC :: ln_breivikFV_2016 !: Breivik 2016 profile 78 LOGICAL , PUBLIC :: ln_vortex_force !: vortex force activation 79 LOGICAL , PUBLIC :: ln_stshear !: Stoked Drift shear contribution in zdftke 80 ! 74 81 !!---------------------------------------------------------------------- 75 82 !! switch definition (improve readability) … … 81 88 INTEGER , PUBLIC, PARAMETER :: jp_purecpl = 5 !: Pure ocean-atmosphere Coupled formulation 82 89 INTEGER , PUBLIC, PARAMETER :: jp_none = 6 !: for OPA when doing coupling via SAS module 83 84 !!---------------------------------------------------------------------- 85 !! Stokes drift parametrization definition 86 !!---------------------------------------------------------------------- 87 INTEGER , PUBLIC, PARAMETER :: jp_breivik_2014 = 0 !: Breivik 2014: v_z=v_0*[exp(2*k*z)/(1-8*k*z)] 88 INTEGER , PUBLIC, PARAMETER :: jp_li_2017 = 1 !: Li et al 2017: Stokes drift based on Phillips spectrum (Breivik 2016) 89 ! with depth averaged profile 90 INTEGER , PUBLIC, PARAMETER :: jp_peakfr = 2 !: Li et al 2017: using the peak wave number read from wave model instead 91 ! of the inverse depth scale 92 LOGICAL , PUBLIC :: ll_st_bv2014 = .FALSE. ! logical indicator, .true. if Breivik 2014 parameterisation is active. 93 LOGICAL , PUBLIC :: ll_st_li2017 = .FALSE. ! logical indicator, .true. if Li 2017 parameterisation is active. 94 LOGICAL , PUBLIC :: ll_st_bv_li = .FALSE. ! logical indicator, .true. if either Breivik or Li parameterisation is active. 95 LOGICAL , PUBLIC :: ll_st_peakfr = .FALSE. ! logical indicator, .true. if using Li 2017 with peak wave number 96 90 ! 97 91 !!---------------------------------------------------------------------- 98 92 !! component definition -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk.F90
r14017 r14021 19 19 !! 4.0 ! 2016-10 (M. Vancoppenolle) Introduce conduction flux emulator (M. Vancoppenolle) 20 20 !! 4.0 ! 2019-03 (F. Lemarié & G. Samson) add ABL compatibility (ln_abl=TRUE) 21 !! 4.2 ! 2020-12 (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 21 22 !!---------------------------------------------------------------------- 22 23 … … 383 384 ! 384 385 IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 ) & 385 386 386 & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & 387 & ' This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' ) 387 388 ENDIF 388 389 END DO 389 !390 IF( ln_wave ) THEN391 !Activated wave module but neither drag nor stokes drift activated392 IF( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) ) THEN393 CALL ctl_stop( 'STOP', 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F' )394 !drag coefficient read from wave model definable only with mfs bulk formulae and core395 ELSEIF(ln_cdgw .AND. .NOT. ln_NCAR ) THEN396 CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR bulk formulae')397 ELSEIF(ln_stcor .AND. .NOT. ln_sdw) THEN398 CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T')399 ENDIF400 ELSE401 IF( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) &402 & CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ', &403 & 'with drag coefficient (ln_cdgw =T) ' , &404 & 'or Stokes Drift (ln_sdw=T) ' , &405 & 'or ocean stress modification due to waves (ln_tauwoc=T) ', &406 & 'or Stokes-Coriolis term (ln_stcori=T)' )407 ENDIF408 390 ! 409 391 IF( ln_abl ) THEN ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_coare3p0.F90
r14017 r14021 15 15 !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk) 16 16 !!---------------------------------------------------------------------- 17 !! History : 4.0 ! 2016-02 (L.Brodeau) Original code 17 !! History : 4.0 ! 2016-02 (L.Brodeau) Original code 18 !! 4.2 ! 2020-12 (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 18 19 !!---------------------------------------------------------------------- 19 20 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_coare3p6.F90
r14017 r14021 16 16 !!---------------------------------------------------------------------- 17 17 !! History : 4.0 ! 2016-02 (L.Brodeau) Original code 18 !! 4.2 ! 2020-12 (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 18 19 !!---------------------------------------------------------------------- 19 20 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ecmwf.F90
r14017 r14021 17 17 !!---------------------------------------------------------------------- 18 18 !! History : 4.0 ! 2016-02 (L.Brodeau) Original code 19 !! 4.2 ! 2020-12 (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 19 20 !!---------------------------------------------------------------------- 20 21 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ice_an05.F90
r13830 r14021 19 19 !!---------------------------------------------------------------------- 20 20 USE par_kind, ONLY: wp 21 USE par_oce, ONLY: jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls 21 USE par_oce, ONLY: jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls, ntsi, ntsj, ntei, ntej 22 22 USE lib_mpp, ONLY: ctl_stop ! distribued memory computing library 23 23 USE phycst ! physical constants -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ice_cdn.F90
r13830 r14021 13 13 !!==================================================================================== 14 14 USE par_kind, ONLY: wp 15 USE par_oce, ONLY: jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls 15 USE par_oce, ONLY: jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls, ntsi, ntsj, ntei, ntej 16 16 USE phycst ! physical constants 17 17 USE sbc_phy ! Catalog of functions for physical/meteorological parameters in the marine boundary layer -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ncar.F90
r14017 r14021 16 16 !!===================================================================== 17 17 !! History : 3.6 ! 2016-02 (L.Brodeau) successor of old turb_ncar of former sbcblk_core.F90 18 !! 4.2 ! 2020-12 (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 18 19 !!---------------------------------------------------------------------- 19 20 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_skin_coare.F90
r13719 r14021 13 13 !! ** Author: L. Brodeau, November 2019 / AeroBulk (https://github.com/brodeau/aerobulk) 14 14 !!---------------------------------------------------------------------- 15 !! History : 4. x! 2019-11 (L.Brodeau) Original code15 !! History : 4.0 ! 2019-11 (L.Brodeau) Original code 16 16 !!---------------------------------------------------------------------- 17 17 USE oce ! ocean dynamics and tracers -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_skin_ecmwf.F90
r13806 r14021 28 28 !! ** Author: L. Brodeau, November 2019 / AeroBulk (https://github.com/brodeau/aerobulk) 29 29 !!---------------------------------------------------------------------- 30 !! History : 4.x ! 2019-11 (L.Brodeau) Original code 30 !! History : 4.0 ! 2019-11 (L.Brodeau) Original code 31 !! 4.2 ! 2020-12 (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 31 32 !!---------------------------------------------------------------------- 32 33 USE oce ! ocean dynamics and tracers -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbccpl.F90
r13655 r14021 8 8 !! 3.1 ! 2009_02 (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface 9 9 !! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields 10 !! 4.2 ! 2020-12 (G. Madec, E. Clementi) wave coupling updates 10 11 !!---------------------------------------------------------------------- 11 12 … … 108 109 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 109 110 INTEGER, PARAMETER :: jpr_mslp = 43 ! mean sea level pressure 111 !** surface wave coupling ** 110 112 INTEGER, PARAMETER :: jpr_hsig = 44 ! Hsig 111 113 INTEGER, PARAMETER :: jpr_phioc = 45 ! Wave=>ocean energy flux … … 114 116 INTEGER, PARAMETER :: jpr_wper = 48 ! Mean wave period 115 117 INTEGER, PARAMETER :: jpr_wnum = 49 ! Mean wavenumber 116 INTEGER, PARAMETER :: jpr_ tauwoc= 50 ! Stress fraction adsorbed by waves118 INTEGER, PARAMETER :: jpr_wstrf = 50 ! Stress fraction adsorbed by waves 117 119 INTEGER, PARAMETER :: jpr_wdrag = 51 ! Neutral surface drag coefficient 118 INTEGER, PARAMETER :: jpr_isf = 52 119 INTEGER, PARAMETER :: jpr_icb = 53 120 INTEGER, PARAMETER :: jpr_wfreq = 54 ! Wave peak frequency 121 INTEGER, PARAMETER :: jpr_tauwx = 55 ! x component of the ocean stress from waves 122 INTEGER, PARAMETER :: jpr_tauwy = 56 ! y component of the ocean stress from waves 123 INTEGER, PARAMETER :: jpr_ts_ice = 57 ! Sea ice surface temp 124 125 INTEGER, PARAMETER :: jprcv = 57 ! total number of fields received 120 INTEGER, PARAMETER :: jpr_charn = 52 ! Chranock coefficient 121 INTEGER, PARAMETER :: jpr_twox = 53 ! wave to ocean momentum flux 122 INTEGER, PARAMETER :: jpr_twoy = 54 ! wave to ocean momentum flux 123 INTEGER, PARAMETER :: jpr_tawx = 55 ! net wave-supported stress 124 INTEGER, PARAMETER :: jpr_tawy = 56 ! net wave-supported stress 125 INTEGER, PARAMETER :: jpr_bhd = 57 ! Bernoulli head. waves' induced surface pressure 126 INTEGER, PARAMETER :: jpr_tusd = 58 ! zonal stokes transport 127 INTEGER, PARAMETER :: jpr_tvsd = 59 ! meridional stokes tranmport 128 INTEGER, PARAMETER :: jpr_isf = 60 129 INTEGER, PARAMETER :: jpr_icb = 61 130 INTEGER, PARAMETER :: jpr_ts_ice = 62 ! Sea ice surface temp 131 132 INTEGER, PARAMETER :: jprcv = 62 ! total number of fields received 126 133 127 134 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 186 193 & sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr 187 194 ! ! Received from the atmosphere 188 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_ tauw, sn_rcv_dqnsdt, sn_rcv_qsr, &195 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, & 189 196 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf, sn_rcv_ts_ice 190 197 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf 191 ! Send to waves198 ! ! Send to waves 192 199 TYPE(FLD_C) :: sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev 193 ! Received from waves194 TYPE(FLD_C) :: sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_tauwoc,&195 sn_rcv_wdrag, sn_rcv_wfreq200 ! ! Received from waves 201 TYPE(FLD_C) :: sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, & 202 & sn_rcv_wstrf, sn_rcv_wdrag, sn_rcv_charn, sn_rcv_taw, sn_rcv_bhd, sn_rcv_tusd, sn_rcv_tvsd 196 203 ! ! Other namelist parameters 197 204 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 276 283 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc , & 277 284 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , & 278 & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_ tauwoc, &279 & sn_rcv_ wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal ,&280 & sn_rcv_ iceflx, sn_rcv_co2 , sn_rcv_mslp ,&281 & sn_rcv_ic b , sn_rcv_isf , sn_rcv_wfreq, sn_rcv_tauw , &282 & sn_rcv_ts_ice 285 & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_wstrf , & 286 & sn_rcv_charn , sn_rcv_taw , sn_rcv_bhd , sn_rcv_tusd , sn_rcv_tvsd, & 287 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 288 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice 289 283 290 !!--------------------------------------------------------------------- 284 291 ! … … 321 328 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 322 329 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 330 WRITE(numout,*)' Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' 331 WRITE(numout,*)' surface waves:' 323 332 WRITE(numout,*)' significant wave heigth = ', TRIM(sn_rcv_hsig%cldes ), ' (', TRIM(sn_rcv_hsig%clcat ), ')' 324 333 WRITE(numout,*)' wave to oce energy flux = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' … … 327 336 WRITE(numout,*)' Mean wave period = ', TRIM(sn_rcv_wper%cldes ), ' (', TRIM(sn_rcv_wper%clcat ), ')' 328 337 WRITE(numout,*)' Mean wave number = ', TRIM(sn_rcv_wnum%cldes ), ' (', TRIM(sn_rcv_wnum%clcat ), ')' 329 WRITE(numout,*)' Wave peak frequency = ', TRIM(sn_rcv_wfreq%cldes ), ' (', TRIM(sn_rcv_wfreq%clcat ), ')' 330 WRITE(numout,*)' Stress frac adsorbed by waves = ', TRIM(sn_rcv_tauwoc%cldes), ' (', TRIM(sn_rcv_tauwoc%clcat ), ')' 331 WRITE(numout,*)' Stress components by waves = ', TRIM(sn_rcv_tauw%cldes ), ' (', TRIM(sn_rcv_tauw%clcat ), ')' 338 WRITE(numout,*)' Stress frac adsorbed by waves = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 332 339 WRITE(numout,*)' Neutral surf drag coefficient = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 333 WRITE(numout,*)' Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')'340 WRITE(numout,*)' Charnock coefficient = ', TRIM(sn_rcv_charn%cldes ), ' (', TRIM(sn_rcv_charn%clcat ), ')' 334 341 WRITE(numout,*)' sent fields (multiple ice categories)' 335 342 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' … … 353 360 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 354 361 ENDIF 355 362 IF( lwp .AND. ln_wave) THEN ! control print 363 WRITE(numout,*)' surface waves:' 364 WRITE(numout,*)' Significant wave heigth = ', TRIM(sn_rcv_hsig%cldes ), ' (', TRIM(sn_rcv_hsig%clcat ), ')' 365 WRITE(numout,*)' Wave to oce energy flux = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 366 WRITE(numout,*)' Surface Stokes drift grid u = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' 367 WRITE(numout,*)' Surface Stokes drift grid v = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')' 368 WRITE(numout,*)' Mean wave period = ', TRIM(sn_rcv_wper%cldes ), ' (', TRIM(sn_rcv_wper%clcat ), ')' 369 WRITE(numout,*)' Mean wave number = ', TRIM(sn_rcv_wnum%cldes ), ' (', TRIM(sn_rcv_wnum%clcat ), ')' 370 WRITE(numout,*)' Stress frac adsorbed by waves = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 371 WRITE(numout,*)' Neutral surf drag coefficient = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 372 WRITE(numout,*)' Charnock coefficient = ', TRIM(sn_rcv_charn%cldes ), ' (', TRIM(sn_rcv_charn%clcat ), ')' 373 WRITE(numout,*)' Transport associated to Stokes drift grid u = ', TRIM(sn_rcv_tusd%cldes ), ' (', TRIM(sn_rcv_tusd%clcat ), ')' 374 WRITE(numout,*)' Transport associated to Stokes drift grid v = ', TRIM(sn_rcv_tvsd%cldes ), ' (', TRIM(sn_rcv_tvsd%clcat ), ')' 375 WRITE(numout,*)' Bernouilli pressure head = ', TRIM(sn_rcv_bhd%cldes ), ' (', TRIM(sn_rcv_bhd%clcat ), ')' 376 WRITE(numout,*)'Wave to ocean momentum flux and Net wave-supported stress = ', TRIM(sn_rcv_taw%cldes ), ' (', TRIM(sn_rcv_taw%clcat ), ')' 377 WRITE(numout,*)' Surface current to waves = ', TRIM(sn_snd_crtw%cldes ), ' (', TRIM(sn_snd_crtw%clcat ), ')' 378 WRITE(numout,*)' - referential = ', sn_snd_crtw%clvref 379 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 380 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 381 ENDIF 356 382 ! ! allocate sbccpl arrays 357 383 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) … … 631 657 cpl_wper = .TRUE. 632 658 ENDIF 633 srcv(jpr_wfreq)%clname = 'O_WFreq' ! wave peak frequency634 IF( TRIM(sn_rcv_wfreq%cldes ) == 'coupled' ) THEN635 srcv(jpr_wfreq)%laction = .TRUE.636 cpl_wfreq = .TRUE.637 ENDIF638 659 srcv(jpr_wnum)%clname = 'O_WNum' ! mean wave number 639 660 IF( TRIM(sn_rcv_wnum%cldes ) == 'coupled' ) THEN … … 641 662 cpl_wnum = .TRUE. 642 663 ENDIF 643 srcv(jpr_tauwoc)%clname = 'O_TauOce' ! stress fraction adsorbed by the wave 644 IF( TRIM(sn_rcv_tauwoc%cldes ) == 'coupled' ) THEN 645 srcv(jpr_tauwoc)%laction = .TRUE. 646 cpl_tauwoc = .TRUE. 647 ENDIF 648 srcv(jpr_tauwx)%clname = 'O_Tauwx' ! ocean stress from wave in the x direction 649 srcv(jpr_tauwy)%clname = 'O_Tauwy' ! ocean stress from wave in the y direction 650 IF( TRIM(sn_rcv_tauw%cldes ) == 'coupled' ) THEN 651 srcv(jpr_tauwx)%laction = .TRUE. 652 srcv(jpr_tauwy)%laction = .TRUE. 653 cpl_tauw = .TRUE. 664 srcv(jpr_wstrf)%clname = 'O_WStrf' ! stress fraction adsorbed by the wave 665 IF( TRIM(sn_rcv_wstrf%cldes ) == 'coupled' ) THEN 666 srcv(jpr_wstrf)%laction = .TRUE. 667 cpl_wstrf = .TRUE. 654 668 ENDIF 655 669 srcv(jpr_wdrag)%clname = 'O_WDrag' ! neutral surface drag coefficient … … 658 672 cpl_wdrag = .TRUE. 659 673 ENDIF 660 IF( srcv(jpr_tauwoc)%laction .AND. srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction ) & 661 CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', & 662 '(sn_rcv_tauwoc=coupled and sn_rcv_tauw=coupled)' ) 674 srcv(jpr_charn)%clname = 'O_Charn' ! Chranock coefficient 675 IF( TRIM(sn_rcv_charn%cldes ) == 'coupled' ) THEN 676 srcv(jpr_charn)%laction = .TRUE. 677 cpl_charn = .TRUE. 678 ENDIF 679 srcv(jpr_bhd)%clname = 'O_Bhd' ! Bernoulli head. waves' induced surface pressure 680 IF( TRIM(sn_rcv_bhd%cldes ) == 'coupled' ) THEN 681 srcv(jpr_bhd)%laction = .TRUE. 682 cpl_bhd = .TRUE. 683 ENDIF 684 srcv(jpr_tusd)%clname = 'O_Tusd' ! zonal stokes transport 685 IF( TRIM(sn_rcv_tusd%cldes ) == 'coupled' ) THEN 686 srcv(jpr_tusd)%laction = .TRUE. 687 cpl_tusd = .TRUE. 688 ENDIF 689 srcv(jpr_tvsd)%clname = 'O_Tvsd' ! meridional stokes tranmport 690 IF( TRIM(sn_rcv_tvsd%cldes ) == 'coupled' ) THEN 691 srcv(jpr_tvsd)%laction = .TRUE. 692 cpl_tvsd = .TRUE. 693 ENDIF 694 695 srcv(jpr_twox)%clname = 'O_Twox' ! wave to ocean momentum flux in the u direction 696 srcv(jpr_twoy)%clname = 'O_Twoy' ! wave to ocean momentum flux in the v direction 697 srcv(jpr_tawx)%clname = 'O_Tawx' ! Net wave-supported stress in the u direction 698 srcv(jpr_tawy)%clname = 'O_Tawy' ! Net wave-supported stress in the v direction 699 IF( TRIM(sn_rcv_taw%cldes ) == 'coupled' ) THEN 700 srcv(jpr_twox)%laction = .TRUE. 701 srcv(jpr_twoy)%laction = .TRUE. 702 srcv(jpr_tawx)%laction = .TRUE. 703 srcv(jpr_tawy)%laction = .TRUE. 704 cpl_taw = .TRUE. 705 ENDIF 663 706 ! 664 707 ! ! ------------------------------- ! … … 1060 1103 ! initialisation of the coupler ! 1061 1104 ! ================================ ! 1062 1063 1105 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 1064 1106 … … 1073 1115 ENDIF 1074 1116 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 1117 ! 1075 1118 ! 1076 1119 END SUBROUTINE sbc_cpl_init … … 1148 1191 IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 1149 1192 1193 IF ( ln_wave .AND. nn_components == 0 ) THEN 1194 ncpl_qsr_freq = 1; 1195 WRITE(numout,*) 'ncpl_qsr_freq is set to 1 when coupling NEMO with wave (without SAS) ' 1196 ENDIF 1150 1197 ENDIF 1151 1198 ! … … 1323 1370 ! 1324 1371 ! ! ========================= ! 1325 ! ! Wave peak frequency !1326 ! ! ========================= !1327 IF( srcv(jpr_wfreq)%laction ) wfreq(:,:) = frcv(jpr_wfreq)%z3(:,:,1)1328 !1329 ! ! ========================= !1330 1372 ! ! Vertical mixing Qiao ! 1331 1373 ! ! ========================= ! … … 1333 1375 1334 1376 ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode 1335 IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction&1336 .OR. srcv(jpr_hsig)%laction .OR. srcv(jpr_wfreq)%laction)THEN1377 IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. & 1378 srcv(jpr_wper)%laction .OR. srcv(jpr_hsig)%laction ) THEN 1337 1379 CALL sbc_stokes( Kmm ) 1338 1380 ENDIF … … 1341 1383 ! ! Stress adsorbed by waves ! 1342 1384 ! ! ========================= ! 1343 IF( srcv(jpr_tauwoc)%laction .AND. ln_tauwoc ) tauoc_wave(:,:) = frcv(jpr_tauwoc)%z3(:,:,1) 1344 1345 ! ! ========================= ! 1346 ! ! Stress component by waves ! 1347 ! ! ========================= ! 1348 IF( srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction .AND. ln_tauw ) THEN 1349 tauw_x(:,:) = frcv(jpr_tauwx)%z3(:,:,1) 1350 tauw_y(:,:) = frcv(jpr_tauwy)%z3(:,:,1) 1351 ENDIF 1352 1385 IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc ) tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1) 1386 ! 1353 1387 ! ! ========================= ! 1354 1388 ! ! Wave drag coefficient ! 1355 1389 ! ! ========================= ! 1356 1390 IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw ) cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1) 1357 1391 ! 1392 ! ! ========================= ! 1393 ! ! Chranock coefficient ! 1394 ! ! ========================= ! 1395 IF( srcv(jpr_charn)%laction .AND. ln_charn ) charn(:,:) = frcv(jpr_charn)%z3(:,:,1) 1396 ! 1397 ! ! ========================= ! 1398 ! ! net wave-supported stress ! 1399 ! ! ========================= ! 1400 IF( srcv(jpr_tawx)%laction .AND. ln_taw ) tawx(:,:) = frcv(jpr_tawx)%z3(:,:,1) 1401 IF( srcv(jpr_tawy)%laction .AND. ln_taw ) tawy(:,:) = frcv(jpr_tawy)%z3(:,:,1) 1402 ! 1403 ! ! ========================= ! 1404 ! !wave to ocean momentum flux! 1405 ! ! ========================= ! 1406 IF( srcv(jpr_twox)%laction .AND. ln_taw ) twox(:,:) = frcv(jpr_twox)%z3(:,:,1) 1407 IF( srcv(jpr_twoy)%laction .AND. ln_taw ) twoy(:,:) = frcv(jpr_twoy)%z3(:,:,1) 1408 ! 1409 ! ! ========================= ! 1410 ! ! wave TKE flux at sfc ! 1411 ! ! ========================= ! 1412 IF( srcv(jpr_phioc)%laction .AND. ln_phioc ) phioc(:,:) = frcv(jpr_phioc)%z3(:,:,1) 1413 ! 1414 ! ! ========================= ! 1415 ! ! Bernoulli head ! 1416 ! ! ========================= ! 1417 IF( srcv(jpr_bhd)%laction .AND. ln_bern_srfc ) bhd_wave(:,:) = frcv(jpr_bhd)%z3(:,:,1) 1418 ! 1419 ! ! ========================= ! 1420 ! ! Stokes transport u dir ! 1421 ! ! ========================= ! 1422 IF( srcv(jpr_tusd)%laction .AND. ln_breivikFV_2016 ) tusd(:,:) = frcv(jpr_tusd)%z3(:,:,1) 1423 ! 1424 ! ! ========================= ! 1425 ! ! Stokes transport v dir ! 1426 ! ! ========================= ! 1427 IF( srcv(jpr_tvsd)%laction .AND. ln_breivikFV_2016 ) tvsd(:,:) = frcv(jpr_tvsd)%z3(:,:,1) 1428 ! 1358 1429 ! Fields received by SAS when OASIS coupling 1359 1430 ! (arrays no more filled at sbcssm stage) -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcmod.F90
r14017 r14021 16 16 !! 4.0 ! 2016-06 (L. Brodeau) new general bulk formulation 17 17 !! 4.0 ! 2019-03 (F. Lemarié & G. Samson) add ABL compatibility (ln_abl=TRUE) 18 !! 4.2 ! 2020-12 (G. Madec, E. Clementi) modified wave forcing and coupling 18 19 !!---------------------------------------------------------------------- 19 20 … … 55 56 USE usrdef_sbc ! user defined: surface boundary condition 56 57 USE closea ! closed sea 58 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 57 59 ! 58 60 USE prtctl ! Print control (prt_ctl routine) … … 71 73 72 74 INTEGER :: nsbc ! type of surface boundary condition (deduced from namsbc informations) 73 75 !! * Substitutions 76 # include "do_loop_substitute.h90" 74 77 !!---------------------------------------------------------------------- 75 78 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 100 103 & nn_ice , ln_ice_embd, & 101 104 & ln_traqsr, ln_dm2dc , & 102 & ln_rnf , nn_fwb , ln_ssr , ln_apr_dyn, & 103 & ln_wave , ln_cdgw , ln_sdw , ln_tauwoc , ln_stcor , & 104 & ln_tauw , nn_lsm, nn_sdrift 105 & ln_rnf , nn_fwb , ln_ssr , ln_apr_dyn, & 106 & ln_wave , nn_lsm 105 107 !!---------------------------------------------------------------------- 106 108 ! … … 134 136 WRITE(numout,*) ' bulk formulation ln_blk = ', ln_blk 135 137 WRITE(numout,*) ' ABL formulation ln_abl = ', ln_abl 138 WRITE(numout,*) ' Surface wave (forced or coupled) ln_wave = ', ln_wave 136 139 WRITE(numout,*) ' Type of coupling (Ocean/Ice/Atmosphere) : ' 137 140 WRITE(numout,*) ' ocean-atmosphere coupled formulation ln_cpl = ', ln_cpl … … 151 154 WRITE(numout,*) ' runoff / runoff mouths ln_rnf = ', ln_rnf 152 155 WRITE(numout,*) ' nb of iterations if land-sea-mask applied nn_lsm = ', nn_lsm 153 WRITE(numout,*) ' surface wave ln_wave = ', ln_wave 154 WRITE(numout,*) ' Stokes drift corr. to vert. velocity ln_sdw = ', ln_sdw 155 WRITE(numout,*) ' vertical parametrization nn_sdrift = ', nn_sdrift 156 WRITE(numout,*) ' wave modified ocean stress ln_tauwoc = ', ln_tauwoc 157 WRITE(numout,*) ' wave modified ocean stress component ln_tauw = ', ln_tauw 158 WRITE(numout,*) ' Stokes coriolis term ln_stcor = ', ln_stcor 159 WRITE(numout,*) ' neutral drag coefficient (CORE,NCAR) ln_cdgw = ', ln_cdgw 160 ENDIF 161 ! 162 IF( .NOT.ln_wave ) THEN 163 ln_sdw = .false. ; ln_cdgw = .false. ; ln_tauwoc = .false. ; ln_tauw = .false. ; ln_stcor = .false. 164 ENDIF 165 IF( ln_sdw ) THEN 166 IF( .NOT.(nn_sdrift==jp_breivik_2014 .OR. nn_sdrift==jp_li_2017 .OR. nn_sdrift==jp_peakfr) ) & 167 CALL ctl_stop( 'The chosen nn_sdrift for Stokes drift vertical velocity must be 0, 1, or 2' ) 168 ENDIF 169 ll_st_bv2014 = ( nn_sdrift==jp_breivik_2014 ) 170 ll_st_li2017 = ( nn_sdrift==jp_li_2017 ) 171 ll_st_bv_li = ( ll_st_bv2014 .OR. ll_st_li2017 ) 172 ll_st_peakfr = ( nn_sdrift==jp_peakfr ) 173 IF( ln_tauwoc .AND. ln_tauw ) & 174 CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', & 175 '(ln_tauwoc=.true. and ln_tauw=.true.)' ) 176 IF( ln_tauwoc ) & 177 CALL ctl_warn( 'You are subtracting the wave stress to the ocean (ln_tauwoc=.true.)' ) 178 IF( ln_tauw ) & 179 CALL ctl_warn( 'The wave modified ocean stress components are used (ln_tauw=.true.) ', & 180 'This will override any other specification of the ocean stress' ) 156 ENDIF 181 157 ! 182 158 IF( .NOT.ln_usr ) THEN ! the model calendar needs some specificities (except in user defined case) … … 358 334 IF( nn_ice == 3 ) CALL cice_sbc_init( nsbc, Kbb, Kmm ) ! CICE initialization 359 335 ! 360 IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation 336 IF( ln_wave ) THEN 337 CALL sbc_wave_init ! surface wave initialisation 338 ELSE 339 IF(lwp) WRITE(numout,*) 340 IF(lwp) WRITE(numout,*) ' No surface waves : all wave related logical set to false' 341 ln_sdw = .false. 342 ln_stcor = .false. 343 ln_cdgw = .false. 344 ln_tauoc = .false. 345 ln_wave_test = .false. 346 ln_charn = .false. 347 ln_taw = .false. 348 ln_phioc = .false. 349 ln_bern_srfc = .false. 350 ln_breivikFV_2016 = .false. 351 ln_vortex_force = .false. 352 ln_stshear = .false. 353 ENDIF 361 354 ! 362 355 END SUBROUTINE sbc_init … … 381 374 INTEGER, INTENT(in) :: kt ! ocean time step 382 375 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 376 INTEGER :: jj, ji ! dummy loop argument 383 377 ! 384 378 LOGICAL :: ll_sas, ll_opa ! local logical … … 413 407 ! 414 408 IF( .NOT.ll_sas ) CALL sbc_ssm ( kt, Kbb, Kmm ) ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 415 IF( ln_wave ) CALL sbc_wave( kt, Kmm ) ! surface waves416 417 409 ! 418 410 ! !== sbc formulation ==! 411 ! 419 412 ! 420 413 SELECT CASE( nsbc ) ! Compute ocean surface boundary condition … … 424 417 CASE( jp_blk ) 425 418 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OPA-SAS coupling: SAS receiving fields from OPA 419 !!!!!!!!!!! ATTENTION:ln_wave is not only used for oasis coupling !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 420 IF( ln_wave ) THEN 421 IF ( lk_oasis ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OPA-wave coupling 422 CALL sbc_wave ( kt, Kmm ) 423 ENDIF 426 424 CALL sbc_blk ( kt ) ! bulk formulation for the ocean 427 425 ! … … 437 435 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! forced-coupled mixed formulation after forcing 438 436 ! 439 IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( ) ! Wind stress provided by waves 437 IF( ln_wave .AND. ln_tauoc ) THEN ! Wave stress reduction 438 DO_2D( 0, 0, 0, 0) 439 utau(ji,jj) = utau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji-1,jj) ) * 0.5_wp 440 vtau(ji,jj) = vtau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji,jj-1) ) * 0.5_wp 441 END_2D 442 ! 443 CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 444 CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 445 ! 446 taum(:,:) = taum(:,:)*tauoc_wave(:,:) 447 ! 448 IF( kt == nit000 ) CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.', & 449 & 'If not requested select ln_tauoc=.false.' ) 450 ! 451 ELSEIF( ln_wave .AND. ln_taw ) THEN ! Wave stress reduction 452 utau(:,:) = utau(:,:) - tawx(:,:) + twox(:,:) 453 vtau(:,:) = vtau(:,:) - tawy(:,:) + twoy(:,:) 454 CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 455 CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 456 ! 457 DO_2D( 0, 0, 0, 0) 458 taum(ji,jj) = sqrt((.5*(utau(ji-1,jj)+utau(ji,jj)))**2 + (.5*(vtau(ji,jj-1)+vtau(ji,jj)))**2) 459 END_2D 460 ! 461 IF( kt == nit000 ) CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.', & 462 & 'If not requested select ln_taw=.false.' ) 463 ! 464 ENDIF 465 CALL lbc_lnk( 'sbcmod', taum(:,:), 'T', 1. ) 440 466 ! 441 467 ! !== Misc. Options ==! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcwave.F90
r13546 r14021 2 2 !!====================================================================== 3 3 !! *** MODULE sbcwave *** 4 !! Wave module 4 !! Wave module 5 5 !!====================================================================== 6 !! History : 3.3 ! 2011-09 (M. Adani) Original code: Drag Coefficient 7 !! : 3.4 ! 2012-10 (M. Adani) Stokes Drift 6 !! History : 3.3 ! 2011-09 (M. Adani) Original code: Drag Coefficient 7 !! : 3.4 ! 2012-10 (M. Adani) Stokes Drift 8 8 !! 3.6 ! 2014-09 (E. Clementi,P. Oddo) New Stokes Drift Computation 9 9 !! - ! 2016-12 (G. Madec, E. Clementi) update Stoke drift computation 10 10 !! + add sbc_wave_ini routine 11 !! 4.2 ! 2020-12 (G. Madec, E. Clementi) updates, new Stoke drift computation 12 !! according to Couvelard et al.,2019 11 13 !!---------------------------------------------------------------------- 12 14 13 15 !!---------------------------------------------------------------------- 14 16 !! sbc_stokes : calculate 3D Stokes-drift velocities 15 !! sbc_wave : wave data from wave model in netcdf files16 !! sbc_wave_init : initialisation fo surface waves 17 !! sbc_wave : wave data from wave model: forced (netcdf files) or coupled mode 18 !! sbc_wave_init : initialisation fo surface waves 17 19 !!---------------------------------------------------------------------- 18 USE phycst ! physical constants 20 USE phycst ! physical constants 19 21 USE oce ! ocean variables 20 USE sbc_oce ! Surface boundary condition: ocean fields21 USE zdf_oce, ONLY : ln_zdfswm22 USE dom_oce ! ocean domain variables 23 USE sbc_oce ! Surface boundary condition: ocean fields 22 24 USE bdy_oce ! open boundary condition variables 23 25 USE domvvl ! domain: variable volume layers … … 26 28 USE in_out_manager ! I/O manager 27 29 USE lib_mpp ! distribued memory computing library 28 USE fldread 30 USE fldread ! read input fields 29 31 30 32 IMPLICIT NONE … … 32 34 33 35 PUBLIC sbc_stokes ! routine called in sbccpl 34 PUBLIC sbc_wstress ! routine called in sbcmod35 36 PUBLIC sbc_wave ! routine called in sbcmod 36 37 PUBLIC sbc_wave_init ! routine called in sbcmod 37 38 38 39 ! Variables checking if the wave parameters are coupled (if not, they are read from file) 39 LOGICAL, PUBLIC :: cpl_hsig = .FALSE. 40 LOGICAL, PUBLIC :: cpl_phioc = .FALSE. 41 LOGICAL, PUBLIC :: cpl_sdrftx = .FALSE. 42 LOGICAL, PUBLIC :: cpl_sdrfty = .FALSE. 43 LOGICAL, PUBLIC :: cpl_wper = .FALSE. 44 LOGICAL, PUBLIC :: cpl_wfreq = .FALSE. 45 LOGICAL, PUBLIC :: cpl_wnum = .FALSE. 46 LOGICAL, PUBLIC :: cpl_tauwoc = .FALSE. 47 LOGICAL, PUBLIC :: cpl_tauw = .FALSE. 48 LOGICAL, PUBLIC :: cpl_wdrag = .FALSE. 40 LOGICAL, PUBLIC :: cpl_hsig = .FALSE. 41 LOGICAL, PUBLIC :: cpl_phioc = .FALSE. 42 LOGICAL, PUBLIC :: cpl_sdrftx = .FALSE. 43 LOGICAL, PUBLIC :: cpl_sdrfty = .FALSE. 44 LOGICAL, PUBLIC :: cpl_wper = .FALSE. 45 LOGICAL, PUBLIC :: cpl_wnum = .FALSE. 46 LOGICAL, PUBLIC :: cpl_wstrf = .FALSE. 47 LOGICAL, PUBLIC :: cpl_wdrag = .FALSE. 48 LOGICAL, PUBLIC :: cpl_charn = .FALSE. 49 LOGICAL, PUBLIC :: cpl_taw = .FALSE. 50 LOGICAL, PUBLIC :: cpl_bhd = .FALSE. 51 LOGICAL, PUBLIC :: cpl_tusd = .FALSE. 52 LOGICAL, PUBLIC :: cpl_tvsd = .FALSE. 49 53 50 54 INTEGER :: jpfld ! number of files to read for stokes drift … … 53 57 INTEGER :: jp_hsw ! index of significant wave hight (m) at T-point 54 58 INTEGER :: jp_wmp ! index of mean wave period (s) at T-point 55 INTEGER :: jp_wfr ! index of wave peak frequency (1/s) at T-point56 59 57 60 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_cd ! structure of input fields (file informations, fields read) Drag Coefficient 58 61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sd ! structure of input fields (file informations, fields read) Stokes Drift 59 62 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_wn ! structure of input fields (file informations, fields read) wave number for Qiao 60 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tauwoc ! structure of input fields (file informations, fields read) normalized wave stress into the ocean 61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tauw ! structure of input fields (file informations, fields read) ocean stress components from wave model 62 63 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: cdn_wave !: 64 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hsw, wmp, wnum !: 65 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: wfreq !: 66 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauoc_wave !: 67 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauw_x, tauw_y !: 68 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tsd2d !: 69 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: div_sd !: barotropic stokes drift divergence 70 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ut0sd, vt0sd !: surface Stokes drift velocities at t-point 71 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: usd , vsd , wsd !: Stokes drift velocities at u-, v- & w-points, resp. 72 63 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tauoc ! structure of input fields (file informations, fields read) normalized wave stress into the ocean 64 65 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: cdn_wave !: Neutral drag coefficient at t-point 66 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hsw !: Significant Wave Height at t-point 67 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: wmp !: Wave Mean Period at t-point 68 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: wnum !: Wave Number at t-point 69 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauoc_wave !: stress reduction factor at t-point 70 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tsd2d !: Surface Stokes Drift module at t-point 71 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: div_sd !: barotropic stokes drift divergence 72 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ut0sd, vt0sd !: surface Stokes drift velocities at t-point 73 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: usd, vsd, wsd !: Stokes drift velocities at u-, v- & w-points, resp.u 74 ! 75 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: charn !: charnock coefficient at t-point 76 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tawx !: Net wave-supported stress, u 77 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tawy !: Net wave-supported stress, v 78 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: twox !: wave-ocean momentum flux, u 79 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: twoy !: wave-ocean momentum flux, v 80 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauoc_wavex !: stress reduction factor at, u component 81 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauoc_wavey !: stress reduction factor at, v component 82 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: phioc !: tke flux from wave model 83 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: KZN2 !: Kz*N2 84 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: bhd_wave !: Bernoulli head. wave induce pression 85 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tusd, tvsd !: Stokes drift transport 86 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: ZMX !: Kz*N2 73 87 !! * Substitutions 74 88 # include "do_loop_substitute.h90" … … 88 102 !! 2014 (DOI: 10.1175/JPO-D-14-0020.1) 89 103 !! 90 !! ** Method : - Calculate Stokes transport speed 91 !! - Calculate horizontal divergence 92 !! - Integrate the horizontal divergenze from the bottom 93 !! ** action 104 !! ** Method : - Calculate the horizontal Stokes drift velocity (Breivik et al. 2014) 105 !! - Calculate its horizontal divergence 106 !! - Calculate the vertical Stokes drift velocity 107 !! - Calculate the barotropic Stokes drift divergence 108 !! 109 !! ** action : - tsd2d : module of the surface Stokes drift velocity 110 !! - usd, vsd, wsd : 3 components of the Stokes drift velocity 111 !! - div_sd : barotropic Stokes drift divergence 94 112 !!--------------------------------------------------------------------- 95 113 INTEGER, INTENT(in) :: Kmm ! ocean time level index 96 114 INTEGER :: jj, ji, jk ! dummy loop argument 97 INTEGER :: ik ! local integer 98 REAL(wp) :: ztransp, zfac, zsp0 99 REAL(wp) :: zdepth, zsqrt_depth, zexp_depth, z_two_thirds, zsqrtpi !sqrt of pi 100 REAL(wp) :: zbot_u, zbot_v, zkb_u, zkb_v, zke3_u, zke3_v, zda_u, zda_v 101 REAL(wp) :: zstokes_psi_u_bot, zstokes_psi_v_bot 102 REAL(wp) :: zdep_u, zdep_v, zkh_u, zkh_v 103 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zk_t, zk_u, zk_v, zu0_sd, zv0_sd ! 2D workspace 104 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zstokes_psi_u_top, zstokes_psi_v_top ! 2D workspace 105 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ze3divh ! 3D workspace 106 !!--------------------------------------------------------------------- 107 ! 108 ALLOCATE( ze3divh(jpi,jpj,jpkm1) ) ! jpkm1 -> avoid lbc_lnk on jpk that is not defined 115 INTEGER :: ik ! local integer 116 REAL(wp) :: ztransp, zfac, ztemp, zsp0, zsqrt, zbreiv16_w 117 REAL(wp) :: zdep_u, zdep_v, zkh_u, zkh_v, zda_u, zda_v, sdtrp 118 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zk_t, zk_u, zk_v, zu0_sd, zv0_sd ! 2D workspace 119 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ze3divh, zInt_w ! 3D workspace 120 !!--------------------------------------------------------------------- 121 ! 122 ALLOCATE( ze3divh(jpi,jpj,jpkm1) ) ! jpkm1 -> avoid lbc_lnk on jpk that is not defined 123 ALLOCATE( zInt_w(jpi,jpj,jpk) ) 109 124 ALLOCATE( zk_t(jpi,jpj), zk_u(jpi,jpj), zk_v(jpi,jpj), zu0_sd(jpi,jpj), zv0_sd(jpi,jpj) ) 125 zk_t (:,:) = 0._wp 126 zk_u (:,:) = 0._wp 127 zk_v (:,:) = 0._wp 128 zu0_sd (:,:) = 0._wp 129 zv0_sd (:,:) = 0._wp 130 ze3divh (:,:,:) = 0._wp 131 110 132 ! 111 133 ! select parameterization for the calculation of vertical Stokes drift 112 134 ! exp. wave number at t-point 113 IF( ll_st_bv_li ) THEN ! (Eq. (19) in Breivik et al. (2014) ) 135 IF( ln_breivikFV_2016 ) THEN 136 ! Assumptions : ut0sd and vt0sd are surface Stokes drift at T-points 137 ! sdtrp is the norm of Stokes transport 138 ! 139 zfac = 0.166666666667_wp 140 DO_2D( 1, 1, 1, 1 ) ! In the deep-water limit we have ke = ||ust0||/( 6 * ||transport|| ) 141 zsp0 = SQRT( ut0sd(ji,jj)*ut0sd(ji,jj) + vt0sd(ji,jj)*vt0sd(ji,jj) ) !<-- norm of Surface Stokes drift 142 tsd2d(ji,jj) = zsp0 143 IF( cpl_tusd .AND. cpl_tvsd ) THEN !stokes transport is provided in coupled mode 144 sdtrp = SQRT( tusd(ji,jj)*tusd(ji,jj) + tvsd(ji,jj)*tvsd(ji,jj) ) !<-- norm of Surface Stokes drift transport 145 ELSE 146 ! Stokes drift transport estimated from Hs and Tmean 147 sdtrp = 2.0_wp * rpi / 16.0_wp * & 148 & hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp ) 149 ENDIF 150 zk_t (ji,jj) = zfac * zsp0 / MAX ( sdtrp, 0.0000001_wp ) !<-- ke = ||ust0||/( 6 * ||transport|| ) 151 END_2D 152 !# define zInt_w ze3divh 153 DO_3D( 1, 1, 1, 1, 1, jpk ) ! Compute the primitive of Breivik 2016 function at W-points 154 zfac = - 2._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm) !<-- zfac should be negative definite 155 ztemp = EXP ( zfac ) 156 zsqrt = SQRT( -zfac ) 157 zbreiv16_w = ztemp - SQRT(rpi)*zsqrt*ERFC(zsqrt) !Eq. 16 Breivik 2016 158 zInt_w(ji,jj,jk) = ztemp - 4._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm) * zbreiv16_w 159 END_3D 160 ! 161 DO jk = 1, jpkm1 162 zfac = 0.166666666667_wp 163 DO_2D( 1, 1, 1, 1 ) !++ Compute the FV Breivik 2016 function at T-points 164 zsp0 = zfac / MAX(zk_t (ji,jj),0.0000001_wp) 165 ztemp = zInt_w(ji,jj,jk) - zInt_w(ji,jj,jk+1) 166 zu0_sd(ji,jj) = ut0sd(ji,jj) * zsp0 * ztemp * tmask(ji,jj,jk) 167 zv0_sd(ji,jj) = vt0sd(ji,jj) * zsp0 * ztemp * tmask(ji,jj,jk) 168 END_2D 169 DO_2D( 1, 0, 1, 0 ) ! ++ Interpolate at U/V points 170 zfac = 1.0_wp / e3u(ji ,jj,jk,Kmm) 171 usd(ji,jj,jk) = 0.5_wp * zfac * ( zu0_sd(ji,jj)+zu0_sd(ji+1,jj) ) * umask(ji,jj,jk) 172 zfac = 1.0_wp / e3v(ji ,jj,jk,Kmm) 173 vsd(ji,jj,jk) = 0.5_wp * zfac * ( zv0_sd(ji,jj)+zv0_sd(ji,jj+1) ) * vmask(ji,jj,jk) 174 END_2D 175 ENDDO 176 !# undef zInt_w 177 ! 178 ELSE 114 179 zfac = 2.0_wp * rpi / 16.0_wp 115 180 DO_2D( 1, 1, 1, 1 ) … … 128 193 zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) ) 129 194 END_2D 130 ELSE IF( ll_st_peakfr ) THEN ! peak wave number calculated from the peak frequency received by the wave model 131 DO_2D( 1, 1, 1, 1 ) 132 zk_t(ji,jj) = ( 2.0_wp * rpi * wfreq(ji,jj) ) * ( 2.0_wp * rpi * wfreq(ji,jj) ) / grav 133 END_2D 134 DO_2D( 1, 0, 1, 0 ) 135 zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) ) 136 zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) ) 137 ! 138 zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) ) 139 zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) ) 140 END_2D 141 ENDIF 142 ! 195 143 196 ! !== horizontal Stokes Drift 3D velocity ==! 144 IF( ll_st_bv2014 ) THEN 197 145 198 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 146 199 zdep_u = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji+1,jj,jk,Kmm) ) 147 200 zdep_v = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji,jj+1,jk,Kmm) ) 148 ! 201 ! 149 202 zkh_u = zk_u(ji,jj) * zdep_u ! k * depth 150 203 zkh_v = zk_v(ji,jj) * zdep_v … … 156 209 vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk) 157 210 END_3D 158 ELSE IF( ll_st_li2017 .OR. ll_st_peakfr ) THEN159 ALLOCATE( zstokes_psi_u_top(jpi,jpj), zstokes_psi_v_top(jpi,jpj) )160 DO_2D( 1, 0, 1, 0 )161 zstokes_psi_u_top(ji,jj) = 0._wp162 zstokes_psi_v_top(ji,jj) = 0._wp163 END_2D164 zsqrtpi = SQRT(rpi)165 z_two_thirds = 2.0_wp / 3.0_wp166 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! exp. wave number & Stokes drift velocity at u- & v-points167 zbot_u = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji+1,jj,jk+1,Kmm) ) ! 2 * bottom depth168 zbot_v = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji,jj+1,jk+1,Kmm) ) ! 2 * bottom depth169 zkb_u = zk_u(ji,jj) * zbot_u ! 2 * k * bottom depth170 zkb_v = zk_v(ji,jj) * zbot_v ! 2 * k * bottom depth171 !172 zke3_u = MAX(1.e-8_wp, 2.0_wp * zk_u(ji,jj) * e3u(ji,jj,jk,Kmm)) ! 2k * thickness173 zke3_v = MAX(1.e-8_wp, 2.0_wp * zk_v(ji,jj) * e3v(ji,jj,jk,Kmm)) ! 2k * thickness174 175 ! Depth attenuation .... do u component first..176 zdepth = zkb_u177 zsqrt_depth = SQRT(zdepth)178 zexp_depth = EXP(-zdepth)179 zstokes_psi_u_bot = 1.0_wp - zexp_depth &180 & - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) &181 & + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )182 zda_u = ( zstokes_psi_u_bot - zstokes_psi_u_top(ji,jj) ) / zke3_u183 zstokes_psi_u_top(ji,jj) = zstokes_psi_u_bot184 185 ! ... and then v component186 zdepth =zkb_v187 zsqrt_depth = SQRT(zdepth)188 zexp_depth = EXP(-zdepth)189 zstokes_psi_v_bot = 1.0_wp - zexp_depth &190 & - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) &191 & + 1.0_wp - (1.0_wp + zdepth)*zexp_depth )192 zda_v = ( zstokes_psi_v_bot - zstokes_psi_v_top(ji,jj) ) / zke3_v193 zstokes_psi_v_top(ji,jj) = zstokes_psi_v_bot194 !195 usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk)196 vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk)197 END_3D198 DEALLOCATE( zstokes_psi_u_top, zstokes_psi_v_top )199 211 ENDIF 200 212 … … 228 240 ! !== Horizontal divergence of barotropic Stokes transport ==! 229 241 div_sd(:,:) = 0._wp 230 DO jk = 1, jpkm1 ! 242 DO jk = 1, jpkm1 ! 231 243 div_sd(:,:) = div_sd(:,:) + ze3divh(:,:,jk) 232 244 END DO … … 235 247 CALL iom_put( "vstokes", vsd ) 236 248 CALL iom_put( "wstokes", wsd ) 237 !238 DEALLOCATE( ze3divh )249 ! ! 250 DEALLOCATE( ze3divh, zInt_w ) 239 251 DEALLOCATE( zk_t, zk_u, zk_v, zu0_sd, zv0_sd ) 240 252 ! 241 253 END SUBROUTINE sbc_stokes 242 243 244 SUBROUTINE sbc_wstress( ) 245 !!--------------------------------------------------------------------- 246 !! *** ROUTINE sbc_wstress *** 247 !! 248 !! ** Purpose : Updates the ocean momentum modified by waves 249 !! 250 !! ** Method : - Calculate u,v components of stress depending on stress 251 !! model 252 !! - Calculate the stress module 253 !! - The wind module is not modified by waves 254 !! ** action 255 !!--------------------------------------------------------------------- 256 INTEGER :: jj, ji ! dummy loop argument 257 ! 258 IF( ln_tauwoc ) THEN 259 utau(:,:) = utau(:,:)*tauoc_wave(:,:) 260 vtau(:,:) = vtau(:,:)*tauoc_wave(:,:) 261 taum(:,:) = taum(:,:)*tauoc_wave(:,:) 262 ENDIF 263 ! 264 IF( ln_tauw ) THEN 265 DO_2D( 1, 0, 1, 0 ) 266 ! Stress components at u- & v-points 267 utau(ji,jj) = 0.5_wp * ( tauw_x(ji,jj) + tauw_x(ji+1,jj) ) 268 vtau(ji,jj) = 0.5_wp * ( tauw_y(ji,jj) + tauw_y(ji,jj+1) ) 269 ! 270 ! Stress module at t points 271 taum(ji,jj) = SQRT( tauw_x(ji,jj)*tauw_x(ji,jj) + tauw_y(ji,jj)*tauw_y(ji,jj) ) 272 END_2D 273 CALL lbc_lnk_multi( 'sbcwave', utau(:,:), 'U', -1.0_wp , vtau(:,:), 'V', -1.0_wp , taum(:,:) , 'T', -1.0_wp ) 274 ENDIF 275 ! 276 END SUBROUTINE sbc_wstress 277 278 254 ! 255 ! 279 256 SUBROUTINE sbc_wave( kt, Kmm ) 280 257 !!--------------------------------------------------------------------- 281 258 !! *** ROUTINE sbc_wave *** 282 259 !! 283 !! ** Purpose : read wave parameters from wave model in netcdf files. 284 !! 285 !! ** Method : - Read namelist namsbc_wave 286 !! - Read Cd_n10 fields in netcdf files 287 !! - Read stokes drift 2d in netcdf files 288 !! - Read wave number in netcdf files 289 !! - Compute 3d stokes drift using Breivik et al.,2014 290 !! formulation 291 !! ** action 260 !! ** Purpose : read wave parameters from wave model in netcdf files 261 !! or from a coupled wave mdoel 262 !! 292 263 !!--------------------------------------------------------------------- 293 264 INTEGER, INTENT(in ) :: kt ! ocean time step 294 265 INTEGER, INTENT(in ) :: Kmm ! ocean time index 295 266 !!--------------------------------------------------------------------- 267 ! 268 IF( kt == nit000 .AND. lwp ) THEN 269 WRITE(numout,*) 270 WRITE(numout,*) 'sbc_wave : update the read waves fields' 271 WRITE(numout,*) '~~~~~~~~ ' 272 ENDIF 296 273 ! 297 274 IF( ln_cdgw .AND. .NOT. cpl_wdrag ) THEN !== Neutral drag coefficient ==! … … 300 277 ENDIF 301 278 302 IF( ln_tauwoc .AND. .NOT. cpl_tauwoc ) THEN !== Wave induced stress ==! 303 CALL fld_read( kt, nn_fsbc, sf_tauwoc ) ! read wave norm stress from external forcing 304 tauoc_wave(:,:) = sf_tauwoc(1)%fnow(:,:,1) * tmask(:,:,1) 305 ENDIF 306 307 IF( ln_tauw .AND. .NOT. cpl_tauw ) THEN !== Wave induced stress ==! 308 CALL fld_read( kt, nn_fsbc, sf_tauw ) ! read ocean stress components from external forcing (T grid) 309 tauw_x(:,:) = sf_tauw(1)%fnow(:,:,1) * tmask(:,:,1) 310 tauw_y(:,:) = sf_tauw(2)%fnow(:,:,1) * tmask(:,:,1) 311 ENDIF 312 313 IF( ln_sdw ) THEN !== Computation of the 3d Stokes Drift ==! 279 IF( ln_tauoc .AND. .NOT. cpl_wstrf ) THEN !== Wave induced stress ==! 280 CALL fld_read( kt, nn_fsbc, sf_tauoc ) ! read stress reduction factor due to wave from external forcing 281 tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1) * tmask(:,:,1) 282 ELSEIF ( ln_taw .AND. cpl_taw ) THEN 283 IF (kt < 1) THEN ! The first fields gave by OASIS have very high erroneous values .... 284 twox(:,:)=0._wp 285 twoy(:,:)=0._wp 286 tawx(:,:)=0._wp 287 tawy(:,:)=0._wp 288 tauoc_wavex(:,:) = 1._wp 289 tauoc_wavey(:,:) = 1._wp 290 ELSE 291 tauoc_wavex(:,:) = abs(twox(:,:)/tawx(:,:)) 292 tauoc_wavey(:,:) = abs(twoy(:,:)/tawy(:,:)) 293 ENDIF 294 ENDIF 295 296 IF ( ln_phioc .and. cpl_phioc .and. kt == nit000 ) THEN 297 WRITE(numout,*) 298 WRITE(numout,*) 'sbc_wave : PHIOC from wave model' 299 WRITE(numout,*) '~~~~~~~~ ' 300 ENDIF 301 302 IF( ln_sdw .AND. .NOT. cpl_sdrftx) THEN !== Computation of the 3d Stokes Drift ==! 314 303 ! 315 304 IF( jpfld > 0 ) THEN ! Read from file only if the field is not coupled 316 305 CALL fld_read( kt, nn_fsbc, sf_sd ) ! read wave parameters from external forcing 306 ! ! NB: test case mode, not read as jpfld=0 317 307 IF( jp_hsw > 0 ) hsw (:,:) = sf_sd(jp_hsw)%fnow(:,:,1) * tmask(:,:,1) ! significant wave height 318 308 IF( jp_wmp > 0 ) wmp (:,:) = sf_sd(jp_wmp)%fnow(:,:,1) * tmask(:,:,1) ! wave mean period 319 IF( jp_wfr > 0 ) wfreq(:,:) = sf_sd(jp_wfr)%fnow(:,:,1) * tmask(:,:,1) ! Peak wave frequency320 309 IF( jp_usd > 0 ) ut0sd(:,:) = sf_sd(jp_usd)%fnow(:,:,1) * tmask(:,:,1) ! 2D zonal Stokes Drift at T point 321 310 IF( jp_vsd > 0 ) vt0sd(:,:) = sf_sd(jp_vsd)%fnow(:,:,1) * tmask(:,:,1) ! 2D meridional Stokes Drift at T point 322 311 ENDIF 323 312 ! 324 ! Read also wave number if needed, so that it is available in coupling routines 325 IF( ln_zdfswm .AND. .NOT.cpl_wnum ) THEN 326 CALL fld_read( kt, nn_fsbc, sf_wn ) ! read wave parameters from external forcing 327 wnum(:,:) = sf_wn(1)%fnow(:,:,1) * tmask(:,:,1) 328 ENDIF 329 330 ! Calculate only if required fields have been read 331 ! In coupled wave model-NEMO case the call is done after coupling 313 IF( jpfld == 4 .OR. ln_wave_test ) & 314 & CALL sbc_stokes( Kmm ) ! Calculate only if all required fields are read 315 ! ! or in wave test case 316 ! ! ! In coupled case the call is done after (in sbc_cpl) 317 ENDIF 332 318 ! 333 IF( ( ll_st_bv_li .AND. jp_hsw>0 .AND. jp_wmp>0 .AND. jp_usd>0 .AND. jp_vsd>0 ) .OR. &334 & ( ll_st_peakfr .AND. jp_wfr>0 .AND. jp_usd>0 .AND. jp_vsd>0 ) ) CALL sbc_stokes( Kmm )335 !336 ENDIF337 !338 319 END SUBROUTINE sbc_wave 339 320 … … 343 324 !! *** ROUTINE sbc_wave_init *** 344 325 !! 345 !! ** Purpose : read wave parameters from wave model in netcdf files.326 !! ** Purpose : Initialisation fo surface waves 346 327 !! 347 328 !! ** Method : - Read namelist namsbc_wave 348 !! - Read Cd_n10 fields in netcdf files 349 !! - Read stokes drift 2d in netcdf files 350 !! - Read wave number in netcdf files 351 !! - Compute 3d stokes drift using Breivik et al.,2014 352 !! formulation 353 !! ** action 329 !! - create the structure used to read required wave fields 330 !! (its size depends on namelist options) 331 !! ** action 354 332 !!--------------------------------------------------------------------- 355 333 INTEGER :: ierror, ios ! local integer … … 357 335 !! 358 336 CHARACTER(len=100) :: cn_dir ! Root directory for location of drag coefficient files 359 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i , slf_j! array of namelist informations on the fields to read337 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read 360 338 TYPE(FLD_N) :: sn_cdg, sn_usd, sn_vsd, & 361 & sn_hsw, sn_wmp, sn_wfr, sn_wnum, & 362 & sn_tauwoc, sn_tauwx, sn_tauwy ! informations about the fields to be read 363 ! 364 NAMELIST/namsbc_wave/ sn_cdg, cn_dir, sn_usd, sn_vsd, sn_hsw, sn_wmp, sn_wfr, & 365 sn_wnum, sn_tauwoc, sn_tauwx, sn_tauwy 366 !!--------------------------------------------------------------------- 339 & sn_hsw, sn_wmp, sn_wnum, sn_tauoc ! informations about the fields to be read 340 ! 341 NAMELIST/namsbc_wave/ cn_dir, sn_cdg, sn_usd, sn_vsd, sn_hsw, sn_wmp, sn_wnum, sn_tauoc, & 342 & ln_cdgw, ln_sdw, ln_tauoc, ln_stcor, ln_charn, ln_taw, ln_phioc, & 343 & ln_wave_test, ln_bern_srfc, ln_breivikFV_2016, ln_vortex_force, ln_stshear 344 !!--------------------------------------------------------------------- 345 IF(lwp) THEN 346 WRITE(numout,*) 347 WRITE(numout,*) 'sbc_wave_init : surface waves in the system' 348 WRITE(numout,*) '~~~~~~~~~~~~~ ' 349 ENDIF 367 350 ! 368 351 READ ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901) 369 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist' 370 352 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in reference namelist') 353 371 354 READ ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 ) 372 355 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist' ) 373 356 IF(lwm) WRITE ( numond, namsbc_wave ) 374 357 ! 375 IF( ln_cdgw ) THEN 376 IF( .NOT. cpl_wdrag ) THEN 377 ALLOCATE( sf_cd(1), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg 378 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 358 IF(lwp) THEN 359 WRITE(numout,*) ' Namelist namsbc_wave' 360 WRITE(numout,*) ' Stokes drift ln_sdw = ', ln_sdw 361 WRITE(numout,*) ' Breivik 2016 ln_breivikFV_2016 = ', ln_breivikFV_2016 362 WRITE(numout,*) ' Stokes Coriolis & tracer advection terms ln_stcor = ', ln_stcor 363 WRITE(numout,*) ' Vortex Force ln_vortex_force = ', ln_vortex_force 364 WRITE(numout,*) ' Bernouilli Head Pressure ln_bern_srfc = ', ln_bern_srfc 365 WRITE(numout,*) ' wave modified ocean stress ln_tauoc = ', ln_tauoc 366 WRITE(numout,*) ' neutral drag coefficient (CORE bulk only) ln_cdgw = ', ln_cdgw 367 WRITE(numout,*) ' charnock coefficient ln_charn = ', ln_charn 368 WRITE(numout,*) ' Stress modificated by wave ln_taw = ', ln_taw 369 WRITE(numout,*) ' TKE flux from wave ln_phioc = ', ln_phioc 370 WRITE(numout,*) ' Surface shear with Stokes drift ln_stshear = ', ln_stshear 371 WRITE(numout,*) ' Test with constant wave fields ln_wave_test = ', ln_wave_test 372 ENDIF 373 374 ! ! option check 375 IF( .NOT.( ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor .OR. ln_charn) ) & 376 & CALL ctl_warn( 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauoc=F, ln_stcor=F') 377 IF( ln_cdgw .AND. ln_blk ) & 378 & CALL ctl_stop( 'drag coefficient read from wave model NOT available yet with aerobulk package') 379 IF( ln_stcor .AND. .NOT.ln_sdw ) & 380 & CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 381 382 ! !== Allocate wave arrays ==! 383 ALLOCATE( ut0sd (jpi,jpj) , vt0sd (jpi,jpj) ) 384 ALLOCATE( hsw (jpi,jpj) , wmp (jpi,jpj) ) 385 ALLOCATE( wnum (jpi,jpj) ) 386 ALLOCATE( tsd2d (jpi,jpj) , div_sd(jpi,jpj) , bhd_wave(jpi,jpj) ) 387 ALLOCATE( usd (jpi,jpj,jpk), vsd (jpi,jpj,jpk), wsd (jpi,jpj,jpk) ) 388 ALLOCATE( tusd (jpi,jpj) , tvsd (jpi,jpj) , ZMX (jpi,jpj,jpk) ) 389 usd (:,:,:) = 0._wp 390 vsd (:,:,:) = 0._wp 391 wsd (:,:,:) = 0._wp 392 hsw (:,:) = 0._wp 393 wmp (:,:) = 0._wp 394 ut0sd (:,:) = 0._wp 395 vt0sd (:,:) = 0._wp 396 tusd (:,:) = 0._wp 397 tvsd (:,:) = 0._wp 398 bhd_wave(:,:) = 0._wp 399 ZMX (:,:,:) = 0._wp 400 ! 401 IF( ln_wave_test ) THEN !== Wave TEST case ==! set uniform waves fields 402 jpfld = 0 ! No field read 403 ln_cdgw = .FALSE. ! No neutral wave drag input 404 ln_tauoc = .FALSE. ! No wave induced drag reduction factor 405 ut0sd(:,:) = 0.13_wp * tmask(:,:,1) ! m/s 406 vt0sd(:,:) = 0.00_wp ! m/s 407 hsw (:,:) = 2.80_wp ! meters 408 wmp (:,:) = 8.00_wp ! seconds 409 ! 410 ELSE !== create the structure associated with fields to be read ==! 411 IF( ln_cdgw ) THEN ! wave drag 412 IF( .NOT. cpl_wdrag ) THEN 413 ALLOCATE( sf_cd(1), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg 414 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 415 ! 416 ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1) ) 417 IF( sn_cdg%ln_tint ) ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) ) 418 CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 419 ENDIF 420 ALLOCATE( cdn_wave(jpi,jpj) ) 421 cdn_wave(:,:) = 0._wp 422 ENDIF 423 IF( ln_charn ) THEN ! wave drag 424 IF( .NOT. cpl_charn ) THEN 425 CALL ctl_stop( 'STOP', 'Charnock based wind stress can be used in coupled mode only' ) 426 ENDIF 427 ALLOCATE( charn(jpi,jpj) ) 428 charn(:,:) = 0._wp 429 ENDIF 430 IF( ln_taw ) THEN ! wind stress 431 IF( .NOT. cpl_taw ) THEN 432 CALL ctl_stop( 'STOP', 'wind stress from wave model can be used in coupled mode only, use ln_cdgw instead' ) 433 ENDIF 434 ALLOCATE( tawx(jpi,jpj) ) 435 ALLOCATE( tawy(jpi,jpj) ) 436 ALLOCATE( twox(jpi,jpj) ) 437 ALLOCATE( twoy(jpi,jpj) ) 438 ALLOCATE( tauoc_wavex(jpi,jpj) ) 439 ALLOCATE( tauoc_wavey(jpi,jpj) ) 440 tawx(:,:) = 0._wp 441 tawy(:,:) = 0._wp 442 twox(:,:) = 0._wp 443 twoy(:,:) = 0._wp 444 tauoc_wavex(:,:) = 1._wp 445 tauoc_wavey(:,:) = 1._wp 446 ENDIF 447 448 IF( ln_phioc ) THEN ! TKE flux 449 IF( .NOT. cpl_phioc ) THEN 450 CALL ctl_stop( 'STOP', 'phioc can be used in coupled mode only' ) 451 ENDIF 452 ALLOCATE( phioc(jpi,jpj) ) 453 phioc(:,:) = 0._wp 454 ENDIF 455 456 IF( ln_tauoc ) THEN ! normalized wave stress into the ocean 457 IF( .NOT. cpl_wstrf ) THEN 458 ALLOCATE( sf_tauoc(1), STAT=ierror ) !* allocate and fill sf_wave with sn_tauoc 459 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_tauoc structure' ) 460 ! 461 ALLOCATE( sf_tauoc(1)%fnow(jpi,jpj,1) ) 462 IF( sn_tauoc%ln_tint ) ALLOCATE( sf_tauoc(1)%fdta(jpi,jpj,1,2) ) 463 CALL fld_fill( sf_tauoc, (/ sn_tauoc /), cn_dir, 'sbc_wave_init', 'Wave module', 'namsbc_wave' ) 464 ENDIF 465 ALLOCATE( tauoc_wave(jpi,jpj) ) 466 tauoc_wave(:,:) = 0._wp 467 ENDIF 468 469 IF( ln_sdw ) THEN ! Stokes drift 470 ! 1. Find out how many fields have to be read from file if not coupled 471 jpfld=0 472 jp_usd=0 ; jp_vsd=0 ; jp_hsw=0 ; jp_wmp=0 473 IF( .NOT. cpl_sdrftx ) THEN 474 jpfld = jpfld + 1 475 jp_usd = jpfld 476 ENDIF 477 IF( .NOT. cpl_sdrfty ) THEN 478 jpfld = jpfld + 1 479 jp_vsd = jpfld 480 ENDIF 481 IF( .NOT. cpl_hsig ) THEN 482 jpfld = jpfld + 1 483 jp_hsw = jpfld 484 ENDIF 485 IF( .NOT. cpl_wper ) THEN 486 jpfld = jpfld + 1 487 jp_wmp = jpfld 488 ENDIF 489 ! 2. Read from file only the non-coupled fields 490 IF( jpfld > 0 ) THEN 491 ALLOCATE( slf_i(jpfld) ) 492 IF( jp_usd > 0 ) slf_i(jp_usd) = sn_usd 493 IF( jp_vsd > 0 ) slf_i(jp_vsd) = sn_vsd 494 IF( jp_hsw > 0 ) slf_i(jp_hsw) = sn_hsw 495 IF( jp_wmp > 0 ) slf_i(jp_wmp) = sn_wmp 496 ALLOCATE( sf_sd(jpfld), STAT=ierror ) !* allocate and fill sf_sd with stokes drift 497 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 498 ! 499 DO ifpr= 1, jpfld 500 ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) ) 501 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) ) 502 END DO 503 ! 504 CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 505 ENDIF 379 506 ! 380 ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1) ) 381 IF( sn_cdg%ln_tint ) ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) ) 382 CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 383 ENDIF 384 ALLOCATE( cdn_wave(jpi,jpj) ) 385 ENDIF 386 387 IF( ln_tauwoc ) THEN 388 IF( .NOT. cpl_tauwoc ) THEN 389 ALLOCATE( sf_tauwoc(1), STAT=ierror ) !* allocate and fill sf_wave with sn_tauwoc 390 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 507 ! 3. Wave number (only needed for Qiao parametrisation, ln_zdfqiao=T) 508 IF( .NOT. cpl_wnum ) THEN 509 ALLOCATE( sf_wn(1), STAT=ierror ) !* allocate and fill sf_wave with sn_wnum 510 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wn structure' ) 511 ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1) ) 512 IF( sn_wnum%ln_tint ) ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) ) 513 CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' ) 514 ENDIF 391 515 ! 392 ALLOCATE( sf_tauwoc(1)%fnow(jpi,jpj,1) ) 393 IF( sn_tauwoc%ln_tint ) ALLOCATE( sf_tauwoc(1)%fdta(jpi,jpj,1,2) ) 394 CALL fld_fill( sf_tauwoc, (/ sn_tauwoc /), cn_dir, 'sbc_wave_init', 'Wave module', 'namsbc_wave' ) 395 ENDIF 396 ALLOCATE( tauoc_wave(jpi,jpj) ) 397 ENDIF 398 399 IF( ln_tauw ) THEN 400 IF( .NOT. cpl_tauw ) THEN 401 ALLOCATE( sf_tauw(2), STAT=ierror ) !* allocate and fill sf_wave with sn_tauwx/y 402 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_tauw structure' ) 403 ! 404 ALLOCATE( slf_j(2) ) 405 slf_j(1) = sn_tauwx 406 slf_j(2) = sn_tauwy 407 ALLOCATE( sf_tauw(1)%fnow(jpi,jpj,1) ) 408 ALLOCATE( sf_tauw(2)%fnow(jpi,jpj,1) ) 409 IF( slf_j(1)%ln_tint ) ALLOCATE( sf_tauw(1)%fdta(jpi,jpj,1,2) ) 410 IF( slf_j(2)%ln_tint ) ALLOCATE( sf_tauw(2)%fdta(jpi,jpj,1,2) ) 411 CALL fld_fill( sf_tauw, (/ slf_j /), cn_dir, 'sbc_wave_init', 'read wave input', 'namsbc_wave' ) 412 ENDIF 413 ALLOCATE( tauw_x(jpi,jpj) ) 414 ALLOCATE( tauw_y(jpi,jpj) ) 415 ENDIF 416 417 IF( ln_sdw ) THEN ! Find out how many fields have to be read from file if not coupled 418 jpfld=0 419 jp_usd=0 ; jp_vsd=0 ; jp_hsw=0 ; jp_wmp=0 ; jp_wfr=0 420 IF( .NOT. cpl_sdrftx ) THEN 421 jpfld = jpfld + 1 422 jp_usd = jpfld 423 ENDIF 424 IF( .NOT. cpl_sdrfty ) THEN 425 jpfld = jpfld + 1 426 jp_vsd = jpfld 427 ENDIF 428 IF( .NOT. cpl_hsig .AND. ll_st_bv_li ) THEN 429 jpfld = jpfld + 1 430 jp_hsw = jpfld 431 ENDIF 432 IF( .NOT. cpl_wper .AND. ll_st_bv_li ) THEN 433 jpfld = jpfld + 1 434 jp_wmp = jpfld 435 ENDIF 436 IF( .NOT. cpl_wfreq .AND. ll_st_peakfr ) THEN 437 jpfld = jpfld + 1 438 jp_wfr = jpfld 439 ENDIF 440 441 ! Read from file only the non-coupled fields 442 IF( jpfld > 0 ) THEN 443 ALLOCATE( slf_i(jpfld) ) 444 IF( jp_usd > 0 ) slf_i(jp_usd) = sn_usd 445 IF( jp_vsd > 0 ) slf_i(jp_vsd) = sn_vsd 446 IF( jp_hsw > 0 ) slf_i(jp_hsw) = sn_hsw 447 IF( jp_wmp > 0 ) slf_i(jp_wmp) = sn_wmp 448 IF( jp_wfr > 0 ) slf_i(jp_wfr) = sn_wfr 449 450 ALLOCATE( sf_sd(jpfld), STAT=ierror ) !* allocate and fill sf_sd with stokes drift 451 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 452 ! 453 DO ifpr= 1, jpfld 454 ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) ) 455 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) ) 456 END DO 457 ! 458 CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 459 ENDIF 460 ALLOCATE( usd (jpi,jpj,jpk), vsd (jpi,jpj,jpk), wsd(jpi,jpj,jpk) ) 461 ALLOCATE( hsw (jpi,jpj) , wmp (jpi,jpj) ) 462 ALLOCATE( wfreq(jpi,jpj) ) 463 ALLOCATE( ut0sd(jpi,jpj) , vt0sd(jpi,jpj) ) 464 ALLOCATE( div_sd(jpi,jpj) ) 465 ALLOCATE( tsd2d (jpi,jpj) ) 466 467 ut0sd(:,:) = 0._wp 468 vt0sd(:,:) = 0._wp 469 hsw(:,:) = 0._wp 470 wmp(:,:) = 0._wp 471 472 usd(:,:,:) = 0._wp 473 vsd(:,:,:) = 0._wp 474 wsd(:,:,:) = 0._wp 475 ! Wave number needed only if ln_zdfswm=T 476 IF( .NOT. cpl_wnum ) THEN 477 ALLOCATE( sf_wn(1), STAT=ierror ) !* allocate and fill sf_wave with sn_wnum 478 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave_init: unable toallocate sf_wave structure' ) 479 ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1) ) 480 IF( sn_wnum%ln_tint ) ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) ) 481 CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' ) 482 ENDIF 483 ALLOCATE( wnum(jpi,jpj) ) 516 ENDIF 517 ! 484 518 ENDIF 485 519 ! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/TRA/eosbn2.F90
r14017 r14021 56 56 ! !! * Interface 57 57 INTERFACE eos 58 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 58 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d 59 59 END INTERFACE 60 60 ! … … 574 574 ! 575 575 END SUBROUTINE eos_insitu_2d_t 576 577 578 SUBROUTINE eos_insitu_pot_2d( pts, prhop ) 579 !!---------------------------------------------------------------------- 580 !! *** ROUTINE eos_insitu_pot *** 581 !! 582 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 583 !! potential volumic mass (Kg/m3) from potential temperature and 584 !! salinity fields using an equation of state selected in the 585 !! namelist. 586 !! 587 !! ** Action : 588 !! - prhop, the potential volumic mass (Kg/m3) 589 !! 590 !!---------------------------------------------------------------------- 591 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 592 ! ! 2 : salinity [psu] 593 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out) :: prhop ! potential density (surface referenced) 594 ! 595 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 596 INTEGER :: jdof 597 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 598 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 599 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 600 !!---------------------------------------------------------------------- 601 ! 602 IF( ln_timing ) CALL timing_start('eos-pot') 603 ! 604 SELECT CASE ( neos ) 605 ! 606 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 607 ! 608 DO_2D( 1, 1, 1, 1 ) 609 ! 610 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 611 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 612 ztm = tmask(ji,jj,1) ! tmask 613 ! 614 zn0 = (((((EOS060*zt & 615 & + EOS150*zs+EOS050)*zt & 616 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 617 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 618 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 619 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 620 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 621 ! 622 ! 623 prhop(ji,jj) = zn0 * ztm ! potential density referenced at the surface 624 ! 625 END_2D 626 627 CASE( np_seos ) !== simplified EOS ==! 628 ! 629 DO_2D( 1, 1, 1, 1 ) 630 zt = pts (ji,jj,jp_tem) - 10._wp 631 zs = pts (ji,jj,jp_sal) - 35._wp 632 ztm = tmask(ji,jj,1) 633 ! ! potential density referenced at the surface 634 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 635 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 636 & - rn_nu * zt * zs 637 prhop(ji,jj) = ( rho0 + zn ) * ztm 638 ! 639 END_2D 640 ! 641 END SELECT 642 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prhop, clinfo1=' pot: ', kdim=1 ) 643 ! 644 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' ) 645 ! 646 IF( ln_timing ) CALL timing_stop('eos-pot') 647 ! 648 END SUBROUTINE eos_insitu_pot_2d 576 649 577 650 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/TRA/trazdf.F90
r14017 r14021 17 17 USE phycst ! physical constant 18 18 USE zdf_oce ! ocean vertical physics variables 19 USE zdfmfc ! Mass FLux Convection 19 20 USE sbc_oce ! surface boundary condition: ocean 20 21 USE ldftra ! lateral diffusion: eddy diffusivity … … 198 199 ENDIF 199 200 ! 201 ! Modification of diagonal to add MF scheme 202 IF ( ln_zdfmfc ) THEN 203 CALL diag_mfc( zwi, zwd, zws, p2dt, Kaa ) 204 END IF 205 ! 200 206 !! Matrix inversion from the first level 201 207 !!---------------------------------------------------------------------- … … 225 231 ! 226 232 ENDIF 233 ! 234 ! Modification of rhs to add MF scheme 235 IF ( ln_zdfmfc ) THEN 236 CALL rhs_mfc( pt(:,:,:,jn,Krhs), jn ) 237 END IF 227 238 ! 228 239 DO_2D( 0, 0, 0, 0 ) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/ZDF/zdf_oce.F90
r10425 r14021 40 40 LOGICAL , PUBLIC :: ln_zdfswm !: surface wave-induced mixing flag 41 41 LOGICAL , PUBLIC :: ln_zdfiwm !: internal wave-induced mixing flag 42 ! ! coefficients 42 LOGICAL , PUBLIC :: ln_zdfmfc !: convection: eddy diffusivity Mass Flux Convection 43 ! ! coefficients 43 44 REAL(wp), PUBLIC :: rn_avm0 !: vertical eddy viscosity (m2/s) 44 45 REAL(wp), PUBLIC :: rn_avt0 !: vertical eddy diffusivity (m2/s) … … 55 56 !!---------------------------------------------------------------------- 56 57 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 57 !! $Id$ 58 !! $Id$ 58 59 !! Software governed by the CeCILL license (see ./LICENSE) 59 60 !!---------------------------------------------------------------------- … … 66 67 ! 67 68 ALLOCATE( avm (jpi,jpj,jpk) , avm_k(jpi,jpj,jpk) , avs(jpi,jpj,jpk) , & 68 & avt (jpi,jpj,jpk) , avt_k(jpi,jpj,jpk) , en (jpi,jpj,jpk) , & 69 & avt (jpi,jpj,jpk) , avt_k(jpi,jpj,jpk) , en (jpi,jpj,jpk) , & 69 70 & avmb(jpk) , avtb(jpk) , avtb_2d(jpi,jpj) , STAT = zdf_oce_alloc ) 70 71 ! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/ZDF/zdfphy.F90
r13558 r14021 9 9 !!---------------------------------------------------------------------- 10 10 !! zdf_phy_init : initialization of all vertical physics packages 11 !! zdf_phy : upadate at each time-step the vertical mixing coeff. 11 !! zdf_phy : upadate at each time-step the vertical mixing coeff. 12 12 !!---------------------------------------------------------------------- 13 13 USE oce ! ocean dynamics and tracers variables 14 USE zdf_oce ! vertical physics: shared variables 14 USE zdf_oce ! vertical physics: shared variables 15 15 USE zdfdrg ! vertical physics: top/bottom drag coef. 16 16 USE zdfsh2 ! vertical physics: shear production term of TKE 17 USE zdfric ! vertical physics: RIChardson dependent vertical mixing 17 USE zdfric ! vertical physics: RIChardson dependent vertical mixing 18 18 USE zdftke ! vertical physics: TKE vertical mixing 19 19 USE zdfgls ! vertical physics: GLS vertical mixing 20 20 USE zdfosm ! vertical physics: OSMOSIS vertical mixing 21 USE zdfddm ! vertical physics: double diffusion mixing 22 USE zdfevd ! vertical physics: convection via enhanced vertical diffusion 23 USE zdfiwm ! vertical physics: internal wave-induced mixing 21 USE zdfddm ! vertical physics: double diffusion mixing 22 USE zdfevd ! vertical physics: convection via enhanced vertical diffusion 23 USE zdfmfc ! vertical physics: Mass Flux Convection 24 USE zdfiwm ! vertical physics: internal wave-induced mixing 24 25 USE zdfswm ! vertical physics: surface wave-induced mixing 25 26 USE zdfmxl ! vertical physics: mixed layer 26 27 USE tranpc ! convection: non penetrative adjustment 27 USE trc_oce ! variables shared between passive tracer & ocean 28 USE trc_oce ! variables shared between passive tracer & ocean 28 29 USE sbc_oce ! surface module (only for nn_isf in the option compatibility test) 29 30 USE sbcrnf ! surface boundary condition: runoff variables … … 45 46 PUBLIC zdf_phy ! called by step.F90 46 47 47 INTEGER :: nzdf_phy ! type of vertical closure used 48 INTEGER :: nzdf_phy ! type of vertical closure used 48 49 ! ! associated indicators 49 50 INTEGER, PARAMETER :: np_CST = 1 ! Constant Kz … … 65 66 !!---------------------------------------------------------------------- 66 67 !! *** ROUTINE zdf_phy_init *** 67 !! 68 !! 68 69 !! ** Purpose : initializations of the vertical ocean physics 69 70 !! 70 !! ** Method : Read namelist namzdf, control logicals 71 !! ** Method : Read namelist namzdf, control logicals 71 72 !! set horizontal shape and vertical profile of background mixing coef. 72 73 !!---------------------------------------------------------------------- … … 78 79 NAMELIST/namzdf/ ln_zdfcst, ln_zdfric, ln_zdftke, ln_zdfgls, & ! type of closure scheme 79 80 & ln_zdfosm, & ! type of closure scheme 81 & ln_zdfmfc, & ! convection : mass flux 80 82 & ln_zdfevd, nn_evdm, rn_evd , & ! convection : evd 81 83 & ln_zdfnpc, nn_npc , nn_npcp, & ! convection : npc … … 112 114 WRITE(numout,*) ' OSMOSIS-OBL closure (OSM) ln_zdfosm = ', ln_zdfosm 113 115 WRITE(numout,*) ' convection: ' 116 WRITE(numout,*) ' convection mass flux (mfc) ln_zdfmfc = ', ln_zdfmfc 114 117 WRITE(numout,*) ' enhanced vertical diffusion ln_zdfevd = ', ln_zdfevd 115 118 WRITE(numout,*) ' applied on momentum (=1/0) nn_evdm = ', nn_evdm … … 140 143 IF( nn_avb == 0 ) THEN ! Define avmb, avtb from namelist parameter 141 144 avmb(:) = rn_avm0 142 avtb(:) = rn_avt0 145 avtb(:) = rn_avt0 143 146 ELSE ! Background profile of avt (fit a theoretical/observational profile (Krauss 1990) 144 147 avmb(:) = rn_avm0 … … 147 150 ENDIF 148 151 ! ! 2D shape of the avtb 149 avtb_2d(:,:) = 1._wp ! uniform 152 avtb_2d(:,:) = 1._wp ! uniform 150 153 ! 151 154 IF( nn_havtb == 1 ) THEN ! decrease avtb by a factor of ten in the equatorial band … … 172 175 IF( ln_zdfnpc .AND. ln_zdfevd ) CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfnpc and ln_zdfevd' ) 173 176 IF( ln_zdfosm .AND. ln_zdfevd ) CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfosm and ln_zdfevd' ) 177 IF( ln_zdfmfc .AND. ln_zdfevd ) CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfmfc and ln_zdfevd' ) 178 IF( ln_zdfmfc .AND. ln_zdfnpc ) CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfmfc and ln_zdfnpc' ) 179 IF( ln_zdfmfc .AND. ln_zdfosm ) CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfmfc and ln_zdfosm' ) 174 180 IF( lk_top .AND. ln_zdfnpc ) CALL ctl_stop( 'zdf_phy_init: npc scheme is not working with key_top' ) 175 181 IF( lk_top .AND. ln_zdfosm ) CALL ctl_stop( 'zdf_phy_init: osmosis scheme is not working with key_top' ) 182 IF( lk_top .AND. ln_zdfmfc ) CALL ctl_stop( 'zdf_phy_init: Mass Flux scheme is not working with key_top' ) 176 183 IF(lwp) THEN 177 184 WRITE(numout,*) 178 185 IF ( ln_zdfnpc ) THEN ; WRITE(numout,*) ' ==>>> convection: use non penetrative convective scheme' 179 186 ELSEIF( ln_zdfevd ) THEN ; WRITE(numout,*) ' ==>>> convection: use enhanced vertical diffusion scheme' 187 ELSEIF( ln_zdfmfc ) THEN ; WRITE(numout,*) ' ==>>> convection: use Mass Flux scheme' 180 188 ELSE ; WRITE(numout,*) ' ==>>> convection: no specific scheme used' 181 189 ENDIF … … 190 198 191 199 ! !== type of vertical turbulent closure ==! (set nzdf_phy) 192 ioptio = 0 200 ioptio = 0 193 201 IF( ln_zdfcst ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_CST ; ENDIF 194 202 IF( ln_zdfric ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_RIC ; CALL zdf_ric_init ; ENDIF … … 205 213 ELSE ; l_zdfsh2 = .TRUE. 206 214 ENDIF 207 215 ! !== Mass Flux Convectiive algorithm ==! 216 IF( ln_zdfmfc ) CALL zdf_mfc_init ! Convection computed with eddy diffusivity mass flux 217 ! 208 218 ! !== gravity wave-driven mixing ==! 209 219 IF( ln_zdfiwm ) CALL zdf_iwm_init ! internal wave-driven mixing … … 226 236 !! ** Purpose : Update ocean physics at each time-step 227 237 !! 228 !! ** Method : 238 !! ** Method : 229 239 !! 230 240 !! ** Action : avm, avt vertical eddy viscosity and diffusivity at w-points … … 244 254 ! 245 255 ! !* bottom drag 246 CALL zdf_drg( kt, Kmm, mbkt , r_Cdmin_bot, r_Cdmax_bot, & ! <<== in 256 CALL zdf_drg( kt, Kmm, mbkt , r_Cdmin_bot, r_Cdmax_bot, & ! <<== in 247 257 & r_z0_bot, r_ke0_bot, rCd0_bot, & 248 258 & rCdU_bot ) ! ==>> out : bottom drag [m/s] 249 259 IF( ln_isfcav ) THEN !* top drag (ocean cavities) 250 CALL zdf_drg( kt, Kmm, mikt , r_Cdmin_top, r_Cdmax_top, & ! <<== in 260 CALL zdf_drg( kt, Kmm, mikt , r_Cdmin_top, r_Cdmax_top, & ! <<== in 251 261 & r_z0_top, r_ke0_top, rCd0_top, & 252 262 & rCdU_top ) ! ==>> out : bottom drag [m/s] … … 263 273 ENDIF 264 274 #endif 265 ! 275 ! 266 276 ! !== Kz from chosen turbulent closure ==! (avm_k, avt_k) 267 277 ! … … 280 290 !!gm avm(2:jpim1,2:jpjm1,1:jpkm1) = rn_avm0 * wmask(2:jpim1,2:jpjm1,1:jpkm1) 281 291 END SELECT 282 ! 292 ! 283 293 ! !== ocean Kz ==! (avt, avs, avm) 284 294 ! … … 302 312 ENDIF 303 313 ! 304 ! !* wave-induced mixing 305 IF( ln_zdfswm ) CALL zdf_swm( kt, Kmm, avm, avt, avs ) ! surface wave (Qiao et al. 2004) 314 ! !* wave-induced mixing 315 IF( ln_zdfswm ) CALL zdf_swm( kt, Kmm, avm, avt, avs ) ! surface wave (Qiao et al. 2004) 306 316 IF( ln_zdfiwm ) CALL zdf_iwm( kt, Kmm, avm, avt, avs ) ! internal wave (de Lavergne et al 2017) 307 317 308 #if defined key_agrif 318 #if defined key_agrif 309 319 ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2) 310 320 IF( l_zdfsh2 ) CALL Agrif_avm … … 330 340 IF( ln_zdftke ) CALL tke_rst( kt, 'WRITE' ) 331 341 IF( ln_zdfgls ) CALL gls_rst( kt, 'WRITE' ) 332 IF( ln_zdfric ) CALL ric_rst( kt, 'WRITE' ) 342 IF( ln_zdfric ) CALL ric_rst( kt, 'WRITE' ) 333 343 ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated 334 344 ENDIF -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/ZDF/zdfsh2.F90
r13497 r14021 2 2 !!====================================================================== 3 3 !! *** MODULE zdfsh2 *** 4 !! Ocean physics: shear production term of TKE 4 !! Ocean physics: shear production term of TKE 5 5 !!===================================================================== 6 6 !! History : - ! 2014-10 (A. Barthelemy, G. Madec) original code 7 7 !! NEMO 4.0 ! 2017-04 (G. Madec) remove u-,v-pts avm 8 !! NEMO 4.2 ! 2020-12 (G. Madec, E. Clementi) add Stokes Drift Shear 9 ! ! for wave coupling 8 10 !!---------------------------------------------------------------------- 9 11 … … 13 15 USE oce 14 16 USE dom_oce ! domain: ocean 17 USE sbcwave ! Surface Waves (add Stokes shear) 18 USE sbc_oce , ONLY: ln_stshear !Stoked Drift shear contribution 15 19 ! 16 20 USE in_out_manager ! I/O manager … … 21 25 22 26 PUBLIC zdf_sh2 ! called by zdftke, zdfglf, and zdfric 23 27 24 28 !! * Substitutions 25 29 # include "do_loop_substitute.h90" … … 32 36 CONTAINS 33 37 34 SUBROUTINE zdf_sh2( Kbb, Kmm, p_avm, p_sh2 ) 38 SUBROUTINE zdf_sh2( Kbb, Kmm, p_avm, p_sh2 ) 35 39 !!---------------------------------------------------------------------- 36 40 !! *** ROUTINE zdf_sh2 *** … … 40 44 !! ** Method : - a stable discretization of this term is linked to the 41 45 !! time-space discretization of the vertical diffusion 42 !! of the OGCM. NEMO uses C-grid, a leap-frog environment 46 !! of the OGCM. NEMO uses C-grid, a leap-frog environment 43 47 !! and an implicit computation of vertical mixing term, 44 48 !! so the shear production at w-point is given by: 45 !! sh2 = mi[ mi(avm) * dk[ub]/e3ub * dk[un]/e3un ] 46 !! + mj[ mj(avm) * dk[vb]/e3vb * dk[vn]/e3vn ] 49 !! sh2 = mi[ mi(avm) * dk[ub]/e3ub * dk[un]/e3un ] 50 !! + mj[ mj(avm) * dk[vb]/e3vb * dk[vn]/e3vn ] 47 51 !! NB: wet-point only horizontal averaging of shear 48 52 !! … … 59 63 !!-------------------------------------------------------------------- 60 64 ! 61 DO jk = 2, jpkm1 62 DO_2D( 1, 0, 1, 0 ) !* 2 x shear production at uw- and vw-points (energy conserving form) 63 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 64 & * ( uu(ji,jj,jk-1,Kmm) - uu(ji,jj,jk,Kmm) ) & 65 & * ( uu(ji,jj,jk-1,Kbb) - uu(ji,jj,jk,Kbb) ) & 66 & / ( e3uw(ji,jj,jk ,Kmm) * e3uw(ji,jj,jk,Kbb) ) & 67 & * wumask(ji,jj,jk) 68 zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 69 & * ( vv(ji,jj,jk-1,Kmm) - vv(ji,jj,jk,Kmm) ) & 70 & * ( vv(ji,jj,jk-1,Kbb) - vv(ji,jj,jk,Kbb) ) & 71 & / ( e3vw(ji,jj,jk ,Kmm) * e3vw(ji,jj,jk,Kbb) ) & 72 & * wvmask(ji,jj,jk) 73 END_2D 65 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 66 IF ( cpl_sdrftx .AND. ln_stshear ) THEN ! Surface Stokes Drift available ===>>> shear + stokes drift contibution 67 DO_2D( 1, 0, 1, 0 ) 68 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 69 & * ( uu (ji,jj,jk-1,Kmm) - uu (ji,jj,jk,Kmm) & 70 & + usd(ji,jj,jk-1) - usd(ji,jj,jk) ) & 71 & * ( uu (ji,jj,jk-1,Kbb) - uu (ji,jj,jk,Kbb) ) & 72 & / ( e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) * wumask(ji,jj,jk) 73 zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 74 & * ( vv (ji,jj,jk-1,Kmm) - vv (ji,jj,jk,Kmm) & 75 & + vsd(ji,jj,jk-1) - vsd(ji,jj,jk) ) & 76 & * ( vv (ji,jj,jk-1,Kbb) - vv (ji,jj,jk,Kbb) ) & 77 &/ ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) * wvmask(ji,jj,jk) 78 END_2D 79 ELSE 80 DO_2D( 1, 0, 1, 0 ) !* 2 x shear production at uw- and vw-points (energy conserving form) 81 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 82 & * ( uu(ji,jj,jk-1,Kmm) - uu(ji,jj,jk,Kmm) ) & 83 & * ( uu(ji,jj,jk-1,Kbb) - uu(ji,jj,jk,Kbb) ) & 84 & / ( e3uw(ji,jj,jk ,Kmm) * e3uw(ji,jj,jk,Kbb) ) & 85 & * wumask(ji,jj,jk) 86 zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 87 & * ( vv(ji,jj,jk-1,Kmm) - vv(ji,jj,jk,Kmm) ) & 88 & * ( vv(ji,jj,jk-1,Kbb) - vv(ji,jj,jk,Kbb) ) & 89 & / ( e3vw(ji,jj,jk ,Kmm) * e3vw(ji,jj,jk,Kbb) ) & 90 & * wvmask(ji,jj,jk) 91 END_2D 92 ENDIF 74 93 DO_2D( 0, 0, 0, 0 ) !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 75 94 p_sh2(ji,jj,jk) = 0.25 * ( ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) & 76 95 & + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) ) ) 77 96 END_2D 78 END DO 97 END DO 79 98 ! 80 99 END SUBROUTINE zdf_sh2 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/ZDF/zdftke.F90
r14017 r14021 29 29 !! 4.0 ! 2017-04 (G. Madec) remove CPP ddm key & avm at t-point only 30 30 !! - ! 2017-05 (G. Madec) add top/bottom friction as boundary condition 31 !! 4.2 ! 2020-12 (G. Madec, E. Clementi) add wave coupling 32 ! ! following Couvelard et al., 2019 31 33 !!---------------------------------------------------------------------- 32 34 … … 58 60 USE prtctl ! Print control 59 61 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 62 USE sbcwave ! Surface boundary waves 60 63 61 64 IMPLICIT NONE … … 68 71 ! !!** Namelist namzdf_tke ** 69 72 LOGICAL :: ln_mxl0 ! mixing length scale surface value as function of wind stress or not 73 LOGICAL :: ln_mxhsw ! mixing length scale surface value as a fonction of wave height 70 74 INTEGER :: nn_mxlice ! type of scaling under sea-ice (=0/1/2/3) 71 75 REAL(wp) :: rn_mxlice ! ice thickness value when scaling under sea-ice … … 81 85 INTEGER :: nn_etau ! type of depth penetration of surface tke (=0/1/2/3) 82 86 INTEGER :: nn_htau ! type of tke profile of penetration (=0/1) 87 INTEGER :: nn_bc_surf! surface condition (0/1=Dir/Neum) ! Only applicable for wave coupling 88 INTEGER :: nn_bc_bot ! surface condition (0/1=Dir/Neum) ! Only applicable for wave coupling 83 89 REAL(wp) :: rn_efr ! fraction of TKE surface value which penetrates in the ocean 84 90 LOGICAL :: ln_lc ! Langmuir cells (LC) as a source term of TKE or not … … 209 215 REAL(wp) :: zus , zwlc , zind ! - - 210 216 REAL(wp) :: zzd_up, zzd_lw ! - - 217 REAL(wp) :: ztaui, ztauj, z1_norm 211 218 INTEGER , DIMENSION(jpi,jpj) :: imlc 212 REAL(wp), DIMENSION(jpi,jpj) :: zice_fra, zhlc, zus3 219 REAL(wp), DIMENSION(jpi,jpj) :: zice_fra, zhlc, zus3, zWlc2 213 220 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpelc, zdiag, zd_up, zd_lw 214 221 !!-------------------------------------------------------------------- … … 219 226 zfact2 = 1.5_wp * rn_Dt * rn_ediss 220 227 zfact3 = 0.5_wp * rn_ediss 228 ! 229 zpelc(:,:,:) = 0._wp ! need to be initialised in case ln_lc is not used 221 230 ! 222 231 ! ice fraction considered for attenuation of langmuir & wave breaking … … 232 241 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 233 242 ! 234 DO_2D( 0, 0, 0, 0 ) ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 235 !! clem: this should be the right formulation but it makes the model unstable unless drags are calculated implicitly 236 !! one way around would be to increase zbbirau 237 !! en(ji,jj,1) = MAX( rn_emin0, ( ( 1._wp - fr_i(ji,jj) ) * zbbrau + & 238 !! & fr_i(ji,jj) * zbbirau ) * taum(ji,jj) ) * tmask(ji,jj,1) 243 DO_2D( 0, 0, 0, 0 ) 239 244 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 245 zdiag(ji,jj,1) = 1._wp/en(ji,jj,1) 246 zd_lw(ji,jj,1) = 1._wp 247 zd_up(ji,jj,1) = 0._wp 240 248 END_2D 241 249 ! … … 274 282 ! 275 283 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 276 IF( ln_lc ) THEN ! Langmuir circulation source term added to tke !(Axell JGR 2002)284 IF( ln_lc ) THEN ! Langmuir circulation source term added to tke (Axell JGR 2002) 277 285 ! !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 278 286 ! 279 ! !* total energy produce by LC : cumulative sum over jk 287 ! !* Langmuir velocity scale 288 ! 289 IF ( cpl_sdrftx ) THEN ! Surface Stokes Drift available 290 ! ! Craik-Leibovich velocity scale Wlc = ( u* u_s )^1/2 with u* = (taum/rho0)^1/2 291 ! ! associated kinetic energy : 1/2 (Wlc)^2 = u* u_s 292 ! ! more precisely, it is the dot product that must be used : 293 ! ! 1/2 (W_lc)^2 = MAX( u* u_s + v* v_s , 0 ) only the positive part 294 !!gm ! PS: currently we don't have neither the 2 stress components at t-point !nor the angle between u* and u_s 295 !!gm ! so we will overestimate the LC velocity.... !!gm I will do the work if !LC have an effect ! 296 DO_2D( 0, 0, 0, 0 ) 297 !!XC zWlc2(ji,jj) = 0.5_wp * SQRT( taum(ji,jj) * r1_rho0 * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 ) ) 298 zWlc2(ji,jj) = 0.5_wp * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 ) 299 END_2D 300 ! 301 ! Projection of Stokes drift in the wind stress direction 302 ! 303 DO_2D( 0, 0, 0, 0 ) 304 ztaui = 0.5_wp * ( utau(ji,jj) + utau(ji-1,jj) ) 305 ztauj = 0.5_wp * ( vtau(ji,jj) + vtau(ji,jj-1) ) 306 z1_norm = 1._wp / MAX( SQRT(ztaui*ztaui+ztauj*ztauj), 1.e-12 ) * tmask(ji,jj,1) 307 zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2 308 END_2D 309 CALL lbc_lnk ( 'zdftke', zWlc2, 'T', 1. ) 310 ! 311 ELSE ! Surface Stokes drift deduced from surface stress 312 ! ! Wlc = u_s with u_s = 0.016*U_10m, the surface stokes drift (Axell 2002, Eq.44) 313 ! ! using |tau| = rho_air Cd |U_10m|^2 , it comes: 314 ! ! Wlc = 0.016 * [|tau|/(rho_air Cdrag) ]^1/2 and thus: 315 ! ! 1/2 Wlc^2 = 0.5 * 0.016 * 0.016 |tau| /( rho_air Cdrag ) 316 zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) ! to convert stress in 10m wind using a constant drag 317 DO_2D( 1, 1, 1, 1 ) 318 zWlc2(ji,jj) = zcof * taum(ji,jj) 319 END_2D 320 ! 321 ENDIF 322 ! 323 ! !* Depth of the LC circulation (Axell 2002, Eq.47) 324 ! !- LHS of Eq.47 280 325 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * gdepw(:,:,1,Kmm) * e3w(:,:,1,Kmm) 281 326 DO jk = 2, jpk … … 283 328 & MAX( rn2b(:,:,jk), 0._wp ) * gdepw(:,:,jk,Kmm) * e3w(:,:,jk,Kmm) 284 329 END DO 285 ! !* finite Langmuir Circulation depth286 zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )330 ! 331 ! !- compare LHS to RHS of Eq.47 287 332 imlc(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point (=2 over land) 288 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! Last w-level at which zpelc>=0.5*us*us 289 zus = zcof * taum(ji,jj) ! with us=0.016*wind(starting from jpk-1) 290 IF( zpelc(ji,jj,jk) > zus ) imlc(ji,jj) = jk 333 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 334 IF( zpelc(ji,jj,jk) > zWlc2(ji,jj) ) imlc(ji,jj) = jk 291 335 END_3D 292 336 ! ! finite LC depth … … 294 338 zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 295 339 END_2D 340 ! 296 341 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 297 342 DO_2D( 0, 0, 0, 0 ) 298 zus = zcof * SQRT( taum(ji,jj) )! Stokes drift343 zus = SQRT( 2. * zWlc2(ji,jj) ) ! Stokes drift 299 344 zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 300 345 END_2D … … 351 396 & ) * wmask(ji,jj,jk) 352 397 END_3D 398 ! 399 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 400 ! ! Surface boundary condition on tke if 401 ! ! coupling with waves 402 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 403 ! 404 IF ( cpl_phioc .and. ln_phioc ) THEN 405 SELECT CASE (nn_bc_surf) ! Boundary Condition using surface TKE flux from waves 406 407 CASE ( 0 ) ! Dirichlet BC 408 DO_2D( 0, 0, 0, 0 ) ! en(1) = rn_ebb taum / rho0 (min value rn_emin0) 409 IF ( phioc(ji,jj) < 0 ) phioc(ji,jj) = 0._wp 410 en(ji,jj,1) = MAX( rn_emin0, .5 * ( 15.8 * phioc(ji,jj) / rho0 )**(2./3.) ) * tmask(ji,jj,1) 411 zdiag(ji,jj,1) = 1._wp/en(ji,jj,1) ! choose to keep coherence with former estimation of 412 END_2D 413 414 CASE ( 1 ) ! Neumann BC 415 DO_2D( 0, 0, 0, 0 ) 416 IF ( phioc(ji,jj) < 0 ) phioc(ji,jj) = 0._wp 417 en(ji,jj,2) = en(ji,jj,2) + ( rn_Dt * phioc(ji,jj) / rho0 ) /e3w(ji,jj,2,Kmm) 418 en(ji,jj,1) = en(ji,jj,2) + (2 * e3t(ji,jj,1,Kmm) * phioc(ji,jj)/rho0) / ( p_avm(ji,jj,1) + p_avm(ji,jj,2) ) 419 zdiag(ji,jj,2) = zdiag(ji,jj,2) + zd_lw(ji,jj,2) 420 zdiag(ji,jj,1) = 1._wp 421 zd_lw(ji,jj,2) = 0._wp 422 END_2D 423 424 END SELECT 425 426 ENDIF 427 ! 353 428 ! !* Matrix inversion from level 2 (tke prescribed at level 1) 354 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1429 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 355 430 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 356 431 END_3D 357 DO_2D( 0, 0, 0, 0 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 358 zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 359 END_2D 360 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 432 !XC : commented to allow for neumann boundary condition 433 ! DO_2D( 0, 0, 0, 0 ) 434 ! zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 435 ! END_2D 436 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 361 437 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 362 438 END_3D … … 461 537 zmxld(:,:,:) = rmxl_min 462 538 ! 463 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 464 ! 465 zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 539 IF(ln_sdw .AND. ln_mxhsw) THEN 540 zmxlm(:,:,1)= vkarmn * MAX ( 1.6 * hsw(:,:) , 0.02 ) ! surface mixing length = F(wave height) 541 ! from terray et al 1999 and mellor and blumberg 2004 it should be 0.85 and not 1.6 542 zcoef = vkarmn * ( (rn_ediff*rn_ediss)**0.25 ) / rn_ediff 543 zmxlm(:,:,1)= zcoef * MAX ( 1.6 * hsw(:,:) , 0.02 ) ! surface mixing length = F(wave height) 544 ELSE 545 ! 546 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 547 ! 548 zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 466 549 #if ! defined key_si3 && ! defined key_cice 467 DO_2D( 0, 0, 0, 0 ) ! No sea-ice468 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1)469 END_2D550 DO_2D( 0, 0, 0, 0 ) ! No sea-ice 551 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 552 END_2D 470 553 #else 471 SELECT CASE( nn_mxlice ) ! Type of scaling under sea-ice 472 ! 473 CASE( 0 ) ! No scaling under sea-ice 554 SELECT CASE( nn_mxlice ) ! Type of scaling under sea-ice 555 ! 556 CASE( 0 ) ! No scaling under sea-ice 557 DO_2D( 0, 0, 0, 0 ) 558 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 559 END_2D 560 ! 561 CASE( 1 ) ! scaling with constant sea-ice thickness 562 DO_2D( 0, 0, 0, 0 ) 563 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 564 & fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 565 END_2D 566 ! 567 CASE( 2 ) ! scaling with mean sea-ice thickness 568 DO_2D( 0, 0, 0, 0 ) 569 #if defined key_si3 570 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 571 & fr_i(ji,jj) * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1) 572 #elif defined key_cice 573 zmaxice = MAXVAL( h_i(ji,jj,:) ) 574 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 575 & fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 576 #endif 577 END_2D 578 ! 579 CASE( 3 ) ! scaling with max sea-ice thickness 580 DO_2D( 0, 0, 0, 0 ) 581 zmaxice = MAXVAL( h_i(ji,jj,:) ) 582 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 583 & fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 584 END_2D 585 ! 586 END SELECT 587 #endif 588 ! 474 589 DO_2D( 0, 0, 0, 0 ) 475 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1)590 zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 476 591 END_2D 477 592 ! 478 CASE( 1 ) ! scaling with constant sea-ice thickness 479 DO_2D( 0, 0, 0, 0 ) 480 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 481 & fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 482 END_2D 483 ! 484 CASE( 2 ) ! scaling with mean sea-ice thickness 485 DO_2D( 0, 0, 0, 0 ) 486 #if defined key_si3 487 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 488 & fr_i(ji,jj) * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1) 489 #elif defined key_cice 490 zmaxice = MAXVAL( h_i(ji,jj,:) ) 491 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 492 & fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 493 #endif 494 END_2D 495 ! 496 CASE( 3 ) ! scaling with max sea-ice thickness 497 DO_2D( 0, 0, 0, 0 ) 498 zmaxice = MAXVAL( h_i(ji,jj,:) ) 499 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 500 & fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 501 END_2D 502 ! 503 END SELECT 504 #endif 505 ! 506 DO_2D( 0, 0, 0, 0 ) 507 zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 508 END_2D 509 ! 510 ELSE 511 zmxlm(:,:,1) = rn_mxl0 512 ENDIF 513 593 ELSE 594 zmxlm(:,:,1) = rn_mxl0 595 ENDIF 596 ENDIF 514 597 ! 515 598 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) … … 624 707 & rn_mxl0 , nn_mxlice, rn_mxlice, & 625 708 & nn_pdl , ln_lc , rn_lc , & 626 & nn_etau , nn_htau , rn_efr , nn_eice 709 & nn_etau , nn_htau , rn_efr , nn_eice , & 710 & nn_bc_surf, nn_bc_bot, ln_mxhsw 627 711 !!---------------------------------------------------------------------- 628 712 ! … … 666 750 WRITE(numout,*) ' Langmuir cells parametrization ln_lc = ', ln_lc 667 751 WRITE(numout,*) ' coef to compute vertical velocity of LC rn_lc = ', rn_lc 752 IF ( cpl_phioc .and. ln_phioc ) THEN 753 SELECT CASE( nn_bc_surf) ! Type of scaling under sea-ice 754 CASE( 0 ) ; WRITE(numout,*) ' nn_bc_surf=0 ==>>> DIRICHLET SBC using surface TKE flux from waves' 755 CASE( 1 ) ; WRITE(numout,*) ' nn_bc_surf=1 ==>>> NEUMANN SBC using surface TKE flux from waves' 756 END SELECT 757 ENDIF 668 758 WRITE(numout,*) ' test param. to add tke induced by wind nn_etau = ', nn_etau 669 759 WRITE(numout,*) ' type of tke penetration profile nn_htau = ', nn_htau -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/step.F90
r14017 r14021 296 296 297 297 CALL tra_adv ( kstp, Nbb, Nnn, ts, Nrhs ) ! hor. + vert. advection ==> RHS 298 IF( ln_zdfmfc ) CALL tra_mfc ( kstp, Nbb, ts, Nrhs ) ! Mass Flux Convection 298 299 IF( ln_zdfosm ) CALL tra_osm ( kstp, Nnn, ts, Nrhs ) ! OSMOSIS non-local tracer fluxes ==> RHS 299 300 IF( lrst_oce .AND. ln_zdfosm ) & -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/step_oce.F90
r14017 r14021 70 70 USE zdfphy ! vertical physics manager (zdf_phy_init routine) 71 71 USE zdfosm , ONLY : osm_rst, dyn_osm, tra_osm ! OSMOSIS routines used in step.F90 72 USE zdfmfc ! Mass FLux Convection routine used in step.F90 72 73 73 74 USE diu_layers ! diurnal SST bulk and coolskin routines -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/CANAL/MY_SRC/domvvl.F90
r13458 r14021 282 282 ENDIF 283 283 ! 284 IF(lwxios) THEN285 ! define variables in restart file when writing with XIOS286 CALL iom_set_rstw_var_active('e3t_b')287 CALL iom_set_rstw_var_active('e3t_n')288 ! ! ----------------------- !289 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases !290 ! ! ----------------------- !291 CALL iom_set_rstw_var_active('tilde_e3t_b')292 CALL iom_set_rstw_var_active('tilde_e3t_n')293 END IF294 ! ! -------------!295 IF( ln_vvl_ztilde ) THEN ! z_tilde case !296 ! ! ------------ !297 CALL iom_set_rstw_var_active('hdiv_lf')298 ENDIF299 !300 ENDIF301 !302 284 END SUBROUTINE dom_vvl_zgr 303 285 … … 803 785 IF( ln_rstart ) THEN !* Read the restart file 804 786 CALL rst_read_open ! open the restart file if necessary 805 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) , ldxios = lrxios)787 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) ) 806 788 ! 807 789 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 816 798 ! 817 799 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 818 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)819 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)800 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 801 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 820 802 ! needed to restart if land processor not computed 821 803 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 831 813 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 832 814 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 833 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)815 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 834 816 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 835 817 l_1st_euler = .true. … … 838 820 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 839 821 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 840 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)822 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 841 823 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 842 824 l_1st_euler = .true. … … 863 845 ! ! ----------------------- ! 864 846 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 865 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lrxios)866 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lrxios)847 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 848 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 867 849 ELSE ! one at least array is missing 868 850 tilde_e3t_b(:,:,:) = 0.0_wp … … 873 855 ! ! ------------ ! 874 856 IF( id5 > 0 ) THEN ! required array exists 875 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lrxios)857 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 876 858 ELSE ! array is missing 877 859 hdiv_lf(:,:,:) = 0.0_wp … … 947 929 ! ! =================== 948 930 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 949 IF( lwxios ) CALL iom_swap( cwxios_context )950 931 ! ! --------- ! 951 932 ! ! all cases ! 952 933 ! ! --------- ! 953 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lwxios)954 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lwxios)934 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 935 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 955 936 ! ! ----------------------- ! 956 937 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 957 938 ! ! ----------------------- ! 958 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lwxios)959 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lwxios)939 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 940 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 960 941 END IF 961 942 ! ! -------------! 962 943 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 963 944 ! ! ------------ ! 964 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lwxios)945 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 965 946 ENDIF 966 947 ! 967 IF( lwxios ) CALL iom_swap( cxios_context )968 948 ENDIF 969 949 ! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/CANAL/MY_SRC/trazdf.F90
r13295 r14021 54 54 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 55 55 ! 56 INTEGER :: j k ! Dummy loop indices56 INTEGER :: ji, jj, jk ! Dummy loop indices 57 57 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace 58 58 !!--------------------------------------------------------------------- … … 61 61 ! 62 62 IF( kt == nit000 ) THEN 63 IF(lwp)WRITE(numout,*) 64 IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S' 65 IF(lwp)WRITE(numout,*) '~~~~~~~ ' 63 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 64 IF(lwp)WRITE(numout,*) 65 IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S' 66 IF(lwp)WRITE(numout,*) '~~~~~~~ ' 67 ENDIF 66 68 ENDIF 67 69 ! … … 83 85 84 86 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 85 DO jk = 1, jpkm1 86 ztrdt(:,:,jk) = ( ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_tem,Kbb)*e3t(:,:,jk,Kbb) ) & 87 & / (e3t(:,:,jk,Kmm)*rDt) ) - ztrdt(:,:,jk) 88 ztrds(:,:,jk) = ( ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_sal,Kbb)*e3t(:,:,jk,Kbb) ) & 89 & / (e3t(:,:,jk,Kmm)*rDt) ) - ztrds(:,:,jk) 87 DO jk = 1, jpk 88 ztrdt(:,:,jk) = ( ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) & 89 & - pts(:,:,jk,jp_tem,Kbb)*e3t(:,:,jk,Kbb) ) & 90 & / ( e3t(:,:,jk,Kmm)*rDt ) ) & 91 & - ztrdt(:,:,jk) 92 ztrds(:,:,jk) = ( ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) & 93 & - pts(:,:,jk,jp_sal,Kbb)*e3t(:,:,jk,Kbb) ) & 94 & / ( e3t(:,:,jk,Kmm)*rDt ) ) & 95 & - ztrds(:,:,jk) 90 96 END DO 91 97 !!gm this should be moved in trdtra.F90 and done on all trends … … 135 141 INTEGER :: ji, jj, jk, jn ! dummy loop indices 136 142 REAL(wp) :: zrhs, zzwi, zzws ! local scalars 137 REAL(wp), DIMENSION( jpi,jpj,jpk) :: zwi, zwt, zwd, zws143 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwt, zwd, zws 138 144 !!--------------------------------------------------------------------- 139 145 ! … … 149 155 ! 150 156 ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers 151 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN ; zwt(:,:,2:jpk) = avt(:,:,2:jpk) 152 ELSE ; zwt(:,:,2:jpk) = avs(:,:,2:jpk) 157 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 158 DO_3D( 1, 1, 1, 1, 2, jpk ) 159 zwt(ji,jj,jk) = avt(ji,jj,jk) 160 END_3D 161 ELSE 162 DO_3D( 1, 1, 1, 1, 2, jpk ) 163 zwt(ji,jj,jk) = avs(ji,jj,jk) 164 END_3D 153 165 ENDIF 154 166 zwt(:,:,1) = 0._wp -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ICE_ADV2D/MY_SRC/usrdef_sbc.F90
r13472 r14021 18 18 USE sbc_ice ! Surface boundary condition: ice fields 19 19 USE phycst ! physical constants 20 USE ice, ONLY : at_i_b, a_i_b20 USE ice, ONLY : jpl, at_i_b, a_i_b 21 21 USE icethd_dh ! for CALL ice_thd_snwblow 22 22 ! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ISOMIP+/MY_SRC/dtatsd.F90
r13583 r14021 18 18 USE phycst ! physical constants 19 19 USE dom_oce ! ocean space and time domain 20 USE domain, ONLY : dom_tile 20 21 USE fldread ! read input fields 21 22 ! … … 163 164 INTEGER , INTENT(in ) :: kt ! ocean time-step 164 165 CHARACTER(LEN=3) , INTENT(in ) :: cddta ! dmp or ini 165 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts), INTENT( out) :: ptsd ! T & S data166 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data 166 167 ! 167 168 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 168 169 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 170 INTEGER :: itile 169 171 REAL(wp):: zl, zi ! local scalars 170 172 REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace 171 173 !!---------------------------------------------------------------------- 172 174 ! 175 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only for the full domain 176 itile = ntile 177 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 178 179 SELECT CASE(cddta) 180 CASE('ini') 181 CALL fld_read( kt, 1, sf_tsdini ) !== read T & S data at kt time step ==! 182 CASE('dmp') 183 CALL fld_read( kt, 1, sf_tsddmp ) !== read T & S data at kt time step ==! 184 CASE DEFAULT 185 CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown') 186 END SELECT 187 188 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 189 ENDIF 190 ! 173 191 SELECT CASE(cddta) 174 CASE('ini') 175 CALL fld_read( kt, 1, sf_tsdini ) !== read T & S data at kt time step ==! 176 ptsd(:,:,:,jp_tem) = sf_tsdini(jp_tem)%fnow(:,:,:) ! NO mask 177 ptsd(:,:,:,jp_sal) = sf_tsdini(jp_sal)%fnow(:,:,:) 192 CASE('ini') 193 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 194 ptsd(ji,jj,jk,jp_tem) = sf_tsdini(jp_tem)%fnow(ji,jj,jk) ! NO mask 195 ptsd(ji,jj,jk,jp_sal) = sf_tsdini(jp_sal)%fnow(ji,jj,jk) 196 END_3D 178 197 CASE('dmp') 179 CALL fld_read( kt, 1, sf_tsddmp ) !== read T & S data at kt time step ==! 180 ptsd(:,:,:,jp_tem) = sf_tsddmp(jp_tem)%fnow(:,:,:) ! NO mask 181 ptsd(:,:,:,jp_sal) = sf_tsddmp(jp_sal)%fnow(:,:,:) 198 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 199 ptsd(ji,jj,jk,jp_tem) = sf_tsddmp(jp_tem)%fnow(ji,jj,jk) ! NO mask 200 ptsd(ji,jj,jk,jp_sal) = sf_tsddmp(jp_sal)%fnow(ji,jj,jk) 201 END_3D 182 202 CASE DEFAULT 183 203 CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown') … … 186 206 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 187 207 ! 188 IF( kt == nit000 .AND. lwp )THEN 189 WRITE(numout,*) 190 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 208 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 209 IF( kt == nit000 .AND. lwp )THEN 210 WRITE(numout,*) 211 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 212 ENDIF 191 213 ENDIF 192 214 ! … … 220 242 ELSE !== z- or zps- coordinate ==! 221 243 ! 222 ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:) ! Mask 223 ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 244 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 245 ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask 246 ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 247 END_3D 224 248 ! 225 249 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ISOMIP+/MY_SRC/eosbn2.F90
r13583 r14021 39 39 !!---------------------------------------------------------------------- 40 40 USE dom_oce ! ocean space and time domain 41 USE domutl, ONLY : is_tile 41 42 USE phycst ! physical constants 42 43 USE stopar ! Stochastic T/S fluctuations … … 55 56 ! !! * Interface 56 57 INTERFACE eos 57 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 58 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d 58 59 END INTERFACE 59 60 ! … … 191 192 192 193 SUBROUTINE eos_insitu( pts, prd, pdep ) 194 !! 195 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 196 ! ! 2 : salinity [psu] 197 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 198 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 199 !! 200 CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 201 END SUBROUTINE eos_insitu 202 203 SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep ) 193 204 !!---------------------------------------------------------------------- 194 205 !! *** ROUTINE eos_insitu *** … … 228 239 !! TEOS-10 Manual, 2010 229 240 !!---------------------------------------------------------------------- 230 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 241 INTEGER , INTENT(in ) :: ktts, ktrd, ktdep 242 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 231 243 ! ! 2 : salinity [psu] 232 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prd ! in situ density [-]233 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in ) :: pdep ! depth [m]244 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 245 REAL(wp), DIMENSION(A2D_T(ktdep),JPK ), INTENT(in ) :: pdep ! depth [m] 234 246 ! 235 247 INTEGER :: ji, jj, jk ! dummy loop indices … … 312 324 IF( ln_timing ) CALL timing_stop('eos-insitu') 313 325 ! 314 END SUBROUTINE eos_insitu 326 END SUBROUTINE eos_insitu_t 315 327 316 328 317 329 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 330 !! 331 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 332 ! ! 2 : salinity [psu] 333 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 334 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prhop ! potential density (surface referenced) 335 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 336 !! 337 CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 338 END SUBROUTINE eos_insitu_pot 339 340 341 SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 318 342 !!---------------------------------------------------------------------- 319 343 !! *** ROUTINE eos_insitu_pot *** … … 328 352 !! 329 353 !!---------------------------------------------------------------------- 330 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 354 INTEGER , INTENT(in ) :: ktts, ktrd, ktrhop, ktdep 355 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 331 356 ! ! 2 : salinity [psu] 332 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prd ! in situ density [-]333 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prhop ! potential density (surface referenced)334 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in ) :: pdep ! depth [m]357 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 358 REAL(wp), DIMENSION(A2D_T(ktrhop),JPK ), INTENT( out) :: prhop ! potential density (surface referenced) 359 REAL(wp), DIMENSION(A2D_T(ktdep) ,JPK ), INTENT(in ) :: pdep ! depth [m] 335 360 ! 336 361 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices … … 482 507 IF( ln_timing ) CALL timing_stop('eos-pot') 483 508 ! 484 END SUBROUTINE eos_insitu_pot 509 END SUBROUTINE eos_insitu_pot_t 485 510 486 511 487 512 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 513 !! 514 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 515 ! ! 2 : salinity [psu] 516 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 517 REAL(wp), DIMENSION(:,:) , INTENT( out) :: prd ! in situ density 518 !! 519 CALL eos_insitu_2d_t( pts, is_tile(pts), pdep, is_tile(pdep), prd, is_tile(prd) ) 520 END SUBROUTINE eos_insitu_2d 521 522 523 SUBROUTINE eos_insitu_2d_t( pts, ktts, pdep, ktdep, prd, ktrd ) 488 524 !!---------------------------------------------------------------------- 489 525 !! *** ROUTINE eos_insitu_2d *** … … 496 532 !! 497 533 !!---------------------------------------------------------------------- 498 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 534 INTEGER , INTENT(in ) :: ktts, ktdep, ktrd 535 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 499 536 ! ! 2 : salinity [psu] 500 REAL(wp), DIMENSION( jpi,jpj), INTENT(in ) :: pdep ! depth [m]501 REAL(wp), DIMENSION( jpi,jpj), INTENT( out) :: prd ! in situ density537 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 538 REAL(wp), DIMENSION(A2D_T(ktrd) ), INTENT( out) :: prd ! in situ density 502 539 ! 503 540 INTEGER :: ji, jj, jk ! dummy loop indices … … 584 621 IF( ln_timing ) CALL timing_stop('eos2d') 585 622 ! 586 END SUBROUTINE eos_insitu_2d 623 END SUBROUTINE eos_insitu_2d_t 624 625 626 SUBROUTINE eos_insitu_pot_2d( pts, prhop ) 627 !!---------------------------------------------------------------------- 628 !! *** ROUTINE eos_insitu_pot *** 629 !! 630 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 631 !! potential volumic mass (Kg/m3) from potential temperature and 632 !! salinity fields using an equation of state selected in the 633 !! namelist. 634 !! 635 !! ** Action : 636 !! - prhop, the potential volumic mass (Kg/m3) 637 !! 638 !!---------------------------------------------------------------------- 639 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 640 ! ! 2 : salinity [psu] 641 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out) :: prhop ! potential density (surface referenced) 642 ! 643 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 644 INTEGER :: jdof 645 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 646 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 647 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 648 !!---------------------------------------------------------------------- 649 ! 650 IF( ln_timing ) CALL timing_start('eos-pot') 651 ! 652 SELECT CASE ( neos ) 653 ! 654 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 655 ! 656 DO_2D( 1, 1, 1, 1 ) 657 ! 658 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 659 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 660 ztm = tmask(ji,jj,1) ! tmask 661 ! 662 zn0 = (((((EOS060*zt & 663 & + EOS150*zs+EOS050)*zt & 664 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 665 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 666 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 667 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 668 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 669 ! 670 ! 671 prhop(ji,jj) = zn0 * ztm ! potential density referenced at the surface 672 ! 673 END_2D 674 675 CASE( np_seos ) !== simplified EOS ==! 676 ! 677 DO_2D( 1, 1, 1, 1 ) 678 zt = pts (ji,jj,jp_tem) - 10._wp 679 zs = pts (ji,jj,jp_sal) - 35._wp 680 ztm = tmask(ji,jj,1) 681 ! ! potential density referenced at the surface 682 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 683 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 684 & - rn_nu * zt * zs 685 prhop(ji,jj) = ( rho0 + zn ) * ztm 686 ! 687 END_2D 688 ! 689 CASE( np_leos ) !== ISOMIP EOS ==! 690 ! 691 DO_2D( 1, 1, 1, 1 ) 692 ! 693 zt = pts (ji,jj,jp_tem) - (-1._wp) 694 zs = pts (ji,jj,jp_sal) - 34.2_wp 695 !zh = pdep (ji,jj) ! depth at the partial step level 696 ! 697 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 698 ! 699 prhop(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 700 ! 701 END_2D 702 ! 703 END SELECT 704 ! 705 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' ) 706 ! 707 IF( ln_timing ) CALL timing_stop('eos-pot') 708 ! 709 END SUBROUTINE eos_insitu_pot_2d 587 710 588 711 589 712 SUBROUTINE rab_3d( pts, pab, Kmm ) 713 !! 714 INTEGER , INTENT(in ) :: Kmm ! time level index 715 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 716 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 717 !! 718 CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 719 END SUBROUTINE rab_3d 720 721 722 SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm ) 590 723 !!---------------------------------------------------------------------- 591 724 !! *** ROUTINE rab_3d *** … … 598 731 !!---------------------------------------------------------------------- 599 732 INTEGER , INTENT(in ) :: Kmm ! time level index 600 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 601 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab ! thermal/haline expansion ratio 733 INTEGER , INTENT(in ) :: ktts, ktab 734 REAL(wp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 735 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 602 736 ! 603 737 INTEGER :: ji, jj, jk ! dummy loop indices … … 706 840 IF( ln_timing ) CALL timing_stop('rab_3d') 707 841 ! 708 END SUBROUTINE rab_3d 842 END SUBROUTINE rab_3d_t 709 843 710 844 711 845 SUBROUTINE rab_2d( pts, pdep, pab, Kmm ) 846 !! 847 INTEGER , INTENT(in ) :: Kmm ! time level index 848 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 849 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 850 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 851 !! 852 CALL rab_2d_t(pts, is_tile(pts), pdep, is_tile(pdep), pab, is_tile(pab), Kmm) 853 END SUBROUTINE rab_2d 854 855 856 SUBROUTINE rab_2d_t( pts, ktts, pdep, ktdep, pab, ktab, Kmm ) 712 857 !!---------------------------------------------------------------------- 713 858 !! *** ROUTINE rab_2d *** … … 718 863 !!---------------------------------------------------------------------- 719 864 INTEGER , INTENT(in ) :: Kmm ! time level index 720 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT(in ) :: pts ! pot. temperature & salinity 721 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 722 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT( out) :: pab ! thermal/haline expansion ratio 865 INTEGER , INTENT(in ) :: ktts, ktdep, ktab 866 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 867 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 868 REAL(wp), DIMENSION(A2D_T(ktab),JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 723 869 ! 724 870 INTEGER :: ji, jj, jk ! dummy loop indices … … 829 975 IF( ln_timing ) CALL timing_stop('rab_2d') 830 976 ! 831 END SUBROUTINE rab_2d 977 END SUBROUTINE rab_2d_t 832 978 833 979 … … 942 1088 943 1089 SUBROUTINE bn2( pts, pab, pn2, Kmm ) 1090 !! 1091 INTEGER , INTENT(in ) :: Kmm ! time level index 1092 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 1093 REAL(wp), DIMENSION(:,:,:,:) , INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 1094 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 1095 !! 1096 CALL bn2_t( pts, pab, is_tile(pab), pn2, is_tile(pn2), Kmm ) 1097 END SUBROUTINE bn2 1098 1099 1100 SUBROUTINE bn2_t( pts, pab, ktab, pn2, ktn2, Kmm ) 944 1101 !!---------------------------------------------------------------------- 945 1102 !! *** ROUTINE bn2 *** … … 956 1113 !!---------------------------------------------------------------------- 957 1114 INTEGER , INTENT(in ) :: Kmm ! time level index 1115 INTEGER , INTENT(in ) :: ktab, ktn2 958 1116 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 959 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1]960 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2]1117 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 1118 REAL(wp), DIMENSION(A2D_T(ktn2),JPK ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 961 1119 ! 962 1120 INTEGER :: ji, jj, jk ! dummy loop indices … … 982 1140 IF( ln_timing ) CALL timing_stop('bn2') 983 1141 ! 984 END SUBROUTINE bn2 1142 END SUBROUTINE bn2_t 985 1143 986 1144 … … 1043 1201 1044 1202 SUBROUTINE eos_fzp_2d( psal, ptf, pdep ) 1203 !! 1204 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1205 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1206 REAL(wp), DIMENSION(:,:) , INTENT(out ) :: ptf ! freezing temperature [Celsius] 1207 !! 1208 CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep ) 1209 END SUBROUTINE eos_fzp_2d 1210 1211 1212 SUBROUTINE eos_fzp_2d_t( psal, ptf, kttf, pdep ) 1045 1213 !!---------------------------------------------------------------------- 1046 1214 !! *** ROUTINE eos_fzp *** … … 1054 1222 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978 1055 1223 !!---------------------------------------------------------------------- 1224 INTEGER , INTENT(in ) :: kttf 1056 1225 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1057 1226 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1058 REAL(wp), DIMENSION( jpi,jpj), INTENT(out ) :: ptf ! freezing temperature [Celsius]1227 REAL(wp), DIMENSION(A2D_T(kttf)), INTENT(out ) :: ptf ! freezing temperature [Celsius] 1059 1228 ! 1060 1229 INTEGER :: ji, jj ! dummy loop indices … … 1089 1258 END SELECT 1090 1259 ! 1091 END SUBROUTINE eos_fzp_2d 1260 END SUBROUTINE eos_fzp_2d_t 1092 1261 1093 1262 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ISOMIP+/MY_SRC/tradmp.F90
r13295 r14021 95 95 ! 96 96 INTEGER :: ji, jj, jk, jn ! dummy loop indices 97 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts) :: zts_dta97 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts) :: zts_dta 98 98 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrdts 99 99 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/STATION_ASF/MY_SRC/nemogcm.F90
r13655 r14021 271 271 IF( ln_timing ) CALL timing_start( 'nemo_init') 272 272 ! 273 CALL phy_cst ! Physical constants274 CALL eos_init ! Equation of state273 CALL phy_cst ! Physical constants 274 CALL eos_init ! Equation of state 275 275 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 276 CALL dom_init( Nbb, Nnn, Naa, "OPA") ! Domain276 CALL dom_init( Nbb, Nnn, Naa ) ! Domain 277 277 IF( sn_cfctl%l_prtctl ) & 278 278 & CALL prt_ctl_init ! Print control 279 279 280 CALL istate_init( Nbb, Nnn, Naa ) ! ocean initial state (Dynamics and tracers)280 CALL istate_init( Nbb, Nnn, Naa ) ! ocean initial state (Dynamics and tracers) 281 281 282 282 ! ! external forcing 283 CALL sbc_init( Nbb, Nnn, Naa ) ! surface boundary conditions (including sea-ice)283 CALL sbc_init( Nbb, Nnn, Naa ) ! surface boundary conditions (including sea-ice) 284 284 285 285 !#LB: -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/VORTEX/MY_SRC/domvvl.F90
r13458 r14021 282 282 ENDIF 283 283 ! 284 IF(lwxios) THEN285 ! define variables in restart file when writing with XIOS286 CALL iom_set_rstw_var_active('e3t_b')287 CALL iom_set_rstw_var_active('e3t_n')288 ! ! ----------------------- !289 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases !290 ! ! ----------------------- !291 CALL iom_set_rstw_var_active('tilde_e3t_b')292 CALL iom_set_rstw_var_active('tilde_e3t_n')293 END IF294 ! ! -------------!295 IF( ln_vvl_ztilde ) THEN ! z_tilde case !296 ! ! ------------ !297 CALL iom_set_rstw_var_active('hdiv_lf')298 ENDIF299 !300 ENDIF301 !302 284 END SUBROUTINE dom_vvl_zgr 303 285 … … 803 785 IF( ln_rstart ) THEN !* Read the restart file 804 786 CALL rst_read_open ! open the restart file if necessary 805 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) , ldxios = lrxios)787 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) ) 806 788 ! 807 789 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 816 798 ! 817 799 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 818 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)819 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)800 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 801 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 820 802 ! needed to restart if land processor not computed 821 803 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 831 813 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 832 814 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 833 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)815 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 834 816 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 835 817 l_1st_euler = .true. … … 838 820 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 839 821 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 840 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)822 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 841 823 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 842 824 l_1st_euler = .true. … … 863 845 ! ! ----------------------- ! 864 846 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 865 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lrxios)866 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lrxios)847 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 848 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 867 849 ELSE ! one at least array is missing 868 850 tilde_e3t_b(:,:,:) = 0.0_wp … … 873 855 ! ! ------------ ! 874 856 IF( id5 > 0 ) THEN ! required array exists 875 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lrxios)857 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 876 858 ELSE ! array is missing 877 859 hdiv_lf(:,:,:) = 0.0_wp … … 947 929 ! ! =================== 948 930 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 949 IF( lwxios ) CALL iom_swap( cwxios_context )950 931 ! ! --------- ! 951 932 ! ! all cases ! 952 933 ! ! --------- ! 953 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lwxios)954 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lwxios)934 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 935 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 955 936 ! ! ----------------------- ! 956 937 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 957 938 ! ! ----------------------- ! 958 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lwxios)959 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lwxios)939 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 940 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 960 941 END IF 961 942 ! ! -------------! 962 943 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 963 944 ! ! ------------ ! 964 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lwxios)945 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 965 946 ENDIF 966 947 ! 967 IF( lwxios ) CALL iom_swap( cxios_context )968 948 ENDIF 969 949 ! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/demo_cfgs.txt
r13675 r14021 12 12 STATION_ASF OCE ICE 13 13 CPL_OASIS OCE TOP ICE NST 14 C1D_ASICS OCE 15 ICE_RHEO OCE SAS ICE
Note: See TracChangeset
for help on using the changeset viewer.