Changeset 4900 for branches/2014/dev_CNRS_2014
- Timestamp:
- 2014-11-27T16:28:53+01:00 (10 years ago)
- Location:
- branches/2014/dev_CNRS_2014/NEMOGCM
- Files:
-
- 59 edited
- 2 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml
r4343 r4900 85 85 </file> 86 86 87 <file id="file8" name_suffix="_icemod" description="ice variables" >88 <field field_ref="ice_pres" />89 <field field_ref="snowthic_cea" name="snd" long_name="surface_snow_thickness" />90 <field field_ref="icethic_cea" name="sit" long_name="sea_ice_thickness" />91 <field field_ref="iceprod_cea" name="sip" long_name="sea_ice_thickness" />92 <field field_ref="ist_ipa" />93 <field field_ref="ioceflxb" />94 <field field_ref="uice_ipa" />95 <field field_ref="vice_ipa" />96 <field field_ref="utau_ice" />97 <field field_ref="vtau_ice" />98 <field field_ref="qsr_io_cea" />99 <field field_ref="qns_io_cea" />100 <field field_ref="snowpre" />101 </file>102 103 87 </file_group> 104 88 -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
r4272 r4900 82 82 <field field_ref="iceprod_cea" name="sip" long_name="sea_ice_thickness" /> 83 83 <field field_ref="ist_ipa" /> 84 <field field_ref="ioceflxb" />85 84 <field field_ref="uice_ipa" /> 86 85 <field field_ref="vice_ipa" /> -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml
r4100 r4900 47 47 <field field_ref="mldkz5" /> 48 48 <field field_ref="mldr10_1" /> 49 <field field_ref="heatc" name="heatc" long_name="Heat content vertically integrated" /> 50 <field field_ref="saltc" name="saltc" long_name="Salt content vertically integrated" /> 49 51 </file> 50 52 51 53 <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 52 54 <field field_ref="empmr" name="wfo" long_name="water_flux_into_sea_water" /> 53 <field field_ref="qsr" name="rsntds" long_name="surface_net_downward_shortwave_flux" /> 54 <field field_ref="qt" name="tohfls" long_name="surface_net_downward_total_heat_flux" /> 55 <field field_ref="saltflx" name="sosflxdo" /> 55 <field field_ref="qsr_oce" name="qsr_oce" long_name="downward shortwave flux at ocean surface" /> 56 <field field_ref="qns_oce" name="qns_oce" long_name="downward non solar flux at ocean surface" /> 57 <field field_ref="qt_oce" name="qt_oce" long_name="downward total flux at ocean surface" /> 58 <field field_ref="qsr_ice" name="qsr_ice" long_name="downward shortwave flux at ice surface" /> 59 <field field_ref="qns_ice" name="qns_ice" long_name="downward non solar flux at ice surface" /> 60 <field field_ref="qtr_ice" name="qtr_ice" long_name="shortwave flux transmitted thru the ice" /> 61 <field field_ref="qt_ice" name="qt_ice" long_name="downward total flux at ice surface" /> 62 <field field_ref="saltflx" name="sfx" /> 56 63 <field field_ref="taum" name="taum" /> 57 <field field_ref="wspd" name=" sowindsp" />58 <field field_ref="precip" name="soprecip" />64 <field field_ref="wspd" name="windsp" /> 65 <field field_ref="precip" name="precip" /> 59 66 <!-- ice and snow --> 60 67 <field field_ref="snowpre" /> 61 <field field_ref="qsr_io" name="iicesflx" /> 62 <field field_ref="qns_io" name="iicenflx" /> 63 <field field_ref="utau_ice" name="iicestru" /> 64 <field field_ref="vtau_ice" name="iicestrv" /> 68 <field field_ref="utau_ice" name="utau_ice" /> 69 <field field_ref="vtau_ice" name="vtau_ice" /> 65 70 66 71 </file> … … 73 78 <field field_ref="u_masstr" name="vozomatr" /> 74 79 <field field_ref="u_heattr" name="sozohetr" /> 80 <field field_ref="u_salttr" name="sozosatr" /> 75 81 </file> 76 82 … … 82 88 <field field_ref="v_masstr" name="vomematr" /> 83 89 <field field_ref="v_heattr" name="somehetr" /> 90 <field field_ref="v_salttr" name="somesatr" /> 84 91 </file> 85 92 … … 90 97 </file> 91 98 92 <file id="file6" name_suffix="_icemod" description="ice variables" > 93 <field field_ref="snowthic_cea" name="snd" long_name="surface_snow_thickness" /> 94 <field field_ref="icethic_cea" name="sit" long_name="sea_ice_thickness" /> 95 <field field_ref="icevolu" name="iicevolu" /> 96 <field field_ref="snowvol" name="isnowvol" /> 97 <field field_ref="iceconc" name="iiceconc" /> 98 99 <field field_ref="icebopr" name="iicebopr" /> 100 <field field_ref="icedypr" name="iicedypr" /> 101 <field field_ref="ioceflxb" name="ioceflxb" /> 102 <field field_ref="uice_ipa" name="iicevelu" /> 103 <field field_ref="vice_ipa" name="iicevelv" /> 104 <field field_ref="isst" name="isstempe" /> 105 <field field_ref="isss" name="isssalin" /> 106 <field field_ref="micesalt" name="iicesali" /> 107 <field field_ref="miceage" name="iiceages" /> 108 <field field_ref="icelapr" name="iicelapr" /> 109 <field field_ref="icesipr" name="iicesipr" /> 110 <field field_ref="micet" name="iicetemp" /> 111 <field field_ref="icehc" name="iiceheco" /> 112 <field field_ref="isnowhc" name="isnoheco" /> 113 <field field_ref="icest" name="iicesurt" /> 114 <field field_ref="sfxbri" name="iicefsbr" /> 115 <field field_ref="sfxthd" name="iicefseq" /> 116 <field field_ref="ibrinv" name="ibrinvol" /> 117 <field field_ref="icecolf" name="iicecolf" /> 118 <field field_ref="icestr" name="iicestre" /> 119 <field field_ref="icevel" name="iicevelo" /> 120 <field field_ref="isume" name="iicesume" /> 121 <field field_ref="ibome" name="iicebome" /> 122 <field field_ref="idive" name="iicedive" /> 123 <field field_ref="ishear" name="iiceshea" /> 124 <field field_ref="icerepr" name="iicerepr" /> 125 <field field_ref="sfxmec" name="iicefsrp" /> 126 <field field_ref="sfxres" name="iicefsre" /> 127 <field field_ref="icetrp" name="iicevtrp" /> 128 </file> 129 130 131 <file id="file7" name_suffix="_scalar" description="scalar variables" > 99 <file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." > 100 <field field_ref="snowthic_cea" name="snthic" long_name="surface_snow_thickness" /> 101 <field field_ref="icethic_cea" name="sithic" long_name="sea_ice_thickness" /> 102 <field field_ref="icevolu" name="sivolu" /> 103 <field field_ref="snowvol" name="snvolu" /> 104 <field field_ref="iceconc" name="siconc" /> 105 106 <field field_ref="vfxbog" name="vfxbog" /> 107 <field field_ref="vfxdyn" name="vfxdyn" /> 108 <field field_ref="vfxopw" name="vfxopw" /> 109 <field field_ref="vfxsni" name="vfxsni" /> 110 <field field_ref="vfxsum" name="vfxsum" /> 111 <field field_ref="vfxbom" name="vfxbom" /> 112 <field field_ref="vfxres" name="vfxres" /> 113 <field field_ref="vfxice" name="vfxice" /> 114 <field field_ref="vfxsnw" name="vfxsnw" /> 115 <field field_ref="vfxsub" name="vfxsub" /> 116 <field field_ref="vfxspr" name="vfxspr" /> 117 118 <field field_ref="icetrp" name="sivtrp" /> 119 <field field_ref="snwtrp" name="snvtrp" /> 120 <field field_ref="deitrp" name="deitrp" /> 121 <field field_ref="destrp" name="destrp" /> 122 123 <field field_ref="sfxbri" name="sfxbri" /> 124 <field field_ref="sfxdyn" name="sfxdyn" /> 125 <field field_ref="sfxres" name="sfxres" /> 126 <field field_ref="sfxbog" name="sfxbog" /> 127 <field field_ref="sfxbom" name="sfxbom" /> 128 <field field_ref="sfxsum" name="sfxsum" /> 129 <field field_ref="sfxsni" name="sfxsni" /> 130 <field field_ref="sfxopw" name="sfxopw" /> 131 <field field_ref="sfx" name="sfx" /> 132 133 <field field_ref="hfxsum" name="hfxsum" /> 134 <field field_ref="hfxbom" name="hfxbom" /> 135 <field field_ref="hfxbog" name="hfxbog" /> 136 <field field_ref="hfxdif" name="hfxdif" /> 137 <field field_ref="hfxopw" name="hfxopw" /> 138 <field field_ref="hfxout" name="hfxout" /> 139 <field field_ref="hfxin" name="hfxin" /> 140 <field field_ref="hfxsnw" name="hfxsnw" /> 141 <field field_ref="hfxerr" name="hfxerr" /> 142 <field field_ref="hfxerr_rem" name="hfxerr_rem" /> 143 144 <!-- ice-ocean heat flux from mass exchange --> 145 <field field_ref="hfxdyn" name="hfxdyn" /> 146 <field field_ref="hfxres" name="hfxres" /> 147 <field field_ref="hfxthd" name="hfxthd" /> 148 <!-- ice-atm. heat flux from mass exchange --> 149 <field field_ref="hfxsub" name="hfxsub" /> 150 <field field_ref="hfxspr" name="hfxspr" /> 151 152 <!-- diags --> 153 <field field_ref="hfxdhc" name="hfxdhc" /> 154 <field field_ref="hfxtur" name="hfxtur" /> 155 156 <field field_ref="isst" name="sst" /> 157 <field field_ref="isss" name="sss" /> 158 <field field_ref="micesalt" name="sisali" /> 159 <field field_ref="micet" name="sitemp" /> 160 <field field_ref="icest" name="sistem" /> 161 <field field_ref="icehc" name="siheco" /> 162 <field field_ref="isnowhc" name="snheco" /> 163 <field field_ref="miceage" name="siages" /> 164 165 <field field_ref="uice_ipa" name="sivelu" /> 166 <field field_ref="vice_ipa" name="sivelv" /> 167 <field field_ref="icevel" name="sivelo" /> 168 <field field_ref="idive" name="sidive" /> 169 <field field_ref="ishear" name="sishea" /> 170 <field field_ref="icestr" name="sistre" /> 171 172 <field field_ref="ibrinv" name="sibrin" /> 173 <field field_ref="icecolf" name="sicolf" /> 174 175 <field field_ref="iceage_cat" name="siagecat"/> 176 <field field_ref="iceconc_cat" name="siconcat"/> 177 <field field_ref="icethic_cat" name="sithicat"/> 178 <field field_ref="snowthic_cat" name="snthicat"/> 179 <field field_ref="salinity_cat" name="salincat"/> 180 <field field_ref="brinevol_cat" name="sibricat"/> 181 182 </file> 183 184 <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." > 132 185 <field field_ref="voltot" name="scvoltot" /> 133 186 <field field_ref="sshtot" name="scsshtot" /> … … 137 190 <field field_ref="temptot" name="sctemtot" /> 138 191 <field field_ref="saltot" name="scsaltot" /> 139 140 <!-- available with ln_diahsb --> 141 <field field_ref="bgtemper" name="bgtemper" /> 142 <field field_ref="bgsaline" name="bgsaline" /> 143 <field field_ref="bgheatco" name="bgheatco" /> 144 <field field_ref="bgsaltco" name="bgsaltco" /> 145 <field field_ref="bgvolssh" name="bgvolssh" /> 146 <field field_ref="bgvoltot" name="bgvoltot" /> 147 <field field_ref="bgsshtot" name="bgsshtot" /> 148 <field field_ref="bgfrcvol" name="bgfrcvol" /> 149 <field field_ref="bgfrctem" name="bgfrctem" /> 150 <field field_ref="bgfrcsal" name="bgfrcsal" /> 151 <!-- available with ln_limdiahsb --> 152 <field field_ref="ibgvoltot" name="ibgvoltot" /> 153 <field field_ref="sbgvoltot" name="sbgvoltot" /> 154 <field field_ref="ibgarea" name="ibgarea" /> 155 <field field_ref="ibgsaline" name="ibgsaline" /> 156 <field field_ref="ibgtemper" name="ibgtemper" /> 157 <field field_ref="ibgheatco" name="ibgheatco" /> 158 <field field_ref="ibgsaltco" name="ibgsaltco" /> 159 <field field_ref="sbgheatco" name="sbgheatco" /> 160 <field field_ref="ibgfrcsfx" name="ibgfrcsfx" /> 161 <field field_ref="ibgfrcemp" name="ibgfrcemp" /> 162 <field field_ref="ibgsfx" name="ibgsfx" /> 163 <field field_ref="ibgemp" name="ibgemp" /> 164 <field field_ref="ibgsfxbri" name="ibgsfxbri" /> 165 <field field_ref="ibgsfxthd" name="ibgsfxthd" /> 166 <field field_ref="ibgsfxres" name="ibgsfxres" /> 167 <field field_ref="ibgsfxmec" name="ibgsfxmec" /> 168 <field field_ref="ibggrpme" name="ibggrpme" /> 169 170 </file> 192 193 <field field_ref="bgtemper" name="bgtemper" /> 194 <field field_ref="bgsaline" name="bgsaline" /> 195 <field field_ref="bgheatco" name="bgheatco" /> 196 <field field_ref="bgsaltco" name="bgsaltco" /> 197 <field field_ref="bgvolssh" name="bgvolssh" /> 198 <field field_ref="bgvole3t" name="bgvole3t" /> 199 <field field_ref="bgfrcvol" name="bgfrcvol" /> 200 <field field_ref="bgfrctem" name="bgfrctem" /> 201 <field field_ref="bgfrcsal" name="bgfrcsal" /> 202 203 <field field_ref="ibgvoltot" name="ibgvoltot" /> 204 <field field_ref="sbgvoltot" name="sbgvoltot" /> 205 <field field_ref="ibgarea" name="ibgarea" /> 206 <field field_ref="ibgsaline" name="ibgsaline" /> 207 <field field_ref="ibgtemper" name="ibgtemper" /> 208 <field field_ref="ibgheatco" name="ibgheatco" /> 209 <field field_ref="sbgheatco" name="sbgheatco" /> 210 <field field_ref="ibgsaltco" name="ibgsaltco" /> 211 212 <field field_ref="ibgvfx" name="ibgvfx" /> 213 <field field_ref="ibgvfxbog" name="ibgvfxbog" /> 214 <field field_ref="ibgvfxopw" name="ibgvfxopw" /> 215 <field field_ref="ibgvfxsni" name="ibgvfxsni" /> 216 <field field_ref="ibgvfxdyn" name="ibgvfxdyn" /> 217 <field field_ref="ibgvfxbom" name="ibgvfxbom" /> 218 <field field_ref="ibgvfxsum" name="ibgvfxsum" /> 219 <field field_ref="ibgvfxres" name="ibgvfxres" /> 220 <field field_ref="ibgvfxspr" name="ibgvfxspr" /> 221 <field field_ref="ibgvfxsnw" name="ibgvfxsnw" /> 222 <field field_ref="ibgvfxsub" name="ibgvfxsub" /> 223 224 <field field_ref="ibgsfx" name="ibgsfx" /> 225 <field field_ref="ibgsfxbri" name="ibgsfxbri" /> 226 <field field_ref="ibgsfxdyn" name="ibgsfxdyn" /> 227 <field field_ref="ibgsfxres" name="ibgsfxres" /> 228 <field field_ref="ibgsfxbog" name="ibgsfxbog" /> 229 <field field_ref="ibgsfxopw" name="ibgsfxopw" /> 230 <field field_ref="ibgsfxsni" name="ibgsfxsni" /> 231 <field field_ref="ibgsfxbom" name="ibgsfxbom" /> 232 <field field_ref="ibgsfxsum" name="ibgsfxsum" /> 233 234 <field field_ref="ibghfxdhc" name="ibghfxdhc" /> 235 <field field_ref="ibghfxspr" name="ibghfxspr" /> 236 237 <field field_ref="ibghfxres" name="ibghfxres" /> 238 <field field_ref="ibghfxsub" name="ibghfxsub" /> 239 <field field_ref="ibghfxdyn" name="ibghfxdyn" /> 240 <field field_ref="ibghfxthd" name="ibghfxthd" /> 241 <field field_ref="ibghfxsum" name="ibghfxsum" /> 242 <field field_ref="ibghfxbom" name="ibghfxbom" /> 243 <field field_ref="ibghfxbog" name="ibghfxbog" /> 244 <field field_ref="ibghfxdif" name="ibghfxdif" /> 245 <field field_ref="ibghfxopw" name="ibghfxopw" /> 246 <field field_ref="ibghfxout" name="ibghfxout" /> 247 <field field_ref="ibghfxin" name="ibghfxin" /> 248 <field field_ref="ibghfxsnw" name="ibghfxsnw" /> 249 250 <field field_ref="ibgfrcvol" name="ibgfrcvol" /> 251 <field field_ref="ibgfrcsfx" name="ibgfrcsfx" /> 252 <field field_ref="ibgvolgrm" name="ibgvolgrm" /> 253 254 </file> 171 255 172 256 <!-- … … 214 298 <axis id="nfloat" long_name="Float number" unit="-" /> 215 299 <axis id="icbcla" long_name="Iceberg class" unit="-" /> 300 <axis id="ncatice" long_name="Ice categories" unit="-" /> 216 301 </axis_definition> 217 302 -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_default.xml
r4100 r4900 47 47 <field field_ref="mldkz5" /> 48 48 <field field_ref="mldr10_1" /> 49 <field field_ref="heatc" name="heatc" long_name="Heat content vertically integrated" /> 50 <field field_ref="saltc" name="saltc" long_name="Salt content vertically integrated" /> 49 51 </file> 50 52 51 53 <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 52 54 <field field_ref="empmr" name="wfo" long_name="water_flux_into_sea_water" /> 53 <field field_ref="qsr" name="rsntds" long_name="surface_net_downward_shortwave_flux" /> 54 <field field_ref="qt" name="tohfls" long_name="surface_net_downward_total_heat_flux" /> 55 <field field_ref="saltflx" name="sosflxdo" /> 55 <field field_ref="qsr_oce" name="qsr_oce" long_name="downward shortwave flux at ocean surface" /> 56 <field field_ref="qns_oce" name="qns_oce" long_name="downward non solar flux at ocean surface" /> 57 <field field_ref="qt_oce" name="qt_oce" long_name="downward total flux at ocean surface" /> 58 <field field_ref="qsr_ice" name="qsr_ice" long_name="downward shortwave flux at ice surface" /> 59 <field field_ref="qns_ice" name="qns_ice" long_name="downward non solar flux at ice surface" /> 60 <field field_ref="qtr_ice" name="qtr_ice" long_name="shortwave flux transmitted thru the ice" /> 61 <field field_ref="qt_ice" name="qt_ice" long_name="downward total flux at ice surface" /> 62 <field field_ref="saltflx" name="sfx" /> 56 63 <field field_ref="taum" name="taum" /> 57 <field field_ref="wspd" name=" sowindsp" />58 <field field_ref="precip" name="soprecip" />64 <field field_ref="wspd" name="windsp" /> 65 <field field_ref="precip" name="precip" /> 59 66 <!-- ice and snow --> 60 67 <field field_ref="snowpre" /> 61 <field field_ref="qsr_io" name="iicesflx" /> 62 <field field_ref="qns_io" name="iicenflx" /> 63 <field field_ref="utau_ice" name="iicestru" /> 64 <field field_ref="vtau_ice" name="iicestrv" /> 68 <field field_ref="utau_ice" name="utau_ice" /> 69 <field field_ref="vtau_ice" name="vtau_ice" /> 65 70 66 71 </file> … … 73 78 <field field_ref="u_masstr" name="vozomatr" /> 74 79 <field field_ref="u_heattr" name="sozohetr" /> 80 <field field_ref="u_salttr" name="sozosatr" /> 75 81 </file> 76 82 … … 82 88 <field field_ref="v_masstr" name="vomematr" /> 83 89 <field field_ref="v_heattr" name="somehetr" /> 90 <field field_ref="v_salttr" name="somesatr" /> 84 91 </file> 85 92 … … 90 97 </file> 91 98 92 <file id="file6" name_suffix="_icemod" description="ice variables" > 93 <field field_ref="snowthic_cea" name="snd" long_name="surface_snow_thickness" /> 94 <field field_ref="icethic_cea" name="sit" long_name="sea_ice_thickness" /> 95 <field field_ref="icevolu" name="iicevolu" /> 96 <field field_ref="snowvol" name="isnowvol" /> 97 <field field_ref="iceconc" name="iiceconc" /> 98 99 <field field_ref="icebopr" name="iicebopr" /> 100 <field field_ref="icedypr" name="iicedypr" /> 101 <field field_ref="ioceflxb" name="ioceflxb" /> 102 <field field_ref="uice_ipa" name="iicevelu" /> 103 <field field_ref="vice_ipa" name="iicevelv" /> 104 <field field_ref="isst" name="isstempe" /> 105 <field field_ref="isss" name="isssalin" /> 106 <field field_ref="micesalt" name="iicesali" /> 107 <field field_ref="miceage" name="iiceages" /> 108 <field field_ref="icelapr" name="iicelapr" /> 109 <field field_ref="icesipr" name="iicesipr" /> 110 <field field_ref="micet" name="iicetemp" /> 111 <field field_ref="icehc" name="iiceheco" /> 112 <field field_ref="isnowhc" name="isnoheco" /> 113 <field field_ref="icest" name="iicesurt" /> 114 <field field_ref="sfxbri" name="iicefsbr" /> 115 <field field_ref="sfxthd" name="iicefseq" /> 116 <field field_ref="ibrinv" name="ibrinvol" /> 117 <field field_ref="icecolf" name="iicecolf" /> 118 <field field_ref="icestr" name="iicestre" /> 119 <field field_ref="icevel" name="iicevelo" /> 120 <field field_ref="isume" name="iicesume" /> 121 <field field_ref="ibome" name="iicebome" /> 122 <field field_ref="idive" name="iicedive" /> 123 <field field_ref="ishear" name="iiceshea" /> 124 <field field_ref="icerepr" name="iicerepr" /> 125 <field field_ref="sfxmec" name="iicefsrp" /> 126 <field field_ref="sfxres" name="iicefsre" /> 127 <field field_ref="icetrp" name="iicevtrp" /> 128 </file> 129 130 131 <file id="file7" name_suffix="_scalar" description="scalar variables" > 99 <file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." > 100 <field field_ref="snowthic_cea" name="snthic" long_name="surface_snow_thickness" /> 101 <field field_ref="icethic_cea" name="sithic" long_name="sea_ice_thickness" /> 102 <field field_ref="icevolu" name="sivolu" /> 103 <field field_ref="snowvol" name="snvolu" /> 104 <field field_ref="iceconc" name="siconc" /> 105 106 <field field_ref="vfxbog" name="vfxbog" /> 107 <field field_ref="vfxdyn" name="vfxdyn" /> 108 <field field_ref="vfxopw" name="vfxopw" /> 109 <field field_ref="vfxsni" name="vfxsni" /> 110 <field field_ref="vfxsum" name="vfxsum" /> 111 <field field_ref="vfxbom" name="vfxbom" /> 112 <field field_ref="vfxres" name="vfxres" /> 113 <field field_ref="vfxice" name="vfxice" /> 114 <field field_ref="vfxsnw" name="vfxsnw" /> 115 <field field_ref="vfxsub" name="vfxsub" /> 116 <field field_ref="vfxspr" name="vfxspr" /> 117 118 <field field_ref="icetrp" name="sivtrp" /> 119 <field field_ref="snwtrp" name="snvtrp" /> 120 <field field_ref="deitrp" name="deitrp" /> 121 <field field_ref="destrp" name="destrp" /> 122 123 <field field_ref="sfxbri" name="sfxbri" /> 124 <field field_ref="sfxdyn" name="sfxdyn" /> 125 <field field_ref="sfxres" name="sfxres" /> 126 <field field_ref="sfxbog" name="sfxbog" /> 127 <field field_ref="sfxbom" name="sfxbom" /> 128 <field field_ref="sfxsum" name="sfxsum" /> 129 <field field_ref="sfxsni" name="sfxsni" /> 130 <field field_ref="sfxopw" name="sfxopw" /> 131 <field field_ref="sfx" name="sfx" /> 132 133 <field field_ref="hfxsum" name="hfxsum" /> 134 <field field_ref="hfxbom" name="hfxbom" /> 135 <field field_ref="hfxbog" name="hfxbog" /> 136 <field field_ref="hfxdif" name="hfxdif" /> 137 <field field_ref="hfxopw" name="hfxopw" /> 138 <field field_ref="hfxout" name="hfxout" /> 139 <field field_ref="hfxin" name="hfxin" /> 140 <field field_ref="hfxsnw" name="hfxsnw" /> 141 <field field_ref="hfxerr" name="hfxerr" /> 142 <field field_ref="hfxerr_rem" name="hfxerr_rem" /> 143 144 <!-- ice-ocean heat flux from mass exchange --> 145 <field field_ref="hfxdyn" name="hfxdyn" /> 146 <field field_ref="hfxres" name="hfxres" /> 147 <field field_ref="hfxthd" name="hfxthd" /> 148 <!-- ice-atm. heat flux from mass exchange --> 149 <field field_ref="hfxsub" name="hfxsub" /> 150 <field field_ref="hfxspr" name="hfxspr" /> 151 152 <!-- diags --> 153 <field field_ref="hfxdhc" name="hfxdhc" /> 154 <field field_ref="hfxtur" name="hfxtur" /> 155 156 <field field_ref="isst" name="sst" /> 157 <field field_ref="isss" name="sss" /> 158 <field field_ref="micesalt" name="sisali" /> 159 <field field_ref="micet" name="sitemp" /> 160 <field field_ref="icest" name="sistem" /> 161 <field field_ref="icehc" name="siheco" /> 162 <field field_ref="isnowhc" name="snheco" /> 163 <field field_ref="miceage" name="siages" /> 164 165 <field field_ref="uice_ipa" name="sivelu" /> 166 <field field_ref="vice_ipa" name="sivelv" /> 167 <field field_ref="icevel" name="sivelo" /> 168 <field field_ref="idive" name="sidive" /> 169 <field field_ref="ishear" name="sishea" /> 170 <field field_ref="icestr" name="sistre" /> 171 172 <field field_ref="ibrinv" name="sibrin" /> 173 <field field_ref="icecolf" name="sicolf" /> 174 175 <field field_ref="iceage_cat" name="siagecat"/> 176 <field field_ref="iceconc_cat" name="siconcat"/> 177 <field field_ref="icethic_cat" name="sithicat"/> 178 <field field_ref="snowthic_cat" name="snthicat"/> 179 <field field_ref="salinity_cat" name="salincat"/> 180 <field field_ref="brinevol_cat" name="sibricat"/> 181 182 </file> 183 184 <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." > 132 185 <field field_ref="voltot" name="scvoltot" /> 133 186 <field field_ref="sshtot" name="scsshtot" /> … … 137 190 <field field_ref="temptot" name="sctemtot" /> 138 191 <field field_ref="saltot" name="scsaltot" /> 139 140 <!-- available with ln_diahsb --> 141 <field field_ref="bgtemper" name="bgtemper" /> 142 <field field_ref="bgsaline" name="bgsaline" /> 143 <field field_ref="bgheatco" name="bgheatco" /> 144 <field field_ref="bgsaltco" name="bgsaltco" /> 145 <field field_ref="bgvolssh" name="bgvolssh" /> 146 <field field_ref="bgvoltot" name="bgvoltot" /> 147 <field field_ref="bgsshtot" name="bgsshtot" /> 148 <field field_ref="bgfrcvol" name="bgfrcvol" /> 149 <field field_ref="bgfrctem" name="bgfrctem" /> 150 <field field_ref="bgfrcsal" name="bgfrcsal" /> 151 <!-- available with ln_limdiahsb --> 152 <field field_ref="ibgvoltot" name="ibgvoltot" /> 153 <field field_ref="sbgvoltot" name="sbgvoltot" /> 154 <field field_ref="ibgarea" name="ibgarea" /> 155 <field field_ref="ibgsaline" name="ibgsaline" /> 156 <field field_ref="ibgtemper" name="ibgtemper" /> 157 <field field_ref="ibgheatco" name="ibgheatco" /> 158 <field field_ref="ibgsaltco" name="ibgsaltco" /> 159 <field field_ref="sbgheatco" name="sbgheatco" /> 160 <field field_ref="ibgfrcsfx" name="ibgfrcsfx" /> 161 <field field_ref="ibgfrcemp" name="ibgfrcemp" /> 162 <field field_ref="ibgsfx" name="ibgsfx" /> 163 <field field_ref="ibgemp" name="ibgemp" /> 164 <field field_ref="ibgsfxbri" name="ibgsfxbri" /> 165 <field field_ref="ibgsfxthd" name="ibgsfxthd" /> 166 <field field_ref="ibgsfxres" name="ibgsfxres" /> 167 <field field_ref="ibgsfxmec" name="ibgsfxmec" /> 168 <field field_ref="ibggrpme" name="ibggrpme" /> 169 170 </file> 192 193 <field field_ref="bgtemper" name="bgtemper" /> 194 <field field_ref="bgsaline" name="bgsaline" /> 195 <field field_ref="bgheatco" name="bgheatco" /> 196 <field field_ref="bgsaltco" name="bgsaltco" /> 197 <field field_ref="bgvolssh" name="bgvolssh" /> 198 <field field_ref="bgvole3t" name="bgvole3t" /> 199 <field field_ref="bgfrcvol" name="bgfrcvol" /> 200 <field field_ref="bgfrctem" name="bgfrctem" /> 201 <field field_ref="bgfrcsal" name="bgfrcsal" /> 202 203 <field field_ref="ibgvoltot" name="ibgvoltot" /> 204 <field field_ref="sbgvoltot" name="sbgvoltot" /> 205 <field field_ref="ibgarea" name="ibgarea" /> 206 <field field_ref="ibgsaline" name="ibgsaline" /> 207 <field field_ref="ibgtemper" name="ibgtemper" /> 208 <field field_ref="ibgheatco" name="ibgheatco" /> 209 <field field_ref="sbgheatco" name="sbgheatco" /> 210 <field field_ref="ibgsaltco" name="ibgsaltco" /> 211 212 <field field_ref="ibgvfx" name="ibgvfx" /> 213 <field field_ref="ibgvfxbog" name="ibgvfxbog" /> 214 <field field_ref="ibgvfxopw" name="ibgvfxopw" /> 215 <field field_ref="ibgvfxsni" name="ibgvfxsni" /> 216 <field field_ref="ibgvfxdyn" name="ibgvfxdyn" /> 217 <field field_ref="ibgvfxbom" name="ibgvfxbom" /> 218 <field field_ref="ibgvfxsum" name="ibgvfxsum" /> 219 <field field_ref="ibgvfxres" name="ibgvfxres" /> 220 <field field_ref="ibgvfxspr" name="ibgvfxspr" /> 221 <field field_ref="ibgvfxsnw" name="ibgvfxsnw" /> 222 <field field_ref="ibgvfxsub" name="ibgvfxsub" /> 223 224 <field field_ref="ibgsfx" name="ibgsfx" /> 225 <field field_ref="ibgsfxbri" name="ibgsfxbri" /> 226 <field field_ref="ibgsfxdyn" name="ibgsfxdyn" /> 227 <field field_ref="ibgsfxres" name="ibgsfxres" /> 228 <field field_ref="ibgsfxbog" name="ibgsfxbog" /> 229 <field field_ref="ibgsfxopw" name="ibgsfxopw" /> 230 <field field_ref="ibgsfxsni" name="ibgsfxsni" /> 231 <field field_ref="ibgsfxbom" name="ibgsfxbom" /> 232 <field field_ref="ibgsfxsum" name="ibgsfxsum" /> 233 234 <field field_ref="ibghfxdhc" name="ibghfxdhc" /> 235 <field field_ref="ibghfxspr" name="ibghfxspr" /> 236 237 <field field_ref="ibghfxres" name="ibghfxres" /> 238 <field field_ref="ibghfxsub" name="ibghfxsub" /> 239 <field field_ref="ibghfxdyn" name="ibghfxdyn" /> 240 <field field_ref="ibghfxthd" name="ibghfxthd" /> 241 <field field_ref="ibghfxsum" name="ibghfxsum" /> 242 <field field_ref="ibghfxbom" name="ibghfxbom" /> 243 <field field_ref="ibghfxbog" name="ibghfxbog" /> 244 <field field_ref="ibghfxdif" name="ibghfxdif" /> 245 <field field_ref="ibghfxopw" name="ibghfxopw" /> 246 <field field_ref="ibghfxout" name="ibghfxout" /> 247 <field field_ref="ibghfxin" name="ibghfxin" /> 248 <field field_ref="ibghfxsnw" name="ibghfxsnw" /> 249 250 <field field_ref="ibgfrcvol" name="ibgfrcvol" /> 251 <field field_ref="ibgfrcsfx" name="ibgfrcsfx" /> 252 <field field_ref="ibgvolgrm" name="ibgvolgrm" /> 253 254 </file> 171 255 172 256 <!-- … … 214 298 <axis id="nfloat" long_name="Float number" unit="-" /> 215 299 <axis id="icbcla" long_name="Iceberg class" unit="-" /> 300 <axis id="ncatice" long_name="Ice categories" unit="-" /> 216 301 </axis_definition> 217 302 -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_ice_cfg
r4161 r4900 16 16 / 17 17 !----------------------------------------------------------------------- 18 &namicet rp ! ice transport18 &namicethd ! ice thermodynamic 19 19 !----------------------------------------------------------------------- 20 20 / 21 21 !----------------------------------------------------------------------- 22 &namice thd ! ice thermodynamic22 &namicesal ! ice salinity 23 23 !----------------------------------------------------------------------- 24 24 / 25 !----------------------------------------------------------------------- 26 &namiceitdme ! parameters for mechanical redistribution of ice 27 !----------------------------------------------------------------------- 28 / 29 !----------------------------------------------------------------------- 30 &namicedia ! ice diagnostics 31 !----------------------------------------------------------------------- 32 / -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml
r4245 r4900 101 101 <field field_ref="iceprod_cea" name="sip" long_name="sea_ice_thickness" /> 102 102 <field field_ref="ist_ipa" /> 103 <field field_ref="ioceflxb" />104 103 <field field_ref="uice_ipa" /> 105 104 <field field_ref="vice_ipa" /> -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/iodef.xml
r4186 r4900 84 84 <field field_ref="iceprod_cea" name="sip" long_name="sea_ice_thickness" /> 85 85 <field field_ref="ist_ipa" /> 86 <field field_ref="ioceflxb" />87 86 <field field_ref="uice_ipa" /> 88 87 <field field_ref="vice_ipa" /> -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/SHARED/1_namelist_ref
r4347 r4900 225 225 ln_cdgw = .false. ! Neutral drag coefficient read from wave model (T => fill namsbc_wave) 226 226 ln_sdw = .false. ! Computation of 3D stokes drift (T => fill namsbc_wave) 227 nn_lsm = 0 ! =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 228 ! =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 227 229 cn_iceflx = 'linear' ! redistribution of solar input into ice categories during coupling ice/atm. 228 230 / -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/SHARED/domain_def.xml
r3771 r4900 5 5 <!-- My zoom: example of hand defined zoom --> 6 6 <domain id="myzoom" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="5" zoom_nj="5" /> 7 <!-- Eq section --> 7 <domain id="1point" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="1" zoom_nj="1" /> 8 <!-- Eq section --> 8 9 <domain id="EqT" zoom_ibegin="1" zoom_jbegin="0000" zoom_ni="0000" zoom_nj="1" /> 9 10 <!-- TAO --> … … 170 171 <domain_group id="scalarpoint"> 171 172 <domain id="scalarpoint" long_name="scalar"/> 173 <!-- 172 174 <domain id="1point" zoom_ibegin="1" zoom_jbegin="1" zoom_ni="1" zoom_nj="1" /> 175 --> 173 176 </domain_group> 174 177 -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref
r4205 r4900 15 15 !----------------------------------------------------------------------- 16 16 cn_icerst_in = "restart_ice" ! suffix of ice restart name (input) 17 cn_icerst_out = "restart_ice" 18 ln_limdyn = .true.! ice dynamics (T) or thermodynamics only (F)19 amax = 0.999! maximum ice concentration20 cai = 1.40e-3 ! atmospheric drag over sea ice21 cao = 1.00e-3 ! atmospheric drag over ocean22 ln_nicep = .false.! Ice points output for debug (yes or no)23 ln_limdiahsb = .false. ! check the heat and salt budgets (T) or not (F)24 ln_limdiaout = . false.! output the heat and salt budgets (T) or not (F)17 cn_icerst_out = "restart_ice" ! suffix of ice restart name (output) 18 ln_limdyn = .true. ! ice dynamics (T) or thermodynamics only (F) 19 amax = 0.999 ! maximum ice concentration 20 cai = 1.40e-3 ! atmospheric drag over sea ice (clio) 21 cao = 1.00e-3 ! atmospheric drag over ocean (clio) 22 ln_nicep = .false. ! Ice points output for debug (yes or no) 23 ln_limdiahsb = .false. ! check the heat and salt budgets (T) or not (F) 24 ln_limdiaout = .true. ! output the heat and salt budgets (T) or not (F) 25 25 / 26 26 !----------------------------------------------------------------------- 27 27 &namiceini ! ice initialisation 28 28 !----------------------------------------------------------------------- 29 ttest = 2.0 ! threshold water temperature for initial sea ice 30 hninn = 0.3 ! initial snow thickness in the north 31 hnins = 0.1 ! " " south 32 hginn = 3.50 ! initial undeformed ice thickness in the north 33 hgins = 1.0 ! " " " south 34 aginn = 0.95 ! initial undeformed ice concentration in the north 35 agins = 0.9 ! " " " south 36 sinn = 6.301 ! initial salinity in the north 37 sins = 6.301 ! " " south 29 ln_limini = .false. ! activate ice initialization (T) or not (F) 30 thres_sst = 0.0 ! threshold water temperature for initial sea ice 31 hts_ini_n = 0.3 ! initial snow thickness in the north 32 hts_ini_s = 0.3 ! " " south 33 hti_ini_n = 1.0 ! initial ice thickness in the north 34 hti_ini_s = 1.0 ! " " south 35 ati_ini_n = 0.9 ! initial ice concentration in the north 36 ati_ini_s = 0.9 ! " " south 37 smi_ini_n = 6.301 ! initial ice salinity in the north 38 smi_ini_s = 6.301 ! " " south 39 tmi_ini_n = 270. ! initial ice/snw temp in the north 40 tmi_ini_s = 270. ! initial ice/snw temp in the south 38 41 / 39 42 !----------------------------------------------------------------------- … … 41 44 !----------------------------------------------------------------------- 42 45 epsd = 1.0e-20 ! tolerance parameter 43 alpha = 0.5 ! coefficient for semi-implicit coriolis44 dm = 0.6e+03 ! diffusion constant for dynamics45 nbiter = 1 ! number of sub-time steps for relaxation46 nbitdr = 500 ! maximum number of iterations for relaxation47 46 om = 0.5 ! relaxation constant 48 resl = 5.0e-05 ! maximum value for the residual of relaxation49 47 cw = 5.0e-03 ! drag coefficient for oceanic stress 50 48 angvg = 0.0 ! turning angle for oceanic stress 51 49 pstar = 2.0e+04 ! 1st bulk-rheology parameter 52 50 c_rhg = 20.0 ! 2nd bulk-rhelogy parameter 53 etamn = 0.0e+07 ! minimun value for viscosity54 51 creepl = 1.0e-12 ! creep limit 55 52 ecc = 2.0 ! eccentricity of the elliptical yield curve … … 61 58 / 62 59 !----------------------------------------------------------------------- 63 &namicetrp ! ice transport64 !-----------------------------------------------------------------------65 bound = 0. ! boundary conditions (=0.0 no-slip, =1.0 free-slip)66 /67 !-----------------------------------------------------------------------68 60 &namicethd ! ice thermodynamic 69 61 !----------------------------------------------------------------------- 70 62 hmelt = -0.15 ! maximum melting at the bottom 71 hiccrit = 0.1 , 0.1 ! ice thickness for lateral accretion in the Northern (Southern) Hemisphere63 hiccrit = 0.1 ! ice thickness for lateral accretion 72 64 ! caution 1.0, 1.0 best value to be used!!! (gilles G.) ???? 73 fraz_swi = 0 .0! use of frazil ice collection thickness in function of wind (1.0) or not (0.0)65 fraz_swi = 0 ! use of frazil ice collection thickness in function of wind (1.0) or not (0.0) 74 66 maxfrazb = 0.0 ! maximum portion of frazil ice collecting at the ice bottom 75 67 vfrazb = 0.4166667 ! thresold drift speed for frazil ice collecting at the ice bottom 76 68 Cfrazb = 5.0 ! squeezing coefficient for frazil ice collecting at the ice bottom 77 hicmin = 0.2 ! ice thickness corr. to max. energy stored in brine pocket78 69 hiclim = 0.10 ! minimum ice thickness 79 sbeta = 1. ! numerical caracteritic of the scheme for diffusion in ice80 ! Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)81 parlat = 0.0 ! percentage of energy used for lateral ablation82 hakspl = 0.25 ! slope of distr. for Hakkinen-Mellor's lateral melting83 hibspl = 0.5 ! slope of distribution for Hibler's lateral melting84 exld = 2.0 ! exponent for leads-closure rate85 hakdif = 1.0 ! coefficient for diffusions of ice and snow86 thth = 0.2 ! threshold thickness for comp. of eq. thermal conductivity87 70 hnzst = 0.1 ! thickness of the surf. layer in temp. computation 88 71 parsub = 1.0 ! switch for snow sublimation or not 89 alphs = 1.0 ! coefficient for snow density when snow ice formation90 72 betas = 0.6 ! exponent in lead-ice fractionation of snow precipitation 0.66 91 73 ! betas = 1 -> equipartition, betas < 1 -> more on leads … … 124 106 astar = 0.05 ! equivalent of gstar (0.05 for TH75 and 0.03 for weaker ice) 125 107 Hstar = 100.0 ! parameter determining the maximum thickness of ridged ice 126 raft swi= 1 ! rafting or not108 raft_swi = 1 ! rafting or not 127 109 hparmeter = 0.75 ! threshold thickness for rafting or not 128 110 Craft = 5.0 ! coefficient used in the rafting function 129 111 ridge_por = 0.3 ! initial porosity of the ridged ice (typically 0.30) 130 sal_max_ridge = 15.0 ! maximum ridged ice salinity131 112 partfun_swi = 1 ! participation function linear, TH75 (0) or exponential Letal07 (1) 132 transfun_swi = 0 ! transfer function uniform of H80 (0) or exponential Letal07 (1)133 113 brinstren_swi = 0 ! (1) use brine volume to diminish ice strength 134 114 / … … 144 124 !&namicehsb ! Heat and salt budgets 145 125 !!----------------------------------------------------------------------- 146 !147 126 !/ 148 !-----------------------------------------------------------------------149 &namiceout ! parameters for outputs150 !-----------------------------------------------------------------------151 noumef = 43 ! number of fields152 add_diag_swi= 1 ! 1 -> diagnose distribution in thickness space153 ! 0 -> only simple diagnostics154 !155 ! ! title of the field ! name ! units ! save ! multipl. ! additive !156 ! ! ! ! ! or not ! factor ! factor !157 field_1 = 'Ice concentration ', 'iiceconc', '% ', 1 , 1.0 , 0.0158 field_2 = 'Ice thickness ', 'iicethic', 'm ', 1 , 1.0 , 0.0159 field_3 = 'Snow thickness ', 'isnowthi', 'm ', 1 , 1.0 , 0.0160 field_4 = 'Daily bottom thermo ice production ', 'iicebopr', 'km3/day ', 1 , 1.0e-9 , 0.0161 field_5 = 'Daily dynamic ice production ', 'iicedypr', 'km3/day ', 1 , 1.0e-9 , 0.0162 field_6 = 'Oceanic flux at the ice base ', 'ioceflxb', 'w/m2 ', 1 , 1.0 , 0.0163 field_7 = 'Ice velocity u ', 'iicevelu', 'm/s ', 1 , 1.0 , 0.0164 field_8 = 'Ice velocity v ', 'iicevelv', 'm/s ', 1 , 1.0 , 0.0165 field_9 = 'Sea surface temperature ', 'isstempe', 'C ', 1 , 1.0 , -273.15166 field_10 = 'Sea surface salinity ', 'isssalin', 'PSU ', 1 , 1.0 , 0.0167 field_11 = 'Total flux at ocean surface ', 'iocetflx', 'w/m2 ', 1 , 1.0 , 0.0168 field_12 = 'Solar flux at ocean surface ', 'iocesflx', 'w/m2 ', 1 , 1.0 , 0.0169 field_13 = 'Non-solar flux at ocean surface ', 'iocwnsfl', 'w/m2 ', 1 , 1.0 , 0.0170 field_14 = 'Heat flux due to brine release ', 'iocehebr', 'w/m2 ', 1 , 1.0 , 0.0171 field_15 = 'Wind stress u ', 'iocestru', 'Pa ', 1 , 1.0 , 0.0172 field_16 = 'Wind stress v ', 'iocestrv', 'Pa ', 1 , 1.0 , 0.0173 field_17 = 'Solar flux at ice/ocean surface ', 'iicesflx', 'w/m2 ', 1 , 1.0 , 0.0174 field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2 ', 1 , 1.0 , 0.0175 field_19 = 'Snow precipitation ', 'isnowpre', 'kg/m2/d ', 1 , 1.0 , 0.0176 field_20 = 'Mean ice salinity ', 'iicesali', 'psu ', 1 , 1.0 , 0.0177 field_21 = 'Mean ice age ', 'iiceages', 'years ', 1 , 0.002739, 0.0178 field_22 = 'Daily lateral thermo ice prod. ', 'iicelapr', 'km3/day ', 1 ,1.0e-9 , 0.0179 field_23 = 'Daily snowice ice production ', 'iicesipr', 'km3/day ', 1 ,1.0e-9 , 0.0180 field_24 = 'Mean ice temperature ', 'iicetemp', 'C ', 1 , 1.0 , -273.15181 field_25 = 'Ice total heat content ', 'iiceheco', '10^9 J ', 1 , 1.0 , 0.0182 field_26 = 'Ice surface temperature ', 'iicesurt', 'C ', 1 , 1.0 , -273.15183 field_27 = 'Snow temperature ', 'isnotem2', 'C ', 1 , 1.0 , -273.15184 field_28 = 'Fsbri - brine salt flux ', 'iicefsbr', 'kg/m2/d ', 1 , 1.0 , 0.0185 field_29 = 'Fseqv - equivalent FW salt flux ', 'iicefseq', 'kg/m2/d ', 1 , 1.0 , 0.0186 field_30 = 'Brine volume ', 'ibrinvol', '% ', 1 , 100.0 , 0.0187 field_31 = 'Frazil ice collection thickness ', 'iicecolf', 'm ', 1 , 1.0 , 0.0188 field_32 = 'Ice strength ', 'iicestre', 'N/m ', 1 , 0.001 , 0.0189 field_33 = 'Ice velocity ', 'iicevelo', 'm/s ', 1 , 1.0 , 0.0190 field_34 = 'Surface melt ', 'iicesume', 'km3/day ', 1 ,1.0e-9 , 0.0191 field_35 = 'Bottom melt ', 'iicebome', 'km3/day ', 1 ,1.0e-9 , 0.0192 field_36 = 'Divergence ', 'iicedive', '10-8s-1 ', 1 , 1.0e8 , 0.0193 field_37 = 'Shear ', 'iiceshea', '10-8s-1 ', 1 , 1.0e8 , 0.0194 field_38 = 'Daily resultant ice prod/melt ', 'iicerepr', 'km3/day ', 1 , 1.0e-9 , 0.0195 field_39 = 'Ice volume ', 'iicevolu', 'km3 ', 1 , 1.0e-9 , 0.0196 field_40 = 'Snow volume ', 'isnowvol', 'km3 ', 1 , 1.0e-9 , 0.0197 field_41 = 'Fsrpo - salt flux from ridg/raft ', 'iicefsrp', 'kg/m2/d ', 1 , 1.0 , 0.0198 field_42 = 'Fsres - salt flux from limupdate ', 'iicefsre', 'kg/m2/d ', 1 , 1.0 , 0.0199 field_43 = 'Ice volume transport ', 'iicevtrp', 'km3/day ', 1 ,1.0e-9 , 0.0200 /201 127 -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/SHARED/namelist_ref
r4898 r4900 245 245 ! =1 global mean of e-p-r set to zero at each time step 246 246 ! =2 annual global mean of e-p-r set to zero 247 ! =3 global emp set to zero and spread out over erp area 247 248 ln_wave = .false. ! Activate coupling with wave (either Stokes Drift or Drag coefficient, or both) (T => fill namsbc_wave) 248 249 ln_cdgw = .false. ! Neutral drag coefficient read from wave model (T => fill namsbc_wave) 249 250 ln_sdw = .false. ! Computation of 3D stokes drift (T => fill namsbc_wave) 251 nn_lsm = 0 ! =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 252 ! =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 250 253 cn_iceflx = 'linear' ! redistribution of solar input into ice categories during coupling ice/atm. 251 254 / … … 565 568 nn_tra_dta = 0 ! = 0, bdy data are equal to the initial state 566 569 ! = 1, bdy data are read in 'bdydata .nc' files 570 cn_ice_lim = 'none' ! 571 nn_ice_lim_dta = 0 ! = 0, bdy data are equal to the initial state 572 ! = 1, bdy data are read in 'bdydata .nc' files 573 rn_ice_tem = 270. ! lim3 only: arbitrary temperature of incoming sea ice 574 rn_ice_sal = 10. ! lim3 only: -- salinity -- 575 rn_ice_age = 30. ! lim3 only: -- age -- 576 567 577 ln_tra_dmp =.false. ! open boudaries conditions for tracers 568 578 ln_dyn3d_dmp =.false. ! open boundary condition for baroclinic velocities … … 585 595 bn_tem = 'amm12_bdyT_tra' , 24 , 'votemper' , .true. , .false. , 'daily' , '' , '' , '' 586 596 bn_sal = 'amm12_bdyT_tra' , 24 , 'vosaline' , .true. , .false. , 'daily' , '' , '' , '' 597 ! for lim2 598 ! bn_frld = 'amm12_bdyT_ice' , 24 , 'ileadfra' , .true. , .false. , 'daily' , '' , '' , '' 599 ! bn_hicif = 'amm12_bdyT_ice' , 24 , 'iicethic' , .true. , .false. , 'daily' , '' , '' , '' 600 ! bn_hsnif = 'amm12_bdyT_ice' , 24 , 'isnowthi' , .true. , .false. , 'daily' , '' , '' , '' 601 ! for lim3 602 ! bn_a_i = 'amm12_bdyT_ice' , 24 , 'ileadfra' , .true. , .false. , 'daily' , '' , '' , '' 603 ! bn_ht_i = 'amm12_bdyT_ice' , 24 , 'iicethic' , .true. , .false. , 'daily' , '' , '' , '' 604 ! bn_ht_s = 'amm12_bdyT_ice' , 24 , 'isnowthi' , .true. , .false. , 'daily' , '' , '' , '' 587 605 cn_dir = 'bdydta/' 588 606 ln_full_vel = .false. -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/cfg.txt
r4898 r4900 6 6 ORCA2_SAS_LIM OPA_SRC SAS_SRC LIM_SRC_2 NST_SRC 7 7 C1D_PAPA OPA_SRC 8 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC9 8 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 10 9 AMM12 OPA_SRC 11 10 GYRE_BFM OPA_SRC TOP_SRC 12 11 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 12 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r4897 r4900 440 440 !-------------------------------------------------------------------------------- 441 441 ztmp(:,:) = 1. - pfrld(:,:) ! fraction of ice after the dynamic, before the thermodynamic 442 CALL iom_put( 'ioceflxb', fbif ) ! Oceanic flux at the ice base [W/m2 ???]443 442 CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) ) ! Ice surface temperature [Celius] 444 443 CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
r4897 r4900 333 333 CALL histdef( kid, "ileadfra", "Ice concentration" , "-" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 334 334 CALL histdef( kid, "iicetemp", "Ice temperature" , "K" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 335 CALL histdef( kid, "ioceflxb", "flux at ice base" , "w/m2" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )336 335 CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 337 336 CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) … … 351 350 CALL histwrite( kid, "ileadfra", kt, 1. - frld(:,:) , jpi*jpj, (/1/) ) 352 351 CALL histwrite( kid, "iicetemp", kt, sist(:,:) - rt0, jpi*jpj, (/1/) ) 353 CALL histwrite( kid, "ioceflxb", kt, fbif , jpi*jpj, (/1/) )354 352 CALL histwrite( kid, "iicevelu", kt, u_ice , jpi*jpj, (/1/) ) 355 353 CALL histwrite( kid, "iicevelv", kt, v_ice , jpi*jpj, (/1/) ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r4333 r4900 166 166 167 167 ! !!** ice-dynamic namelist (namicedyn) ** 168 INTEGER , PUBLIC :: nbiter !: number of sub-time steps for relaxation169 INTEGER , PUBLIC :: nbitdr !: maximum number of iterations for relaxation170 168 INTEGER , PUBLIC :: nevp !: number of iterations for subcycling 171 INTEGER , PUBLIC :: nlay_i = 5 !: number of layers in the ice172 173 ! !!** ice-dynamic namelist (namicedyn) **174 169 REAL(wp), PUBLIC :: epsd !: tolerance parameter for dynamic 175 REAL(wp), PUBLIC :: alpha !: coefficient for semi-implicit coriolis176 REAL(wp), PUBLIC :: dm !: diffusion constant for dynamics177 170 REAL(wp), PUBLIC :: om !: relaxation constant 178 REAL(wp), PUBLIC :: resl !: maximum value for the residual of relaxation179 171 REAL(wp), PUBLIC :: cw !: drag coefficient for oceanic stress 180 172 REAL(wp), PUBLIC :: angvg !: turning angle for oceanic stress 181 173 REAL(wp), PUBLIC :: pstar !: determines ice strength (N/M), Hibler JPO79 182 174 REAL(wp), PUBLIC :: c_rhg !: determines changes in ice strength 183 REAL(wp), PUBLIC :: etamn !: minimun value for viscosity : has to be 0184 175 REAL(wp), PUBLIC :: creepl !: creep limit : has to be under 1.0e-9 185 176 REAL(wp), PUBLIC :: ecc !: eccentricity of the elliptical yield curve … … 188 179 REAL(wp), PUBLIC :: alphaevp !: coeficient of the internal stresses !SB 189 180 REAL(wp), PUBLIC :: unit_fac = 1.e+09_wp !: conversion factor for ice / snow enthalpy 190 REAL(wp), PUBLIC :: hminrhg = 0.001_wp !: clem: ice volume (a*h, in m) below which ice velocity is set to ocean velocity181 REAL(wp), PUBLIC :: hminrhg !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity 191 182 192 183 ! !!** ice-salinity namelist (namicesal) ** … … 202 193 203 194 ! !!** ice-salinity namelist (namicesal) ** 204 INTEGER , PUBLIC :: num_sal !: salinity configuration used in the model195 INTEGER , PUBLIC :: num_sal !: salinity configuration used in the model 205 196 ! ! 1 - constant salinity in both space and time 206 197 ! ! 2 - prognostic salinity (s(z,t)) 207 198 ! ! 3 - salinity profile, constant in time 208 INTEGER , PUBLIC :: sal_prof = 1 !: salinity profile or not 209 INTEGER , PUBLIC :: thcon_i_swi !: thermal conductivity: =1 Untersteiner (1964) ; =2 Pringle et al (2007) 199 INTEGER , PUBLIC :: thcon_i_swi !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 210 200 211 201 ! !!** ice-mechanical redistribution namelist (namiceitdme) … … 220 210 REAL(wp), PUBLIC :: Craft !: coefficient for smoothness of the hyperbolic tangent in rafting 221 211 REAL(wp), PUBLIC :: ridge_por !: initial porosity of ridges (0.3 regular value) 222 REAL(wp), PUBLIC :: sal_max_ridge !: maximum ridged ice salinity (ppt)223 212 REAL(wp), PUBLIC :: betas !: coef. for partitioning of snowfall between leads and sea ice 224 213 REAL(wp), PUBLIC :: kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] … … 228 217 ! !!** ice-mechanical redistribution namelist (namiceitdme) 229 218 INTEGER , PUBLIC :: ridge_scheme_swi !: scheme used for ice ridging 230 INTEGER , PUBLIC :: raft swi!: rafting of ice or not219 INTEGER , PUBLIC :: raft_swi !: rafting of ice or not 231 220 INTEGER , PUBLIC :: partfun_swi !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 232 INTEGER , PUBLIC :: transfun_swi !: transfer function: =0 Hibler 1980, =1 Lipscomb et al. 2007233 221 INTEGER , PUBLIC :: brinstren_swi !: use brine volume to diminish ice strength 234 222 … … 249 237 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: shear_i !: Shear of the velocity field [s-1] 250 238 ! 251 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: firic !: IR flux over the ice (diag only)252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcsic !: Sensible heat flux over the ice (diag only)253 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fleic !: Latent heat flux over the ice (diag only)254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qlatic !: latent flux255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvosif !: Variation of volume at surface (diag only)256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvobif !: Variation of ice volume at the bottom ice (diag only)257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fdvolif !: Total variation of ice volume (diag only)258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdvonif !: Lateral Variation of ice volume (diag only)259 239 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sist !: Average Sea-Ice Surface Temperature [Kelvin] 260 240 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: icethi !: total ice thickness (for all categories) (diag only) 261 241 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_bo !: Sea-Ice bottom temperature [Kelvin] 262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicifp !: Ice production/melting==>!obsolete... can be removed263 242 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frld !: Leads fraction = 1 - ice fraction 264 243 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfrld !: Leads fraction at previous time 265 244 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: phicif !: Old ice thickness 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fbif !: Heat flux at the ice base 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdm_snw !: Variation of snow mass over 1 time step [Kg/m2] 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdq_snw !: Heat content associated with rdm_snw [J/m2] 269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdm_ice !: Variation of ice mass over 1 time step [Kg/m2] 270 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rdq_ice !: Heat content associated with rdm_ice [J/m2] 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qldif !: heat balance of the lead (or of the open ocean) 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qcmif !: Energy needed to bring the ocean to freezing 273 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fdtcn !: net downward heat flux from the ice to the ocean 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qdtcn !: energy from the ice to the ocean 275 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fstric !: transmitted solar radiation under ice 276 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fscmbq !: associated with lead chipotage with solar flux 277 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ffltbif !: related to max heat contained in brine pockets (?) 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsbbq !: Also linked with the solar flux below the ice (?) 279 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qfvbq !: store energy in case of total lateral ablation (?) 280 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dmgwi !: Variation of the mass of snow ice 281 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_thd !: salt flux due to ice growth/melt [PSU/m2/s] 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qlead !: heat balance of the lead (or of the open ocean) 246 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhtur !: net downward heat flux from the ice to the ocean 247 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhld !: heat flux from the lead used for bottom melting 248 249 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: Variation of snow mass over 1 time step [Kg/m2] 250 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: Variation of ice mass over 1 time step [Kg/m2] 251 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: Variation of snow mass over 1 time step due to sublimation [Kg/m2] 252 253 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: snow ice growth 254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: lateral ice growth 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: bottom ice growth 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: dynamical ice growth 257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: vertical bottom melt 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: vertical surface melt 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: production (growth+melt) due to limupdate 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: snow precipitation on ice 261 262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice growth/melt [PSU/m2/s] 263 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bom !: salt flux due to ice growth/melt [PSU/m2/s] 264 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sum !: salt flux due to ice growth/melt [PSU/m2/s] 265 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sni !: salt flux due to ice growth/melt [PSU/m2/s] 266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_opw !: salt flux due to ice growth/melt [PSU/m2/s] 282 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bri !: salt flux due to brine rejection [PSU/m2/s] 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_ mec!: salt flux due to porous ridged ice formation [PSU/m2/s]268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_dyn !: salt flux due to porous ridged ice formation [PSU/m2/s] 284 269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: residual salt flux due to correction of ice thickness [PSU/m2/s] 285 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhbri !: heat flux due to brine rejection 286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fheat_mec !: heat flux associated with porous ridged ice formation [???] 287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fheat_res !: residual heat flux due to correction of ice thickness 288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmec !: mass flux due to snow loss during compression [Kg/m2/s] 289 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhmec !: heat flux due to snow loss during compression 270 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bog !: total heat flux causing bottom ice growth 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bom !: total heat flux causing bottom ice melt 273 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sum !: total heat flux causing surface ice melt 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_opw !: total heat flux causing open water ice formation 275 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dif !: total heat flux causing Temp change in the ice 276 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_snw !: heat flux for snow melt 277 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err !: heat flux error after heat diffusion 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping 279 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_in !: heat flux available for thermo transformations 280 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_out !: heat flux remaining at the end of thermo transformations 281 282 ! heat flux associated with ice-atmosphere mass exchange 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sub !: heat flux for sublimation 284 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_spr !: heat flux of the snow precipitation 285 286 ! heat flux associated with ice-ocean mass exchange 287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_thd !: ice-ocean heat flux from thermo processes (limthd_dh) 288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dyn !: ice-ocean heat flux from mecanical processes (limitd_me) 289 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: residual heat flux due to correction of ice thickness 290 291 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 290 292 291 293 ! temporary arrays for dummy version of the code 292 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh_i_surf2D, dh_i_bott2D, fstbif, fsup2D, focea2D,q_s294 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh_i_surf2D, dh_i_bott2D, q_s 293 295 294 296 !!-------------------------------------------------------------------------- … … 404 406 LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F) 405 407 LOGICAL , PUBLIC :: ln_limdiaout !: flag for ice diag (T) or not (F) 406 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: v_newice !: volume of ice formed in the leads 407 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dv_dt_thd !: thermodynamic growth rates 408 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: izero, fstroc, fhbricat 409 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_sni_gr ! snow ice growth 410 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_lat_gr ! lateral ice growth 411 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_bot_gr ! bottom ice growth 412 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_dyn_gr ! dynamical ice growth 413 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_bot_me ! vertical bottom melt 414 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_sur_me ! vertical surface melt 415 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_res_pr ! production (growth+melt) due to limupdate 416 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi ! transport of ice volume 408 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dv_dt_thd !: thermodynamic growth rates 409 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: izero 410 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vi !: transport of ice volume 411 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_vs !: transport of snw volume 412 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei !: transport of ice enthalpy (W/m2) 413 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es !: transport of snw enthalpy (W/m2) 414 ! 415 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat_dhc !: snw/ice heat content variation [W/m2] 416 ! 417 417 INTEGER , PUBLIC :: jiindx, jjindx !: indexes of the debugging point 418 418 … … 447 447 448 448 ii = ii + 1 449 ALLOCATE( firic (jpi,jpj) , fcsic (jpi,jpj) , fleic (jpi,jpj) , qlatic (jpi,jpj) ,&450 & rdvosif (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif(jpi,jpj) , rdvonif (jpi,jpj) ,&451 & sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , hicifp (jpi,jpj) ,&452 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , fbif(jpi,jpj) , &453 & rdm_snw (jpi,jpj) , rdq_snw(jpi,jpj) , rdm_ice(jpi,jpj) , rdq_ice(jpi,jpj) , &454 & qldif (jpi,jpj) , qcmif (jpi,jpj) ,&455 & fdtcn (jpi,jpj) , qdtcn (jpi,jpj) , fstric (jpi,jpj) , fscmbq (jpi,jpj) ,&456 & ffltbif (jpi,jpj) , fsbbq (jpi,jpj) , qfvbq (jpi,jpj) , dmgwi (jpi,jpj) ,&457 & sfx_res (jpi,jpj) , sfx_bri(jpi,jpj) , sfx_mec(jpi,jpj) , fheat_mec(jpi,jpj) ,&458 & fhbri (jpi,jpj) , fmmec (jpi,jpj) , sfx_thd(jpi,jpj) , fhmec (jpi,jpj) ,&459 & fheat_res(jpi,jpj) , STAT=ierr(ii) )460 461 ii = ii + 1 462 ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , fstbif(jpi,jpj) , &463 & fsup2D (jpi,jpj) , focea2D (jpi,jpj) , q_s(jpi,jpj) , STAT=ierr(ii) )449 ALLOCATE( sist (jpi,jpj) , icethi (jpi,jpj) , t_bo (jpi,jpj) , & 450 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , & 451 & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , & 452 & wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , & 453 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , qlead (jpi,jpj) , & 454 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl) , & 455 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , & 456 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 457 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), & 458 & hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) , & 459 & hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , & 460 & hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) , STAT=ierr(ii) ) 461 462 ii = ii + 1 463 ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , q_s(jpi,jpj) , STAT=ierr(ii) ) 464 464 465 465 ! * Ice global state variables … … 522 522 ! * Ice diagnostics 523 523 ii = ii + 1 524 ALLOCATE( dv_dt_thd(jpi,jpj,jpl) , diag_sni_gr(jpi,jpj) , diag_lat_gr(jpi,jpj) , & 525 & izero (jpi,jpj,jpl) , diag_bot_gr(jpi,jpj) , diag_dyn_gr(jpi,jpj) , & 526 & fstroc (jpi,jpj,jpl) , diag_bot_me(jpi,jpj) , diag_sur_me(jpi,jpj) , & 527 & fhbricat (jpi,jpj,jpl) , diag_res_pr(jpi,jpj) , diag_trp_vi(jpi,jpj) , v_newice(jpi,jpj) , STAT=ierr(ii) ) 524 ALLOCATE( dv_dt_thd(jpi,jpj,jpl) , & 525 & izero (jpi,jpj,jpl) , diag_trp_vi(jpi,jpj) , diag_trp_vs(jpi,jpj), diag_trp_ei(jpi,jpj), diag_trp_es(jpi,jpj), & 526 & diag_heat_dhc(jpi,jpj) , STAT=ierr(ii) ) 528 527 529 528 ice_alloc = MAXVAL( ierr(:) ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
r4161 r4900 32 32 33 33 REAL(wp) :: epsi20 = 1.e-20_wp ! constant values 34 REAL(wp) :: rzero = 0._wp ! - -35 REAL(wp) :: rone = 1._wp ! - -36 34 37 35 !! * Substitutions … … 84 82 DO jj = 1, jpj 85 83 DO ji = 1, jpi 86 zslpmax = MAX( rzero, ps0(ji,jj) )84 zslpmax = MAX( 0._wp, ps0(ji,jj) ) 87 85 zs1max = 1.5 * zslpmax 88 86 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) ) 89 87 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 90 88 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) ) ) 91 zin0 = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask89 zin0 = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask 92 90 93 91 ps0 (ji,jj) = zslpmax … … 106 104 DO jj = 1, jpj ! Flux from i to i+1 WHEN u GT 0 107 105 DO ji = 1, jpi 108 zbet(ji,jj) = MAX( rzero, SIGN( rone, put(ji,jj) ) )109 zalf = MAX( rzero, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj)106 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 107 zalf = MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 110 108 zalfq = zalf * zalf 111 109 zalf1 = 1.0 - zalf … … 133 131 DO jj = 1, jpjm1 ! Flux from i+1 to i when u LT 0. 134 132 DO ji = 1, fs_jpim1 135 zalf = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)133 zalf = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj) 136 134 zalg (ji,jj) = zalf 137 135 zalfq = zalf * zalf … … 269 267 DO jj = 1, jpj 270 268 DO ji = 1, jpi 271 zslpmax = MAX( rzero, ps0(ji,jj) )269 zslpmax = MAX( 0._wp, ps0(ji,jj) ) 272 270 zs1max = 1.5 * zslpmax 273 271 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 274 272 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 275 273 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) ) ) 276 zin0 = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask274 zin0 = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj) ! Case of empty boxes & Apply mask 277 275 ! 278 276 ps0 (ji,jj) = zslpmax … … 291 289 DO jj = 1, jpj ! Flux from j to j+1 WHEN v GT 0 292 290 DO ji = 1, jpi 293 zbet(ji,jj) = MAX( rzero, SIGN( rone, pvt(ji,jj) ) )294 zalf = MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj)291 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 292 zalf = MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 295 293 zalfq = zalf * zalf 296 294 zalf1 = 1.0 - zalf … … 318 316 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 319 317 DO ji = 1, jpi 320 zalf = ( MAX( rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)318 zalf = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1) 321 319 zalg (ji,jj) = zalf 322 320 zalfq = zalf * zalf -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r4161 r4900 7 7 !! 3.0 ! 2004-06 (M. Vancoppenolle) Energy Conservation 8 8 !! 4.0 ! 2011-02 (G. Madec) add mpp considerations 9 !! - ! 2014-05 (C. Rousset) add lim_cons_hsm 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_lim3 … … 14 15 !! lim_cons : checks whether energy, mass and salt are conserved 15 16 !!---------------------------------------------------------------------- 17 USE phycst ! physical constants 16 18 USE par_ice ! LIM-3 parameter 17 19 USE ice ! LIM-3 variables … … 28 30 PUBLIC lim_column_sum_energy 29 31 PUBLIC lim_cons_check 32 PUBLIC lim_cons_hsm 30 33 31 34 !!---------------------------------------------------------------------- … … 151 154 END SUBROUTINE lim_cons_check 152 155 156 157 SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 158 !!------------------------------------------------------------------- 159 !! *** ROUTINE lim_cons_hsm *** 160 !! 161 !! ** Purpose : Test the conservation of heat, salt and mass for each routine 162 !! 163 !! ** Method : 164 !!--------------------------------------------------------------------- 165 INTEGER , INTENT(in) :: icount ! determine wether this is the beggining of the routine (0) or the end (1) 166 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 167 REAL(wp) , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 168 REAL(wp) :: zvi, zsmv, zei, zfs, zfw, zft 169 REAL(wp) :: zvmin, zamin, zamax 170 171 IF( icount == 0 ) THEN 172 173 zvi_b = glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 174 zsmv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 175 zei_b = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 176 zfw_b = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 177 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) ) * area(:,:) * tms(:,:) ) 178 zfs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 179 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) 180 zft_b = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 181 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) 182 183 ELSEIF( icount == 1 ) THEN 184 185 zfs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 186 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zfs_b 187 zfw = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 188 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) ) * area(:,:) * tms(:,:) ) - zfw_b 189 zft = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 190 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zft_b 191 192 zvi = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zvi_b ) * r1_rdtice - zfw 193 zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zsmv_b ) * r1_rdtice + ( zfs / rhoic ) 194 zei = glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zei_b * r1_rdtice + zft 195 196 zvmin = glob_min(v_i) 197 zamax = glob_max(SUM(a_i,dim=3)) 198 zamin = glob_min(a_i) 199 200 IF(lwp) THEN 201 IF ( ABS( zvi ) > 1.e-4 ) WRITE(numout,*) 'violation volume [kg/day] (',cd_routine,') = ',(zvi * rday) 202 IF ( ABS( zsmv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday) 203 IF ( ABS( zei ) > 1. ) WRITE(numout,*) 'violation enthalpy [1e9 J] (',cd_routine,') = ',(zei) 204 IF ( zvmin < 0. ) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',(zvmin) 205 IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > amax+1.e-10 ) THEN 206 WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax 207 ENDIF 208 IF ( zamin < 0. ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin 209 ENDIF 210 211 ENDIF 212 213 END SUBROUTINE lim_cons_hsm 214 153 215 #else 154 216 !!---------------------------------------------------------------------- -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
r4346 r4900 18 18 USE dom_oce ! ocean domain 19 19 USE sbc_oce ! surface boundary condition: ocean fields 20 USE sbc_ice ! Surface boundary condition: sea-ice fields 20 21 USE daymod ! model calendar 21 22 USE phycst ! physical constant … … 37 38 REAL(dp) :: bg_grme ! global ice growth+melt trends 38 39 REAL(wp) :: epsi06 = 1.e-6_wp ! small number 39 REAL(wp) :: epsi03 = 1.e-3_wp ! small number40 41 40 42 41 !! * Substitutions … … 60 59 !! 61 60 REAL(dp) :: zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 62 REAL(dp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_thd, zbg_sfx_res, zbg_sfx_mec 63 REAL(dp) :: zbg_emp, zbg_emp_bog, zbg_emp_lag, zbg_emp_sig, zbg_emp_dyg, zbg_emp_bom, zbg_emp_sum, zbg_emp_res 61 REAL(dp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni, zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn 62 REAL(dp) :: zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 63 REAL(dp) :: zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub 64 REAL(dp) :: zbg_hfx_dhc, zbg_hfx_spr 65 REAL(dp) :: zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in 66 REAL(dp) :: zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 64 67 REAL(dp) :: z_frc_vol, z_frc_sal, z_bg_grme 65 68 REAL(dp) :: z1_area ! - - … … 86 89 !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 87 90 88 zbg_ihc = glob_sum( et_i(:,:) * 1.e-11 ) ! ice heat content [10^9*1.e-11 J] 89 zbg_shc = glob_sum( et_s(:,:) * 1.e-11 ) ! snow heat content [10^9*1.e-11 J] 90 91 zbg_emp = zinda * glob_sum( emp(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 92 zbg_emp_bog = zinda * glob_sum( diag_bot_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 93 zbg_emp_lag = zinda * glob_sum( diag_lat_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 94 zbg_emp_sig = zinda * glob_sum( diag_sni_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 95 zbg_emp_dyg = zinda * glob_sum( diag_dyn_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 96 zbg_emp_bom = zinda * glob_sum( diag_bot_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 97 zbg_emp_sum = zinda * glob_sum( diag_sur_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 98 zbg_emp_res = zinda * glob_sum( diag_res_pr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 99 91 ! Volume 92 zbg_vfx = zinda * glob_sum( emp(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 93 zbg_vfx_bog = zinda * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 94 zbg_vfx_opw = zinda * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 95 zbg_vfx_sni = zinda * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 96 zbg_vfx_dyn = zinda * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 97 zbg_vfx_bom = zinda * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 98 zbg_vfx_sum = zinda * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 99 zbg_vfx_res = zinda * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 100 zbg_vfx_spr = zinda * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 101 zbg_vfx_snw = zinda * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 102 zbg_vfx_sub = zinda * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 103 104 ! Salt 100 105 zbg_sfx = zinda * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 101 106 zbg_sfx_bri = zinda * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 102 zbg_sfx_thd = zinda * glob_sum( sfx_thd(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday103 107 zbg_sfx_res = zinda * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 104 zbg_sfx_mec = zinda * glob_sum( sfx_mec(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 105 108 zbg_sfx_dyn = zinda * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 109 110 zbg_sfx_bog = zinda * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 111 zbg_sfx_opw = zinda * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 112 zbg_sfx_sni = zinda * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 113 zbg_sfx_bom = zinda * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 114 zbg_sfx_sum = zinda * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 115 116 ! Heat budget 117 zbg_ihc = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content [1.e-20 J] 118 zbg_shc = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J] 119 zbg_hfx_dhc = glob_sum( diag_heat_dhc(:,:) * area(:,:) * tms(:,:) ) ! [in W] 120 zbg_hfx_spr = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W] 121 122 zbg_hfx_thd = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W] 123 zbg_hfx_dyn = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W] 124 zbg_hfx_res = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W] 125 zbg_hfx_sub = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W] 126 zbg_hfx_snw = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 127 zbg_hfx_sum = glob_sum( hfx_sum(:,:) * area(:,:) * tms(:,:) ) ! [in W] 128 zbg_hfx_bom = glob_sum( hfx_bom(:,:) * area(:,:) * tms(:,:) ) ! [in W] 129 zbg_hfx_bog = glob_sum( hfx_bog(:,:) * area(:,:) * tms(:,:) ) ! [in W] 130 zbg_hfx_dif = glob_sum( hfx_dif(:,:) * area(:,:) * tms(:,:) ) ! [in W] 131 zbg_hfx_opw = glob_sum( hfx_opw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 132 zbg_hfx_out = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W] 133 zbg_hfx_in = glob_sum( hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W] 134 106 135 ! --------------------------------------------- ! 107 136 ! 2 - Trends due to forcing and ice growth/melt ! … … 109 138 z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes 110 139 z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes 111 z_bg_grme = glob_sum( ( diag_bot_gr(:,:) + diag_lat_gr(:,:) + diag_sni_gr(:,:) + diag_dyn_gr(:,:) + &112 & diag_bot_me(:,:) + diag_sur_me(:,:) + diag_res_pr(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes140 z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 141 & wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + wfx_sub(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes 113 142 ! 114 143 frc_vol = frc_vol + z_frc_vol * rdt_ice … … 134 163 CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9 ) ! ice salt content (psu*km3 equivalent liquid) 135 164 136 CALL iom_put( 'ibgemp' , zbg_emp ) ! volume flux emp (m/day liquid) 137 CALL iom_put( 'ibgempbog' , zbg_emp_bog ) ! volume flux bottom growth -(m/day equivalent liquid) 138 CALL iom_put( 'ibgemplag' , zbg_emp_lag ) ! volume flux open water growth - 139 CALL iom_put( 'ibgempsig' , zbg_emp_sig ) ! volume flux snow ice growth - 140 CALL iom_put( 'ibgempdyg' , zbg_emp_dyg ) ! volume flux dynamic growth - 141 CALL iom_put( 'ibgempbom' , zbg_emp_bom ) ! volume flux bottom melt - 142 CALL iom_put( 'ibgempsum' , zbg_emp_sum ) ! volume flux surface melt - 143 CALL iom_put( 'ibgempres' , zbg_emp_res ) ! volume flux resultant - 165 CALL iom_put( 'ibgvfx' , zbg_vfx ) ! volume flux emp (m/day liquid) 166 CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog ) ! volume flux bottom growth -(m/day equivalent liquid) 167 CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw ) ! volume flux open water growth - 168 CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni ) ! volume flux snow ice growth - 169 CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn ) ! volume flux dynamic growth - 170 CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom ) ! volume flux bottom melt - 171 CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum ) ! volume flux surface melt - 172 CALL iom_put( 'ibgvfxres' , zbg_vfx_res ) ! volume flux resultant - 173 CALL iom_put( 'ibgvfxspr' , zbg_vfx_spr ) ! volume flux from snow precip - 174 CALL iom_put( 'ibgvfxsnw' , zbg_vfx_snw ) ! volume flux from snow melt - 175 CALL iom_put( 'ibgvfxsub' , zbg_vfx_sub ) ! volume flux from sublimation - 144 176 145 177 CALL iom_put( 'ibgsfx' , zbg_sfx ) ! salt flux -(psu*m/day equivalent liquid) 146 178 CALL iom_put( 'ibgsfxbri' , zbg_sfx_bri ) ! salt flux brines - 147 CALL iom_put( 'ibgsfxthd' , zbg_sfx_thd ) ! salt flux thermo - 148 CALL iom_put( 'ibgsfxmec' , zbg_sfx_mec ) ! salt flux dynamic - 179 CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn ) ! salt flux dynamic - 149 180 CALL iom_put( 'ibgsfxres' , zbg_sfx_res ) ! salt flux result - 181 CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog ) ! salt flux bottom growth 182 CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw ) ! salt flux open water growth - 183 CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni ) ! salt flux snow ice growth - 184 CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom ) ! salt flux bottom melt - 185 CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum ) ! salt flux surface melt - 186 187 CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc ) ! Heat content variation in snow and ice [W] 188 CALL iom_put( 'ibghfxspr' , zbg_hfx_spr ) ! Heat content of snow precip [W] 189 190 CALL iom_put( 'ibghfxres' , zbg_hfx_res ) ! 191 CALL iom_put( 'ibghfxsub' , zbg_hfx_sub ) ! 192 CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn ) ! 193 CALL iom_put( 'ibghfxthd' , zbg_hfx_thd ) ! 194 CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw ) ! 195 CALL iom_put( 'ibghfxsum' , zbg_hfx_sum ) ! 196 CALL iom_put( 'ibghfxbom' , zbg_hfx_bom ) ! 197 CALL iom_put( 'ibghfxbog' , zbg_hfx_bog ) ! 198 CALL iom_put( 'ibghfxdif' , zbg_hfx_dif ) ! 199 CALL iom_put( 'ibghfxopw' , zbg_hfx_opw ) ! 200 CALL iom_put( 'ibghfxout' , zbg_hfx_out ) ! 201 CALL iom_put( 'ibghfxin' , zbg_hfx_in ) ! 150 202 151 203 CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9 ) ! vol - forcing (km3 equivalent liquid) 152 204 CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9 ) ! sal - forcing (psu*km3 equivalent liquid) 153 CALL iom_put( 'ibggrme' , bg_grme * rhoic * r1_rau0 * 1.e-9 ) ! vol growth + melt (km3 equivalent liquid) 205 CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9 ) ! vol growth + melt (km3 equivalent liquid) 206 154 207 ! 155 208 IF( lrst_ice ) CALL lim_diahsb_rst( numit, 'WRITE' ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r4897 r4900 30 30 USE lib_fortran ! glob_sum 31 31 USE timing ! Timing 32 USE limcons ! conservation tests 32 33 33 34 IMPLICIT NONE … … 66 67 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 67 68 REAL(wp), POINTER, DIMENSION(:,:) :: zu_io, zv_io ! ice-ocean velocity 68 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)69 REAL(wp) :: z chk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset)69 ! 70 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 70 71 !!--------------------------------------------------------------------- 71 72 … … 75 76 CALL wrk_alloc( jpj, zind, zmsk ) 76 77 77 ! -------------------------------78 !- check conservation (C Rousset)79 IF (ln_limdiahsb) THEN80 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )81 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) )82 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) )83 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) )84 ENDIF85 !- check conservation (C Rousset)86 ! -------------------------------87 88 78 IF( kt == nit000 ) CALL lim_dyn_init ! Initialization (first time-step only) 89 79 90 80 IF( ln_limdyn ) THEN 91 81 ! 82 ! conservation test 83 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 84 92 85 old_u_ice(:,:) = u_ice(:,:) * tmu(:,:) 93 86 old_v_ice(:,:) = v_ice(:,:) * tmv(:,:) … … 171 164 END DO 172 165 END DO 166 ! 167 ! conservation test 168 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 173 169 ! 174 170 ELSE ! no ice dynamics : transmit directly the atmospheric stress to the ocean … … 224 220 ENDIF 225 221 ! 226 ! -------------------------------227 !- check conservation (C Rousset)228 IF (ln_limdiahsb) THEN229 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b230 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b231 232 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice233 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic )234 235 zchk_vmin = glob_min(v_i)236 zchk_amax = glob_max(SUM(a_i,dim=3))237 zchk_amin = glob_min(a_i)238 239 IF(lwp) THEN240 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limdyn) = ',(zchk_v_i * rday)241 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limdyn) = ',(zchk_smv * rday)242 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limdyn) = ',(zchk_vmin * 1.e-3)243 !IF ( zchk_amax > amax+1.e-10 ) WRITE(numout,*) 'violation a_i>amax (limdyn) = ',zchk_amax244 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limdyn) = ',zchk_amin245 ENDIF246 ENDIF247 !- check conservation (C Rousset)248 ! -------------------------------249 250 222 CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 251 223 CALL wrk_dealloc( jpj, zind, zmsk ) … … 269 241 !!------------------------------------------------------------------- 270 242 INTEGER :: ios ! Local integer output status for namelist read 271 NAMELIST/namicedyn/ epsd, alpha, & 272 & dm, nbiter, nbitdr, om, resl, cw, angvg, pstar, & 273 & c_rhg, etamn, creepl, ecc, ahi0, & 243 NAMELIST/namicedyn/ epsd, om, cw, angvg, pstar, & 244 & c_rhg, creepl, ecc, ahi0, & 274 245 & nevp, telast, alphaevp, hminrhg 275 246 !!------------------------------------------------------------------- … … 289 260 WRITE(numout,*) '~~~~~~~~~~~~' 290 261 WRITE(numout,*) ' tolerance parameter epsd = ', epsd 291 WRITE(numout,*) ' coefficient for semi-implicit coriolis alpha = ', alpha292 WRITE(numout,*) ' diffusion constant for dynamics dm = ', dm293 WRITE(numout,*) ' number of sub-time steps for relaxation nbiter = ', nbiter294 WRITE(numout,*) ' maximum number of iterations for relaxation nbitdr = ', nbitdr295 262 WRITE(numout,*) ' relaxation constant om = ', om 296 WRITE(numout,*) ' maximum value for the residual of relaxation resl = ', resl297 263 WRITE(numout,*) ' drag coefficient for oceanic stress cw = ', cw 298 264 WRITE(numout,*) ' turning angle for oceanic stress angvg = ', angvg 299 265 WRITE(numout,*) ' first bulk-rheology parameter pstar = ', pstar 300 266 WRITE(numout,*) ' second bulk-rhelogy parameter c_rhg = ', c_rhg 301 WRITE(numout,*) ' minimun value for viscosity etamn = ', etamn302 267 WRITE(numout,*) ' creep limit creepl = ', creepl 303 268 WRITE(numout,*) ' eccentricity of the elliptical yield curve ecc = ', ecc -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r4897 r4900 26 26 USE dom_ice ! sea-ice domain 27 27 USE in_out_manager ! I/O manager 28 USE lbclnk ! lateral boundary condition - MPP exchanges29 28 USE lib_mpp ! MPP library 30 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 31 30 USE wrk_nemo ! work arrays 31 USE cpl_oasis3, ONLY : lk_cpl 32 32 33 33 IMPLICIT NONE … … 37 37 38 38 ! !!** init namelist (namiceini) ** 39 REAL(wp) :: ttest ! threshold water temperature for initial sea ice 40 REAL(wp) :: hninn ! initial snow thickness in the north 41 REAL(wp) :: hnins ! initial snow thickness in the south 42 REAL(wp) :: hginn ! initial ice thickness in the north 43 REAL(wp) :: hgins ! initial ice thickness in the south 44 REAL(wp) :: aginn ! initial leads area in the north 45 REAL(wp) :: agins ! initial leads area in the south 46 REAL(wp) :: sinn ! initial salinity 47 REAL(wp) :: sins 48 39 REAL(wp) :: thres_sst ! threshold water temperature for initial sea ice 40 REAL(wp) :: hts_ini_n ! initial snow thickness in the north 41 REAL(wp) :: hts_ini_s ! initial snow thickness in the south 42 REAL(wp) :: hti_ini_n ! initial ice thickness in the north 43 REAL(wp) :: hti_ini_s ! initial ice thickness in the south 44 REAL(wp) :: ati_ini_n ! initial leads area in the north 45 REAL(wp) :: ati_ini_s ! initial leads area in the south 46 REAL(wp) :: smi_ini_n ! initial salinity 47 REAL(wp) :: smi_ini_s ! initial salinity 48 REAL(wp) :: tmi_ini_n ! initial temperature 49 REAL(wp) :: tmi_ini_s ! initial temperature 50 51 LOGICAL :: ln_limini ! initialization or not 49 52 !!---------------------------------------------------------------------- 50 53 !! LIM 3.0, UCL-LOCEAN-IPSL (2008) … … 88 91 INTEGER :: i_hemis, i_fill, jl0 89 92 REAL(wp) :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv 90 REAL(wp), POINTER, DIMENSION(:) :: zh m_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini91 REAL(wp), POINTER, DIMENSION(:,:) :: zh t_i_ini, za_i_ini, zv_i_ini92 REAL(wp), POINTER, DIMENSION(:,:) :: z idto! ice indicator93 REAL(wp), POINTER, DIMENSION(:) :: zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini 94 REAL(wp), POINTER, DIMENSION(:,:) :: zh_i_ini, za_i_ini, zv_i_ini 95 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch ! ice indicator 93 96 INTEGER, POINTER, DIMENSION(:,:) :: zhemis ! hemispheric index 94 97 !-------------------------------------------------------------------- 95 98 96 CALL wrk_alloc( jpi, jpj, z idto)99 CALL wrk_alloc( jpi, jpj, zswitch ) 97 100 CALL wrk_alloc( jpi, jpj, zhemis ) 98 CALL wrk_alloc( jpl, 2, zht_i_ini, za_i_ini, zv_i_ini ) 99 CALL wrk_alloc( 2, zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini ) 100 101 epsi20 = 1.0e-20 101 CALL wrk_alloc( jpl, 2, zh_i_ini, za_i_ini, zv_i_ini ) 102 CALL wrk_alloc( 2, zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 103 104 epsi20 = 1.e-20_wp 105 102 106 IF(lwp) WRITE(numout,*) 103 107 IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' … … 110 114 CALL lim_istate_init ! reading the initials parameters of the ice 111 115 112 !!gm in lim2 the initialisation if only done if required in the namelist : 113 !!gm IF( .NOT. ln_limini ) THEN 114 !!gm this should be added in lim3 namelist... 116 # if defined key_coupled 117 albege(:,:) = 0.8 * tms(:,:) 118 # endif 119 120 ! surface temperature 121 DO jl = 1, jpl ! loop over categories 122 t_su (:,:,jl) = rtt * tms(:,:) 123 tn_ice(:,:,jl) = rtt * tms(:,:) 124 END DO 125 126 IF( ln_limini ) THEN 115 127 116 128 !-------------------------------------------------------------------- 117 129 ! 2) Basal temperature, ice mask and hemispheric index 118 130 !-------------------------------------------------------------------- 119 120 ! Basal temperature is set to the freezing point of seawater in Celsius 121 t_bo(:,:) = eos_fzp( tsn(:,:,1,jp_sal) ) * tmask(:,:,1) ! freezing/melting point of sea water [Celcius] 131 t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:) 122 132 123 133 DO jj = 1, jpj ! ice if sst <= t-freez + ttest 124 134 DO ji = 1, jpi 125 IF( tsn(ji,jj,1,jp_tem) - t_bo(ji,jj) >= ttest ) THEN ; zidto(ji,jj) = 0._wp! no ice126 ELSE ; zidto(ji,jj) = 1._wp! ice135 IF( ( tsn(ji,jj,1,jp_tem) - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN ; zswitch(ji,jj) = 0._wp * tms(ji,jj) ! no ice 136 ELSE ; zswitch(ji,jj) = 1._wp * tms(ji,jj) ! ice 127 137 ENDIF 128 138 END DO 129 139 END DO 130 140 131 t_bo(:,:) = t_bo(:,:) + rt0 ! conversion to Kelvin132 141 133 142 ! Hemispheric index … … 151 160 ! 3.1) Hemisphere-dependent arrays 152 161 !----------------------------- 153 ! assign initial thickness, concentration, snow depth and salinity to 154 ! an hemisphere-dependent array 155 zhm_i_ini(1) = hginn ; zhm_i_ini(2) = hgins ! ice thickness 156 zat_i_ini(1) = aginn ; zat_i_ini(2) = agins ! ice concentration 157 zvt_i_ini(:) = zhm_i_ini(:) * zat_i_ini(:) ! ice volume 158 zhm_s_ini(1) = hninn ; zhm_s_ini(2) = hnins ! snow depth 159 zsm_i_ini(1) = sinn ; zsm_i_ini(2) = sins ! bulk ice salinity 162 ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 163 zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s ! ice thickness 164 zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s ! snow depth 165 zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s ! ice concentration 166 zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s ! bulk ice salinity 167 ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s ! temperature (ice and snow) 168 169 zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:) ! ice volume 160 170 161 171 !--------------------------------------------------------------------- … … 181 191 ! *** 1 category to fill 182 192 IF ( i_fill .EQ. 1 ) THEN 183 zh t_i_ini(1,i_hemis) = zhm_i_ini(i_hemis)184 za_i_ini(1,i_hemis) 185 zh t_i_ini(2:jpl,i_hemis) = 0._wp186 za_i_ini(2:jpl,i_hemis) 193 zh_i_ini(1,i_hemis) = zht_i_ini(i_hemis) 194 za_i_ini(1,i_hemis) = zat_i_ini(i_hemis) 195 zh_i_ini(2:jpl,i_hemis) = 0._wp 196 za_i_ini(2:jpl,i_hemis) = 0._wp 187 197 ELSE 188 198 189 ! *** >1 categores to fill190 !--- Ice thicknesses in the i_fill - 1 first categories199 ! *** >1 categores to fill 200 !--- Ice thicknesses in the i_fill - 1 first categories 191 201 DO jl = 1, i_fill - 1 192 zh t_i_ini(jl,i_hemis) = 0.5 * ( hi_max(jl) + hi_max(jl-1) )202 zh_i_ini(jl,i_hemis) = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 193 203 END DO 194 195 !--- jl0: most likely index where cc will be maximum204 205 !--- jl0: most likely index where cc will be maximum 196 206 DO jl = 1, jpl 197 IF ( ( zh m_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. &198 ( zhm_i_ini(i_hemis) .LE. hi_max(jl) ) ) THEN207 IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 208 ( zht_i_ini(i_hemis) .LE. hi_max(jl) ) ) THEN 199 209 jl0 = jl 200 210 ENDIF 201 211 END DO 202 212 jl0 = MIN(jl0, i_fill) 203 204 !--- Concentrations213 214 !--- Concentrations 205 215 za_i_ini(jl0,i_hemis) = zat_i_ini(i_hemis) / SQRT(REAL(jpl)) 206 216 DO jl = 1, i_fill - 1 207 217 IF ( jl .NE. jl0 ) THEN 208 zsigma = 0.5 * zh m_i_ini(i_hemis)209 zarg = ( zh t_i_ini(jl,i_hemis) - zhm_i_ini(i_hemis) ) / zsigma218 zsigma = 0.5 * zht_i_ini(i_hemis) 219 zarg = ( zh_i_ini(jl,i_hemis) - zht_i_ini(i_hemis) ) / zsigma 210 220 za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2) 211 221 ENDIF 212 END DO 213 222 END DO 223 214 224 zA = 0. ! sum of the areas in the jpl categories 215 225 DO jl = 1, i_fill - 1 … … 219 229 IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 220 230 221 !--- Ice thickness in the last category231 !--- Ice thickness in the last category 222 232 zV = 0. ! sum of the volumes of the N-1 categories 223 233 DO jl = 1, i_fill - 1 224 zV = zV + za_i_ini(jl,i_hemis)*zh t_i_ini(jl,i_hemis)234 zV = zV + za_i_ini(jl,i_hemis)*zh_i_ini(jl,i_hemis) 225 235 END DO 226 zh t_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)227 IF ( i_fill .LT. jpl ) zh t_i_ini(i_fill+1:jpl, i_hemis) = 0._wp228 229 !--- volumes230 zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh t_i_ini(:,i_hemis)236 zh_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis) 237 IF ( i_fill .LT. jpl ) zh_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 238 239 !--- volumes 240 zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh_i_ini(:,i_hemis) 231 241 IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 232 242 … … 260 270 261 271 ! Test 3: thickness of the last category is in-bounds ? 262 IF ( zh t_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN272 IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 263 273 ztest_3 = 1 264 274 ELSE 265 275 ! this write is useful 266 IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh t_i_ini(i_fill,i_hemis) = ', &267 zh t_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1)276 IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', & 277 zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 268 278 ztest_3 = 0 269 279 ENDIF … … 289 299 IF ( ztests .NE. 4 ) THEN 290 300 WRITE(numout,*) 291 WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 292 WRITE(numout,*), ' !!!! RED ALERT !!! ' 293 WRITE(numout,*), ' !!!! BIIIIP BIIIP BIIIIP BIIIIP !!!' 301 WRITE(numout,*), ' !!!! ALERT !!! ' 294 302 WRITE(numout,*), ' !!!! Something is wrong in the LIM3 initialization procedure ' 295 WRITE(numout,*), ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '296 303 WRITE(numout,*) 297 304 WRITE(numout,*), ' *** ztests is not equal to 4 ' 298 305 WRITE(numout,*), ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 299 306 WRITE(numout,*), ' zat_i_ini : ', zat_i_ini(i_hemis) 300 WRITE(numout,*), ' zh m_i_ini : ', zhm_i_ini(i_hemis)307 WRITE(numout,*), ' zht_i_ini : ', zht_i_ini(i_hemis) 301 308 ENDIF ! ztests .NE. 4 302 309 ENDIF … … 312 319 DO jj = 1, jpj 313 320 DO ji = 1, jpi 314 a_i(ji,jj,jl) = z idto(ji,jj) * za_i_ini (jl,zhemis(ji,jj)) ! concentration315 ht_i(ji,jj,jl) = z idto(ji,jj) * zht_i_ini(jl,zhemis(ji,jj)) ! ice thickness316 ht_s(ji,jj,jl) = ht_i(ji,jj,jl) * ( zh m_s_ini( zhemis(ji,jj) ) / zhm_i_ini( zhemis(ji,jj) ) ) ! snow depth317 sm_i(ji,jj,jl) = z idto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min ! salinity318 o_i(ji,jj,jl) = z idto(ji,jj) * 1._wp + ( 1._wp - zidto(ji,jj) ) ! age319 t_su(ji,jj,jl) = z idto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * 270.0! surf temp321 a_i(ji,jj,jl) = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj)) ! concentration 322 ht_i(ji,jj,jl) = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj)) ! ice thickness 323 ht_s(ji,jj,jl) = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) ) ! snow depth 324 sm_i(ji,jj,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity 325 o_i(ji,jj,jl) = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age 326 t_su(ji,jj,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp 320 327 321 328 ! This case below should not be used if (ht_s/ht_i) is ok in namelist … … 341 348 DO jj = 1, jpj 342 349 DO ji = 1, jpi 343 t_s(ji,jj,jk,jl) = z idto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * rtt350 t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 344 351 ! Snow energy of melting 345 e_s(ji,jj,jk,jl) = z idto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus )352 e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 346 353 ! Change dimensions 347 354 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 348 ! Multiply by volume, so that heat content in 10^9Joules355 ! Multiply by volume, so that heat content in Joules 349 356 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 350 357 END DO ! ji … … 358 365 DO jj = 1, jpj 359 366 DO ji = 1, jpi 360 t_i(ji,jj,jk,jl) = z idto(ji,jj) * 270.00 + ( 1._wp - zidto(ji,jj) ) * rtt361 s_i(ji,jj,jk,jl) = z idto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min367 t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 368 s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min 362 369 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 363 370 364 371 ! heat content per unit volume 365 e_i(ji,jj,jk,jl) = z idto(ji,jj) * rhoic * ( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) &372 e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * ( cpic * ( ztmelts - t_i(ji,jj,jk,jl) ) & 366 373 + lfus * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 367 374 - rcp * ( ztmelts - rtt ) ) … … 370 377 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 371 378 372 ! Mutliply by ice volume, and divide by number of layers 373 ! to get heat content in 10^9 J 379 ! Mutliply by ice volume, and divide by number of layers to get heat content in J 374 380 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 375 381 END DO ! ji … … 378 384 END DO ! jk 379 385 386 tn_ice (:,:,:) = t_su (:,:,:) 387 388 ELSE 389 ! if ln_limini=false 390 a_i (:,:,:) = 0._wp 391 v_i (:,:,:) = 0._wp 392 v_s (:,:,:) = 0._wp 393 smv_i(:,:,:) = 0._wp 394 oa_i (:,:,:) = 0._wp 395 ht_i (:,:,:) = 0._wp 396 ht_s (:,:,:) = 0._wp 397 sm_i (:,:,:) = 0._wp 398 o_i (:,:,:) = 0._wp 399 400 e_i(:,:,:,:) = 0._wp 401 e_s(:,:,:,:) = 0._wp 402 403 DO jl = 1, jpl 404 DO jk = 1, nlay_i 405 t_i(:,:,jk,jl) = rtt * tms(:,:) 406 END DO 407 DO jk = 1, nlay_s 408 t_s(:,:,jk,jl) = rtt * tms(:,:) 409 END DO 410 END DO 411 412 ENDIF ! ln_limini 413 414 at_i (:,:) = 0.0_wp 415 DO jl = 1, jpl 416 at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 417 END DO 418 ! 380 419 !-------------------------------------------------------------------- 381 420 ! 4) Global ice variables for output diagnostics | 382 421 !-------------------------------------------------------------------- 383 fsbbq (:,:) = 0._wp384 422 u_ice (:,:) = 0._wp 385 423 v_ice (:,:) = 0._wp … … 388 426 stress12_i(:,:) = 0._wp 389 427 390 # if defined key_coupled391 albege(:,:) = 0.8 * tms(:,:)392 # endif393 394 428 !-------------------------------------------------------------------- 395 429 ! 5) Moments for advection … … 426 460 sxyage (:,:,:) = 0._wp 427 461 428 !-------------------------------------------------------------------- 429 ! 6) Lateral boundary conditions | 430 !-------------------------------------------------------------------- 431 432 DO jl = 1, jpl 433 434 CALL lbc_lnk( a_i(:,:,jl) , 'T', 1. ) 435 CALL lbc_lnk( v_i(:,:,jl) , 'T', 1. ) 436 CALL lbc_lnk( v_s(:,:,jl) , 'T', 1. ) 437 CALL lbc_lnk( smv_i(:,:,jl), 'T', 1. ) 438 CALL lbc_lnk( oa_i(:,:,jl) , 'T', 1. ) 439 440 CALL lbc_lnk( ht_i(:,:,jl) , 'T', 1. ) 441 CALL lbc_lnk( ht_s(:,:,jl) , 'T', 1. ) 442 CALL lbc_lnk( sm_i(:,:,jl) , 'T', 1. ) 443 CALL lbc_lnk( o_i(:,:,jl) , 'T', 1. ) 444 CALL lbc_lnk( t_su(:,:,jl) , 'T', 1. ) 445 DO jk = 1, nlay_s 446 CALL lbc_lnk(t_s(:,:,jk,jl), 'T', 1. ) 447 CALL lbc_lnk(e_s(:,:,jk,jl), 'T', 1. ) 448 END DO 449 DO jk = 1, nlay_i 450 CALL lbc_lnk(t_i(:,:,jk,jl), 'T', 1. ) 451 CALL lbc_lnk(e_i(:,:,jk,jl), 'T', 1. ) 452 END DO 453 ! 454 a_i(:,:,jl) = tms(:,:) * a_i(:,:,jl) 455 END DO 456 457 at_i (:,:) = 0.0_wp 458 DO jl = 1, jpl 459 at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 460 END DO 461 462 CALL lbc_lnk( at_i , 'T', 1. ) 463 at_i(:,:) = tms(:,:) * at_i(:,:) ! put 0 over land 464 ! 465 CALL lbc_lnk( fsbbq , 'T', 1. ) 466 ! 467 !-------------------------------------------------------------------- 468 ! 6) ???? | 469 !-------------------------------------------------------------------- 470 tn_ice (:,:,:) = t_su (:,:,:) 471 472 CALL wrk_dealloc( jpi, jpj, zidto ) 462 463 CALL wrk_dealloc( jpi, jpj, zswitch ) 473 464 CALL wrk_dealloc( jpi, jpj, zhemis ) 474 CALL wrk_dealloc( jpl, 2, zh t_i_ini, za_i_ini, zv_i_ini )475 CALL wrk_dealloc( 2, zh m_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini )465 CALL wrk_dealloc( jpl, 2, zh_i_ini, za_i_ini, zv_i_ini ) 466 CALL wrk_dealloc( 2, zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 476 467 477 468 END SUBROUTINE lim_istate … … 493 484 !! 8.5 ! 07-11 (M. Vancoppenolle) rewritten initialization 494 485 !!----------------------------------------------------------------------------- 495 NAMELIST/namiceini/ ttest, hninn, hnins, hginn, hgins, aginn, agins, sinn, sins496 !486 NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s, & 487 & ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s 497 488 INTEGER :: ios ! Local integer output status for namelist read 498 489 !!----------------------------------------------------------------------------- … … 514 505 WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 515 506 WRITE(numout,*) '~~~~~~~~~~~~~~~' 516 WRITE(numout,*) ' threshold water temp. for initial sea-ice ttest = ', ttest 517 WRITE(numout,*) ' initial snow thickness in the north hninn = ', hninn 518 WRITE(numout,*) ' initial snow thickness in the south hnins = ', hnins 519 WRITE(numout,*) ' initial ice thickness in the north hginn = ', hginn 520 WRITE(numout,*) ' initial ice thickness in the south hgins = ', hgins 521 WRITE(numout,*) ' initial ice concentr. in the north aginn = ', aginn 522 WRITE(numout,*) ' initial ice concentr. in the north agins = ', agins 523 WRITE(numout,*) ' initial ice salinity in the north sinn = ', sinn 524 WRITE(numout,*) ' initial ice salinity in the south sins = ', sins 507 WRITE(numout,*) ' initialization with ice (T) or not (F) ln_limini = ', ln_limini 508 WRITE(numout,*) ' threshold water temp. for initial sea-ice thres_sst = ', thres_sst 509 WRITE(numout,*) ' initial snow thickness in the north hts_ini_n = ', hts_ini_n 510 WRITE(numout,*) ' initial snow thickness in the south hts_ini_s = ', hts_ini_s 511 WRITE(numout,*) ' initial ice thickness in the north hti_ini_n = ', hti_ini_n 512 WRITE(numout,*) ' initial ice thickness in the south hti_ini_s = ', hti_ini_s 513 WRITE(numout,*) ' initial ice concentr. in the north ati_ini_n = ', ati_ini_n 514 WRITE(numout,*) ' initial ice concentr. in the north ati_ini_s = ', ati_ini_s 515 WRITE(numout,*) ' initial ice salinity in the north smi_ini_n = ', smi_ini_n 516 WRITE(numout,*) ' initial ice salinity in the south smi_ini_s = ', smi_ini_s 517 WRITE(numout,*) ' initial ice/snw temp in the north tmi_ini_n = ', tmi_ini_n 518 WRITE(numout,*) ' initial ice/snw temp in the south tmi_ini_s = ', tmi_ini_s 525 519 ENDIF 526 520 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r4897 r4900 5 5 !!====================================================================== 6 6 !! History : LIM ! 2006-02 (M. Vancoppenolle) Original code 7 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_ mec7 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_dyn 8 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 9 9 !!---------------------------------------------------------------------- … … 22 22 USE limthd_lac ! LIM 23 23 USE limvar ! LIM 24 USE limcons ! LIM25 24 USE in_out_manager ! I/O manager 26 25 USE lbclnk ! lateral boundary condition - MPP exchanges … … 30 29 ! Check budget (Rousset) 31 30 USE iom ! I/O manager 32 USE lib_fortran ! glob_sum31 USE lib_fortran ! glob_sum 33 32 USE limdiahsb 34 USE timing ! Timing 33 USE timing ! Timing 34 USE limcons ! conservation tests 35 35 36 36 IMPLICIT NONE … … 143 143 REAL(wp), POINTER, DIMENSION(:,:) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2) 144 144 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 145 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 146 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 147 ! mass and salt flux (clem) 148 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume... 145 ! 146 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 149 147 !!----------------------------------------------------------------------------- 150 148 IF( nn_timing == 1 ) CALL timing_start('limitd_me') 151 149 152 150 CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 153 154 CALL wrk_alloc( jpi, jpj, jpl, zviold, zvsold, zsmvold ) ! clem155 151 156 152 IF( numit == nstart ) CALL lim_itd_me_init ! Initialization (first time-step only) … … 162 158 163 159 IF( ln_limdyn ) THEN ! Start ridging and rafting ! 164 ! ------------------------------- 165 !- check conservation (C Rousset) 166 IF (ln_limdiahsb) THEN 167 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 168 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 169 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 170 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 171 ENDIF 172 !- check conservation (C Rousset) 173 ! ------------------------------- 174 175 ! mass and salt flux init (clem) 176 zviold(:,:,:) = v_i(:,:,:) 177 zvsold(:,:,:) = v_s(:,:,:) 178 zsmvold(:,:,:) = smv_i(:,:,:) 160 161 ! conservation test 162 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 179 163 180 164 !-----------------------------------------------------------------------------! … … 362 346 ! 5) Heat, salt and freshwater fluxes 363 347 !-----------------------------------------------------------------------------! 364 fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice ! fresh water source for ocean365 fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice ! heat sink for ocean348 wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice ! fresh water source for ocean 349 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * unit_fac / area(ji,jj) * r1_rdtice ! heat sink for ocean (<0, W.m-2) 366 350 367 351 END DO … … 399 383 CALL lim_itd_me_zapsmall 400 384 401 !--------------------------------402 ! Update mass/salt fluxes (clem)403 !--------------------------------404 DO jl = 1, jpl405 DO jj = 1, jpj406 DO ji = 1, jpi407 diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice408 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic409 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn410 sfx_mec(ji,jj) = sfx_mec(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic * r1_rdtice411 END DO412 END DO413 END DO414 385 415 386 IF(ln_ctl) THEN ! Control print … … 445 416 ENDIF 446 417 447 ! ------------------------------- 448 !- check conservation (C Rousset) 449 IF (ln_limdiahsb) THEN 450 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 451 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 452 453 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 454 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 455 456 zchk_vmin = glob_min(v_i) 457 zchk_amax = glob_max(SUM(a_i,dim=3)) 458 zchk_amin = glob_min(a_i) 459 460 IF(lwp) THEN 461 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limitd_me) = ',(zchk_v_i * rday) 462 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_me) = ',(zchk_smv * rday) 463 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limitd_me) = ',(zchk_vmin * 1.e-3) 464 IF ( zchk_amax > kamax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limitd_me) = ',zchk_amax 465 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limitd_me) = ',zchk_amin 466 ENDIF 467 ENDIF 468 !- check conservation (C Rousset) 469 ! ------------------------------- 418 ! conservation test 419 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 470 420 471 421 ENDIF ! ln_limdyn=.true. 472 422 ! 473 423 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 474 !475 CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zsmvold ) ! clem476 424 ! 477 425 IF( nn_timing == 1 ) CALL timing_stop('limitd_me') … … 670 618 !!---------------------------------------------------------------------! 671 619 INTEGER :: ji,jj, jl ! dummy loop indices 672 INTEGER :: krdg_index !673 620 REAL(wp) :: Gstari, astari, hi, hrmean, zdummy ! local scalar 674 621 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here … … 746 693 !----------------------------------------------------------------- 747 694 748 krdg_index = 1 749 750 IF( krdg_index == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975) 695 IF( partfun_swi == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975) 751 696 DO jl = 0, ice_cat_bounds(1,2) ! only undeformed ice participates 752 697 DO jj = 1, jpj … … 776 721 END DO 777 722 ! 778 ENDIF ! krdg_index779 780 IF( raft swi == 1 ) THEN ! Ridging and rafting ice participation functions723 ENDIF ! partfun_swi 724 725 IF( raft_swi == 1 ) THEN ! Ridging and rafting ice participation functions 781 726 ! 782 727 DO jl = 1, jpl … … 794 739 END DO ! jl 795 740 796 ELSE ! raft swi = 0741 ELSE ! raft_swi = 0 797 742 ! 798 743 DO jl = 1, jpl … … 802 747 ENDIF 803 748 804 IF ( raft swi == 1 ) THEN749 IF ( raft_swi == 1 ) THEN 805 750 806 751 IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi10 ) THEN … … 908 853 INTEGER :: ij ! horizontal index, combines i and j loops 909 854 INTEGER :: icells ! number of cells with aicen > puny 910 REAL(wp) :: zindb , zsrdg2! local scalar855 REAL(wp) :: zindb ! local scalar 911 856 REAL(wp) :: hL, hR, farea, zdummy, zdummy0, ztmelts ! left and right limits of integration 857 REAL(wp) :: zsstK ! SST in Kelvin 912 858 913 859 INTEGER , POINTER, DIMENSION(:) :: indxi, indxj ! compressed indices … … 917 863 918 864 REAL(wp), POINTER, DIMENSION(:,:,:) :: aicen_init, vicen_init ! ice area & volume before ridging 919 REAL(wp), POINTER, DIMENSION(:,:,:) :: vsn on_init, esnon_init ! snow volume & energy before ridging865 REAL(wp), POINTER, DIMENSION(:,:,:) :: vsnwn_init, esnwn_init ! snow volume & energy before ridging 920 866 REAL(wp), POINTER, DIMENSION(:,:,:) :: smv_i_init, oa_i_init ! ice salinity & age before ridging 921 867 … … 952 898 CALL wrk_alloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw ) 953 899 CALL wrk_alloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 954 CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsn on_init, esnon_init, smv_i_init, oa_i_init )900 CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 955 901 CALL wrk_alloc( jpi, jpj, jkmax, eirft, erdg1, erdg2, ersw ) 956 902 CALL wrk_alloc( jpi, jpj, jkmax, jpl, eicen_init ) … … 1008 954 aicen_init(:,:,jl) = a_i(:,:,jl) 1009 955 vicen_init(:,:,jl) = v_i(:,:,jl) 1010 vsn on_init(:,:,jl) = v_s(:,:,jl)956 vsnwn_init(:,:,jl) = v_s(:,:,jl) 1011 957 ! 1012 958 smv_i_init(:,:,jl) = smv_i(:,:,jl) … … 1014 960 END DO !jl 1015 961 1016 esn on_init(:,:,:) = e_s(:,:,1,:)962 esnwn_init(:,:,:) = e_s(:,:,1,:) 1017 963 1018 964 DO jl = 1, jpl … … 1095 1041 vsw (ji,jj) = vrdg1(ji,jj) * ridge_por 1096 1042 1097 vsrdg(ji,jj) = vsn on_init(ji,jj,jl1) * afrac(ji,jj)1098 esrdg(ji,jj) = esn on_init(ji,jj,jl1) * afrac(ji,jj)1043 vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 1044 esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 1099 1045 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 1100 srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 1046 srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 1101 1047 1102 1048 ! rafting volumes, heat contents ... 1103 1049 virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 1104 vsrft(ji,jj) = vsn on_init(ji,jj,jl1) * afrft(ji,jj)1105 esrft(ji,jj) = esn on_init(ji,jj,jl1) * afrft(ji,jj)1050 vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 1051 esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 1106 1052 smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 1107 1053 … … 1120 1066 ! Salinity 1121 1067 !------------- 1122 smsw(ji,jj) = sss_m(ji,jj) * vsw(ji,jj) * rhoic / rau0 ! salt content of seawater frozen in voids 1123 1124 zsrdg2 = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge 1125 1126 srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 ) ! impose a maximum salinity 1068 smsw(ji,jj) = vsw(ji,jj) * sss_m(ji,jj) ! salt content of seawater frozen in voids !! MV HC2014 1069 srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge 1070 1071 !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 ) ! impose a maximum salinity 1127 1072 1128 ! ! excess of salt is flushed into the ocean 1129 !sfx_mec(ji,jj) = sfx_mec(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic * r1_rdtice 1130 1131 !rdm_ice(ji,jj) = rdm_ice(ji,jj) + vsw(ji,jj) * rhoic ! gurvan: increase in ice volume du to seawater frozen in voids 1073 sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 1074 wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice ! gurvan: increase in ice volume du to seawater frozen in voids 1132 1075 1133 1076 !------------------------------------ … … 1158 1101 & + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 1159 1102 1160 esnow_mlt(ji,jj) = esnow_mlt(ji,jj) + esrdg(ji,jj)*(1.0-fsnowrdg) & !rafting included 1161 & + esrft(ji,jj)*(1.0-fsnowrft) 1103 ! in 1e-9 Joules (same as e_s) 1104 esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-fsnowrdg) & !rafting included 1105 & - esrft(ji,jj)*(1.0-fsnowrft) 1162 1106 1163 1107 !----------------------------------------------------------------- … … 1187 1131 eirft(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 1188 1132 e_i (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk) 1189 ! sea water heat content 1190 ztmelts = - tmut * sss_m(ji,jj) + rtt 1191 ! heat content per unit volume 1192 zdummy0 = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj) 1193 1194 ! corrected sea water salinity 1195 zindb = MAX( 0._wp , SIGN( 1._wp , vsw(ji,jj) - epsi20 ) ) 1196 zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / MAX( ridge_por * vsw(ji,jj), epsi20 ) 1197 1198 ztmelts = - tmut * zdummy + rtt 1199 ersw(ji,jj,jk) = - rcp * ( ztmelts - rtt ) * vsw(ji,jj) 1200 1201 ! heat flux 1202 fheat_mec(ji,jj) = fheat_mec(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) * r1_rdtice 1133 1134 1135 ! enthalpy of the trapped seawater (J/m2, >0) 1136 ! clem: if sst>0, then ersw <0 (is that possible?) 1137 zsstK = sst_m(ji,jj) + rt0 1138 ersw(ji,jj,jk) = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i ) 1139 1140 ! heat flux to the ocean 1141 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice ! > 0 [W.m-2] ocean->ice flux 1203 1142 1204 1143 ! Correct dimensions to avoid big values 1205 ersw(ji,jj,jk) = ersw(ji,jj,jk) * 1.e-09 1206 1207 ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 1208 ersw (ji,jj,jk) = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / REAL( nlay_i ) 1144 ersw(ji,jj,jk) = ersw(ji,jj,jk) / unit_fac 1145 1146 ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J 1147 ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 1148 !! MV HC 2014 1149 ersw (ji,jj,jk) = ersw(ji,jj,jk) * area(ji,jj) 1209 1150 1210 1151 erdg2(ji,jj,jk) = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 1152 1211 1153 END DO ! ij 1212 1154 END DO !jk … … 1361 1303 CALL wrk_dealloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw ) 1362 1304 CALL wrk_dealloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 1363 CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsn on_init, esnon_init, smv_i_init, oa_i_init )1305 CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 1364 1306 CALL wrk_dealloc( jpi, jpj, jkmax, eirft, erdg1, erdg2, ersw ) 1365 1307 CALL wrk_dealloc( jpi, jpj, jkmax, jpl, eicen_init ) … … 1404 1346 !!------------------------------------------------------------------- 1405 1347 INTEGER :: ios ! Local integer output status for namelist read 1406 NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,& 1407 Gstar, astar, & 1408 Hstar, raftswi, hparmeter, Craft, ridge_por, & 1409 sal_max_ridge, partfun_swi, transfun_swi, & 1410 brinstren_swi 1348 NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft, & 1349 & Gstar, astar, Hstar, raft_swi, hparmeter, Craft, ridge_por, & 1350 & partfun_swi, brinstren_swi 1411 1351 !!------------------------------------------------------------------- 1412 1352 ! … … 1432 1372 WRITE(numout,*)' Equivalent to G* for an exponential part function astar ', astar 1433 1373 WRITE(numout,*)' Quantity playing a role in max ridged ice thickness Hstar ', Hstar 1434 WRITE(numout,*)' Rafting of ice sheets or not raft swi ', raftswi1374 WRITE(numout,*)' Rafting of ice sheets or not raft_swi ', raft_swi 1435 1375 WRITE(numout,*)' Parmeter thickness (threshold between ridge-raft) hparmeter ', hparmeter 1436 1376 WRITE(numout,*)' Rafting hyperbolic tangent coefficient Craft ', Craft 1437 1377 WRITE(numout,*)' Initial porosity of ridges ridge_por ', ridge_por 1438 WRITE(numout,*)' Maximum salinity of ridging ice sal_max_ridge ', sal_max_ridge1439 1378 WRITE(numout,*)' Switch for part. function (0) linear (1) exponential partfun_swi ', partfun_swi 1440 WRITE(numout,*)' Switch for tran. function (0) linear (1) exponential transfun_swi ', transfun_swi1441 1379 WRITE(numout,*)' Switch for including brine volume in ice strength comp. brinstren_swi ', brinstren_swi 1442 1380 ENDIF … … 1462 1400 1463 1401 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! 2D workspace 1464 REAL(wp) :: zmask_glo 1402 REAL(wp) :: zmask_glo, zsal, zvi, zvs, zei, zes 1465 1403 !!gm REAL(wp) :: xtmp ! temporary variable 1466 1404 !!------------------------------------------------------------------- … … 1468 1406 CALL wrk_alloc( jpi, jpj, zmask ) 1469 1407 1408 ! to be sure that at_i is the sum of a_i(jl) 1409 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 1410 1470 1411 DO jl = 1, jpl 1471 1472 1412 !----------------------------------------------------------------- 1473 1413 ! Count categories to be zapped. 1474 ! Abort model in case of negative area.1475 1414 !----------------------------------------------------------------- 1476 1415 icells = 0 … … 1478 1417 DO jj = 1, jpj 1479 1418 DO ji = 1, jpi 1480 IF( ( a_i(ji,jj,jl) >= -epsi10 .AND. a_i(ji,jj,jl) < 0._wp ) .OR. & 1481 & ( a_i(ji,jj,jl) > 0._wp .AND. a_i(ji,jj,jl) <= epsi10 ) .OR. & 1482 & ( v_i(ji,jj,jl) == 0._wp .AND. a_i(ji,jj,jl) > 0._wp ) .OR. & 1483 & ( v_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) <= epsi10 ) ) zmask(ji,jj) = 1._wp 1419 IF( a_i(ji,jj,jl) <= epsi10 .OR. v_i(ji,jj,jl) <= epsi10 .OR. at_i(ji,jj) <= epsi10 ) THEN 1420 zmask(ji,jj) = 1._wp 1421 ENDIF 1484 1422 END DO 1485 1423 END DO … … 1494 1432 DO jj = 1 , jpj 1495 1433 DO ji = 1 , jpi 1496 !!gm xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) * r1_rdtice 1497 !!gm xtmp = xtmp * unit_fac 1498 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 1434 zei = e_i(ji,jj,jk,jl) 1499 1435 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) 1436 t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) + rtt * zmask(ji,jj) 1437 ! update exchanges with ocean 1438 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 1500 1439 END DO 1501 1440 END DO … … 1504 1443 DO jj = 1 , jpj 1505 1444 DO ji = 1 , jpi 1506 1445 1446 zsal = smv_i(ji,jj,jl) 1447 zvi = v_i(ji,jj,jl) 1448 zvs = v_s(ji,jj,jl) 1449 zes = e_s(ji,jj,1,jl) 1507 1450 !----------------------------------------------------------------- 1508 1451 ! Zap snow energy and use ocean heat to melt snow … … 1514 1457 ! fluxes are positive to the ocean 1515 1458 ! here the flux has to be negative for the ocean 1516 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice1517 ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp1518 1519 !!gm xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice !RB ???????1520 1521 1459 t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 1522 1460 … … 1524 1462 ! zap ice and snow volume, add water and salt to ocean 1525 1463 !----------------------------------------------------------------- 1526 1527 ! xtmp = (rhoi*vicen(i,j,n) + rhos*vsnon(i,j,n)) / dt 1528 ! sfx_res(ji,jj) = sfx_res(ji,jj) + ( sss_m(ji,jj) ) & 1529 ! * rhosn * v_s(ji,jj,jl) * r1_rdtice 1530 ! sfx_res(ji,jj) = sfx_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) & 1531 ! * rhoic * v_i(ji,jj,jl) * r1_rdtice 1532 ! sfx (i,j) = sfx (i,j) + xtmp 1533 1534 ato_i(ji,jj) = a_i (ji,jj,jl) * zmask(ji,jj) + ato_i(ji,jj) 1464 ato_i(ji,jj) = a_i (ji,jj,jl) * zmask(ji,jj) + ato_i(ji,jj) 1535 1465 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1536 1466 v_i (ji,jj,jl) = v_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) … … 1539 1469 oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1540 1470 smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 1541 ! 1471 e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 1472 ! additional condition 1473 IF( v_s(ji,jj,jl) <= epsi10 ) THEN 1474 v_s(ji,jj,jl) = 0._wp 1475 e_s(ji,jj,1,jl) = 0._wp 1476 ENDIF 1477 ! update exchanges with ocean 1478 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 1479 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 1480 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 1481 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 1542 1482 END DO 1543 1483 END DO 1544 ! 1545 END DO ! jl 1484 END DO ! jl 1485 1486 ! to be sure that at_i is the sum of a_i(jl) 1487 at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 1546 1488 ! 1547 1489 CALL wrk_dealloc( jpi, jpj, zmask ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r4333 r4900 35 35 USE lib_fortran ! to use key_nosignedzero 36 36 USE timing ! Timing 37 USE limcons ! conservation tests 37 38 38 39 IMPLICIT NONE … … 65 66 INTEGER, INTENT(in) :: kt ! time step index 66 67 ! 67 INTEGER :: j l, ja, jm, jbnd1, jbnd2 ! ice types dummy loop index68 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)69 REAL(wp) :: z chk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset)68 INTEGER :: ji,jj, jk, jl, ja, jm, jbnd1, jbnd2 ! ice types dummy loop index 69 ! 70 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 70 71 !!------------------------------------------------------------------ 71 72 IF( nn_timing == 1 ) CALL timing_start('limitd_th') 72 73 73 ! ------------------------------- 74 !- check conservation (C Rousset) 75 IF (ln_limdiahsb) THEN 76 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 77 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 78 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 79 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 80 ENDIF 81 !- check conservation (C Rousset) 82 ! ------------------------------- 74 ! conservation test 75 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 83 76 84 77 IF( kt == nit000 .AND. lwp ) THEN … … 105 98 ! 3) Add frazil ice growing in leads. 106 99 !------------------------------------------------------------------------------| 107 108 100 CALL lim_thd_lac 109 101 CALL lim_var_glo2eqv ! only for info 110 111 IF(ln_ctl) THEN ! Control print102 103 IF(ln_ctl) THEN ! Control print 112 104 CALL prt_ctl_info(' ') 113 105 CALL prt_ctl_info(' - Cell values : ') … … 141 133 ENDIF 142 134 ! 143 ! ------------------------------- 144 !- check conservation (C Rousset) 145 IF( ln_limdiahsb ) THEN 146 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 147 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 148 149 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 150 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 151 152 zchk_vmin = glob_min(v_i) 153 zchk_amax = glob_max(SUM(a_i,dim=3)) 154 zchk_amin = glob_min(a_i) 155 156 IF(lwp) THEN 157 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limitd_th) = ',(zchk_v_i * rday) 158 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_th) = ',(zchk_smv * rday) 159 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limitd_th) = ',(zchk_vmin * 1.e-3) 160 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limitd_th) = ',zchk_amax 161 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limitd_th) = ',zchk_amin 162 ENDIF 163 ENDIF 164 !- check conservation (C Rousset) 165 ! ------------------------------- 135 ! conservation test 136 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 166 137 ! 167 138 IF( nn_timing == 1 ) CALL timing_stop('limitd_th') … … 258 229 zindb = 1.0 - MAX( 0.0, SIGN( 1.0, - old_a_i(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 259 230 zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX( old_a_i(ji,jj,jl), epsi10 ) * zindb 260 IF( a_i(ji,jj,jl) > epsi 06) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)231 IF( a_i(ji,jj,jl) > epsi10 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl) 261 232 END DO 262 233 END DO … … 302 273 ij = nind_j(ji) 303 274 ! 304 IF ( ( zht_i_o(ii,ij,jl) .GT. epsi10 ) .AND. &305 ( zht_i_o(ii,ij,jl+1) .GT. epsi10 )) THEN275 zhbnew(ii,ij,jl) = hi_max(jl) 276 IF ( old_a_i(ii,ij,jl) > epsi10 .AND. old_a_i(ii,ij,jl+1) > epsi10 ) THEN 306 277 !interpolate between adjacent category growth rates 307 zslope = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / & 308 ( zht_i_o (ii,ij,jl+1) - zht_i_o (ii,ij,jl) ) 309 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + & 310 zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 311 ELSEIF (zht_i_o(ii,ij,jl).gt.epsi10) THEN 278 zslope = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_o(ii,ij,jl+1) - zht_i_o(ii,ij,jl) ) 279 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 280 ELSEIF ( old_a_i(ii,ij,jl) > epsi10) THEN 312 281 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 313 ELSEIF ( zht_i_o(ii,ij,jl+1).gt.epsi10) THEN282 ELSEIF ( old_a_i(ii,ij,jl+1) > epsi10) THEN 314 283 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 315 ELSE316 zhbnew(ii,ij,jl) = hi_max(jl)317 284 ENDIF 318 285 END DO … … 320 287 !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 321 288 DO ji = 1, nbrem 322 ! jl, ji323 289 ii = nind_i(ji) 324 290 ij = nind_j(ji) 325 ! jl, ji 326 IF ( ( a_i(ii,ij,jl) .GT.epsi10) .AND. & 327 ( ht_i(ii,ij,jl).GE. zhbnew(ii,ij,jl) ) & 328 ) THEN 291 IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 329 292 zremap_flag(ii,ij) = 0 330 ELSEIF ( ( a_i(ii,ij,jl+1) .GT. epsi10 ) .AND. & 331 ( ht_i(ii,ij,jl+1).LE. zhbnew(ii,ij,jl) ) & 332 ) THEN 293 ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN 333 294 zremap_flag(ii,ij) = 0 334 295 ENDIF 335 296 336 297 !- 4.3 Check that each zhbnew does not exceed maximal values hi_max 337 ! jl, ji 338 IF (zhbnew(ii,ij,jl).gt.hi_max(jl+1)) THEN 339 zremap_flag(ii,ij) = 0 340 ENDIF 341 ! jl, ji 342 IF (zhbnew(ii,ij,jl).lt.hi_max(jl-1)) THEN 343 zremap_flag(ii,ij) = 0 344 ENDIF 345 ! jl, ji 346 END DO !ji 347 ! ji 298 IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 299 IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 300 END DO 301 348 302 END DO !jl 349 303 … … 354 308 DO jj = 1, jpj 355 309 DO ji = 1, jpi 356 IF 310 IF( zremap_flag(ji,jj) == 1 ) THEN 357 311 nbrem = nbrem + 1 358 312 nind_i(nbrem) = ji 359 313 nind_j(nbrem) = jj 360 314 ENDIF 361 END DO !ji362 END DO !jj315 END DO 316 END DO 363 317 364 318 !----------------------------------------------------------------------------------------------- … … 380 334 ENDIF 381 335 382 IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) 336 IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 383 337 384 338 END DO !jj … … 444 398 DO jl = klbnd, kubnd 445 399 CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 446 g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), & 447 zremap_flag) 400 g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag) 448 401 END DO 449 402 … … 493 446 nd = zdonor(ii,ij,jl) 494 447 zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1 495 zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + & 496 zdaice(ii,ij,jl)*hL(ii,ij,nd) 448 zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 497 449 498 450 END DO ! ji … … 511 463 ii = nind_i(ji) 512 464 ij = nind_j(ji) 513 IF ( ( a_i(ii,ij,1) > epsi10 ) .AND. ( ht_i(ii,ij,1) < hiclim )) THEN465 IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN 514 466 a_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim 515 467 ht_i(ii,ij,1) = hiclim 516 v_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem-useless517 468 ENDIF 518 469 END DO !ji … … 799 750 !-------------- 800 751 801 zdvsnow 752 zdvsnow = v_s(ii,ij,jl1) * zworka(ii,ij) 802 753 v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 803 754 v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow … … 807 758 !-------------------- 808 759 809 zdesnow 760 zdesnow = e_s(ii,ij,1,jl1) * zworka(ii,ij) 810 761 e_s(ii,ij,1,jl1) = e_s(ii,ij,1,jl1) - zdesnow 811 762 e_s(ii,ij,1,jl2) = e_s(ii,ij,1,jl2) + zdesnow … … 815 766 !-------------- 816 767 817 zdo_aice 768 zdo_aice = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 818 769 oa_i(ii,ij,jl1) = oa_i(ii,ij,jl1) - zdo_aice 819 770 oa_i(ii,ij,jl2) = oa_i(ii,ij,jl2) + zdo_aice … … 823 774 !-------------- 824 775 825 zdsm_vice 776 zdsm_vice = smv_i(ii,ij,jl1) * zworka(ii,ij) 826 777 smv_i(ii,ij,jl1) = smv_i(ii,ij,jl1) - zdsm_vice 827 778 smv_i(ii,ij,jl2) = smv_i(ii,ij,jl2) + zdsm_vice … … 831 782 !--------------------- 832 783 833 zdaTsf 784 zdaTsf = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 834 785 zaTsfn(ii,ij,jl1) = zaTsfn(ii,ij,jl1) - zdaTsf 835 786 zaTsfn(ii,ij,jl2) = zaTsfn(ii,ij,jl2) + zdaTsf … … 910 861 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 911 862 !!------------------------------------------------------------------ 863 !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate 912 864 913 865 CALL wrk_alloc( jpi,jpj,jpl, zdonor ) ! interger … … 1015 967 1016 968 !clem-change 969 DO jj = 1, jpj 970 DO ji = 1, jpi 971 IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 972 ! 973 zshiftflag = 1 974 zdonor(ji,jj,jl) = jl + 1 975 zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 976 zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 977 ENDIF 978 END DO ! ji 979 END DO ! jj 980 981 IF(lk_mpp) CALL mpp_max( zshiftflag ) 982 983 IF( zshiftflag == 1 ) THEN ! Shift ice between categories 984 CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 985 ! Reset shift parameters 986 zdonor(:,:,jl) = 0 987 zdaice(:,:,jl) = 0._wp 988 zdvice(:,:,jl) = 0._wp 989 ENDIF 990 !clem-change 991 992 ! ! clem-change begin: why not doing that? 1017 993 ! DO jj = 1, jpj 1018 994 ! DO ji = 1, jpi 1019 ! IF( a_i(ji,jj,jl+1) > epsi10 .AND. & 1020 ! ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 1021 ! ! 1022 ! zshiftflag = 1 1023 ! zdonor(ji,jj,jl) = jl + 1 1024 ! zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 1025 ! zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 995 ! IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 996 ! ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 997 ! a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1) 1026 998 ! ENDIF 1027 999 ! END DO ! ji 1028 1000 ! END DO ! jj 1029 !1030 ! IF(lk_mpp) CALL mpp_max( zshiftflag )1031 !1032 ! IF( zshiftflag == 1 ) THEN ! Shift ice between categories1033 ! CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice )1034 ! ! Reset shift parameters1035 ! zdonor(:,:,jl) = 01036 ! zdaice(:,:,jl) = 0._wp1037 ! zdvice(:,:,jl) = 0._wp1038 ! ENDIF1039 !clem-change1040 1041 ! clem-change begin: why not doing that?1042 DO jj = 1, jpj1043 DO ji = 1, jpi1044 IF( a_i(ji,jj,jl+1) > epsi10 .AND. &1045 ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN1046 ht_i(ji,jj,jl+1) = hi_max(jl) + epsi101047 a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)1048 ENDIF1049 END DO ! ji1050 END DO ! jj1051 1001 ! clem-change end 1052 1002 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r4346 r4900 51 51 52 52 REAL(wp) :: epsi10 = 1.e-10_wp ! 53 REAL(wp) :: rzero = 0._wp ! constant values54 REAL(wp) :: rone = 1._wp ! constant values55 53 56 54 !! * Substitutions … … 514 512 !CDIR NOVERRCHK 515 513 DO ji = fs_2, fs_jpim1 516 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj)514 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 517 515 zsang = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg 518 516 z0 = zmass1(ji,jj)/dtevp … … 547 545 DO ji = fs_2, fs_jpim1 548 546 549 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj)547 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 550 548 zsang = SIGN(1.0,fcor(ji,jj))*sangvg 551 549 z0 = zmass2(ji,jj)/dtevp … … 579 577 !CDIR NOVERRCHK 580 578 DO ji = fs_2, fs_jpim1 581 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj)579 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 582 580 zsang = SIGN(1.0,fcor(ji,jj))*sangvg 583 581 z0 = zmass2(ji,jj)/dtevp … … 611 609 !CDIR NOVERRCHK 612 610 DO ji = fs_2, fs_jpim1 613 zmask = (1.0-MAX( rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj)611 zmask = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 614 612 zsang = SIGN(1.0,fcor(ji,jj))*sangvg 615 613 z0 = zmass1(ji,jj)/dtevp … … 661 659 ! 4) Prevent ice velocities when the ice is thin 662 660 !------------------------------------------------------------------------------! 663 !clem : add hminrhg in the namelist664 !665 661 ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 666 662 ! ocean velocity, -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r4205 r4900 142 142 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 143 143 END DO 144 144 145 145 DO jl = 1, jpl 146 146 WRITE(zchar,'(I1)') jl … … 162 162 CALL iom_rstput( iter, nitrst, numriw, 'u_ice' , u_ice ) 163 163 CALL iom_rstput( iter, nitrst, numriw, 'v_ice' , v_ice ) 164 CALL iom_rstput( iter, nitrst, numriw, 'fsbbq' , fsbbq )165 164 CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i ) 166 165 CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i ) … … 393 392 CALL iom_get( numrir, jpdom_autoglo, 'u_ice' , u_ice ) 394 393 CALL iom_get( numrir, jpdom_autoglo, 'v_ice' , v_ice ) 395 CALL iom_get( numrir, jpdom_autoglo, 'fsbbq' , fsbbq )396 394 CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i ) 397 395 CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i ) … … 522 520 END DO 523 521 ! 522 ! clem: I do not understand why the following IF is needed 523 ! I suspect something inconsistent in the main code with option num_sal=1 524 IF( num_sal == 1 ) THEN 525 DO jl = 1, jpl 526 sm_i(:,:,jl) = bulk_sal 527 DO jk = 1, nlay_i 528 s_i(:,:,jk,jl) = bulk_sal 529 END DO 530 END DO 531 ENDIF 532 ! 524 533 !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90 525 534 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4614 r4900 27 27 USE par_ice ! ice parameters 28 28 USE dom_oce ! ocean domain 29 USE domvvl ! ocean vertical scale factors 30 USE dom_ice, ONLY : tms 29 USE dom_ice, ONLY : tms, area 31 30 USE ice ! LIM sea-ice variables 32 31 USE sbc_ice ! Surface boundary condition: sea-ice fields … … 43 42 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 43 USE traqsr ! clem: add penetration of solar flux into the calculation of heat budget 44 USE iom 45 USE domvvl ! Variable volume 45 46 46 47 IMPLICIT NONE … … 51 52 PUBLIC lim_sbc_tau ! called by sbc_ice_lim 52 53 53 REAL(wp) :: rzero = 0._wp54 REAL(wp) :: rone = 1._wp54 REAL(wp) :: epsi10 = 1.e-10 ! 55 REAL(wp) :: epsi20 = 1.e-20 ! 55 56 56 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] … … 104 105 INTEGER, INTENT(in) :: kt ! number of iteration 105 106 ! 106 INTEGER :: ji, jj, jl ! dummy loop indices 107 INTEGER :: ierr, ifvt, i1mfr, idfr ! local integer 108 INTEGER :: iflt, ial , iadv , ifral, ifrdv ! - - 109 REAL(wp) :: zinda, zemp, zemp_snow, zfmm ! local scalars 110 REAL(wp) :: zemp_snw ! - - 111 REAL(wp) :: zfcm1 , zfcm2 ! - - 107 INTEGER :: ji, jj, jl, jk ! dummy loop indices 108 REAL(wp) :: zinda, zemp ! local scalars 109 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 110 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 112 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 113 REAL(wp) :: zzfcm1, zfscmbq ! clem: for light penetration114 112 !!--------------------------------------------------------------------- 115 113 116 114 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 117 115 118 !------------------------------------------! 119 ! heat flux at the ocean surface ! 120 !------------------------------------------! 116 ! make calls for heat fluxes before it is modified 117 CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 118 CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) ) ! non-solar flux at ocean surface 119 CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) ) ! solar flux at ice surface 120 CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 121 CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 122 CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) ) 123 CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * old_a_i(:,:,:), dim=3 ) ) 124 121 125 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 122 ! changed to old_frld and old ht_i123 124 126 DO jj = 1, jpj 125 127 DO ji = 1, jpi 126 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 127 ifvt = zinda * MAX( rzero , SIGN( rone, - phicif(ji,jj) ) ) !subscripts are bad here 128 i1mfr = 1.0 - MAX( rzero , SIGN( rone , - at_i(ji,jj) ) ) 129 idfr = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 130 iflt = zinda * (1 - i1mfr) * (1 - ifvt ) 131 ial = ifvt * i1mfr + ( 1 - ifvt ) * idfr 132 iadv = ( 1 - i1mfr ) * zinda 133 ifral = ( 1 - i1mfr * ( 1 - ial ) ) 134 ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv 135 136 ! switch --- 1.0 ---------------- 0.0 -------------------- 137 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 138 ! zinda | if pfrld = 1 | if pfrld < 1 | 139 ! -> ifvt| if pfrld old_ht_i 140 ! i1mfr | if frld = 1 | if frld < 1 | 141 ! idfr | if frld <= pfrld | if frld > pfrld | 142 ! iflt | 143 ! ial | 144 ! iadv | 145 ! ifral 146 ! ifrdv 147 148 ! computation the solar flux at ocean surface 149 IF (lk_cpl) THEN ! be carfeful: not been tested yet 128 129 !------------------------------------------! 130 ! heat flux at the ocean surface ! 131 !------------------------------------------! 132 zinda = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( 1._wp - pfrld(ji,jj) ) ) ) ! 1 if ice 133 134 ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 135 !--------------------------------------------------- 136 IF( lk_cpl ) THEN ! be carfeful: not been tested yet 150 137 ! original line 151 !zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) 152 ! new line to include solar penetration (not tested) 153 zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 138 zfcm1 = qsr_tot(ji,jj) 139 !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 154 140 DO jl = 1, jpl 155 zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) *a_i(ji,jj,jl)141 zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl) 156 142 END DO 157 143 ELSE 158 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 159 & ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 144 !!!zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 145 !!! & ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 146 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) 147 DO jl = 1, jpl 148 zfcm1 = zfcm1 + old_a_i(ji,jj,jl) * ftr_ice(ji,jj,jl) 149 END DO 160 150 ENDIF 161 ! fstric Solar flux transmitted trough the ice 162 ! qsr Net short wave heat flux on free ocean 163 ! new line 164 fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 165 166 ! solar flux and fscmbq with light penetration (clem) 167 zzfcm1 = pfrld(ji,jj) * qsr(ji,jj) * oatte(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 168 zfscmbq = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 169 170 ! computation the non solar heat flux at ocean surface 171 zfcm2 = - zzfcm1 & ! 172 & + iflt * zfscmbq & ! total ablation: heat given to the ocean 173 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 174 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice & 175 & + fhmec(ji,jj) & ! snow melt when ridging 176 & + fheat_mec(ji,jj) & ! ridge formation 177 & + fheat_res(ji,jj) ! residual heat flux 178 ! qcmif Energy needed to bring the ocean surface layer until its freezing (ok) 179 ! qldif heat balance of the lead (or of the open ocean) 180 ! qfvbq latent heat uptake/release after accretion/ablation 181 ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 182 183 IF( num_sal == 2 ) zfcm2 = zfcm2 + fhbri(ji,jj) ! add contribution due to brine drainage 184 185 ! bottom radiative component is sent to the computation of the oceanic heat flux 186 fsbbq(ji,jj) = ( 1._wp - ( ifvt + iflt ) ) * fscmbq(ji,jj) 187 188 ! used to compute the oceanic heat flux at the next time step 189 qsr(ji,jj) = zfcm1 ! solar heat flux 190 qns(ji,jj) = zfcm2 - fdtcn(ji,jj) ! non solar heat flux 191 ! ! fdtcn : turbulent oceanic heat flux 192 END DO 193 END DO 194 195 !------------------------------------------! 196 ! mass flux at the ocean surface ! 197 !------------------------------------------! 198 199 !!gm optimisation: this loop have to be merged with the previous one 200 DO jj = 1, jpj 201 DO ji = 1, jpi 151 152 ! Total heat flux reaching the ocean = hfx_out (W.m-2) 153 !--------------------------------------------------- 154 zf_mass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 155 hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 156 157 ! New qsr and qns used to compute the oceanic heat flux at the next time step 158 !--------------------------------------------------- 159 qsr(ji,jj) = zfcm1 160 qns(ji,jj) = hfx_out(ji,jj) - zfcm1 161 162 !------------------------------------------! 163 ! mass flux at the ocean surface ! 164 !------------------------------------------! 202 165 ! case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 203 166 ! ------------------------------------------------------------------------------------- … … 208 171 ! Even if i see Ice melting as a FW and SALT flux 209 172 ! 210 211 173 ! computing freshwater exchanges at the ice/ocean interface 212 IF (lk_cpl) THEN174 IF( lk_cpl ) THEN 213 175 zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! 214 & - rdm_snw(ji,jj) / rdt_ice176 & + wfx_snw(ji,jj) 215 177 ELSE 216 zemp = emp(ji,jj) * ( 1.0 - at_i(ji,jj) ) & ! evaporation over oceanic fraction 217 & - tprecip(ji,jj) * at_i(ji,jj) & ! all precipitation reach the ocean 218 & + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) ) & ! except solid precip intercepted by sea-ice 219 & - fmmec(ji,jj) ! snow falling when ridging 178 zemp = emp(ji,jj) * pfrld(ji,jj) & ! evaporation over oceanic fraction 179 & - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! all precipitation reach the ocean 180 & + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas ) ! except solid precip intercepted by sea-ice 220 181 ENDIF 221 182 222 ! mass flux at the ocean/ice interface (sea ice fraction) 223 zemp_snw = rdm_snw(ji,jj) * r1_rdtice ! snow melting = pure water that enters the ocean 224 zfmm = rdm_ice(ji,jj) * r1_rdtice ! Freezing minus melting 225 226 fmmflx(ji,jj) = zfmm ! F/M mass flux save at least for biogeochemical model 227 228 emp(ji,jj) = zemp + zemp_snw + zfmm ! mass flux + F/M mass flux (always ice/ocean mass exchange) 183 ! mass flux from ice/ocean 184 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 185 186 ! mass flux at the ocean/ice interface 187 fmmflx(ji,jj) = - wfx_ice(ji,jj) * rdt_ice ! F/M mass flux save at least for biogeochemical model 188 emp(ji,jj) = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_sub(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 229 189 230 ! correcting brine salt fluxes (zinda = 1 if pfrld=1 , =0 otherwise)231 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) )232 sfx_bri(ji,jj) = zinda * sfx_bri(ji,jj)233 190 END DO 234 191 END DO … … 237 194 ! salt flux at the ocean surface ! 238 195 !------------------------------------------! 239 240 IF( num_sal == 2 ) THEN ! variable ice salinity: brine drainage included in the salt flux 241 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) + sfx_bri(:,:) 242 ELSE ! constant ice salinity: 243 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) 244 ENDIF 245 !-----------------------------------------------! 246 ! mass of snow and ice per unit area ! 247 !-----------------------------------------------! 248 IF( nn_ice_embd /= 0 ) THEN ! embedded sea-ice (mass required) 249 snwice_mass_b(:,:) = snwice_mass(:,:) ! save mass from the previous ice time step 250 ! ! new mass per unit area 196 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 197 198 !-------------------------------------------------------------! 199 ! mass of snow and ice per unit area for embedded sea-ice ! 200 !-------------------------------------------------------------! 201 IF( nn_ice_embd /= 0 ) THEN 202 ! save mass from the previous ice time step 203 snwice_mass_b(:,:) = snwice_mass(:,:) 204 ! new mass per unit area 251 205 snwice_mass (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 252 ! !time evolution of snow+ice mass206 ! time evolution of snow+ice mass 253 207 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 254 208 ENDIF … … 265 219 IF( lk_cpl ) THEN ! coupled case 266 220 CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) ! snow/ice albedo 267 !268 221 alb_ice(:,:,:) = 0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:) ! Ice albedo (mean clear and overcast skys) 269 222 ENDIF 223 270 224 271 225 IF(ln_ctl) THEN -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r4897 r4900 8 8 !! 3.0 ! 2005-11 (M. Vancoppenolle) LIM-3 : Multi-layer thermodynamics + salinity variations 9 9 !! - ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec, lim_thd_con_dh and lim_thd_con_dif 10 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw10 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw 11 11 !! 3.3 ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 12 12 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation … … 43 43 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 44 USE timing ! Timing 45 USE cpl_oasis3, ONLY : lk_cpl 46 USE limcons ! conservation tests 45 47 46 48 IMPLICIT NONE … … 51 53 52 54 REAL(wp) :: epsi10 = 1.e-10_wp ! 53 REAL(wp) :: zzero = 0._wp !54 REAL(wp) :: zone = 1._wp !55 55 56 56 !! * Substitutions … … 84 84 INTEGER, INTENT(in) :: kt ! number of iteration 85 85 !! 86 INTEGER :: 87 INTEGER :: 88 REAL(wp) :: zfric_umin = 5e-03_wp ! lower bound for the friction velocity89 REAL(wp) :: zfric_umax = 2e-02_wp ! upper bound for the friction velocity90 REAL(wp) :: zinda, zindb, zthsnice, zfric_u ! local scalar91 REAL(wp) :: zfntlat, zpareff, zareamin, zcoef ! - -92 REAL(wp) , POINTER, DIMENSION(:,:) :: zqlbsbq ! link with lead energy budget qldif93 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)94 REAL(wp) :: z chk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset)86 INTEGER :: ji, jj, jk, jl ! dummy loop indices 87 INTEGER :: nbpb ! nb of icy pts for thermo. cal. 88 INTEGER :: ii, ij ! temporary dummy loop index 89 REAL(wp) :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 90 REAL(wp) :: zch = 0.0057_wp ! heat transfer coefficient 91 REAL(wp) :: zinda, zindb, zareamin 92 REAL(wp) :: zfric_u, zqld, zqfr 93 ! 94 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 95 95 !!------------------------------------------------------------------- 96 96 IF( nn_timing == 1 ) CALL timing_start('limthd') 97 97 98 CALL wrk_alloc( jpi, jpj, zqlbsbq ) 99 100 ! ------------------------------- 101 !- check conservation (C Rousset) 102 IF (ln_limdiahsb) THEN 103 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 104 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 105 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 106 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 107 ENDIF 108 !- check conservation (C Rousset) 109 ! ------------------------------- 98 ! conservation test 99 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 110 100 111 101 !------------------------------------------------------------------------------! … … 121 111 DO jj = 1, jpj 122 112 DO ji = 1, jpi 123 !Energy of melting q(S,T) [J.m-3]124 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i )125 113 !0 if no ice and 1 if yes 126 114 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) ) 127 !convert units ! very important that this line is here 128 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 115 !Energy of melting q(S,T) [J.m-3] 116 e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 117 !convert units ! very important that this line is here 118 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 129 119 END DO 130 120 END DO … … 133 123 DO jj = 1, jpj 134 124 DO ji = 1, jpi 135 !Energy of melting q(S,T) [J.m-3]136 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s )137 125 !0 if no ice and 1 if yes 138 126 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 ) ) 127 !Energy of melting q(S,T) [J.m-3] 128 e_s(ji,jj,jk,jl) = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 139 129 !convert units ! very important that this line is here 140 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac * zindb130 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac 141 131 END DO 142 132 END DO 143 133 END DO 144 134 END DO 145 146 !-----------------------------------147 ! 1.4) Compute global heat content148 !-----------------------------------149 qt_i_in (:,:) = 0.e0150 qt_s_in (:,:) = 0.e0151 qt_i_fin (:,:) = 0.e0152 qt_s_fin (:,:) = 0.e0153 sum_fluxq(:,:) = 0.e0154 fatm (:,:) = 0.e0155 135 156 136 ! 2) Partial computation of forcing for the thermodynamic sea ice model. ! … … 161 141 !CDIR NOVERRCHK 162 142 DO ji = 1, jpi 163 zinda = tms(ji,jj) * ( 1. 0 - MAX( zzero , SIGN( zone , - at_i(ji,jj) + epsi10 ) ) )143 zinda = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice 164 144 ! 165 145 ! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget … … 168 148 ! ! net downward heat flux from the ice to the ocean, expressed as a function of ocean 169 149 ! ! temperature and turbulent mixing (McPhee, 1992) 170 ! friction velocity171 zfric_u = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )172 173 ! here the drag will depend on ice thickness and type (0.006)174 fdtcn(ji,jj) = zinda * rau0 * rcp * 0.006 * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) )175 ! also category dependent176 ! !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead177 qdtcn(ji,jj) = zinda * fdtcn(ji,jj) * ( 1.0 - at_i(ji,jj) ) * rdt_ice178 !179 ! !-- Lead heat budget, qldif (part 1, next one is in limthd_dh)180 ! ! caution: exponent betas used as more snow can fallinto leads181 qldif(ji,jj) = tms(ji,jj) * rdt_ice * ( &182 & pfrld(ji,jj) * ( qsr(ji,jj) * oatte(ji,jj) & ! solar heat + clem modif183 & + qns(ji,jj) & ! non solar heat184 & + fdtcn(ji,jj) & ! turbulent ice-ocean heat185 & + fsbbq(ji,jj) * ( 1.0 - zinda ) ) & ! residual heat from previous step186 & - pfrld(ji,jj)**betas * sprecip(ji,jj) * lfus ) ! latent heat of sprecip melting187 150 ! 188 ! Positive heat budget is used for bottom ablation 189 zfntlat = 1.0 - MAX( zzero , SIGN( zone , - qldif(ji,jj) ) ) 190 != 1 if positive heat budget 191 zpareff = 1.0 - zinda * zfntlat 192 != 0 if ice and positive heat budget and 1 if one of those two is false 193 zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / ( rdt_ice * MAX( at_i(ji,jj), epsi10 ) ) 151 ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 152 zqld = tms(ji,jj) * rdt_ice * & 153 & ( pfrld(ji,jj) * ( qsr(ji,jj) * oatte(ji,jj) & ! solar heat + clem modif 154 & + qns(ji,jj) ) & ! non solar heat 155 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 156 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 157 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 158 159 !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 160 zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 161 162 !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 163 qlead(ji,jj) = MIN( 0._wp , zqld - zqfr ) 164 165 ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting 166 IF( at_i(ji,jj) > epsi10 .AND. zqld > 0._wp ) THEN 167 fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90 168 qlead(ji,jj) = 0._wp 169 ENDIF 194 170 ! 195 ! Heat budget of the lead, energy transferred from ice to ocean 196 qldif (ji,jj) = zpareff * qldif(ji,jj) 197 qdtcn (ji,jj) = zpareff * qdtcn(ji,jj) 198 ! 199 ! Energy needed to bring ocean surface layer until its freezing (qcmif, limflx) 200 qcmif (ji,jj) = rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 201 ! 202 ! oceanic heat flux (limthd_dh) 203 fbif (ji,jj) = zinda * ( fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) + fdtcn(ji,jj) ) 204 ! 171 !-- Energy from the turbulent oceanic heat flux --- ! 172 !clem zfric_u = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) 173 zfric_u = MAX( SQRT( ust2s(ji,jj) ), zfric_umin ) 174 fhtur(ji,jj) = MAX( 0._wp, zinda * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 175 ! upper bound for fhtur: we do not want SST to drop below Tfreeze. 176 ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr) 177 ! This is not a clean budget, so that should be corrected at some point 178 fhtur(ji,jj) = zinda * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 179 180 ! ----------------------------------------- 181 ! Net heat flux on top of ice-ocean [W.m-2] 182 ! ----------------------------------------- 183 ! First step here : heat flux at the ocean surface + precip 184 ! Second step below : heat flux at the ice surface (after limthd_dif) 185 hfx_in(ji,jj) = hfx_in(ji,jj) & 186 ! heat flux above the ocean 187 & + pfrld(ji,jj) * ( qns(ji,jj) + qsr(ji,jj) ) & 188 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 189 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 190 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) 191 192 ! ----------------------------------------------------------------------------- 193 ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2] 194 ! ----------------------------------------------------------------------------- 195 ! First step here : non solar + precip - qlead - qturb 196 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 197 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 198 hfx_out(ji,jj) = hfx_out(ji,jj) & 199 ! Non solar heat flux received by the ocean 200 & + pfrld(ji,jj) * qns(ji,jj) & 201 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 202 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 203 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) & 204 ! heat flux taken from the ocean where there is open water ice formation 205 & - qlead(ji,jj) * r1_rdtice & 206 ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 207 & - at_i(ji,jj) * fhtur(ji,jj) & 208 & - at_i(ji,jj) * fhld(ji,jj) 209 205 210 END DO 206 211 END DO … … 234 239 DO jj = mj0(jjindx), mj1(jjindx) 235 240 jiindex_1d = (jj - 1) * jpi + ji 241 WRITE(numout,*) ' lim_thd : Category no : ', jl 236 242 END DO 237 243 END DO … … 271 277 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) ) 272 278 CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb), fr2_i0 , jpi, jpj, npb(1:nbpb) ) 273 CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 274 #if ! defined key_coupled 275 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 276 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 277 #endif 279 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 280 CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 281 IF( .NOT. lk_cpl ) THEN 282 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 283 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 284 ENDIF 278 285 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 279 286 CALL tab_2d_1d( nbpb, t_bo_b (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) 280 287 CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip , jpi, jpj, npb(1:nbpb) ) 281 CALL tab_2d_1d( nbpb, fbif_1d (1:nbpb), fbif , jpi, jpj, npb(1:nbpb) ) 282 CALL tab_2d_1d( nbpb, qldif_1d (1:nbpb), qldif , jpi, jpj, npb(1:nbpb) ) 283 CALL tab_2d_1d( nbpb, rdm_ice_1d (1:nbpb), rdm_ice , jpi, jpj, npb(1:nbpb) ) 284 CALL tab_2d_1d( nbpb, rdm_snw_1d (1:nbpb), rdm_snw , jpi, jpj, npb(1:nbpb) ) 285 CALL tab_2d_1d( nbpb, dmgwi_1d (1:nbpb), dmgwi , jpi, jpj, npb(1:nbpb) ) 286 CALL tab_2d_1d( nbpb, qlbbq_1d (1:nbpb), zqlbsbq , jpi, jpj, npb(1:nbpb) ) 287 288 CALL tab_2d_1d( nbpb, sfx_thd_1d (1:nbpb), sfx_thd , jpi, jpj, npb(1:nbpb) ) 288 CALL tab_2d_1d( nbpb, fhtur_1d (1:nbpb), fhtur , jpi, jpj, npb(1:nbpb) ) 289 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 290 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 291 292 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 293 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 294 295 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 296 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) 297 CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum , jpi, jpj, npb(1:nbpb) ) 298 CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni , jpi, jpj, npb(1:nbpb) ) 299 CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) ) 300 CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) ) 301 302 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 303 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) 304 CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum , jpi, jpj, npb(1:nbpb) ) 305 CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni , jpi, jpj, npb(1:nbpb) ) 289 306 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 290 CALL tab_2d_1d( nbpb, fhbri_1d (1:nbpb), fhbri , jpi, jpj, npb(1:nbpb) ) 291 CALL tab_2d_1d( nbpb, fstbif_1d (1:nbpb), fstric , jpi, jpj, npb(1:nbpb) ) 292 CALL tab_2d_1d( nbpb, qfvbq_1d (1:nbpb), qfvbq , jpi, jpj, npb(1:nbpb) ) 293 294 CALL tab_2d_1d( nbpb, iatte_1d (1:nbpb), iatte , jpi, jpj, npb(1:nbpb) ) ! clem modif 295 CALL tab_2d_1d( nbpb, oatte_1d (1:nbpb), oatte , jpi, jpj, npb(1:nbpb) ) ! clem modif 307 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 308 309 CALL tab_2d_1d( nbpb, iatte_1d (1:nbpb), iatte , jpi, jpj, npb(1:nbpb) ) 310 CALL tab_2d_1d( nbpb, oatte_1d (1:nbpb), oatte , jpi, jpj, npb(1:nbpb) ) 311 312 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 313 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) 314 CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum , jpi, jpj, npb(1:nbpb) ) 315 CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom , jpi, jpj, npb(1:nbpb) ) 316 CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog , jpi, jpj, npb(1:nbpb) ) 317 CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif , jpi, jpj, npb(1:nbpb) ) 318 CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw , jpi, jpj, npb(1:nbpb) ) 319 CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw , jpi, jpj, npb(1:nbpb) ) 320 CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub , jpi, jpj, npb(1:nbpb) ) 321 CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err , jpi, jpj, npb(1:nbpb) ) 322 CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res , jpi, jpj, npb(1:nbpb) ) 323 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 324 296 325 !-------------------------------- 297 326 ! 4.3) Thermodynamic processes 298 327 !-------------------------------- 299 328 300 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_enmelt( 1, nbpb ) ! computes sea ice energy of melting 301 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_glohec( qt_i_in, qt_s_in, q_i_layer_in, 1, nbpb, jl ) 302 303 ! !---------------------------------! 304 CALL lim_thd_dif( 1, nbpb, jl ) ! Ice/Snow Temperature profile ! 305 ! !---------------------------------! 306 307 CALL lim_thd_enmelt( 1, nbpb ) ! computes sea ice energy of melting compulsory for limthd_dh 308 309 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_glohec ( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl ) 310 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_con_dif( 1 , nbpb , jl ) 311 312 ! !---------------------------------! 313 CALL lim_thd_dh( 1, nbpb, jl ) ! Ice/Snow thickness ! 314 ! !---------------------------------! 315 316 ! !---------------------------------! 317 CALL lim_thd_ent( 1, nbpb, jl ) ! Ice/Snow enthalpy remapping ! 318 ! !---------------------------------! 319 320 ! !---------------------------------! 321 CALL lim_thd_sal( 1, nbpb ) ! Ice salinity computation ! 322 ! !---------------------------------! 323 324 ! CALL lim_thd_enmelt(1,nbpb) ! computes sea ice energy of melting 325 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_glohec( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl ) 326 IF( con_i .AND. jiindex_1d > 0 ) CALL lim_thd_con_dh ( 1 , nbpb , jl ) 329 !---------------------------------! 330 ! Ice/Snow Temperature profile ! 331 !---------------------------------! 332 CALL lim_thd_dif( 1, nbpb ) 333 334 !---------------------------------! 335 ! Ice/Snow thicnkess ! 336 !---------------------------------! 337 CALL lim_thd_dh( 1, nbpb ) 338 339 ! --- Ice enthalpy remapping --- ! 340 CALL lim_thd_ent( 1, nbpb, q_i_b(1:nbpb,:) ) 341 342 !---------------------------------! 343 ! --- Ice salinity --- ! 344 !---------------------------------! 345 CALL lim_thd_sal( 1, nbpb ) 346 347 !---------------------------------! 348 ! --- temperature update --- ! 349 !---------------------------------! 350 CALL lim_thd_temp( 1, nbpb ) 327 351 328 352 !-------------------------------- … … 345 369 CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b (1:nbpb,jk), jpi, jpj) 346 370 END DO 347 CALL tab_1d_2d( nbpb, fstric , npb, fstbif_1d (1:nbpb) , jpi, jpj ) 348 CALL tab_1d_2d( nbpb, qldif , npb, qldif_1d (1:nbpb) , jpi, jpj ) 349 CALL tab_1d_2d( nbpb, qfvbq , npb, qfvbq_1d (1:nbpb) , jpi, jpj ) 350 CALL tab_1d_2d( nbpb, rdm_ice , npb, rdm_ice_1d(1:nbpb) , jpi, jpj ) 351 CALL tab_1d_2d( nbpb, rdm_snw , npb, rdm_snw_1d(1:nbpb) , jpi, jpj ) 352 CALL tab_1d_2d( nbpb, dmgwi , npb, dmgwi_1d (1:nbpb) , jpi, jpj ) 353 CALL tab_1d_2d( nbpb, rdvosif , npb, dvsbq_1d (1:nbpb) , jpi, jpj ) 354 CALL tab_1d_2d( nbpb, rdvobif , npb, dvbbq_1d (1:nbpb) , jpi, jpj ) 355 CALL tab_1d_2d( nbpb, fdvolif , npb, dvlbq_1d (1:nbpb) , jpi, jpj ) 356 CALL tab_1d_2d( nbpb, rdvonif , npb, dvnbq_1d (1:nbpb) , jpi, jpj ) 357 CALL tab_1d_2d( nbpb, sfx_thd , npb, sfx_thd_1d(1:nbpb) , jpi, jpj ) 371 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 372 373 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 374 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 375 376 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 377 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) 378 CALL tab_1d_2d( nbpb, wfx_sum , npb, wfx_sum_1d(1:nbpb) , jpi, jpj ) 379 CALL tab_1d_2d( nbpb, wfx_sni , npb, wfx_sni_1d(1:nbpb) , jpi, jpj ) 380 CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj ) 381 CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj ) 382 383 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 384 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) 385 CALL tab_1d_2d( nbpb, sfx_sum , npb, sfx_sum_1d(1:nbpb) , jpi, jpj ) 386 CALL tab_1d_2d( nbpb, sfx_sni , npb, sfx_sni_1d(1:nbpb) , jpi, jpj ) 387 CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj ) 358 388 ! 359 389 IF( num_sal == 2 ) THEN 360 390 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 361 CALL tab_1d_2d( nbpb, fhbri , npb, fhbri_1d (1:nbpb) , jpi, jpj )362 391 ENDIF 392 393 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 394 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) 395 CALL tab_1d_2d( nbpb, hfx_sum , npb, hfx_sum_1d(1:nbpb) , jpi, jpj ) 396 CALL tab_1d_2d( nbpb, hfx_bom , npb, hfx_bom_1d(1:nbpb) , jpi, jpj ) 397 CALL tab_1d_2d( nbpb, hfx_bog , npb, hfx_bog_1d(1:nbpb) , jpi, jpj ) 398 CALL tab_1d_2d( nbpb, hfx_dif , npb, hfx_dif_1d(1:nbpb) , jpi, jpj ) 399 CALL tab_1d_2d( nbpb, hfx_opw , npb, hfx_opw_1d(1:nbpb) , jpi, jpj ) 400 CALL tab_1d_2d( nbpb, hfx_snw , npb, hfx_snw_1d(1:nbpb) , jpi, jpj ) 401 CALL tab_1d_2d( nbpb, hfx_sub , npb, hfx_sub_1d(1:nbpb) , jpi, jpj ) 402 CALL tab_1d_2d( nbpb, hfx_err , npb, hfx_err_1d(1:nbpb) , jpi, jpj ) 403 CALL tab_1d_2d( nbpb, hfx_res , npb, hfx_res_1d(1:nbpb) , jpi, jpj ) 404 CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb) , jpi, jpj ) 363 405 ! 364 406 !+++++ temporary stuff for a dummy version 365 CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb) , jpi, jpj ) 366 CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb) , jpi, jpj ) 367 CALL tab_1d_2d( nbpb, fsup2D , npb, fsup (1:nbpb) , jpi, jpj ) 368 CALL tab_1d_2d( nbpb, focea2D , npb, focea (1:nbpb) , jpi, jpj ) 369 CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new (1:nbpb) , jpi, jpj ) 370 CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0 (1:nbpb) , jpi, jpj ) 371 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 407 CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb) , jpi, jpj ) 408 CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb) , jpi, jpj ) 409 CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new (1:nbpb) , jpi, jpj ) 410 CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0 (1:nbpb) , jpi, jpj ) 372 411 !+++++ 412 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 413 CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 373 414 ! 374 415 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? … … 384 425 ! 5.1) Ice heat content 385 426 !------------------------ 386 ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 387 zcoef = 1._wp / ( unit_fac * REAL( nlay_i ) ) 427 ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 388 428 DO jl = 1, jpl 389 429 DO jk = 1, nlay_i 390 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef430 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) ) 391 431 END DO 392 432 END DO … … 395 435 ! 5.2) Snow heat content 396 436 !------------------------ 397 ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 398 zcoef = 1._wp / ( unit_fac * REAL( nlay_s ) ) 437 ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 399 438 DO jl = 1, jpl 400 439 DO jk = 1, nlay_s 401 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef440 e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) ) 402 441 END DO 403 442 END DO … … 411 450 ! 5.4) Diagnostic thermodynamic growth rates 412 451 !-------------------------------------------- 413 !clem@useless d_v_i_thd(:,:,:) = v_i (:,:,:) - old_v_i(:,:,:) ! ice volumes414 !clem@mv-to-itd dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday415 416 IF( con_i .AND. jiindex_1d > 0 ) fbif(:,:) = fbif(:,:) + zqlbsbq(:,:)417 418 452 IF(ln_ctl) THEN ! Control print 419 453 CALL prt_ctl_info(' ') … … 448 482 ENDIF 449 483 ! 450 ! ------------------------------- 451 !- check conservation (C Rousset) 452 IF (ln_limdiahsb) THEN 453 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 454 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 455 456 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 457 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 458 459 zchk_vmin = glob_min(v_i) 460 zchk_amax = glob_max(SUM(a_i,dim=3)) 461 zchk_amin = glob_min(a_i) 462 463 IF(lwp) THEN 464 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limthd) = ',(zchk_v_i * rday) 465 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limthd) = ',(zchk_smv * rday) 466 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limthd) = ',(zchk_vmin * 1.e-3) 467 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limthd) = ',zchk_amax 468 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limthd) = ',zchk_amin 469 ENDIF 470 ENDIF 471 !- check conservation (C Rousset) 472 ! ------------------------------- 473 ! 474 CALL wrk_dealloc( jpi, jpj, zqlbsbq ) 484 ! conservation test 485 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 475 486 ! 476 487 IF( nn_timing == 1 ) CALL timing_stop('limthd') 477 END SUBROUTINE lim_thd 478 479 480 SUBROUTINE lim_thd_glohec( eti, ets, etilayer, kideb, kiut, jl ) 488 END SUBROUTINE lim_thd 489 490 SUBROUTINE lim_thd_temp( kideb, kiut ) 481 491 !!----------------------------------------------------------------------- 482 !! *** ROUTINE lim_thd_ glohec***492 !! *** ROUTINE lim_thd_temp *** 483 493 !! 484 !! ** Purpose : Compute total heat content for each category 485 !! Works with 1d vectors only 486 !!----------------------------------------------------------------------- 487 INTEGER , INTENT(in ) :: kideb, kiut ! bounds for the spatial loop 488 INTEGER , INTENT(in ) :: jl ! category number 489 REAL(wp), INTENT( out), DIMENSION (jpij,jpl ) :: eti, ets ! vertically-summed heat content for ice & snow 490 REAL(wp), INTENT( out), DIMENSION (jpij,jkmax) :: etilayer ! heat content for ice layers 491 !! 492 INTEGER :: ji,jk ! loop indices 493 !!----------------------------------------------------------------------- 494 eti(:,:) = 0._wp 495 ets(:,:) = 0._wp 496 ! 497 DO jk = 1, nlay_i ! total q over all layers, ice [J.m-2] 498 DO ji = kideb, kiut 499 etilayer(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 500 eti (ji,jl) = eti(ji,jl) + etilayer(ji,jk) 501 END DO 502 END DO 503 DO ji = kideb, kiut ! total q over all layers, snow [J.m-2] 504 ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / REAL( nlay_s ) 505 END DO 506 ! 507 WRITE(numout,*) ' lim_thd_glohec ' 508 WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) * r1_rdtice 509 WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) * r1_rdtice 510 WRITE(numout,*) ' qt_in : ', ( eti(jiindex_1d,jl) + ets(jiindex_1d,jl) ) * r1_rdtice 511 ! 512 END SUBROUTINE lim_thd_glohec 513 514 515 SUBROUTINE lim_thd_con_dif( kideb, kiut, jl ) 516 !!----------------------------------------------------------------------- 517 !! *** ROUTINE lim_thd_con_dif *** 518 !! 519 !! ** Purpose : Test energy conservation after heat diffusion 520 !!------------------------------------------------------------------- 521 INTEGER , INTENT(in ) :: kideb, kiut ! bounds for the spatial loop 522 INTEGER , INTENT(in ) :: jl ! category number 523 524 INTEGER :: ji, jk ! loop indices 525 INTEGER :: ii, ij 526 INTEGER :: numce ! number of points for which conservation is violated 527 REAL(wp) :: meance ! mean conservation error 528 REAL(wp) :: max_cons_err, max_surf_err 529 !!--------------------------------------------------------------------- 530 531 max_cons_err = 1.0_wp ! maximum tolerated conservation error 532 max_surf_err = 0.001_wp ! maximum tolerated surface error 533 534 !-------------------------- 535 ! Increment of energy 536 !-------------------------- 537 ! global 538 DO ji = kideb, kiut 539 dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl) 540 END DO 541 ! layer by layer 542 dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:) 543 544 !---------------------------------------- 545 ! Atmospheric heat flux, ice heat budget 546 !---------------------------------------- 547 DO ji = kideb, kiut 548 ii = MOD( npb(ji) - 1 , jpi ) + 1 549 ij = ( npb(ji) - 1 ) / jpi + 1 550 fatm (ji,jl) = qnsr_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) 551 sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji) * i0(ji) - fstroc(ii,ij,jl) 552 END DO 553 554 !-------------------- 555 ! Conservation error 556 !-------------------- 557 DO ji = kideb, kiut 558 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 559 END DO 560 561 numce = 0 562 meance = 0._wp 563 DO ji = kideb, kiut 564 IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 565 numce = numce + 1 566 meance = meance + cons_error(ji,jl) 567 ENDIF 568 END DO 569 IF( numce > 0 ) meance = meance / numce 570 571 WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 572 WRITE(numout,*) ' After lim_thd_dif, category : ', jl 573 WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 574 WRITE(numout,*) ' Number of points where there is a cons err gt than c.e. : ', numce, numit 575 576 !------------------------------------------------------- 577 ! Surface error due to imbalance between Fatm and Fcsu 578 !------------------------------------------------------- 579 numce = 0 580 meance = 0._wp 581 582 DO ji = kideb, kiut 583 surf_error(ji,jl) = ABS ( fatm(ji,jl) - fc_su(ji) ) 584 IF( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) THEN 585 numce = numce + 1 586 meance = meance + surf_error(ji,jl) 587 ENDIF 588 ENDDO 589 IF( numce > 0 ) meance = meance / numce 590 591 WRITE(numout,*) ' Maximum tolerated surface error : ', max_surf_err 592 WRITE(numout,*) ' After lim_thd_dif, category : ', jl 593 WRITE(numout,*) ' Mean surface error on big error points ', meance, numit 594 WRITE(numout,*) ' Number of points where there is a surf err gt than surf_err : ', numce, numit 595 596 WRITE(numout,*) ' fc_su : ', fc_su(jiindex_1d) 597 WRITE(numout,*) ' fatm : ', fatm(jiindex_1d,jl) 598 WRITE(numout,*) ' t_su : ', t_su_b(jiindex_1d) 599 600 !--------------------------------------- 601 ! Write ice state in case of big errors 602 !--------------------------------------- 603 DO ji = kideb, kiut 604 IF ( ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) .OR. & 605 ( cons_error(ji,jl) .GT. max_cons_err ) ) THEN 606 ii = MOD( npb(ji) - 1, jpi ) + 1 607 ij = ( npb(ji) - 1 ) / jpi + 1 608 ! 609 WRITE(numout,*) ' alerte 1 ' 610 WRITE(numout,*) ' Untolerated conservation / surface error after ' 611 WRITE(numout,*) ' heat diffusion in the ice ' 612 WRITE(numout,*) ' Category : ', jl 613 WRITE(numout,*) ' ii , ij : ', ii, ij 614 WRITE(numout,*) ' lat, lon : ', gphit(ii,ij), glamt(ii,ij) 615 WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 616 WRITE(numout,*) ' surf_error : ', surf_error(ji,jl) 617 WRITE(numout,*) ' dq_i : ', - dq_i(ji,jl) * r1_rdtice 618 WRITE(numout,*) ' Fdt : ', sum_fluxq(ji,jl) 619 WRITE(numout,*) 620 ! WRITE(numout,*) ' qt_i_in : ', qt_i_in(ji,jl) 621 ! WRITE(numout,*) ' qt_s_in : ', qt_s_in(ji,jl) 622 ! WRITE(numout,*) ' qt_i_fin : ', qt_i_fin(ji,jl) 623 ! WRITE(numout,*) ' qt_s_fin : ', qt_s_fin(ji,jl) 624 ! WRITE(numout,*) ' qt : ', qt_i_fin(ji,jl) + qt_s_fin(ji,jl) 625 WRITE(numout,*) ' ht_i : ', ht_i_b(ji) 626 WRITE(numout,*) ' ht_s : ', ht_s_b(ji) 627 WRITE(numout,*) ' t_su : ', t_su_b(ji) 628 WRITE(numout,*) ' t_s : ', t_s_b(ji,1) 629 WRITE(numout,*) ' t_i : ', t_i_b(ji,1:nlay_i) 630 WRITE(numout,*) ' t_bo : ', t_bo_b(ji) 631 WRITE(numout,*) ' q_i : ', q_i_b(ji,1:nlay_i) 632 WRITE(numout,*) ' s_i : ', s_i_b(ji,1:nlay_i) 633 WRITE(numout,*) ' tmelts : ', rtt - tmut*s_i_b(ji,1:nlay_i) 634 WRITE(numout,*) 635 WRITE(numout,*) ' Fluxes ' 636 WRITE(numout,*) ' ~~~~~~ ' 637 WRITE(numout,*) ' fatm : ', fatm(ji,jl) 638 WRITE(numout,*) ' fc_su : ', fc_su (ji) 639 WRITE(numout,*) ' fstr_inice : ', qsr_ice_1d(ji)*i0(ji) 640 WRITE(numout,*) ' fc_bo : ', - fc_bo_i (ji) 641 WRITE(numout,*) ' foc : ', fbif_1d(ji) 642 WRITE(numout,*) ' fstroc : ', fstroc (ii,ij,jl) 643 WRITE(numout,*) ' i0 : ', i0(ji) 644 WRITE(numout,*) ' qsr_ice : ', (1.0-i0(ji))*qsr_ice_1d(ji) 645 WRITE(numout,*) ' qns_ice : ', qnsr_ice_1d(ji) 646 WRITE(numout,*) ' Conduction fluxes : ' 647 WRITE(numout,*) ' fc_s : ', fc_s(ji,0:nlay_s) 648 WRITE(numout,*) ' fc_i : ', fc_i(ji,0:nlay_i) 649 WRITE(numout,*) 650 WRITE(numout,*) ' Layer by layer ... ' 651 WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 652 WRITE(numout,*) ' dfc_snow : ', fc_s(ji,1) - fc_s(ji,0) 653 DO jk = 1, nlay_i 654 WRITE(numout,*) ' layer : ', jk 655 WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) * r1_rdtice 656 WRITE(numout,*) ' radab : ', radab(ji,jk) 657 WRITE(numout,*) ' dfc_i : ', fc_i(ji,jk) - fc_i(ji,jk-1) 658 WRITE(numout,*) ' tot f : ', fc_i(ji,jk) - fc_i(ji,jk-1) - radab(ji,jk) 659 END DO 660 661 ENDIF 662 ! 663 END DO 664 ! 665 END SUBROUTINE lim_thd_con_dif 666 667 668 SUBROUTINE lim_thd_con_dh( kideb, kiut, jl ) 669 !!----------------------------------------------------------------------- 670 !! *** ROUTINE lim_thd_con_dh *** 671 !! 672 !! ** Purpose : Test energy conservation after enthalpy redistr. 673 !!----------------------------------------------------------------------- 674 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 675 INTEGER, INTENT(in) :: jl ! category number 676 ! 677 INTEGER :: ji ! loop indices 678 INTEGER :: ii, ij, numce ! local integers 679 REAL(wp) :: meance, max_cons_err !local scalar 680 !!--------------------------------------------------------------------- 681 682 max_cons_err = 1._wp 683 684 !-------------------------- 685 ! Increment of energy 686 !-------------------------- 687 DO ji = kideb, kiut 688 dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl) ! global 689 END DO 690 dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:) ! layer by layer 691 692 !---------------------------------------- 693 ! Atmospheric heat flux, ice heat budget 694 !---------------------------------------- 695 DO ji = kideb, kiut 696 ii = MOD( npb(ji) - 1 , jpi ) + 1 697 ij = ( npb(ji) - 1 ) / jpi + 1 698 699 fatm (ji,jl) = qnsr_ice_1d(ji) + qsr_ice_1d(ji) ! total heat flux 700 sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(ii,ij,jl) 701 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 702 END DO 703 704 !-------------------- 705 ! Conservation error 706 !-------------------- 707 DO ji = kideb, kiut 708 cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 709 END DO 710 711 numce = 0 712 meance = 0._wp 713 DO ji = kideb, kiut 714 IF( cons_error(ji,jl) .GT. max_cons_err ) THEN 715 numce = numce + 1 716 meance = meance + cons_error(ji,jl) 717 ENDIF 718 ENDDO 719 IF(numce > 0 ) meance = meance / numce 720 721 WRITE(numout,*) ' Error report - Category : ', jl 722 WRITE(numout,*) ' ~~~~~~~~~~~~ ' 723 WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 724 WRITE(numout,*) ' After lim_thd_ent, category : ', jl 725 WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 726 WRITE(numout,*) ' Number of points where there is a cons err gt than 0.1 W/m2 : ', numce, numit 727 728 !--------------------------------------- 729 ! Write ice state in case of big errors 730 !--------------------------------------- 731 DO ji = kideb, kiut 732 IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 733 ii = MOD( npb(ji) - 1, jpi ) + 1 734 ij = ( npb(ji) - 1 ) / jpi + 1 735 ! 736 WRITE(numout,*) ' alerte 1 - category : ', jl 737 WRITE(numout,*) ' Untolerated conservation error after limthd_ent ' 738 WRITE(numout,*) ' ii , ij : ', ii, ij 739 WRITE(numout,*) ' lat, lon : ', gphit(ii,ij), glamt(ii,ij) 740 WRITE(numout,*) ' * ' 741 WRITE(numout,*) ' Ftotal : ', sum_fluxq(ji,jl) 742 WRITE(numout,*) ' dq_t : ', - dq_i(ji,jl) * r1_rdtice 743 WRITE(numout,*) ' dq_i : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) * r1_rdtice 744 WRITE(numout,*) ' dq_s : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 745 WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 746 WRITE(numout,*) ' * ' 747 WRITE(numout,*) ' Fluxes --- : ' 748 WRITE(numout,*) ' fatm : ', fatm(ji,jl) 749 WRITE(numout,*) ' foce : ', fbif_1d(ji) 750 WRITE(numout,*) ' fres : ', ftotal_fin(ji) 751 WRITE(numout,*) ' fhbri : ', fhbricat(ii,ij,jl) 752 WRITE(numout,*) ' * ' 753 WRITE(numout,*) ' Heat contents --- : ' 754 WRITE(numout,*) ' qt_s_in : ', qt_s_in(ji,jl) * r1_rdtice 755 WRITE(numout,*) ' qt_i_in : ', qt_i_in(ji,jl) * r1_rdtice 756 WRITE(numout,*) ' qt_in : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) * r1_rdtice 757 WRITE(numout,*) ' qt_s_fin : ', qt_s_fin(ji,jl) * r1_rdtice 758 WRITE(numout,*) ' qt_i_fin : ', qt_i_fin(ji,jl) * r1_rdtice 759 WRITE(numout,*) ' qt_fin : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) * r1_rdtice 760 WRITE(numout,*) ' * ' 761 WRITE(numout,*) ' Ice variables --- : ' 762 WRITE(numout,*) ' ht_i : ', ht_i_b(ji) 763 WRITE(numout,*) ' ht_s : ', ht_s_b(ji) 764 WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) 765 WRITE(numout,*) ' dh_snowice: ', dh_snowice(ji) 766 WRITE(numout,*) ' dh_i_surf : ', dh_i_surf(ji) 767 WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 768 ENDIF 769 ! 770 END DO 771 ! 772 END SUBROUTINE lim_thd_con_dh 773 774 775 SUBROUTINE lim_thd_enmelt( kideb, kiut ) 776 !!----------------------------------------------------------------------- 777 !! *** ROUTINE lim_thd_enmelt *** 778 !! 779 !! ** Purpose : Computes sea ice energy of melting q_i (J.m-3) 494 !! ** Purpose : Computes sea ice temperature (Kelvin) from enthalpy 780 495 !! 781 496 !! ** Method : Formula (Bitz and Lipscomb, 1999) … … 784 499 !! 785 500 INTEGER :: ji, jk ! dummy loop indices 786 REAL(wp) :: ztmelts ! local scalar501 REAL(wp) :: ztmelts, zswitch, zaaa, zbbb, zccc, zdiscrim ! local scalar 787 502 !!------------------------------------------------------------------- 788 ! 789 DO jk = 1, nlay_i ! Sea ice energy of melting503 ! Recover ice temperature 504 DO jk = 1, nlay_i 790 505 DO ji = kideb, kiut 791 ztmelts = - tmut * s_i_b(ji,jk) + rtt 792 q_i_b(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_b(ji,jk) ) & 793 & + lfus * ( 1.0 - (ztmelts-rtt) / MIN( t_i_b(ji,jk)-rtt, -epsi10 ) ) & 794 & - rcp * ( ztmelts-rtt ) ) 795 END DO 796 END DO 797 DO jk = 1, nlay_s ! Snow energy of melting 798 DO ji = kideb, kiut 799 q_s_b(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 800 END DO 801 END DO 802 ! 803 END SUBROUTINE lim_thd_enmelt 804 506 ztmelts = -tmut * s_i_b(ji,jk) + rtt 507 ! Conversion q(S,T) -> T (second order equation) 508 zaaa = cpic 509 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 510 zccc = lfus * ( ztmelts - rtt ) 511 zdiscrim = SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 512 t_i_b(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 513 514 ! mask temperature 515 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_b(ji) ) ) 516 t_i_b(ji,jk) = zswitch * t_i_b(ji,jk) + ( 1._wp - zswitch ) * rtt 517 END DO 518 END DO 519 520 END SUBROUTINE lim_thd_temp 805 521 806 522 SUBROUTINE lim_thd_init … … 818 534 INTEGER :: ios ! Local integer output status for namelist read 819 535 NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb, & 820 & hicmin, hiclim, & 821 & sbeta , parlat, hakspl, hibspl, exld, & 822 & hakdif, hnzst , thth , parsub, alphs, betas, & 536 & hiclim, hnzst, parsub, betas, & 823 537 & kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi 824 538 !!------------------------------------------------------------------- … … 843 557 WRITE(numout,*)' Namelist of ice parameters for ice thermodynamic computation ' 844 558 WRITE(numout,*)' maximum melting at the bottom hmelt = ', hmelt 845 WRITE(numout,*)' ice thick. for lateral accretion in NH (SH) hiccrit(1/2)= ', hiccrit559 WRITE(numout,*)' ice thick. for lateral accretion hiccrit = ', hiccrit 846 560 WRITE(numout,*)' Frazil ice thickness as a function of wind or not fraz_swi = ', fraz_swi 847 561 WRITE(numout,*)' Maximum proportion of frazil ice collecting at bottom maxfrazb = ', maxfrazb 848 562 WRITE(numout,*)' Thresold relative drift speed for collection of frazil vfrazb = ', vfrazb 849 563 WRITE(numout,*)' Squeezing coefficient for collection of frazil Cfrazb = ', Cfrazb 850 WRITE(numout,*)' ice thick. corr. to max. energy stored in brine pocket hicmin = ', hicmin851 564 WRITE(numout,*)' minimum ice thickness hiclim = ', hiclim 852 565 WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice ' 853 WRITE(numout,*)' Cranck-Nicholson (=0.5), implicit (=1), explicit (=0) sbeta = ', sbeta854 WRITE(numout,*)' percentage of energy used for lateral ablation parlat = ', parlat855 WRITE(numout,*)' slope of distr. for Hakkinen-Mellor lateral melting hakspl = ', hakspl856 WRITE(numout,*)' slope of distribution for Hibler lateral melting hibspl = ', hibspl857 WRITE(numout,*)' exponent for leads-closure rate exld = ', exld858 WRITE(numout,*)' coefficient for diffusions of ice and snow hakdif = ', hakdif859 WRITE(numout,*)' threshold thick. for comp. of eq. thermal conductivity zhth = ', thth860 566 WRITE(numout,*)' thickness of the surf. layer in temp. computation hnzst = ', hnzst 861 567 WRITE(numout,*)' switch for snow sublimation (=1) or not (=0) parsub = ', parsub 862 WRITE(numout,*)' coefficient for snow density when snow ice formation alphs = ', alphs863 568 WRITE(numout,*)' coefficient for ice-lead partition of snowfall betas = ', betas 864 569 WRITE(numout,*)' extinction radiation parameter in sea ice (1.0) kappa_i = ', kappa_i … … 866 571 WRITE(numout,*)' maximal err. on T for heat diffusion computation maxer_i_thd = ', maxer_i_thd 867 572 WRITE(numout,*)' switch for comp. of thermal conductivity in the ice thcon_i_swi = ', thcon_i_swi 573 WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i 868 574 ENDIF 869 !870 rcdsn = hakdif * rcdsn871 rcdic = hakdif * rcdic872 575 ! 873 576 END SUBROUTINE lim_thd_init -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r4333 r4900 6 6 !! History : LIM ! 2003-05 (M. Vancoppenolle) Original code in 1D 7 7 !! ! 2005-06 (M. Vancoppenolle) 3D version 8 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw & rdm_ice8 !! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw & wfx_ice 9 9 !! 3.4 ! 2011-02 (G. Madec) dynamical allocation 10 10 !! 3.5 ! 2012-10 (G. Madec & co) salt flux + bug fixes … … 26 26 USE wrk_nemo ! work arrays 27 27 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 28 28 USE cpl_oasis3, ONLY : lk_cpl 29 29 30 IMPLICIT NONE 30 31 PRIVATE … … 34 35 REAL(wp) :: epsi20 = 1.e-20 ! constant values 35 36 REAL(wp) :: epsi10 = 1.e-10 ! 36 REAL(wp) :: epsi13 = 1.e-13 !37 REAL(wp) :: zzero = 0._wp !38 REAL(wp) :: zone = 1._wp !39 37 40 38 !!---------------------------------------------------------------------- … … 45 43 CONTAINS 46 44 47 SUBROUTINE lim_thd_dh( kideb, kiut , jl)45 SUBROUTINE lim_thd_dh( kideb, kiut ) 48 46 !!------------------------------------------------------------------ 49 47 !! *** ROUTINE lim_thd_dh *** … … 70 68 !!------------------------------------------------------------------ 71 69 INTEGER , INTENT(in) :: kideb, kiut ! Start/End point on which the the computation is applied 72 INTEGER , INTENT(in) :: jl ! Thickness cateogry number73 70 !! 74 71 INTEGER :: ji , jk ! dummy loop indices 75 72 INTEGER :: ii, ij ! 2D corresponding indices to ji 76 INTEGER :: isnow ! switch for presence (1) or absence (0) of snow77 INTEGER :: isnowic ! snow ice formation not78 INTEGER :: i_ice_switch ! ice thickness above a certain treshold or not79 73 INTEGER :: iter 80 74 81 REAL(wp) :: zzfmass_i, zihgnew ! local scalar 82 REAL(wp) :: zzfmass_s, zhsnew, ztmelts ! local scalar 83 REAL(wp) :: zhn, zdhcf, zdhbf, zhni, zhnfi, zihg ! 84 REAL(wp) :: zdhnm, zhnnew, zhisn, zihic, zzc ! 75 REAL(wp) :: ztmelts ! local scalar 76 REAL(wp) :: zdh, zfdum ! 85 77 REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment 86 78 REAL(wp) :: zcoeff ! dummy argument for snowfall partitioning over ice and leads 87 REAL(wp) :: zs m_snowice! snow-ice salinity79 REAL(wp) :: zs_snic ! snow-ice salinity 88 80 REAL(wp) :: zswi1 ! switch for computation of bottom salinity 89 81 REAL(wp) :: zswi12 ! switch for computation of bottom salinity 90 82 REAL(wp) :: zswi2 ! switch for computation of bottom salinity 91 83 REAL(wp) :: zgrr ! bottom growth rate 92 REAL(wp) :: ztform ! bottom formation temperature 93 ! 94 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness 84 REAL(wp) :: zt_i_new ! bottom formation temperature 85 86 REAL(wp) :: zQm ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean 87 REAL(wp) :: zEi ! specific enthalpy of sea ice (J/kg) 88 REAL(wp) :: zEw ! specific enthalpy of exchanged water (J/kg) 89 REAL(wp) :: zdE ! specific enthalpy difference (J/kg) 90 REAL(wp) :: zfmdt ! exchange mass flux x time step (J/m2), >0 towards the ocean 91 REAL(wp) :: zsstK ! SST in Kelvin 92 95 93 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 96 REAL(wp), POINTER, DIMENSION(:) :: ztfs ! melting point 97 REAL(wp), POINTER, DIMENSION(:) :: zhsold ! old snow thickness 98 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow 99 REAL(wp), POINTER, DIMENSION(:) :: zqfont_su ! incoming, remaining surface energy 100 REAL(wp), POINTER, DIMENSION(:) :: zqfont_bo ! incoming, bottom energy 101 REAL(wp), POINTER, DIMENSION(:) :: z_f_surf ! surface heat for ablation 102 REAL(wp), POINTER, DIMENSION(:) :: zhgnew ! new ice thickness 103 REAL(wp), POINTER, DIMENSION(:) :: zfmass_i ! 94 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow (J.m-3) 95 REAL(wp), POINTER, DIMENSION(:) :: zq_su ! heat for surface ablation (J.m-2) 96 REAL(wp), POINTER, DIMENSION(:) :: zq_bo ! heat for bottom ablation (J.m-2) 97 REAL(wp), POINTER, DIMENSION(:) :: zq_1cat ! corrected heat in case 1-cat and hmelt>15cm (J.m-2) 98 REAL(wp), POINTER, DIMENSION(:) :: zq_rema ! remaining heat at the end of the routine (J.m-2) 99 REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) 100 INTEGER , POINTER, DIMENSION(:) :: icount ! number of layers vanished by melting 104 101 105 102 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel ! snow melt … … 108 105 109 106 REAL(wp), POINTER, DIMENSION(:,:) :: zdeltah 110 111 ! Pathological cases 112 REAL(wp), POINTER, DIMENSION(:) :: zfdt_init ! total incoming heat for ice melt 113 REAL(wp), POINTER, DIMENSION(:) :: zfdt_final ! total remaing heat for ice melt 114 REAL(wp), POINTER, DIMENSION(:) :: zqt_i ! total ice heat content 115 REAL(wp), POINTER, DIMENSION(:) :: zqt_s ! total snow heat content 116 REAL(wp), POINTER, DIMENSION(:) :: zqt_dummy ! dummy heat content 117 118 REAL(wp), POINTER, DIMENSION(:,:) :: zqt_i_lay ! total ice heat content 107 REAL(wp), POINTER, DIMENSION(:,:) :: zh_i ! ice layer thickness 108 109 REAL(wp), POINTER, DIMENSION(:) :: zqh_i ! total ice heat content (J.m-2) 110 REAL(wp), POINTER, DIMENSION(:) :: zqh_s ! total snow heat content (J.m-2) 111 REAL(wp), POINTER, DIMENSION(:) :: zq_s ! total snow enthalpy (J.m-3) 119 112 120 113 ! mass and salt flux (clem) 121 REAL(wp) :: zdvres, zdvsur, zdvbot 122 REAL(wp), POINTER, DIMENSION(:) :: zviold, zvsold ! old ice volume... 114 REAL(wp) :: zdvres, zswitch_sal, zswitch 123 115 124 116 ! Heat conservation 125 INTEGER :: num_iter_max, numce_dh 126 REAL(wp) :: meance_dh 127 REAL(wp) :: zinda 128 REAL(wp), POINTER, DIMENSION(:) :: zinnermelt 129 REAL(wp), POINTER, DIMENSION(:) :: zfbase, zdq_i 117 INTEGER :: num_iter_max 118 REAL(wp) :: zinda, zindq, zindh 119 REAL(wp), POINTER, DIMENSION(:) :: zintermelt ! debug 120 130 121 !!------------------------------------------------------------------ 131 122 132 CALL wrk_alloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 133 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 134 CALL wrk_alloc( jpij, zinnermelt, zfbase, zdq_i ) 135 CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay ) 136 137 CALL wrk_alloc( jpij, zviold, zvsold ) ! clem 123 ! Discriminate between varying salinity (num_sal=2) and prescribed cases (other values) 124 SELECT CASE( num_sal ) ! varying salinity or not 125 CASE( 1, 3, 4 ) ; zswitch_sal = 0 ! prescribed salinity profile 126 CASE( 2 ) ; zswitch_sal = 1 ! varying salinity profile 127 END SELECT 128 129 CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 130 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 131 CALL wrk_alloc( jpij, zintermelt ) 132 CALL wrk_alloc( jpij, jkmax, zdeltah, zh_i ) 133 CALL wrk_alloc( jpij, icount ) 138 134 139 ftotal_fin(:) = 0._wp 140 zfdt_init (:) = 0._wp 141 zfdt_final(:) = 0._wp 142 143 dh_i_surf (:) = 0._wp 144 dh_i_bott (:) = 0._wp 145 dh_snowice(:) = 0._wp 146 147 DO ji = kideb, kiut 148 old_ht_i_b(ji) = ht_i_b(ji) 149 old_ht_s_b(ji) = ht_s_b(ji) 150 zviold(ji) = a_i_b(ji) * ht_i_b(ji) ! clem 151 zvsold(ji) = a_i_b(ji) * ht_s_b(ji) ! clem 152 END DO 135 dh_i_surf (:) = 0._wp ; dh_i_bott (:) = 0._wp ; dh_snowice(:) = 0._wp 136 dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp 137 138 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt (:) = 0._wp 139 zq_1cat(:) = 0._wp ; zq_rema(:) = 0._wp 140 141 zh_s (:) = 0._wp 142 zdh_s_pre(:) = 0._wp 143 zdh_s_mel(:) = 0._wp 144 zdh_s_sub(:) = 0._wp 145 zqh_s (:) = 0._wp 146 zqh_i (:) = 0._wp 147 148 zh_i (:,:) = 0._wp 149 zdeltah (:,:) = 0._wp 150 zintermelt(:) = 0._wp 151 icount (:) = 0 152 153 ! initialize layer thicknesses and enthalpies 154 h_i_old (:,0:nlay_i+1) = 0._wp 155 qh_i_old(:,0:nlay_i+1) = 0._wp 156 DO jk = 1, nlay_i 157 DO ji = kideb, kiut 158 h_i_old (ji,jk) = ht_i_b(ji) / REAL( nlay_i ) 159 qh_i_old(ji,jk) = q_i_b(ji,jk) * h_i_old(ji,jk) 160 ENDDO 161 ENDDO 153 162 ! 154 163 !------------------------------------------------------------------------------! 155 ! 1) Calculate available heat for surface a blation!164 ! 1) Calculate available heat for surface and bottom ablation ! 156 165 !------------------------------------------------------------------------------! 157 166 ! 158 167 DO ji = kideb, kiut 159 isnow = INT( 1.0 - MAX( 0.0 , SIGN( 1.0 , - ht_s_b(ji) ) ) ) 160 ztfs (ji) = isnow * rtt + ( 1.0 - isnow ) * rtt 161 z_f_surf (ji) = qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 162 z_f_surf (ji) = MAX( zzero , z_f_surf(ji) ) * MAX( zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) ) ) 163 zfdt_init(ji) = ( z_f_surf(ji) + MAX( fbif_1d(ji) + qlbbq_1d(ji) + fc_bo_i(ji),0.0 ) ) * rdt_ice 164 END DO ! ji 165 166 zqfont_su (:) = 0._wp 167 zqfont_bo (:) = 0._wp 168 dsm_i_se_1d(:) = 0._wp 169 dsm_i_si_1d(:) = 0._wp 168 zinda = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) 169 ztmelts = zinda * rtt + ( 1._wp - zinda ) * rtt 170 171 zfdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 172 zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 173 174 zq_su (ji) = MAX( 0._wp, zfdum * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_b(ji) - ztmelts ) ) 175 zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 176 END DO 177 170 178 ! 171 179 !------------------------------------------------------------------------------! 172 ! 2) Computing layer thicknesses and snow and sea-ice enthalpies. ! 180 ! If snow temperature is above freezing point, then snow melts 181 ! (should not happen but sometimes it does) 173 182 !------------------------------------------------------------------------------! 174 ! 175 DO ji = kideb, kiut ! Layer thickness 176 zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 183 DO ji = kideb, kiut 184 IF( t_s_b(ji,1) > rtt ) THEN !!! Internal melting 185 ! Contribution to heat flux to the ocean [W.m-2], < 0 186 hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_b(ji,1) * ht_s_b(ji) * a_i_b(ji) * r1_rdtice 187 ! Contribution to mass flux 188 wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * ht_s_b(ji) * a_i_b(ji) * r1_rdtice 189 ! updates 190 ht_s_b(ji) = 0._wp 191 q_s_b (ji,1) = 0._wp 192 t_s_b (ji,1) = rtt 193 END IF 194 END DO 195 196 !------------------------------------------------------------! 197 ! 2) Computing layer thicknesses and enthalpies. ! 198 !------------------------------------------------------------! 199 ! 200 DO ji = kideb, kiut 177 201 zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 178 202 END DO 179 203 ! 180 zqt_s(:) = 0._wp ! Total enthalpy of the snow181 204 DO jk = 1, nlay_s 182 205 DO ji = kideb, kiut 183 zq t_s(ji) = zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s)206 zqh_s(ji) = zqh_s(ji) + q_s_b(ji,jk) * zh_s(ji) 184 207 END DO 185 208 END DO 186 209 ! 187 zqt_i(:) = 0._wp ! Total enthalpy of the ice188 210 DO jk = 1, nlay_i 189 211 DO ji = kideb, kiut 190 zzc = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 191 zqt_i(ji) = zqt_i(ji) + zzc 192 zqt_i_lay(ji,jk) = zzc 212 zh_i(ji,jk) = ht_i_b(ji) / REAL( nlay_i ) 213 zqh_i(ji) = zqh_i(ji) + q_i_b(ji,jk) * zh_i(ji,jk) 193 214 END DO 194 215 END DO … … 212 233 ! Martin Vancoppenolle, December 2006 213 234 214 ! Snow fall 215 DO ji = kideb, kiut 216 zcoeff = ( 1.0 - ( 1.0 - at_i_b(ji) )**betas ) / at_i_b(ji) 235 DO ji = kideb, kiut 236 !----------- 237 ! Snow fall 238 !----------- 239 ! thickness change 240 zcoeff = ( 1._wp - ( 1._wp - at_i_b(ji) )**betas ) / at_i_b(ji) 217 241 zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn 218 END DO 219 zdh_s_mel(:) = 0._wp 220 221 ! Melt of fallen snow 222 DO ji = kideb, kiut 223 ! tatm_ice is now in K 224 zqprec (ji) = rhosn * ( cpic * ( rtt - tatm_ice_1d(ji) ) + lfus ) 225 zqfont_su(ji) = z_f_surf(ji) * rdt_ice 226 zdeltah (ji,1) = MIN( 0.e0 , - zqfont_su(ji) / MAX( zqprec(ji) , epsi13 ) ) 227 zqfont_su(ji) = MAX( 0.e0 , - zdh_s_pre(ji) - zdeltah(ji,1) ) * zqprec(ji) 228 zdeltah (ji,1) = MAX( - zdh_s_pre(ji) , zdeltah(ji,1) ) 229 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,1) 230 ! heat conservation 231 qt_s_in(ji,jl) = qt_s_in(ji,jl) + zqprec(ji) * zdh_s_pre(ji) 232 zqt_s (ji) = zqt_s (ji) + zqprec(ji) * zdh_s_pre(ji) 233 zqt_s (ji) = MAX( zqt_s(ji) - zqfont_su(ji) , 0.e0 ) 234 END DO 235 236 237 ! Snow melt due to surface heat imbalance 242 ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K) 243 zqprec (ji) = rhosn * ( cpic * ( rtt - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus ) 244 IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp 245 ! heat flux from snow precip (>0, W.m-2) 246 hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_b(ji) * zqprec(ji) * r1_rdtice 247 ! mass flux, <0 248 wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_b(ji) * zdh_s_pre(ji) * r1_rdtice 249 ! update thickness 250 ht_s_b (ji) = MAX( 0._wp , ht_s_b(ji) + zdh_s_pre(ji) ) 251 252 !--------------------- 253 ! Melt of falling snow 254 !--------------------- 255 ! thickness change 256 IF( zdh_s_pre(ji) > 0._wp ) THEN 257 zindq = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zqprec(ji) + epsi20 ) ) 258 zdh_s_mel (ji) = - zindq * zq_su(ji) / MAX( zqprec(ji) , epsi20 ) 259 zdh_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting 260 ! heat used to melt snow (W.m-2, >0) 261 hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdh_s_mel(ji) * a_i_b(ji) * zqprec(ji) * r1_rdtice 262 ! snow melting only = water into the ocean (then without snow precip), >0 263 wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_b(ji) * zdh_s_mel(ji) * r1_rdtice 264 265 ! updates available heat + thickness 266 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) ) 267 ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdh_s_mel(ji) ) 268 zh_s (ji) = ht_s_b(ji) / REAL( nlay_s ) 269 270 ENDIF 271 END DO 272 273 ! If heat still available, then melt more snow 274 zdeltah(:,:) = 0._wp ! important 238 275 DO jk = 1, nlay_s 239 276 DO ji = kideb, kiut 240 zdeltah (ji,jk) = - zqfont_su(ji) / q_s_b(ji,jk) 241 zqfont_su(ji) = MAX( 0.0 , - zh_s(ji) - zdeltah(ji,jk) ) * q_s_b(ji,jk) 242 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) 243 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,jk) ! resulting melt of snow 277 ! thickness change 278 zindh = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_b(ji) ) ) 279 zindq = 1._wp - MAX( 0._wp, SIGN( 1._wp, - q_s_b(ji,jk) + epsi20 ) ) 280 zdeltah (ji,jk) = - zindh * zindq * zq_su(ji) / MAX( q_s_b(ji,jk), epsi20 ) 281 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting 282 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,jk) 283 ! heat used to melt snow(W.m-2, >0) 284 hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_b(ji) * q_s_b(ji,jk) * r1_rdtice 285 ! snow melting only = water into the ocean (then without snow precip) 286 wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 287 288 ! updates available heat + thickness 289 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_b(ji,jk) ) 290 ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdeltah(ji,jk) ) 291 244 292 END DO 245 293 END DO 246 294 247 ! Apply snow melt to snow depth 248 DO ji = kideb, kiut 249 dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) 250 ! Old and new snow depths 251 zhsold(ji) = ht_s_b(ji) 252 zhsnew = ht_s_b(ji) + dh_s_tot(ji) 253 ! If snow is still present zhn = 1, else zhn = 0 254 zhn = 1.0 - MAX( zzero , SIGN( zone , - zhsnew ) ) 255 ht_s_b(ji) = MAX( zzero , zhsnew ) 256 ! we recompute dh_s_tot (clem) 257 dh_s_tot (ji) = ht_s_b(ji) - zhsold(ji) 258 ! Volume and mass variations of snow 259 dvsbq_1d (ji) = a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_pre(ji) ) 260 dvsbq_1d (ji) = MIN( zzero, dvsbq_1d(ji) ) 261 !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + rhosn * dvsbq_1d(ji) 295 !---------------------- 296 ! 3.2 Snow sublimation 297 !---------------------- 298 ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 299 ! clem comment: not counted in mass exchange in limsbc since this is an exchange with atm. (not ocean) 300 ! clem comment: ice should also sublimate 301 IF( lk_cpl ) THEN 302 ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 303 zdh_s_sub(:) = 0._wp 304 ELSE 305 ! forced mode: snow thickness change due to sublimation 306 DO ji = kideb, kiut 307 zdh_s_sub(ji) = MAX( - ht_s_b(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 308 ! Heat flux by sublimation [W.m-2], < 0 309 ! sublimate first snow that had fallen, then pre-existing snow 310 zcoeff = ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) * zqprec(ji) + & 311 & ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_b(ji,1) ) & 312 & * a_i_b(ji) * r1_rdtice 313 hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff 314 ! Mass flux by sublimation 315 wfx_sub_1d(ji) = wfx_sub_1d(ji) - rhosn * a_i_b(ji) * zdh_s_sub(ji) * r1_rdtice 316 ! new snow thickness 317 ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdh_s_sub(ji) ) 318 END DO 319 ENDIF 320 321 ! --- Update snow diags --- ! 322 DO ji = kideb, kiut 323 dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 324 zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 262 325 END DO ! ji 263 326 327 !------------------------------------------- 328 ! 3.3 Update temperature, energy 329 !------------------------------------------- 330 ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 331 zq_s(:) = 0._wp 332 DO jk = 1, nlay_s 333 DO ji = kideb,kiut 334 zindh = MAX( 0._wp , SIGN( 1._wp, - ht_s_b(ji) + epsi20 ) ) 335 q_s_b(ji,jk) = ( 1._wp - zindh ) / MAX( ht_s_b(ji), epsi20 ) * & 336 & ( ( MAX( 0._wp, dh_s_tot(ji) ) ) * zqprec(ji) + & 337 & ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_b(ji) ) * rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) ) 338 zq_s(ji) = zq_s(ji) + q_s_b(ji,jk) 339 END DO 340 END DO 341 264 342 !-------------------------- 265 ! 3. 2Surface ice ablation343 ! 3.4 Surface ice ablation 266 344 !-------------------------- 267 DO ji = kideb, kiut 268 z_f_surf (ji) = zqfont_su(ji) * r1_rdtice ! heat conservation test 269 zdq_i (ji) = 0._wp 270 END DO ! ji 271 345 zdeltah(:,:) = 0._wp ! important 272 346 DO jk = 1, nlay_i 273 347 DO ji = kideb, kiut 274 ! ! melt of layer jk 275 zdeltah (ji,jk) = - zqfont_su(ji) / q_i_b(ji,jk) 276 ! ! recompute heat available 277 zqfont_su(ji ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 278 ! ! melt of layer jk cannot be higher than its thickness 279 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_i(ji) ) 280 ! ! update surface melt 281 dh_i_surf(ji ) = dh_i_surf(ji) + zdeltah(ji,jk) 282 ! ! for energy conservation 283 zdq_i (ji ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 284 ! 285 ! clem 286 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) & 287 & * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic / rdt_ice 348 zEi = - q_i_b(ji,jk) / rhoic ! Specific enthalpy of layer k [J/kg, <0] 349 350 ztmelts = - tmut * s_i_b(ji,jk) + rtt ! Melting point of layer k [K] 351 352 zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of resulting meltwater [J/kg, <0] 353 354 zdE = zEi - zEw ! Specific enthalpy difference < 0 355 356 zfmdt = - zq_su(ji) / zdE ! Mass flux to the ocean [kg/m2, >0] 357 358 zdeltah(ji,jk) = - zfmdt / rhoic ! Melt of layer jk [m, <0] 359 360 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) ) ! Melt of layer jk cannot exceed the layer thickness [m, <0] 361 362 zq_su(ji) = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 363 364 dh_i_surf(ji) = dh_i_surf(ji) + zdeltah(ji,jk) ! Cumulate surface melt 365 366 zfmdt = - rhoic * zdeltah(ji,jk) ! Recompute mass flux [kg/m2, >0] 367 368 zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0] 369 370 ! Contribution to salt flux (clem: using sm_i_b and not s_i_b(jk) is ok) 371 sfx_sum_1d(ji) = sfx_sum_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 372 373 ! Contribution to heat flux [W.m-2], < 0 374 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 375 376 ! Total heat flux used in this process [W.m-2], > 0 377 hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice 378 379 ! Contribution to mass flux 380 wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 381 382 ! record which layers have disappeared (for bottom melting) 383 ! => icount=0 : no layer has vanished 384 ! => icount=5 : 5 layers have vanished 385 zindh = NINT( MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) ) 386 icount(ji) = icount(ji) + zindh 387 zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 388 389 ! update heat content (J.m-2) and layer thickness 390 qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk) 391 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 288 392 END DO 289 393 END DO 290 291 ! !------------------- 292 IF( con_i .AND. jiindex_1d > 0 ) THEN ! Conservation test 293 ! !------------------- 294 numce_dh = 0 295 meance_dh = 0._wp 296 DO ji = kideb, kiut 297 IF ( ( z_f_surf(ji) + zdq_i(ji) ) .GE. 1.0e-3 ) THEN 298 numce_dh = numce_dh + 1 299 meance_dh = meance_dh + z_f_surf(ji) + zdq_i(ji) 300 ENDIF 301 IF( z_f_surf(ji) + zdq_i(ji) .GE. 1.0e-3 ) THEN! 302 WRITE(numout,*) ' ALERTE heat loss for surface melt ' 303 WRITE(numout,*) ' ii, ij, jl :', ii, ij, jl 304 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 305 WRITE(numout,*) ' z_f_surf : ', z_f_surf(ji) 306 WRITE(numout,*) ' zdq_i : ', zdq_i(ji) 307 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 308 WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji) 309 WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji) 310 WRITE(numout,*) ' qlbbq_1d : ', qlbbq_1d(ji) 311 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 312 WRITE(numout,*) ' sss_m : ', sss_m(ii,ij) 313 ENDIF 314 END DO 315 ! 316 IF( numce_dh > 0 ) meance_dh = meance_dh / numce_dh 317 WRITE(numout,*) ' Error report - Category : ', jl 318 WRITE(numout,*) ' ~~~~~~~~~~~~ ' 319 WRITE(numout,*) ' Number of points where there is sur. me. error : ', numce_dh 320 WRITE(numout,*) ' Mean basal growth error on error points : ', meance_dh 321 ! 322 ENDIF 323 324 !---------------------- 325 ! 3.3 Snow sublimation 326 !---------------------- 327 328 DO ji = kideb, kiut 329 ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 330 #if defined key_coupled 331 zdh_s_sub(ji) = 0._wp ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 332 #else 333 ! ! forced mode: snow thickness change due to sublimation 334 zdh_s_sub(ji) = - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice 335 #endif 336 dh_s_tot (ji) = dh_s_tot(ji) + zdh_s_sub(ji) 337 zdhcf = ht_s_b(ji) + zdh_s_sub(ji) 338 ht_s_b (ji) = MAX( zzero , zdhcf ) 339 ! we recompute dh_s_tot 340 dh_s_tot (ji) = ht_s_b(ji) - zhsold(ji) 341 qt_s_in (ji,jl) = qt_s_in(ji,jl) + zdh_s_sub(ji)*q_s_b(ji,1) 342 END DO 343 344 zqt_dummy(:) = 0.e0 345 DO jk = 1, nlay_s 346 DO ji = kideb,kiut 347 q_s_b (ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 348 zqt_dummy(ji) = zqt_dummy(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s ) ! heat conservation 349 END DO 350 END DO 351 352 DO jk = 1, nlay_s 353 DO ji = kideb, kiut 354 ! In case of disparition of the snow, we have to update the snow temperatures 355 zhisn = MAX( zzero , SIGN( zone, - ht_s_b(ji) ) ) 356 t_s_b(ji,jk) = ( 1.0 - zhisn ) * t_s_b(ji,jk) + zhisn * rtt 357 q_s_b(ji,jk) = ( 1.0 - zhisn ) * q_s_b(ji,jk) 358 END DO 394 ! update ice thickness 395 DO ji = kideb, kiut 396 ht_i_b(ji) = MAX( 0._wp , ht_i_b(ji) + dh_i_surf(ji) ) 359 397 END DO 360 398 … … 364 402 !------------------------------------------------------------------------------! 365 403 ! 366 ! Ice basal growth / melt is given by the ratio of heat budget over basal 367 ! ice heat content. Basal heat budget is given by the difference between 368 ! the inner conductive flux (fc_bo_i), from the open water heat flux 369 ! (qlbbqb) and the turbulent ocean flux (fbif). 370 ! fc_bo_i is positive downwards. fbif and qlbbq are positive to the ice 371 372 !----------------------------------------------------- 373 ! 4.1 Basal growth - (a) salinity not varying in time 374 !----------------------------------------------------- 375 IF( num_sal /= 2 ) THEN ! ice salinity constant in time 404 !------------------ 405 ! 4.1 Basal growth 406 !------------------ 407 ! Basal growth is driven by heat imbalance at the ice-ocean interface, 408 ! between the inner conductive flux (fc_bo_i), from the open water heat flux 409 ! (fhld) and the turbulent ocean flux (fhtur). 410 ! fc_bo_i is positive downwards. fhtur and fhld are positive to the ice 411 412 ! If salinity varies in time, an iterative procedure is required, because 413 ! the involved quantities are inter-dependent. 414 ! Basal growth (dh_i_bott) depends upon new ice specific enthalpy (zEi), 415 ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bott) 416 ! -> need for an iterative procedure, which converges quickly 417 418 IF ( num_sal == 2 ) THEN 419 num_iter_max = 5 420 ELSE 421 num_iter_max = 1 422 ENDIF 423 424 !clem debug. Just to be sure that enthalpy at nlay_i+1 is null 425 DO ji = kideb, kiut 426 q_i_b(ji,nlay_i+1) = 0._wp 427 END DO 428 429 ! Iterative procedure 430 DO iter = 1, num_iter_max 376 431 DO ji = kideb, kiut 377 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) < 0._wp ) THEN 378 s_i_new(ji) = sm_i_b(ji) 379 ! Melting point in K 380 ztmelts = - tmut * s_i_new(ji) + rtt 381 ! New ice heat content (Bitz and Lipscomb, 1999) 382 ztform = t_i_b(ji,nlay_i) ! t_bo_b crashes in the 383 ! Baltic 384 q_i_b(ji,nlay_i+1) = rhoic * ( cpic * ( ztmelts - ztform ) & 385 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( ztform - rtt ) ) & 386 & - rcp * ( ztmelts - rtt ) ) 387 ! Basal growth rate = - F*dt / q 388 dh_i_bott(ji) = - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 389 sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 390 ENDIF 391 END DO 392 ENDIF 393 394 !------------------------------------------------- 395 ! 4.1 Basal growth - (b) salinity varying in time 396 !------------------------------------------------- 397 IF( num_sal == 2 ) THEN 398 ! the growth rate (dh_i_bott) is function of the new ice heat content (q_i_b(nlay_i+1)). 399 ! q_i_b depends on the new ice salinity (snewice). 400 ! snewice depends on dh_i_bott ; it converges quickly, so, no problem 401 ! See Vancoppenolle et al., OM08 for more info on this 402 403 ! Initial value (tested 1D, can be anything between 1 and 20) 404 num_iter_max = 4 405 s_i_new(:) = 4.0 406 407 ! Iterative procedure 408 DO iter = 1, num_iter_max 409 DO ji = kideb, kiut 410 IF( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) < 0.e0 ) THEN 411 ii = MOD( npb(ji) - 1, jpi ) + 1 412 ij = ( npb(ji) - 1 ) / jpi + 1 413 ! Melting point in K 414 ztmelts = - tmut * s_i_new(ji) + rtt 415 ! New ice heat content (Bitz and Lipscomb, 1999) 416 q_i_b(ji,nlay_i+1) = rhoic * ( cpic * ( ztmelts - t_bo_b(ji) ) & 417 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) ) & 418 & - rcp * ( ztmelts-rtt ) ) 419 ! Bottom growth rate = - F*dt / q 420 dh_i_bott(ji) = - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 421 ! New ice salinity ( Cox and Weeks, JGR, 1988 ) 422 ! zswi2 (1) if dh_i_bott/rdt .GT. 3.6e-7 423 ! zswi12 (1) if dh_i_bott/rdt .LT. 3.6e-7 and .GT. 2.0e-8 424 ! zswi1 (1) if dh_i_bott/rdt .LT. 2.0e-8 425 zgrr = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi13 ) ) 426 zswi2 = MAX( zzero , SIGN( zone , zgrr - 3.6e-7 ) ) 427 zswi12 = MAX( zzero , SIGN( zone , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 428 zswi1 = 1. - zswi2 * zswi12 429 zfracs = zswi1 * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) ) & 430 & + zswi2 * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) ) 431 zfracs = MIN( 0.5 , zfracs ) 432 s_i_new(ji) = zfracs * sss_m(ii,ij) 433 ENDIF ! fc_bo_i 434 END DO ! ji 435 END DO ! iter 436 437 ! Final values 438 DO ji = kideb, kiut 439 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .LT. 0.0 ) THEN 440 ! New ice salinity must not exceed 20 psu 441 s_i_new(ji) = MIN( s_i_new(ji), s_i_max ) 442 ! Metling point in K 443 ztmelts = - tmut * s_i_new(ji) + rtt 444 ! New ice heat content (Bitz and Lipscomb, 1999) 445 q_i_b(ji,nlay_i+1) = rhoic * ( cpic * ( ztmelts - t_bo_b(ji) ) & 446 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) ) & 447 & - rcp * ( ztmelts - rtt ) ) 448 ! Basal growth rate = - F*dt / q 449 dh_i_bott(ji) = - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 450 ! Salinity update 451 ! entrapment during bottom growth 452 sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 453 ENDIF ! heat budget 454 END DO 455 ENDIF 432 IF( zf_tt(ji) < 0._wp ) THEN 433 434 ! New bottom ice salinity (Cox & Weeks, JGR88 ) 435 !--- zswi1 if dh/dt < 2.0e-8 436 !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 437 !--- zswi2 if dh/dt > 3.6e-7 438 zgrr = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi10 ) ) 439 zswi2 = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) ) 440 zswi12 = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 441 zswi1 = 1. - zswi2 * zswi12 442 zfracs = MIN ( zswi1 * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) ) & 443 & + zswi2 * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) ) , 0.5 ) 444 445 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 446 447 s_i_new(ji) = zswitch_sal * zfracs * sss_m(ii,ij) & ! New ice salinity 448 + ( 1. - zswitch_sal ) * sm_i_b(ji) 449 ! New ice growth 450 ztmelts = - tmut * s_i_new(ji) + rtt ! New ice melting point (K) 451 452 zt_i_new = zswitch_sal * t_bo_b(ji) + ( 1. - zswitch_sal) * t_i_b(ji, nlay_i) 453 454 zEi = cpic * ( zt_i_new - ztmelts ) & ! Specific enthalpy of forming ice (J/kg, <0) 455 & - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) ) & 456 & + rcp * ( ztmelts-rtt ) 457 458 zEw = rcp * ( t_bo_b(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) 459 460 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 461 462 dh_i_bott(ji) = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoic ) ) 463 464 q_i_b(ji,nlay_i+1) = -zEi * rhoic ! New ice energy of melting (J/m3, >0) 465 466 ENDIF ! fc_bo_i 467 END DO ! ji 468 END DO ! iter 469 470 ! Contribution to Energy and Salt Fluxes 471 DO ji = kideb, kiut 472 IF( zf_tt(ji) < 0._wp ) THEN 473 ! New ice growth 474 475 zfmdt = - rhoic * dh_i_bott(ji) ! Mass flux x time step (kg/m2, < 0) 476 477 ztmelts = - tmut * s_i_new(ji) + rtt ! New ice melting point (K) 478 479 zt_i_new = zswitch_sal * t_bo_b(ji) + ( 1. - zswitch_sal) * t_i_b(ji, nlay_i) 480 481 zEi = cpic * ( zt_i_new - ztmelts ) & ! Specific enthalpy of forming ice (J/kg, <0) 482 & - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) ) & 483 & + rcp * ( ztmelts-rtt ) 484 485 zEw = rcp * ( t_bo_b(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) 486 487 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 488 489 ! Contribution to heat flux to the ocean [W.m-2], >0 490 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 491 492 ! Total heat flux used in this process [W.m-2], <0 493 hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice 494 495 ! Contribution to salt flux, <0 496 sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_b(ji) * zfmdt * r1_rdtice 497 498 ! Contribution to mass flux, <0 499 wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoic * a_i_b(ji) * dh_i_bott(ji) * r1_rdtice 500 501 ! update heat content (J.m-2) and layer thickness 502 qh_i_old(ji,nlay_i+1) = qh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * q_i_b(ji,nlay_i+1) 503 h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bott(ji) 504 ENDIF 505 END DO 456 506 457 507 !---------------- 458 508 ! 4.2 Basal melt 459 509 !---------------- 460 meance_dh = 0._wp 461 numce_dh = 0 462 zinnermelt(:) = 0._wp 463 464 DO ji = kideb, kiut 465 ! heat convergence at the surface > 0 466 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0._wp ) THEN 467 s_i_new(ji) = s_i_b(ji,nlay_i) 468 zqfont_bo(ji) = rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) 469 zfbase(ji) = zqfont_bo(ji) * r1_rdtice ! heat conservation test 470 zdq_i(ji) = 0._wp 471 dh_i_bott(ji) = 0._wp 472 ENDIF 473 END DO 474 510 zdeltah(:,:) = 0._wp ! important 475 511 DO jk = nlay_i, 1, -1 476 512 DO ji = kideb, kiut 477 IF( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) >= 0._wp ) THEN 478 ztmelts = - tmut * s_i_b(ji,jk) + rtt 479 IF( t_i_b(ji,jk) >= ztmelts ) THEN !!gm : a comment is needed 480 zdeltah (ji,jk) = - zh_i(ji) 481 dh_i_bott (ji ) = dh_i_bott(ji) + zdeltah(ji,jk) 482 zinnermelt(ji ) = 1._wp 483 ELSE ! normal ablation 484 zdeltah (ji,jk) = - zqfont_bo(ji) / q_i_b(ji,jk) 485 zqfont_bo(ji ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 486 zdeltah (ji,jk) = MAX(zdeltah(ji,jk), - zh_i(ji) ) 487 dh_i_bott(ji ) = dh_i_bott(ji) + zdeltah(ji,jk) 488 zdq_i (ji ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 513 IF( zf_tt(ji) >= 0._wp .AND. jk > icount(ji) ) THEN ! do not calculate where layer has already disappeared from surface melting 514 515 ztmelts = - tmut * s_i_b(ji,jk) + rtt ! Melting point of layer jk (K) 516 517 IF( t_i_b(ji,jk) >= ztmelts ) THEN !!! Internal melting 518 zintermelt(ji) = 1._wp 519 520 zEi = - q_i_b(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0) 521 522 !!zEw = rcp * ( t_i_b(ji,jk) - rtt ) ! Specific enthalpy of meltwater at T = t_i_b (J/kg, <0) 523 524 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) 525 ! set up at 0 since no energy is needed to melt water...(it is already melted) 526 527 zdeltah (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing 528 ! this should normally not happen, but sometimes, heat diffusion leads to this 529 530 dh_i_bott (ji) = dh_i_bott(ji) + zdeltah(ji,jk) 531 532 zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0 533 534 ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 535 hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_b(ji) * zEi * r1_rdtice 536 537 ! Contribution to salt flux (clem: using sm_i_b and not s_i_b(jk) is ok) 538 sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 539 540 ! Contribution to mass flux 541 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 542 543 ! update heat content (J.m-2) and layer thickness 544 qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk) 545 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 546 547 ELSE !!! Basal melting 548 549 zEi = - q_i_b(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0) 550 551 zEw = rcp * ( ztmelts - rtt )! Specific enthalpy of meltwater (J/kg, <0) 552 553 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 554 555 zfmdt = - zq_bo(ji) / zdE ! Mass flux x time step (kg/m2, >0) 556 557 zdeltah(ji,jk) = - zfmdt / rhoic ! Gross thickness change 558 559 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 560 561 zq_bo(ji) = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors 562 563 dh_i_bott(ji) = dh_i_bott(ji) + zdeltah(ji,jk) ! Update basal melt 564 565 zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0 566 567 zQm = zfmdt * zEw ! Heat exchanged with ocean 568 569 ! Contribution to heat flux to the ocean [W.m-2], <0 570 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 571 572 ! Contribution to salt flux (clem: using sm_i_b and not s_i_b(jk) is ok) 573 sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 574 575 ! Total heat flux used in this process [W.m-2], >0 576 hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice 577 578 ! Contribution to mass flux 579 wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice 580 581 ! update heat content (J.m-2) and layer thickness 582 qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk) 583 h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 489 584 ENDIF 490 ! clem: contribution to salt flux 491 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) & 492 & * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice 585 493 586 ENDIF 494 587 END DO ! ji 495 588 END DO ! jk 496 589 497 ! !-------------------498 IF( con_i .AND. jiindex_1d > 0 ) THEN ! Conservation test499 ! !-------------------500 DO ji = kideb, kiut501 IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0.e0 ) THEN502 IF( ( zfbase(ji) + zdq_i(ji) ) >= 1.e-3 ) THEN503 numce_dh = numce_dh + 1504 meance_dh = meance_dh + zfbase(ji) + zdq_i(ji)505 ENDIF506 IF ( zfbase(ji) + zdq_i(ji) .GE. 1.0e-3 ) THEN507 WRITE(numout,*) ' ALERTE heat loss for basal melt : ii, ij, jl :', ii, ij, jl508 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji)509 WRITE(numout,*) ' zfbase : ', zfbase(ji)510 WRITE(numout,*) ' zdq_i : ', zdq_i(ji)511 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji)512 WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji)513 WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji)514 WRITE(numout,*) ' qlbbq_1d : ', qlbbq_1d(ji)515 WRITE(numout,*) ' s_i_new : ', s_i_new(ji)516 WRITE(numout,*) ' sss_m : ', sss_m(ii,ij)517 WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji)518 WRITE(numout,*) ' innermelt : ', INT( zinnermelt(ji) )519 ENDIF520 ENDIF521 END DO522 IF( numce_dh > 0 ) meance_dh = meance_dh / numce_dh523 WRITE(numout,*) ' Number of points where there is bas. me. error : ', numce_dh524 WRITE(numout,*) ' Mean basal melt error on error points : ', meance_dh525 WRITE(numout,*) ' Remaining bottom heat : ', zqfont_bo(jiindex_1d)526 !527 ENDIF528 529 !530 590 !------------------------------------------------------------------------------! 531 ! 5) Pathological cases ! 591 ! Excessive ablation in a 1-category model 592 ! in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 532 593 !------------------------------------------------------------------------------! 533 ! 534 !---------------------------------------------- 535 ! 5.1 Excessive ablation in a 1-category model 536 !---------------------------------------------- 537 538 DO ji = kideb, kiut 539 ! ! in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 540 IF( jpl == 1 ) THEN ; zdhbf = MAX( hmelt , dh_i_bott(ji) ) 541 ELSE ; zdhbf = dh_i_bott(ji) 542 ENDIF 543 zdvres = zdhbf - dh_i_bott(ji) 544 dh_i_bott(ji) = zdhbf 545 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic * r1_rdtice 546 ! ! excessive energy is sent to lateral ablation 547 zinda = MAX( 0._wp, SIGN( 1._wp , 1.0 - at_i_b(ji) - epsi10 ) ) 548 fsup(ji) = zinda * rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi10 ) * zdvres * r1_rdtice 549 END DO 550 551 !----------------------------------- 552 ! 5.2 More than available ice melts 553 !----------------------------------- 554 ! then heat applied minus heat content at previous time step should equal heat remaining 555 ! 556 DO ji = kideb, kiut 557 ! Adapt the remaining energy if too much ice melts 558 !-------------------------------------------------- 559 zdvres = MAX( 0._wp, - ht_i_b(ji) - dh_i_surf(ji) - dh_i_bott(ji) ) 560 zdvsur = MIN( 0._wp, dh_i_surf(ji) + zdvres ) - dh_i_surf(ji) ! fill the surface first 561 zdvbot = MAX( 0._wp, zdvres - zdvsur ) ! then the bottom 562 dh_i_surf (ji) = dh_i_surf(ji) + zdvsur ! clem 563 dh_i_bott (ji) = dh_i_bott(ji) + zdvbot ! clem 564 565 ! new ice thickness (clem) 566 zhgnew(ji) = ht_i_b(ji) + dh_i_surf(ji) + dh_i_bott(ji) 567 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) !1 if ice 568 zhgnew(ji) = zihgnew * zhgnew(ji) ! ice thickness is put to 0 569 570 ! !since ice volume is only used for outputs, we keep it global for all categories 571 dvbbq_1d (ji) = a_i_b(ji) * dh_i_bott(ji) 572 573 ! remaining heat 574 zfdt_final(ji) = ( 1.0 - zihgnew ) * ( zqfont_su(ji) + zqfont_bo(ji) ) 575 576 ! If snow remains, energy is used to melt snow 577 zhni = ht_s_b(ji) ! snow depth at previous time step 578 zihg = MAX( zzero , SIGN ( zone , - ht_s_b(ji) ) ) ! =0 if snow 579 580 ! energy of melting of remaining snow 581 zinda = MAX( 0._wp, SIGN( 1._wp , zhni - epsi10 ) ) 582 zqt_s(ji) = ( 1. - zihg ) * zqt_s(ji) / MAX( zhni, epsi10 ) * zinda 583 zdhnm = - ( 1. - zihg ) * ( 1. - zihgnew ) * zfdt_final(ji) / MAX( zqt_s(ji) , epsi13 ) 584 zhnfi = zhni + zdhnm 585 zfdt_final(ji) = MAX( zfdt_final(ji) + zqt_s(ji) * zdhnm , 0.0 ) 586 ht_s_b(ji) = MAX( zzero , zhnfi ) 587 zqt_s(ji) = zqt_s(ji) * ht_s_b(ji) 588 ! we recompute dh_s_tot (clem) 589 dh_s_tot (ji) = ht_s_b(ji) - zhsold(ji) 590 591 ! Mass variations of ice and snow 592 !--------------------------------- 593 ! ! mass variation of the jl category 594 zzfmass_s = - a_i_b(ji) * ( zhni - ht_s_b(ji) ) * rhosn ! snow 595 zzfmass_i = a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic ! ice 596 ! 597 zfmass_i(ji) = zzfmass_i ! ice variation saved to compute salt flux (see below) 598 ! 599 ! ! mass variation cumulated over category 600 !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + zzfmass_s ! snow 601 !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + zzfmass_i ! ice 602 603 ! Remaining heat to the ocean 604 !--------------------------------- 605 focea(ji) = - zfdt_final(ji) * r1_rdtice ! focea is in W.m-2 * dt 606 607 ! residual salt flux (clem) 608 !-------------------------- 609 ! surface 610 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvsur * rhoic * r1_rdtice 611 ! bottom 612 IF ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) >= 0._wp ) THEN ! melting 613 sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 614 ELSE ! growth 615 sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 616 ENDIF 617 ! 618 ! diagnostic 619 ii = MOD( npb(ji) - 1, jpi ) + 1 620 ij = ( npb(ji) - 1 ) / jpi + 1 621 diag_bot_gr(ii,ij) = diag_bot_gr(ii,ij) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 622 diag_sur_me(ii,ij) = diag_sur_me(ii,ij) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) * r1_rdtice 623 diag_bot_me(ii,ij) = diag_bot_me(ii,ij) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 624 END DO 625 626 ftotal_fin (:) = zfdt_final(:) * r1_rdtice 627 628 !--------------------------- 629 ! heat fluxes 630 !--------------------------- 631 DO ji = kideb, kiut 632 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) ! =1 if ice 633 ! 634 ! Heat flux 635 ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 636 ! excessive total ablation energy (focea) sent to the ocean 637 qfvbq_1d(ji) = qfvbq_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji) * a_i_b(ji) * rdt_ice 638 639 zihic = 1.0 - MAX( zzero , SIGN( zone , -ht_i_b(ji) ) ) ! equals 0 if ht_i = 0, 1 if ht_i gt 0 640 fscbq_1d(ji) = a_i_b(ji) * fstbif_1d(ji) 641 qldif_1d(ji) = qldif_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea (ji) * a_i_b(ji) * rdt_ice & 642 & + ( 1.0 - zihic ) * fscbq_1d(ji) * rdt_ice 643 END DO ! ji 644 645 !------------------------------------------- 646 ! Correct temperature, energy and thickness 647 !------------------------------------------- 648 DO ji = kideb, kiut 649 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) 650 t_su_b(ji) = zihgnew * t_su_b(ji) + ( 1.0 - zihgnew ) * rtt 651 END DO ! ji 652 653 DO jk = 1, nlay_i 654 DO ji = kideb, kiut 655 zihgnew = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) 656 t_i_b(ji,jk) = zihgnew * t_i_b(ji,jk) + ( 1.0 - zihgnew ) * rtt 657 q_i_b(ji,jk) = zihgnew * q_i_b(ji,jk) 658 END DO 659 END DO ! ji 660 661 DO ji = kideb, kiut 662 ht_i_b(ji) = zhgnew(ji) 663 END DO ! ji 594 ! ??? keep ??? 595 ! clem bug: I think this should be included above, so we would not have to 596 ! track heat/salt/mass fluxes backwards 597 ! IF( jpl == 1 ) THEN 598 ! DO ji = kideb, kiut 599 ! IF( zf_tt(ji) >= 0._wp ) THEN 600 ! zdh = MAX( hmelt , dh_i_bott(ji) ) 601 ! zdvres = zdh - dh_i_bott(ji) ! >=0 602 ! dh_i_bott(ji) = zdh 603 ! 604 ! ! excessive energy is sent to lateral ablation 605 ! zinda = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_b(ji) - epsi20 ) ) 606 ! zq_1cat(ji) = zinda * rhoic * lfus * at_i_b(ji) / MAX( 1._wp - at_i_b(ji) , epsi20 ) * zdvres ! J.m-2 >=0 607 ! 608 ! ! correct salt and mass fluxes 609 ! sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic * r1_rdtice ! this is only a raw approximation 610 ! wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_b(ji) * zdvres * r1_rdtice 611 ! ENDIF 612 ! END DO 613 ! ENDIF 614 615 !------------------------------------------- 616 ! Update temperature, energy 617 !------------------------------------------- 618 DO ji = kideb, kiut 619 ht_i_b(ji) = MAX( 0._wp , ht_i_b(ji) + dh_i_bott(ji) ) 620 END DO 621 622 !------------------------------------------- 623 ! 5. What to do with remaining energy 624 !------------------------------------------- 625 ! If heat still available for melting and snow remains, then melt more snow 626 !------------------------------------------- 627 zdeltah(:,:) = 0._wp ! important 628 DO ji = kideb, kiut 629 zq_rema(ji) = zq_su(ji) + zq_bo(ji) 630 ! zindh = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_b(ji) ) ) ! =1 if snow 631 ! zindq = 1._wp - MAX( 0._wp, SIGN( 1._wp, - zq_s(ji) + epsi20 ) ) 632 ! zdeltah (ji,1) = - zindh * zindq * zq_rema(ji) / MAX( zq_s(ji), epsi20 ) 633 ! zdeltah (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_b(ji) ) ) ! bound melting 634 ! zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,1) 635 ! dh_s_tot (ji) = dh_s_tot(ji) + zdeltah(ji,1) 636 ! ht_s_b (ji) = ht_s_b(ji) + zdeltah(ji,1) 637 ! 638 ! zq_rema(ji) = zq_rema(ji) + zdeltah(ji,1) * zq_s(ji) ! update available heat (J.m-2) 639 ! ! heat used to melt snow 640 ! hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_b(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (>0) 641 ! ! Contribution to mass flux 642 ! wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_b(ji) * zdeltah(ji,1) * r1_rdtice 643 ! 644 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 645 ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 646 hfx_out(ii,ij) = hfx_out(ii,ij) + ( zq_1cat(ji) + zq_rema(ji) * a_i_b(ji) ) * r1_rdtice 647 648 IF( ln_nicep .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 649 END DO 650 664 651 ! 665 652 !------------------------------------------------------------------------------| … … 670 657 DO ji = kideb, kiut 671 658 ! 672 dh_snowice(ji) = MAX( zzero , ( rhosn * ht_s_b(ji) + (rhoic-rau0) * ht_i_b(ji) ) / ( rhosn+rau0-rhoic ) ) 673 zhgnew(ji) = MAX( zhgnew(ji) , zhgnew(ji) + dh_snowice(ji) ) 674 zhnnew = MIN( ht_s_b(ji) , ht_s_b(ji) - dh_snowice(ji) ) 675 676 ! Changes in ice volume and ice mass. 677 dvnbq_1d (ji) = a_i_b(ji) * ( zhgnew(ji)-ht_i_b(ji) ) 678 dmgwi_1d (ji) = dmgwi_1d(ji) + a_i_b(ji) * ( ht_s_b(ji) - zhnnew ) * rhosn 679 680 !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic 681 !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + a_i_b(ji) * ( zhnnew - ht_s_b(ji) ) * rhosn 682 683 ! Equivalent salt flux (1) Snow-ice formation component 684 ! ----------------------------------------------------- 685 ii = MOD( npb(ji) - 1, jpi ) + 1 686 ij = ( npb(ji) - 1 ) / jpi + 1 687 688 IF( num_sal == 2 ) THEN ; zsm_snowice = sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic 689 ELSE ; zsm_snowice = sm_i_b(ji) 690 ENDIF 659 dh_snowice(ji) = MAX( 0._wp , ( rhosn * ht_s_b(ji) + (rhoic-rau0) * ht_i_b(ji) ) / ( rhosn+rau0-rhoic ) ) 660 661 ht_i_b(ji) = ht_i_b(ji) + dh_snowice(ji) 662 ht_s_b(ji) = ht_s_b(ji) - dh_snowice(ji) 663 664 ! Salinity of snow ice 665 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 666 zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic + ( 1. - zswitch_sal ) * sm_i_b(ji) 667 691 668 ! entrapment during snow ice formation 692 ! clem:new salinity difference stored (to be used in limthd_ent.F90)669 ! new salinity difference stored (to be used in limthd_ent.F90) 693 670 IF ( num_sal == 2 ) THEN 694 i_ice_switch = MAX( 0._wp , SIGN( 1._wp , zhgnew(ji) - epsi10 ) )671 zswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_b(ji) - epsi10 ) ) 695 672 ! salinity dif due to snow-ice formation 696 dsm_i_si_1d(ji) = ( zs m_snowice - sm_i_b(ji) ) * dh_snowice(ji) / MAX( zhgnew(ji), epsi10 ) * i_ice_switch673 dsm_i_si_1d(ji) = ( zs_snic - sm_i_b(ji) ) * dh_snowice(ji) / MAX( ht_i_b(ji), epsi10 ) * zswitch 697 674 ! salinity dif due to bottom growth 698 IF ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) < 0._wp ) THEN699 dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_b(ji) ) * dh_i_bott(ji) / MAX( zhgnew(ji), epsi10 ) * i_ice_switch675 IF ( zf_tt(ji) < 0._wp ) THEN 676 dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_b(ji) ) * dh_i_bott(ji) / MAX( ht_i_b(ji), epsi10 ) * zswitch 700 677 ENDIF 701 678 ENDIF 702 679 703 ! Actualize new snow and ice thickness. 704 ht_s_b(ji) = zhnnew 705 ht_i_b(ji) = zhgnew(ji) 706 707 ! Total ablation ! new lines added to debug 680 ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 681 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 682 zfmdt = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp ) ! <0 683 zsstK = sst_m(ii,ij) + rt0 684 zEw = rcp * ( zsstK - rt0 ) 685 zQm = zfmdt * zEw 686 687 ! Contribution to heat flux 688 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 689 690 ! Contribution to salt flux 691 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_b(ji) * zfmdt * r1_rdtice 692 693 ! Contribution to mass flux 694 ! All snow is thrown in the ocean, and seawater is taken to replace the volume 695 wfx_sni_1d(ji) = wfx_sni_1d(ji) - a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice 696 wfx_snw_1d(ji) = wfx_snw_1d(ji) + a_i_b(ji) * dh_snowice(ji) * rhosn * r1_rdtice 697 698 ! update heat content (J.m-2) and layer thickness 699 qh_i_old(ji,0) = qh_i_old(ji,0) + dh_snowice(ji) * q_s_b(ji,1) + zfmdt * zEw 700 h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji) 701 702 ! Total ablation (to debug) 708 703 IF( ht_i_b(ji) <= 0._wp ) a_i_b(ji) = 0._wp 709 704 710 ! diagnostic ( snow ice growth )711 ii = MOD( npb(ji) - 1, jpi ) + 1712 ij = ( npb(ji) - 1 ) / jpi + 1713 diag_sni_gr(ii,ij) = diag_sni_gr(ii,ij) + dh_snowice(ji)*a_i_b(ji) * r1_rdtice714 !715 ! salt flux716 sfx_thd_1d(ji) = sfx_thd_1d(ji) - zsm_snowice * a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice717 !--------------------------------718 ! Update mass fluxes (clem)719 !--------------------------------720 rdm_ice_1d(ji) = rdm_ice_1d(ji) + ( a_i_b(ji) * ht_i_b(ji) - zviold(ji) ) * rhoic721 rdm_snw_1d(ji) = rdm_snw_1d(ji) + ( a_i_b(ji) * ht_s_b(ji) - zvsold(ji) ) * rhosn722 723 705 END DO !ji 724 ! 725 CALL wrk_dealloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 726 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 727 CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i ) 728 CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay ) 729 ! 730 CALL wrk_dealloc( jpij, zviold, zvsold ) ! clem 706 707 ! 708 !------------------------------------------- 709 ! Update temperature, energy 710 !------------------------------------------- 711 !clem bug: we should take snow into account here 712 DO ji = kideb, kiut 713 zindh = 1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_b(ji) ) ) 714 t_su_b(ji) = zindh * t_su_b(ji) + ( 1.0 - zindh ) * rtt 715 END DO ! ji 716 717 DO jk = 1, nlay_s 718 DO ji = kideb,kiut 719 ! mask enthalpy 720 zinda = MAX( 0._wp , SIGN( 1._wp, - ht_s_b(ji) ) ) 721 q_s_b(ji,jk) = ( 1.0 - zinda ) * q_s_b(ji,jk) 722 ! recalculate t_s_b from q_s_b 723 t_s_b(ji,jk) = rtt + ( 1._wp - zinda ) * ( - q_s_b(ji,jk) / ( rhosn * cpic ) + lfus / cpic ) 724 END DO 725 END DO 726 727 CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 728 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 729 CALL wrk_dealloc( jpij, zintermelt ) 730 CALL wrk_dealloc( jpij, jkmax, zdeltah, zh_i ) 731 CALL wrk_dealloc( jpij, icount ) 732 ! 731 733 ! 732 734 END SUBROUTINE lim_thd_dh -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r4333 r4900 25 25 USE wrk_nemo ! work arrays 26 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 27 USE cpl_oasis3, ONLY : lk_cpl 27 28 28 29 IMPLICIT NONE … … 31 32 PUBLIC lim_thd_dif ! called by lim_thd 32 33 33 REAL(wp) :: epsi10 =1.e-10_wp !34 REAL(wp) :: epsi10 = 1.e-10_wp ! 34 35 !!---------------------------------------------------------------------- 35 36 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) … … 39 40 CONTAINS 40 41 41 SUBROUTINE lim_thd_dif( kideb , kiut , jl)42 SUBROUTINE lim_thd_dif( kideb , kiut ) 42 43 !!------------------------------------------------------------------ 43 44 !! *** ROUTINE lim_thd_dif *** … … 91 92 !! (04-2007) Energy conservation tested by M. Vancoppenolle 92 93 !!------------------------------------------------------------------ 93 INTEGER , INTENT (in) :: kideb ! Start point on which the the computation is applied 94 INTEGER , INTENT (in) :: kiut ! End point on which the the computation is applied 95 INTEGER , INTENT (in) :: jl ! Category number 94 INTEGER , INTENT(in) :: kideb, kiut ! Start/End point on which the the computation is applied 96 95 97 96 !! * Local variables … … 102 101 INTEGER :: nconv ! number of iterations in iterative procedure 103 102 INTEGER :: minnumeqmin, maxnumeqmax 104 INTEGER, DIMENSION(kiut) :: numeqmin ! reference number of top equation105 INTEGER, DIMENSION(kiut) :: numeqmax ! reference number of bottom equation106 INTEGER, DIMENSION(kiut) :: isnow ! switch for presence (1) or absence (0) of snow103 INTEGER, POINTER, DIMENSION(:) :: numeqmin ! reference number of top equation 104 INTEGER, POINTER, DIMENSION(:) :: numeqmax ! reference number of bottom equation 105 INTEGER, POINTER, DIMENSION(:) :: isnow ! switch for presence (1) or absence (0) of snow 107 106 REAL(wp) :: zg1s = 2._wp ! for the tridiagonal system 108 107 REAL(wp) :: zg1 = 2._wp ! … … 111 110 REAL(wp) :: zraext_s = 1.e+8_wp ! extinction coefficient of radiation in the snow 112 111 REAL(wp) :: zkimin = 0.10_wp ! minimum ice thermal conductivity 112 REAL(wp) :: ztsu_err = 1.e-5_wp ! range around which t_su is considered as 0°C 113 113 REAL(wp) :: ztmelt_i ! ice melting temperature 114 114 REAL(wp) :: zerritmax ! current maximal error on temperature 115 REAL(wp), DIMENSION(kiut) :: ztfs ! ice melting point 116 REAL(wp), DIMENSION(kiut) :: ztsuold ! old surface temperature (before the iterative procedure ) 117 REAL(wp), DIMENSION(kiut) :: ztsuoldit ! surface temperature at previous iteration 118 REAL(wp), DIMENSION(kiut) :: zh_i ! ice layer thickness 119 REAL(wp), DIMENSION(kiut) :: zh_s ! snow layer thickness 120 REAL(wp), DIMENSION(kiut) :: zfsw ! solar radiation absorbed at the surface 121 REAL(wp), DIMENSION(kiut) :: zf ! surface flux function 122 REAL(wp), DIMENSION(kiut) :: dzf ! derivative of the surface flux function 123 REAL(wp), DIMENSION(kiut) :: zerrit ! current error on temperature 124 REAL(wp), DIMENSION(kiut) :: zdifcase ! case of the equation resolution (1->4) 125 REAL(wp), DIMENSION(kiut) :: zftrice ! solar radiation transmitted through the ice 126 REAL(wp), DIMENSION(kiut) :: zihic, zhsu 127 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztcond_i ! Ice thermal conductivity 128 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zradtr_i ! Radiation transmitted through the ice 129 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zradab_i ! Radiation absorbed in the ice 130 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zkappa_i ! Kappa factor in the ice 131 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztiold ! Old temperature in the ice 132 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zeta_i ! Eta factor in the ice 133 REAL(wp), DIMENSION(kiut,0:nlay_i) :: ztitemp ! Temporary temperature in the ice to check the convergence 134 REAL(wp), DIMENSION(kiut,0:nlay_i) :: zspeche_i ! Ice specific heat 135 REAL(wp), DIMENSION(kiut,0:nlay_i) :: z_i ! Vertical cotes of the layers in the ice 136 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zradtr_s ! Radiation transmited through the snow 137 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zradab_s ! Radiation absorbed in the snow 138 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zkappa_s ! Kappa factor in the snow 139 REAL(wp), DIMENSION(kiut,0:nlay_s) :: zeta_s ! Eta factor in the snow 140 REAL(wp), DIMENSION(kiut,0:nlay_s) :: ztstemp ! Temporary temperature in the snow to check the convergence 141 REAL(wp), DIMENSION(kiut,0:nlay_s) :: ztsold ! Temporary temperature in the snow 142 REAL(wp), DIMENSION(kiut,0:nlay_s) :: z_s ! Vertical cotes of the layers in the snow 143 REAL(wp), DIMENSION(kiut,jkmax+2) :: zindterm ! Independent term 144 REAL(wp), DIMENSION(kiut,jkmax+2) :: zindtbis ! temporary independent term 145 REAL(wp), DIMENSION(kiut,jkmax+2) :: zdiagbis 146 REAL(wp), DIMENSION(kiut,jkmax+2,3) :: ztrid ! tridiagonal system terms 115 REAL(wp), POINTER, DIMENSION(:) :: ztfs ! ice melting point 116 REAL(wp), POINTER, DIMENSION(:) :: ztsuold ! old surface temperature (before the iterative procedure ) 117 REAL(wp), POINTER, DIMENSION(:) :: ztsuoldit ! surface temperature at previous iteration 118 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! ice layer thickness 119 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 120 REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface 121 REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function 122 REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function 123 REAL(wp), POINTER, DIMENSION(:) :: zerrit ! current error on temperature 124 REAL(wp), POINTER, DIMENSION(:) :: zdifcase ! case of the equation resolution (1->4) 125 REAL(wp), POINTER, DIMENSION(:) :: zftrice ! solar radiation transmitted through the ice 126 REAL(wp), POINTER, DIMENSION(:) :: zihic, zhsu 127 REAL(wp), POINTER, DIMENSION(:,:) :: ztcond_i ! Ice thermal conductivity 128 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_i ! Radiation transmitted through the ice 129 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_i ! Radiation absorbed in the ice 130 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_i ! Kappa factor in the ice 131 REAL(wp), POINTER, DIMENSION(:,:) :: ztiold ! Old temperature in the ice 132 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_i ! Eta factor in the ice 133 REAL(wp), POINTER, DIMENSION(:,:) :: ztitemp ! Temporary temperature in the ice to check the convergence 134 REAL(wp), POINTER, DIMENSION(:,:) :: zspeche_i ! Ice specific heat 135 REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! Vertical cotes of the layers in the ice 136 REAL(wp), POINTER, DIMENSION(:,:) :: zradtr_s ! Radiation transmited through the snow 137 REAL(wp), POINTER, DIMENSION(:,:) :: zradab_s ! Radiation absorbed in the snow 138 REAL(wp), POINTER, DIMENSION(:,:) :: zkappa_s ! Kappa factor in the snow 139 REAL(wp), POINTER, DIMENSION(:,:) :: zeta_s ! Eta factor in the snow 140 REAL(wp), POINTER, DIMENSION(:,:) :: ztstemp ! Temporary temperature in the snow to check the convergence 141 REAL(wp), POINTER, DIMENSION(:,:) :: ztsold ! Temporary temperature in the snow 142 REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! Vertical cotes of the layers in the snow 143 REAL(wp), POINTER, DIMENSION(:,:) :: zindterm ! Independent term 144 REAL(wp), POINTER, DIMENSION(:,:) :: zindtbis ! temporary independent term 145 REAL(wp), POINTER, DIMENSION(:,:) :: zdiagbis 146 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! tridiagonal system terms 147 ! diag errors on heat 148 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini 149 REAL(wp) :: zhfx_err 147 150 !!------------------------------------------------------------------ 148 151 ! 152 CALL wrk_alloc( jpij, numeqmin, numeqmax, isnow ) 153 CALL wrk_alloc( jpij, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw ) 154 CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 155 CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0) 156 CALL wrk_alloc( jpij, nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsold, zeta_s, ztstemp, z_s, kjstart=0) 157 CALL wrk_alloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis ) 158 CALL wrk_alloc( jpij, jkmax+2, 3, ztrid ) 159 160 CALL wrk_alloc( jpij, zdq, zq_ini ) 161 162 ! --- diag error on heat diffusion - PART 1 --- ! 163 zdq(:) = 0._wp ; zq_ini(:) = 0._wp 164 DO ji = kideb, kiut 165 zq_ini(ji) = ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 166 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 167 END DO 168 149 169 !------------------------------------------------------------------------------! 150 170 ! 1) Initialization ! 151 171 !------------------------------------------------------------------------------! 152 ! 172 ! clem clean: replace just ztfs by rtt 153 173 DO ji = kideb , kiut 154 174 ! is there snow or not 155 175 isnow(ji)= NINT( 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) ) ) 156 176 ! surface temperature of fusion 157 !!gm ??? ztfs(ji) = rtt !!!????158 177 ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 159 178 ! layer thickness … … 194 213 ! zfsw = (1-i0).qsr_ice is absorbed at the surface 195 214 ! zftrice = io.qsr_ice is below the surface 196 ! f stbif= io.qsr_ice.exp(-k(h_i)) transmitted below the ice215 ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice 197 216 198 217 DO ji = kideb , kiut … … 253 272 254 273 DO ji = kideb, kiut ! Radiation transmitted below the ice 255 fstbif_1d(ji) = fstbif_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 256 END DO 257 258 ! +++++ 259 ! just to check energy conservation 260 DO ji = kideb, kiut 261 ii = MOD( npb(ji) - 1 , jpi ) + 1 262 ij = ( npb(ji) - 1 ) / jpi + 1 263 fstroc(ii,ij,jl) = iatte_1d(ji) * zradtr_i(ji,nlay_i) ! clem modif 264 END DO 265 ! +++++ 266 267 DO layer = 1, nlay_i 268 DO ji = kideb, kiut 269 radab(ji,layer) = zradab_i(ji,layer) 270 END DO 274 !!!ftr_ice_1d(ji) = ftr_ice_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 275 ftr_ice_1d(ji) = zradtr_i(ji,nlay_i) 271 276 END DO 272 277 … … 279 284 ztsuold (ji) = t_su_b(ji) ! temperature at the beg of iter pr. 280 285 ztsuoldit(ji) = t_su_b(ji) ! temperature at the previous iter 281 t_su_b (ji) = MIN( t_su_b(ji), ztfs(ji) -0.00001 )! necessary286 t_su_b (ji) = MIN( t_su_b(ji), ztfs(ji) - ztsu_err ) ! necessary 282 287 zerrit (ji) = 1000._wp ! initial value of error 283 288 END DO … … 403 408 ! 404 409 DO ji = kideb , kiut 405 406 410 ! update of the non solar flux according to the update in T_su 407 qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * & 408 ( t_su_b(ji) - ztsuoldit(ji) ) 411 qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 409 412 410 413 ! update incoming flux 411 414 zf(ji) = zfsw(ji) & ! net absorbed solar radiation 412 + qns r_ice_1d(ji)! non solar total flux415 + qns_ice_1d(ji) ! non solar total flux 413 416 ! (LWup, LWdw, SH, LH) 414 415 417 END DO 416 418 … … 678 680 DO layer = 1, nlay_s 679 681 DO ji = kideb , kiut 680 ii = MOD( npb(ji) - 1, jpi ) + 1681 ij = ( npb(ji) - 1 ) / jpi + 1682 682 t_s_b(ji,layer) = MAX( MIN( t_s_b(ji,layer), rtt ), 190._wp ) 683 683 zerrit(ji) = MAX(zerrit(ji),ABS(t_s_b(ji,layer) - ztstemp(ji,layer))) … … 713 713 !-------------------------------------------------------------------------! 714 714 DO ji = kideb, kiut 715 #if ! defined key_coupled716 715 ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux) 717 qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) ) 718 #endif 716 IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) ) 719 717 ! ! surface ice conduction flux 720 718 isnow(ji) = NINT( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) ) ) … … 725 723 END DO 726 724 727 !-------------------------! 728 ! Heat conservation ! 729 !-------------------------! 730 IF( con_i .AND. jiindex_1d > 0 ) THEN 725 !----------------------------------------- 726 ! Heat flux used to warm/cool ice in W.m-2 727 !----------------------------------------- 728 DO ji = kideb, kiut 729 IF( t_su_b(ji) < rtt ) THEN ! case T_su < 0degC 730 hfx_dif_1d(ji) = hfx_dif_1d(ji) + ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji) 731 ELSE ! case T_su = 0degC 732 hfx_dif_1d(ji) = hfx_dif_1d(ji) + ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji) 733 ENDIF 734 END DO 735 736 ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 737 CALL lim_thd_enmelt( kideb, kiut ) 738 739 ! --- diag error on heat diffusion - PART 2 --- ! 740 DO ji = kideb, kiut 741 zdq(ji) = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 742 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 743 zhfx_err = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 744 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_b(ji) 745 ! --- correction of qns_ice and surface conduction flux --- ! 746 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err 747 fc_su (ji) = fc_su (ji) - zhfx_err 748 ! --- Heat flux at the ice surface in W.m-2 --- ! 749 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 750 hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 751 END DO 752 753 ! 754 CALL wrk_dealloc( jpij, numeqmin, numeqmax, isnow ) 755 CALL wrk_dealloc( jpij, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw ) 756 CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 757 CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 758 CALL wrk_dealloc( jpij, nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsold, zeta_s, ztstemp, z_s, kjstart = 0 ) 759 CALL wrk_dealloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis ) 760 CALL wrk_dealloc( jpij, jkmax+2, 3, ztrid ) 761 CALL wrk_dealloc( jpij, zdq, zq_ini ) 762 763 END SUBROUTINE lim_thd_dif 764 765 SUBROUTINE lim_thd_enmelt( kideb, kiut ) 766 !!----------------------------------------------------------------------- 767 !! *** ROUTINE lim_thd_enmelt *** 768 !! 769 !! ** Purpose : Computes sea ice energy of melting q_i (J.m-3) from temperature 770 !! 771 !! ** Method : Formula (Bitz and Lipscomb, 1999) 772 !!------------------------------------------------------------------- 773 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 774 ! 775 INTEGER :: ji, jk ! dummy loop indices 776 REAL(wp) :: ztmelts, zindb ! local scalar 777 !!------------------------------------------------------------------- 778 ! 779 DO jk = 1, nlay_i ! Sea ice energy of melting 731 780 DO ji = kideb, kiut 732 ! Upper snow value 733 fc_s(ji,0) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) ) 734 ! Bott. snow value 735 fc_s(ji,1) = - REAL( isnow(ji) ) * zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) ) 736 END DO 737 DO ji = kideb, kiut ! Upper ice layer 738 fc_i(ji,0) = - REAL( isnow(ji) ) * & ! interface flux if there is snow 739 ( zkappa_i(ji,0) * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 740 - REAL( 1 - isnow(ji) ) * ( zkappa_i(ji,0) * & 741 zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 742 END DO 743 DO layer = 1, nlay_i - 1 ! Internal ice layers 744 DO ji = kideb, kiut 745 fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - t_i_b(ji,layer) ) 746 ii = MOD( npb(ji) - 1, jpi ) + 1 747 ij = ( npb(ji) - 1 ) / jpi + 1 748 END DO 749 END DO 750 DO ji = kideb, kiut ! Bottom ice layers 751 fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 752 END DO 753 ENDIF 781 ztmelts = - tmut * s_i_b(ji,jk) + rtt 782 zindb = MAX( 0._wp , SIGN( 1._wp , -(t_i_b(ji,jk) - rtt) - epsi10 ) ) 783 q_i_b(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_b(ji,jk) ) & 784 & + lfus * ( 1.0 - zindb * ( ztmelts-rtt ) / MIN( t_i_b(ji,jk)-rtt, -epsi10 ) ) & 785 & - rcp * ( ztmelts-rtt ) ) 786 END DO 787 END DO 788 DO jk = 1, nlay_s ! Snow energy of melting 789 DO ji = kideb, kiut 790 q_s_b(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 791 END DO 792 END DO 754 793 ! 755 END SUBROUTINE lim_thd_ dif794 END SUBROUTINE lim_thd_enmelt 756 795 757 796 #else -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
r4333 r4900 10 10 !! ! 2006-11 (X. Fettweis) Vectorized 11 11 !! 3.0 ! 2008-03 (M. Vancoppenolle) Energy conservation and clean code 12 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 12 !! 3.4 ! 2011-02 (G. Madec) dynamical allocation 13 !! - ! 2014-05 (C. Rousset) complete rewriting 13 14 !!---------------------------------------------------------------------- 14 15 #if defined key_lim3 … … 22 23 USE domain ! 23 24 USE phycst ! physical constants 25 USE sbc_oce ! Surface boundary condition: ocean fields 24 26 USE ice ! LIM variables 25 27 USE par_ice ! LIM parameters … … 34 36 PRIVATE 35 37 36 PUBLIC lim_thd_ent ! called by lim _thd38 PUBLIC lim_thd_ent ! called by limthd and limthd_lac 37 39 38 REAL(wp) :: epsi20 = 1.e-20_wp ! constant values 39 REAL(wp) :: epsi10 = 1.e-10_wp ! 40 REAL(wp) :: zzero = 0._wp ! 41 REAL(wp) :: zone = 1._wp ! 40 REAL(wp) :: epsi20 = 1.e-20 ! constant values 41 REAL(wp) :: epsi10 = 1.e-10 ! constant values 42 42 43 43 !!---------------------------------------------------------------------- … … 48 48 CONTAINS 49 49 50 SUBROUTINE lim_thd_ent( kideb, kiut, jl)50 SUBROUTINE lim_thd_ent( kideb, kiut, qnew ) 51 51 !!------------------------------------------------------------------- 52 52 !! *** ROUTINE lim_thd_ent *** 53 53 !! 54 54 !! ** Purpose : 55 !! This routine computes new vertical grids 56 !! in the ice and in the snow, and consistently redistributes 57 !! temperatures in the snow / ice. 55 !! This routine computes new vertical grids in the ice, 56 !! and consistently redistributes temperatures. 58 57 !! Redistribution is made so as to ensure to energy conservation 59 58 !! … … 61 60 !! ** Method : linear conservative remapping 62 61 !! 63 !! ** Steps : 1) Grid 64 !! 2) Switches 65 !! 3) Snow redistribution 66 !! 4) Ice enthalpy redistribution 67 !! 5) Ice salinity, recover temperature 62 !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses 63 !! 2) linear remapping on the new layers 64 !! 65 !! ------------ cum0(0) ------------- cum1(0) 66 !! NEW ------------- 67 !! ------------ cum0(1) ==> ------------- 68 !! ... ------------- 69 !! ------------ ------------- 70 !! ------------ cum0(nlay_i+2) ------------- cum1(nlay_i) 71 !! 68 72 !! 69 73 !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 70 74 !!------------------------------------------------------------------- 71 75 INTEGER , INTENT(in) :: kideb, kiut ! Start/End point on which the the computation is applied 72 INTEGER , INTENT(in) :: jl ! Thickness cateogry number73 76 74 INTEGER :: ji,jk ! dummy loop indices 75 INTEGER :: ii, ij , & ! dummy indices 76 ntop0 , & ! old layer top index 77 nbot1 , & ! new layer bottom index 78 ntop1 , & ! new layer top index 79 limsum , & ! temporary loop index 80 nlayi0,nlays0 , & ! old number of layers 81 maxnbot0 , & ! old layer bottom index 82 layer0, layer1 ! old/new layer indexes 77 REAL(wp), INTENT(inout), DIMENSION(:,:) :: qnew ! new enthlapies (J.m-3, remapped) 83 78 84 85 REAL(wp) :: & 86 ztmelts , & ! ice melting point 87 zqsnic , & ! enthalpy of snow ice layer 88 zhsnow , & ! temporary snow thickness variable 89 zswitch , & ! dummy switch argument 90 zfac1 , & ! dummy factor 91 zfac2 , & ! dummy factor 92 ztform , & !: bottom formation temperature 93 zaaa , & !: dummy factor 94 zbbb , & !: dummy factor 95 zccc , & !: dummy factor 96 zdiscrim !: dummy factor 97 98 INTEGER, POINTER, DIMENSION(:) :: snswi ! snow switch 99 INTEGER, POINTER, DIMENSION(:) :: nbot0 ! old layer bottom index 100 INTEGER, POINTER, DIMENSION(:) :: icsuind ! ice surface index 101 INTEGER, POINTER, DIMENSION(:) :: icsuswi ! ice surface switch 102 INTEGER, POINTER, DIMENSION(:) :: icboind ! ice bottom index 103 INTEGER, POINTER, DIMENSION(:) :: icboswi ! ice bottom switch 104 INTEGER, POINTER, DIMENSION(:) :: snicind ! snow ice index 105 INTEGER, POINTER, DIMENSION(:) :: snicswi ! snow ice switch 106 INTEGER, POINTER, DIMENSION(:) :: snind ! snow index 79 INTEGER :: ji ! dummy loop indices 80 INTEGER :: jk0, jk1 ! old/new layer indices 81 REAL(wp) :: zswitch 107 82 ! 108 REAL(wp), POINTER, DIMENSION(:) :: zh_i ! thickness of an ice layer 109 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! thickness of a snow layer 110 REAL(wp), POINTER, DIMENSION(:) :: zqsnow ! enthalpy of the snow put in snow ice 111 REAL(wp), POINTER, DIMENSION(:) :: zdeltah ! temporary variable 112 REAL(wp), POINTER, DIMENSION(:) :: zqti_in, zqts_in 113 REAL(wp), POINTER, DIMENSION(:) :: zqti_fin, zqts_fin 114 115 REAL(wp), POINTER, DIMENSION(:,:) :: zm0 ! old layer-system vertical cotes 116 REAL(wp), POINTER, DIMENSION(:,:) :: qm0 ! old layer-system heat content 117 REAL(wp), POINTER, DIMENSION(:,:) :: z_s ! new snow system vertical cotes 118 REAL(wp), POINTER, DIMENSION(:,:) :: z_i ! new ice system vertical cotes 119 REAL(wp), POINTER, DIMENSION(:,:) :: zthick0 ! old ice thickness 120 REAL(wp), POINTER, DIMENSION(:,:) :: zhl0 ! old and new layer thicknesses 121 REAL(wp), POINTER, DIMENSION(:,:) :: zrl01 122 123 REAL(wp) :: zinda 83 REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0 ! old cumulative enthlapies and layers interfaces 84 REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum1, zh_cum1 ! new cumulative enthlapies and layers interfaces 85 REAL(wp), POINTER, DIMENSION(:) :: zhnew ! new layers thicknesses 124 86 !!------------------------------------------------------------------- 125 87 126 CALL wrk_alloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind ) ! integer 127 CALL wrk_alloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin ) ! real 128 CALL wrk_alloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 129 CALL wrk_alloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 88 CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 89 CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 90 CALL wrk_alloc( jpij, zhnew ) 130 91 131 zthick0(:,:) = 0._wp 132 zm0 (:,:) = 0._wp 133 qm0 (:,:) = 0._wp 134 zrl01 (:,:) = 0._wp 135 zhl0 (:,:) = 0._wp 136 z_i (:,:) = 0._wp 137 z_s (:,:) = 0._wp 138 139 ! 140 !------------------------------------------------------------------------------| 141 ! 1) Grid | 142 !------------------------------------------------------------------------------| 143 nlays0 = nlay_s 144 nlayi0 = nlay_i 145 146 DO ji = kideb, kiut 147 zh_i(ji) = old_ht_i_b(ji) / REAL( nlay_i ) 148 zh_s(ji) = old_ht_s_b(ji) / REAL( nlay_s ) 149 END DO 150 151 ! 152 !------------------------------------------------------------------------------| 153 ! 2) Switches | 154 !------------------------------------------------------------------------------| 155 ! 2.1 snind(ji), snswi(ji) 156 ! snow surface behaviour : computation of snind(ji)-snswi(ji) 157 ! snind(ji) : index which equals 158 ! 0 if snow is accumulating 159 ! 1 if 1st layer is melting 160 ! 2 if 2nd layer is melting ... 161 DO ji = kideb, kiut 162 snind (ji) = 0 163 zdeltah(ji) = 0._wp 164 ENDDO !ji 165 166 DO jk = 1, nlays0 92 !-------------------------------------------------------------------------- 93 ! 1) Cumulative integral of old enthalpy * thicnkess and layers interfaces 94 !-------------------------------------------------------------------------- 95 zqh_cum0(:,0:nlay_i+2) = 0._wp 96 zh_cum0 (:,0:nlay_i+2) = 0._wp 97 DO jk0 = 1, nlay_i+2 167 98 DO ji = kideb, kiut 168 snind(ji) = jk * NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)))) & 169 + snind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji))))) 170 zdeltah(ji)= zdeltah(ji) + zh_s(ji) 171 END DO ! ji 172 END DO ! jk 173 174 ! snswi(ji) : switch which value equals 1 if snow melts 175 ! 0 if not 176 DO ji = kideb, kiut 177 snswi(ji) = MAX(0,NINT(-dh_s_tot(ji)/MAX(epsi20,ABS(dh_s_tot(ji))))) 178 END DO ! ji 179 180 ! 2.2 icsuind(ji), icsuswi(ji) 181 ! ice surface behaviour : computation of icsuind(ji)-icsuswi(ji) 182 ! icsuind(ji) : index which equals 183 ! 0 if nothing happens at the surface 184 ! 1 if first layer is melting 185 ! 2 if 2nd layer is reached by melt ... 186 DO ji = kideb, kiut 187 icsuind(ji) = 0 188 zdeltah(ji) = 0._wp 189 END DO !ji 190 DO jk = 1, nlayi0 191 DO ji = kideb, kiut 192 icsuind(ji) = jk * NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)))) & 193 + icsuind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji))))) 194 zdeltah(ji) = zdeltah(ji) + zh_i(ji) 195 END DO ! ji 196 ENDDO !jk 197 198 ! icsuswi(ji) : switch which equals 199 ! 1 if ice melts at the surface 200 ! 0 if not 201 DO ji = kideb, kiut 202 icsuswi(ji) = MAX(0,NINT(-dh_i_surf(ji)/MAX(epsi20 , ABS(dh_i_surf(ji)) ) ) ) 99 zqh_cum0(ji,jk0) = zqh_cum0(ji,jk0-1) + qh_i_old(ji,jk0-1) 100 zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + h_i_old (ji,jk0-1) 101 ENDDO 203 102 ENDDO 204 103 205 ! 2.3 icboind(ji), icboswi(ji) 206 ! ice bottom behaviour : computation of icboind(ji)-icboswi(ji) 207 ! icboind(ji) : index which equals 208 ! 0 if accretion is on the way 209 ! 1 if last layer has started to melt 210 ! 2 if penultiem layer is melting ... and so on 211 ! N+1 if all layers melt and that snow transforms into ice 212 DO ji = kideb, kiut 213 icboind(ji) = 0 214 zdeltah(ji) = 0._wp 215 END DO 216 DO jk = nlayi0, 1, -1 217 DO ji = kideb, kiut 218 icboind(ji) = (nlayi0+1-jk) * NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)))) & 219 & + icboind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji))))) 220 zdeltah(ji) = zdeltah(ji) + zh_i(ji) 221 END DO 222 END DO 223 104 !------------------------------------ 105 ! 2) Interpolation on the new layers 106 !------------------------------------ 107 ! new layer thickesses 224 108 DO ji = kideb, kiut 225 ! case of total ablation with remaining snow 226 IF ( ( ht_i_b(ji) .GT. epsi20 ) .AND. & 227 ( ht_i_b(ji) - dh_snowice(ji) .LT. epsi20 ) ) icboind(ji) = nlay_i + 1 228 END DO 229 230 ! icboswi(ji) : switch which equals 231 ! 1 if ice accretion is on the way 232 ! 0 if ablation is on the way 233 DO ji = kideb, kiut 234 icboswi(ji) = MAX(0,NINT(dh_i_bott(ji) / MAX(epsi20,ABS(dh_i_bott(ji))))) 235 END DO 236 237 ! 2.4 snicind(ji), snicswi(ji) 238 ! snow ice formation : calcul de snicind(ji)-snicswi(ji) 239 ! snicind(ji) : index which equals 240 ! 0 if no snow-ice forms 241 ! 1 if last layer of snow has started to melt 242 ! 2 if penultiem layer ... 243 DO ji = kideb, kiut 244 snicind(ji) = 0 245 zdeltah(ji) = 0._wp 246 END DO 247 DO jk = nlays0, 1, -1 248 DO ji = kideb, kiut 249 snicind(ji) = (nlays0+1-jk) & 250 * NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)))) + snicind(ji) & 251 * (1 - NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji))))) 252 zdeltah(ji) = zdeltah(ji) + zh_s(ji) 253 END DO 254 END DO 255 256 ! snicswi(ji) : switch which equals 257 ! 1 if snow-ice forms 258 ! 0 if not 259 DO ji = kideb, kiut 260 snicswi(ji) = MAX(0,NINT(dh_snowice(ji)/MAX(epsi20,ABS(dh_snowice(ji))))) 109 zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) / REAL( nlay_i ) 261 110 ENDDO 262 111 263 ! 264 !------------------------------------------------------------------------------| 265 ! 3) Snow redistribution | 266 !------------------------------------------------------------------------------| 267 ! 268 !------------- 269 ! Old profile 270 !------------- 271 272 ! by 'old', it is meant that layers coming from accretion are included, 273 ! and that interfacial layers which were partly melted are reduced 274 275 ! indexes of the vectors 276 !------------------------ 277 ntop0 = 1 278 maxnbot0 = 0 279 280 DO ji = kideb, kiut 281 nbot0(ji) = nlays0 + 1 - snind(ji) + ( 1 - snicind(ji) ) * snicswi(ji) 282 ! cotes of the top of the layers 283 zm0(ji,0) = 0._wp 284 maxnbot0 = MAX ( maxnbot0 , nbot0(ji) ) 285 END DO 286 IF( lk_mpp ) CALL mpp_max( maxnbot0, kcom=ncomm_ice ) 287 288 DO jk = 1, maxnbot0 112 ! new layers interfaces 113 zh_cum1(:,0:nlay_i) = 0._wp 114 DO jk1 = 1, nlay_i 289 115 DO ji = kideb, kiut 290 !change 291 limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 292 limsum = MIN( limsum , nlay_s ) 293 zm0(ji,jk) = dh_s_tot(ji) + zh_s(ji) * REAL( limsum ) 294 END DO 295 END DO 296 297 DO ji = kideb, kiut 298 zm0(ji,nbot0(ji)) = dh_s_tot(ji) - REAL( snicswi(ji) ) * dh_snowice(ji) + zh_s(ji) * REAL( nlays0 ) 299 zm0(ji,1) = dh_s_tot(ji) * REAL( 1 - snswi(ji) ) + REAL( snswi(ji) ) * zm0(ji,1) 300 END DO 301 302 DO jk = ntop0, maxnbot0 303 DO ji = kideb, kiut 304 zthick0(ji,jk) = zm0(ji,jk) - zm0(ji,jk-1) ! layer thickness 305 END DO 306 END DO 307 308 zqts_in(:) = 0._wp 309 310 DO ji = kideb, kiut ! layer heat content 311 qm0 (ji,1) = rhosn * ( cpic * ( rtt - REAL( 1 - snswi(ji) ) * tatm_ice_1d(ji) & 312 & - REAL( snswi(ji) ) * t_s_b (ji,1) ) & 313 & + lfus ) * zthick0(ji,1) 314 zqts_in(ji) = zqts_in(ji) + qm0(ji,1) 315 END DO 316 317 DO jk = 2, maxnbot0 318 DO ji = kideb, kiut 319 limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 320 limsum = MIN( limsum , nlay_s ) 321 qm0(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,limsum) ) + lfus ) * zthick0(ji,jk) 322 zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, - ht_s_b(ji) ) ) 323 zqts_in(ji) = zqts_in(ji) + REAL( 1 - snswi(ji) ) * qm0(ji,jk) * zswitch 324 END DO ! jk 325 END DO ! ji 326 327 !------------------------------------------------ 328 ! Energy given by the snow in snow-ice formation 329 !------------------------------------------------ 330 ! zqsnow, enthalpy of the flooded snow 331 DO ji = kideb, kiut 332 zqsnow (ji) = rhosn * lfus 333 zdeltah(ji) = 0._wp 334 END DO 335 336 DO jk = nlays0, 1, -1 337 DO ji = kideb, kiut 338 zhsnow = MAX( 0._wp , dh_snowice(ji)-zdeltah(ji) ) 339 zqsnow (ji) = zqsnow (ji) + rhosn*cpic*(rtt-t_s_b(ji,jk)) 340 zdeltah(ji) = zdeltah(ji) + zh_s(ji) 341 END DO 342 END DO 343 344 DO ji = kideb, kiut 345 zqsnow(ji) = zqsnow(ji) * dh_snowice(ji) 346 END DO 347 348 !------------------ 349 ! new snow profile 350 !------------------ 351 352 !-------------- 353 ! Vector index 354 !-------------- 355 ntop1 = 1 356 nbot1 = nlay_s 357 358 !------------------- 359 ! Layer coordinates 360 !------------------- 361 DO ji = kideb, kiut 362 zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 363 z_s(ji,0) = 0._wp 116 zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji) 117 ENDDO 364 118 ENDDO 365 119 366 DO jk = 1, nlay_s 120 zqh_cum1(:,0:nlay_i) = 0._wp 121 ! new cumulative q*h => linear interpolation 122 DO jk0 = 1, nlay_i+1 123 DO jk1 = 1, nlay_i-1 124 DO ji = kideb, kiut 125 IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN 126 zqh_cum1(ji,jk1) = ( zqh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1 ) ) + & 127 & zqh_cum0(ji,jk0 ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) ) & 128 & / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) ) 129 ENDIF 130 ENDDO 131 ENDDO 132 ENDDO 133 ! to ensure that total heat content is strictly conserved, set: 134 zqh_cum1(:,nlay_i) = zqh_cum0(:,nlay_i+2) 135 136 ! new enthalpies 137 DO jk1 = 1, nlay_i 367 138 DO ji = kideb, kiut 368 z_s(ji,jk) = zh_s(ji) * REAL( jk ) 369 END DO 370 END DO 371 372 !----------------- 373 ! Layer thickness 374 !----------------- 375 DO layer0 = ntop0, maxnbot0 376 DO ji = kideb, kiut 377 zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) 378 END DO 379 END DO 380 381 DO layer1 = ntop1, nbot1 382 DO ji = kideb, kiut 383 q_s_b(ji,layer1) = 0._wp 384 END DO 385 END DO 386 387 !---------------- 388 ! Weight factors 389 !---------------- 390 DO layer0 = ntop0, maxnbot0 391 DO layer1 = ntop1, nbot1 392 DO ji = kideb, kiut 393 zinda = MAX( 0._wp, SIGN( 1._wp , zhl0(ji,layer0) - epsi10 ) ) 394 zrl01(layer1,layer0) = zinda * MAX(0.0,( MIN(zm0(ji,layer0),z_s(ji,layer1)) & 395 & - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1))) / MAX(zhl0(ji,layer0),epsi10)) 396 q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0) & 397 & * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 398 END DO 399 END DO 400 END DO 401 402 ! Heat conservation 403 zqts_fin(:) = 0._wp 404 DO jk = 1, nlay_s 405 DO ji = kideb, kiut 406 zqts_fin(ji) = zqts_fin(ji) + q_s_b(ji,jk) 407 END DO 408 END DO 409 410 IF ( con_i .AND. jiindex_1d > 0 ) THEN 411 DO ji = kideb, kiut 412 IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice > 1.0e-6 ) THEN 413 ii = MOD( npb(ji) - 1, jpi ) + 1 414 ij = ( npb(ji) - 1 ) / jpi + 1 415 WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice 416 WRITE(numout,*) ' ji, jj : ', ii, ij 417 WRITE(numout,*) ' ht_s_b : ', ht_s_b(ji) 418 WRITE(numout,*) ' zqts_in : ', zqts_in (ji) * r1_rdtice 419 WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) * r1_rdtice 420 WRITE(numout,*) ' dh_snowice : ', dh_snowice(ji) 421 WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) 422 WRITE(numout,*) ' snswi : ', snswi(ji) 423 ENDIF 424 END DO 425 ENDIF 426 427 !--------------------- 428 ! Recover heat content 429 !--------------------- 430 DO jk = 1, nlay_s 431 DO ji = kideb, kiut 432 zinda = MAX( 0._wp, SIGN( 1._wp , zh_s(ji) - epsi10 ) ) 433 q_s_b(ji,jk) = zinda * q_s_b(ji,jk) / MAX( zh_s(ji) , epsi10 ) 434 END DO !ji 435 END DO !jk 436 437 !--------------------- 438 ! Recover temperature 439 !--------------------- 440 zfac1 = 1. / ( rhosn * cpic ) 441 zfac2 = lfus / cpic 442 DO jk = 1, nlay_s 443 DO ji = kideb, kiut 444 zswitch = MAX ( 0.0 , SIGN ( 1.0, - ht_s_b(ji) ) ) 445 t_s_b(ji,jk) = rtt + ( 1.0 - zswitch ) * ( - zfac1 * q_s_b(ji,jk) + zfac2 ) 446 END DO 447 END DO 448 ! 449 !------------------------------------------------------------------------------| 450 ! 4) Ice redistribution | 451 !------------------------------------------------------------------------------| 452 ! 453 !------------- 454 ! OLD PROFILE 455 !------------- 456 457 !---------------- 458 ! Vector indexes 459 !---------------- 460 ntop0 = 1 461 maxnbot0 = 0 462 463 DO ji = kideb, kiut 464 ! reference number of the bottommost layer 465 nbot0(ji) = MAX( 1 , MIN( nlayi0 + ( 1 - icboind(ji) ) + & 466 & ( 1 - icsuind(ji) ) * icsuswi(ji) + snicswi(ji) , nlay_i + 2 ) ) 467 ! maximum reference number of the bottommost layer over all domain 468 maxnbot0 = MAX( maxnbot0 , nbot0(ji) ) 469 END DO 470 471 !------------------------- 472 ! Cotes of old ice layers 473 !------------------------- 474 zm0(:,0) = 0._wp 475 476 DO jk = 1, maxnbot0 477 DO ji = kideb, kiut 478 ! jk goes from 1 to nbot0 479 ! the ice layer number goes from 1 to nlay_i 480 ! limsum is the real ice layer number corresponding to present jk 481 limsum = ( (icsuswi(ji)*(icsuind(ji)+jk-1) + & 482 (1-icsuswi(ji))*jk))*(1-snicswi(ji)) + (jk-1)*snicswi(ji) 483 zm0(ji,jk)= REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) & 484 + REAL(limsum) * zh_i(ji) 485 END DO 486 END DO 487 488 DO ji = kideb, kiut 489 zm0(ji,nbot0(ji)) = REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) + dh_i_bott(ji) & 490 + zh_i(ji) * REAL(nlayi0) 491 zm0(ji,1) = REAL(snicswi(ji))*dh_snowice(ji) + REAL(1-snicswi(ji))*zm0(ji,1) 492 END DO 493 494 !----------------------------- 495 ! Thickness of old ice layers 496 !----------------------------- 497 DO jk = ntop0, maxnbot0 498 DO ji = kideb, kiut 499 zthick0(ji,jk) = zm0(ji,jk) - zm0(ji,jk-1) 500 END DO 501 END DO 502 503 !--------------------------- 504 ! Inner layers heat content 505 !--------------------------- 506 qm0(:,:) = 0.0 507 zqti_in(:) = 0.0 508 509 DO jk = ntop0, maxnbot0 510 DO ji = kideb, kiut 511 limsum = MAX(1,MIN(snicswi(ji)*(jk-1) + icsuswi(ji)*(jk-1+icsuind(ji)) + & 512 (1-icsuswi(ji))*(1-snicswi(ji))*jk,nlay_i)) 513 ztmelts = -tmut * s_i_b(ji,limsum) + rtt 514 qm0(ji,jk) = rhoic * ( cpic * (ztmelts-t_i_b(ji,limsum)) + lfus * ( 1.0-(ztmelts-rtt)/ & 515 MIN((t_i_b(ji,limsum)-rtt),-epsi20) ) - rcp*(ztmelts-rtt) ) & 516 * zthick0(ji,jk) 517 END DO 518 END DO 519 520 !---------------------------- 521 ! Bottom layers heat content 522 !---------------------------- 523 DO ji = kideb, kiut 524 ztmelts = REAL( 1 - icboswi(ji) ) * (-tmut * s_i_b (ji,nlayi0) ) & ! case of melting ice 525 & + REAL( icboswi(ji) ) * (-tmut * s_i_new(ji) ) & ! case of forming ice 526 & + rtt ! in Kelvin 527 528 ! bottom formation temperature 529 ztform = t_i_b(ji,nlay_i) 530 IF( num_sal == 2 ) ztform = t_bo_b(ji) 531 qm0(ji,nbot0(ji)) = REAL( 1 - icboswi(ji) )*qm0(ji,nbot0(ji)) & ! case of melting ice 532 & + REAL( icboswi(ji) ) * rhoic * ( cpic*(ztmelts-ztform) & ! case of forming ice 533 + lfus *( 1.0-(ztmelts-rtt) / MIN ( (ztform-rtt) , - epsi10 ) ) & 534 - rcp*(ztmelts-rtt) ) * zthick0(ji,nbot0(ji) ) 535 END DO 536 537 !----------------------------- 538 ! Snow ice layer heat content 539 !----------------------------- 540 DO ji = kideb, kiut 541 ! energy of the flooding seawater 542 zqsnic = rau0 * rcp * ( rtt - t_bo_b(ji) ) * dh_snowice(ji) * & 543 (rhoic - rhosn) / rhoic * REAL(snicswi(ji)) ! generally positive 544 ! Heat conservation diagnostic 545 qt_i_in(ji,jl) = qt_i_in(ji,jl) + zqsnic 546 547 qldif_1d(ji) = qldif_1d(ji) + zqsnic * a_i_b(ji) 548 549 ! enthalpy of the newly formed snow-ice layer 550 ! = enthalpy of snow + enthalpy of frozen water 551 zqsnic = zqsnow(ji) + zqsnic 552 qm0(ji,1) = REAL(snicswi(ji)) * zqsnic + REAL( 1 - snicswi(ji) ) * qm0(ji,1) 553 554 END DO ! ji 555 556 DO jk = ntop0, maxnbot0 557 DO ji = kideb, kiut 558 ! Heat conservation 559 zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-epsi10) ) & 560 & * MAX( 0.0 , SIGN( 1. , REAL(nbot0(ji) - jk) ) ) 561 END DO 562 END DO 563 564 !------------- 565 ! NEW PROFILE 566 !------------- 567 568 !--------------- 569 ! Vectors index 570 !--------------- 571 ntop1 = 1 572 nbot1 = nlay_i 573 574 !------------------ 575 ! Layers thickness 576 !------------------ 577 DO ji = kideb, kiut 578 zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 139 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi10 ) ) 140 qnew(ji,jk1) = zswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi10 ) 141 ENDDO 579 142 ENDDO 580 143 581 !------------- 582 ! Layer cotes 583 !------------- 584 z_i(:,0) = 0._wp 585 DO jk = 1, nlay_i 586 DO ji = kideb, kiut 587 z_i(ji,jk) = zh_i(ji) * jk 588 END DO 144 ! --- diag error on heat remapping --- ! 145 ! comment: if input h_i_old and qh_i_old are already multiplied by a_i (as in limthd_lac), 146 ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 147 DO ji = kideb, kiut 148 hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_b(ji) * r1_rdtice * & 149 & ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( qh_i_old(ji,0:nlay_i+1) ) ) 589 150 END DO 590 591 !--thicknesses of the layers 592 DO layer0 = ntop0, maxnbot0 593 DO ji = kideb, kiut 594 zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) ! thicknesses of the layers 595 END DO 596 END DO 597 598 !------------------------ 599 ! Weights for relayering 600 !------------------------ 601 q_i_b(:,:) = 0._wp 602 DO layer0 = ntop0, maxnbot0 603 DO layer1 = ntop1, nbot1 604 DO ji = kideb, kiut 605 zinda = MAX( 0._wp, SIGN( 1._wp , zhl0(ji,layer0) - epsi10 ) ) 606 zrl01(layer1,layer0) = zinda * MAX(0.0,( MIN(zm0(ji,layer0),z_i(ji,layer1)) & 607 - MAX(zm0(ji,layer0-1), z_i(ji,layer1-1)))/MAX(zhl0(ji,layer0),epsi10)) 608 q_i_b(ji,layer1) = q_i_b(ji,layer1) & 609 + zrl01(layer1,layer0)*qm0(ji,layer0) & 610 * MAX(0.0,SIGN(1.0,ht_i_b(ji)-epsi10)) & 611 * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 612 END DO 613 END DO 614 END DO 615 616 !------------------------- 617 ! Heat conservation check 618 !------------------------- 619 zqti_fin(:) = 0._wp 620 DO jk = 1, nlay_i 621 DO ji = kideb, kiut 622 zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk) 623 END DO 624 END DO 151 625 152 ! 626 IF ( con_i .AND. jiindex_1d > 0 ) THEN 627 DO ji = kideb, kiut 628 IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice > 1.0e-6 ) THEN 629 ii = MOD( npb(ji) - 1, jpi ) + 1 630 ij = ( npb(ji) - 1 ) / jpi + 1 631 WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice 632 WRITE(numout,*) ' ji, jj : ', ii, ij 633 WRITE(numout,*) ' ht_i_b : ', ht_i_b(ji) 634 WRITE(numout,*) ' zqti_in : ', zqti_in (ji) * r1_rdtice 635 WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) * r1_rdtice 636 WRITE(numout,*) ' dh_i_bott: ', dh_i_bott(ji) 637 WRITE(numout,*) ' dh_i_surf: ', dh_i_surf(ji) 638 WRITE(numout,*) ' dh_snowice:', dh_snowice(ji) 639 WRITE(numout,*) ' icsuswi : ', icsuswi(ji) 640 WRITE(numout,*) ' icboswi : ', icboswi(ji) 641 WRITE(numout,*) ' snicswi : ', snicswi(ji) 642 ENDIF 643 END DO 644 ENDIF 645 646 !---------------------- 647 ! Recover heat content 648 !---------------------- 649 DO jk = 1, nlay_i 650 DO ji = kideb, kiut 651 zinda = MAX( 0._wp, SIGN( 1._wp , zh_i(ji) - epsi10 ) ) 652 q_i_b(ji,jk) = zinda * q_i_b(ji,jk) / MAX( zh_i(ji) , epsi10 ) 653 END DO !ji 654 END DO !jk 655 656 ! Heat conservation 657 zqti_fin(:) = 0.0 658 DO jk = 1, nlay_i 659 DO ji = kideb, kiut 660 zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk) * zh_i(ji) 661 END DO 662 END DO 663 664 ! 665 !------------------------------------------------------------------------------| 666 ! 5) Update salinity and recover temperature | 667 !------------------------------------------------------------------------------| 668 ! 669 ! Update salinity (basal entrapment, snow ice formation) 670 DO ji = kideb, kiut 671 sm_i_b(ji) = sm_i_b(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 672 END DO !ji 673 674 ! Recover temperature 675 DO jk = 1, nlay_i 676 DO ji = kideb, kiut 677 ztmelts = -tmut*s_i_b(ji,jk) + rtt 678 !Conversion q(S,T) -> T (second order equation) 679 zaaa = cpic 680 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 681 zccc = lfus * ( ztmelts - rtt ) 682 zdiscrim = SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) ) 683 t_i_b(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa ) 684 END DO !ji 685 686 END DO !jk 687 ! 688 CALL wrk_dealloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind ) ! integer 689 CALL wrk_dealloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin ) ! real 690 CALL wrk_dealloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 691 CALL wrk_dealloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 153 CALL wrk_dealloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 154 CALL wrk_dealloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 155 CALL wrk_dealloc( jpij, zhnew ) 692 156 ! 693 157 END SUBROUTINE lim_thd_ent -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r4333 r4900 30 30 USE wrk_nemo ! work arrays 31 31 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 32 USE limthd_ent 32 33 33 34 IMPLICIT NONE … … 37 38 38 39 REAL(wp) :: epsi10 = 1.e-10_wp ! 39 REAL(wp) :: zzero = 0._wp ! 40 REAL(wp) :: zone = 1._wp ! 40 REAL(wp) :: epsi20 = 1.e-20_wp ! 41 41 42 42 !!---------------------------------------------------------------------- … … 76 76 INTEGER :: layer, nbpac ! local integers 77 77 INTEGER :: ii, ij, iter ! - - 78 REAL(wp) :: ztmelts, zdv, z qold, zfrazb, zweight, zalphai, zindb, zinda, zde ! local scalars78 REAL(wp) :: ztmelts, zdv, zfrazb, zweight, zindb, zinda, zde ! local scalars 79 79 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new ! - - 80 80 REAL(wp) :: ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit ! - - 81 81 LOGICAL :: iterate_frazil ! iterate frazil ice collection thickness 82 82 CHARACTER (len = 15) :: fieldid 83 ! 84 INTEGER , POINTER, DIMENSION(:) :: zcatac ! indexes of categories where new ice grows 83 84 REAL(wp) :: zQm ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean) 85 REAL(wp) :: zEi ! sea ice specific enthalpy (J/kg) 86 REAL(wp) :: zEw ! seawater specific enthalpy (J/kg) 87 REAL(wp) :: zfmdt ! mass flux x time step (kg/m2, >0 towards ocean) 88 89 REAL(wp) :: zv_newfra 90 91 INTEGER , POINTER, DIMENSION(:) :: jcat ! indexes of categories where new ice grows 85 92 REAL(wp), POINTER, DIMENSION(:) :: zswinew ! switch for new ice or not 86 93 … … 93 100 REAL(wp), POINTER, DIMENSION(:) :: zdv_res ! residual volume in case of excessive heat budget 94 101 REAL(wp), POINTER, DIMENSION(:) :: zda_res ! residual area in case of excessive heat budget 95 REAL(wp), POINTER, DIMENSION(:) :: zat_i_ ac! total ice fraction102 REAL(wp), POINTER, DIMENSION(:) :: zat_i_1d ! total ice fraction 96 103 REAL(wp), POINTER, DIMENSION(:) :: zat_i_lev ! total ice fraction for level ice only (type 1) 97 REAL(wp), POINTER, DIMENSION(:) :: zdh_frazb ! accretion of frazil ice at the ice bottom 98 REAL(wp), POINTER, DIMENSION(:) :: zvrel_ac ! relative ice / frazil velocity (1D vector) 99 100 REAL(wp), POINTER, DIMENSION(:,:) :: zhice_old ! previous ice thickness 101 REAL(wp), POINTER, DIMENSION(:,:) :: zdummy ! dummy thickness of new ice 102 REAL(wp), POINTER, DIMENSION(:,:) :: zdhicbot ! thickness of new ice which is accreted vertically 104 REAL(wp), POINTER, DIMENSION(:) :: zv_frazb ! accretion of frazil ice at the ice bottom 105 REAL(wp), POINTER, DIMENSION(:) :: zvrel_1d ! relative ice / frazil velocity (1D vector) 106 103 107 REAL(wp), POINTER, DIMENSION(:,:) :: zv_old ! old volume of ice in category jl 104 108 REAL(wp), POINTER, DIMENSION(:,:) :: za_old ! old area of ice in category jl 105 REAL(wp), POINTER, DIMENSION(:,:) :: za_i_ac ! 1-D version of a_i 106 REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_ac ! 1-D version of v_i 107 REAL(wp), POINTER, DIMENSION(:,:) :: zoa_i_ac ! 1-D version of oa_i 108 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_ac ! 1-D version of smv_i 109 110 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_ac !: 1-D version of e_i 111 112 REAL(wp), POINTER, DIMENSION(:) :: zqbgow ! heat budget of the open water (negative) 113 REAL(wp), POINTER, DIMENSION(:) :: zdhex ! excessively thick accreted sea ice (hlead-hice) 114 115 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqm0 ! old layer-system heat content 116 REAL(wp), POINTER, DIMENSION(:,:,:) :: zthick0 ! old ice thickness 117 118 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 119 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 120 REAL(wp), POINTER, DIMENSION(:,:) :: et_i_init, et_i_final ! ice energy summed over categories 121 REAL(wp), POINTER, DIMENSION(:,:) :: et_s_init ! snow energy summed over categories 109 REAL(wp), POINTER, DIMENSION(:,:) :: za_i_1d ! 1-D version of a_i 110 REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_1d ! 1-D version of v_i 111 REAL(wp), POINTER, DIMENSION(:,:) :: zoa_i_1d ! 1-D version of oa_i 112 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_1d ! 1-D version of smv_i 113 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_1d !: 1-D version of e_i 115 122 116 REAL(wp), POINTER, DIMENSION(:,:) :: zvrel ! relative ice / frazil velocity 123 117 !!-----------------------------------------------------------------------! 124 118 125 CALL wrk_alloc( jpij, zcatac) ! integer119 CALL wrk_alloc( jpij, jcat ) ! integer 126 120 CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 127 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 128 CALL wrk_alloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 129 CALL wrk_alloc( jpij,jkmax,jpl, ze_i_ac ) 130 CALL wrk_alloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 131 CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 132 133 et_i_init(:,:) = 0._wp 134 et_s_init(:,:) = 0._wp 135 vt_i_init(:,:) = 0._wp 136 vt_s_init(:,:) = 0._wp 137 138 !------------------------------------------------------------------------------! 139 ! 1) Conservation check and changes in each ice category 140 !------------------------------------------------------------------------------! 141 IF( con_i ) THEN 142 CALL lim_column_sum ( jpl, v_i , vt_i_init) 143 CALL lim_column_sum ( jpl, v_s , vt_s_init) 144 CALL lim_column_sum_energy ( jpl, nlay_i , e_i , et_i_init) 145 CALL lim_column_sum ( jpl, e_s(:,:,1,:) , et_s_init) 146 ENDIF 121 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zat_i_lev, zv_frazb, zvrel_1d ) 122 CALL wrk_alloc( jpij,jpl, zv_old, za_old, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 123 CALL wrk_alloc( jpij,jkmax,jpl, ze_i_1d ) 124 CALL wrk_alloc( jpi,jpj, zvrel ) 147 125 148 126 !------------------------------------------------------------------------------| … … 154 132 DO ji = 1, jpi 155 133 !Energy of melting q(S,T) [J.m-3] 156 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / MAX( area(ji,jj) * v_i(ji,jj,jl) , epsi10 ) * REAL( nlay_i )157 134 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 158 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 135 e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 136 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 159 137 END DO 160 138 END DO … … 179 157 180 158 ! Default new ice thickness 181 hicol(:,:) = hiccrit (1)182 183 IF( fraz_swi == 1 ._wp) THEN159 hicol(:,:) = hiccrit 160 161 IF( fraz_swi == 1 ) THEN 184 162 185 163 !-------------------- … … 196 174 DO ji = 1, jpi 197 175 198 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0) THEN176 IF ( qlead(ji,jj) < 0._wp ) THEN 199 177 !------------- 200 178 ! Wind stress … … 206 184 & + vtau_ice(ji ,jj ) * tmv(ji ,jj ) ) * 0.5_wp 207 185 ! Square root of wind stress 208 ztenagm = SQRT( SQRT( ztaux * ztaux + ztauy * ztauy) )186 ztenagm = SQRT( SQRT( ztaux**2 + ztauy**2 ) ) 209 187 210 188 !--------------------- 211 189 ! Frazil ice velocity 212 190 !--------------------- 213 zvfrx = zgamafr * zsqcd * ztaux / MAX(ztenagm,epsi10) 214 zvfry = zgamafr * zsqcd * ztauy / MAX(ztenagm,epsi10) 191 zindb = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) ) 192 zvfrx = zindb * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 ) 193 zvfry = zindb * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 ) 215 194 216 195 !------------------- … … 278 257 DO jj = 1, jpj 279 258 DO ji = 1, jpi 280 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) >0._wp ) THEN259 IF ( qlead(ji,jj) < 0._wp ) THEN 281 260 nbpac = nbpac + 1 282 261 npac( nbpac ) = (jj - 1) * jpi + ji … … 290 269 DO ji = mi0(jiindx), mi1(jiindx) 291 270 DO jj = mj0(jjindx), mj1(jjindx) 292 IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) >0._wp ) THEN271 IF ( qlead(ji,jj) < 0._wp ) THEN 293 272 jiindex_1d = (jj - 1) * jpi + ji 294 273 ENDIF … … 307 286 IF ( nbpac > 0 ) THEN 308 287 309 CALL tab_2d_1d( nbpac, zat_i_ ac(1:nbpac) , at_i , jpi, jpj, npac(1:nbpac) )288 CALL tab_2d_1d( nbpac, zat_i_1d (1:nbpac) , at_i , jpi, jpj, npac(1:nbpac) ) 310 289 DO jl = 1, jpl 311 CALL tab_2d_1d( nbpac, za_i_ ac(1:nbpac,jl), a_i (:,:,jl), jpi, jpj, npac(1:nbpac) )312 CALL tab_2d_1d( nbpac, zv_i_ ac(1:nbpac,jl), v_i (:,:,jl), jpi, jpj, npac(1:nbpac) )313 CALL tab_2d_1d( nbpac, zoa_i_ ac(1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) )314 CALL tab_2d_1d( nbpac, zsmv_i_ ac(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) )290 CALL tab_2d_1d( nbpac, za_i_1d (1:nbpac,jl), a_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 291 CALL tab_2d_1d( nbpac, zv_i_1d (1:nbpac,jl), v_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 292 CALL tab_2d_1d( nbpac, zoa_i_1d (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 293 CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 315 294 DO jk = 1, nlay_i 316 CALL tab_2d_1d( nbpac, ze_i_ ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) )295 CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 317 296 END DO ! jk 318 297 END DO ! jl 319 298 320 CALL tab_2d_1d( nbpac, qldif_1d (1:nbpac) , qldif , jpi, jpj, npac(1:nbpac) ) 321 CALL tab_2d_1d( nbpac, qcmif_1d (1:nbpac) , qcmif , jpi, jpj, npac(1:nbpac) ) 299 CALL tab_2d_1d( nbpac, qlead_1d (1:nbpac) , qlead , jpi, jpj, npac(1:nbpac) ) 322 300 CALL tab_2d_1d( nbpac, t_bo_b (1:nbpac) , t_bo , jpi, jpj, npac(1:nbpac) ) 323 CALL tab_2d_1d( nbpac, sfx_thd_1d(1:nbpac) , sfx_thd, jpi, jpj, npac(1:nbpac) ) 324 CALL tab_2d_1d( nbpac, rdm_ice_1d(1:nbpac) , rdm_ice, jpi, jpj, npac(1:nbpac) ) 301 CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac) , sfx_opw, jpi, jpj, npac(1:nbpac) ) 302 CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac) , wfx_opw, jpi, jpj, npac(1:nbpac) ) 303 CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac) , wfx_opw, jpi, jpj, npac(1:nbpac) ) 325 304 CALL tab_2d_1d( nbpac, hicol_b (1:nbpac) , hicol , jpi, jpj, npac(1:nbpac) ) 326 CALL tab_2d_1d( nbpac, zvrel_ac (1:nbpac) , zvrel , jpi, jpj, npac(1:nbpac) ) 305 CALL tab_2d_1d( nbpac, zvrel_1d (1:nbpac) , zvrel , jpi, jpj, npac(1:nbpac) ) 306 307 CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac) , hfx_thd, jpi, jpj, npac(1:nbpac) ) 308 CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac) , hfx_opw, jpi, jpj, npac(1:nbpac) ) 327 309 328 310 !------------------------------------------------------------------------------! … … 330 312 !------------------------------------------------------------------------------! 331 313 314 !----------------------------------------- 315 ! Keep old ice areas and volume in memory 316 !----------------------------------------- 317 zv_old(:,:) = zv_i_1d(:,:) 318 za_old(:,:) = za_i_1d(:,:) 319 332 320 !---------------------- 333 321 ! Thickness of new ice 334 322 !---------------------- 335 323 DO ji = 1, nbpac 336 zh_newice(ji) = hiccrit (1)337 END DO 338 IF( fraz_swi == 1 .0 )zh_newice(:) = hicol_b(:)324 zh_newice(ji) = hiccrit 325 END DO 326 IF( fraz_swi == 1 ) zh_newice(:) = hicol_b(:) 339 327 340 328 !---------------------- 341 329 ! Salinity of new ice 342 330 !---------------------- 343 344 331 SELECT CASE ( num_sal ) 345 332 CASE ( 1 ) ! Sice = constant … … 355 342 END SELECT 356 343 357 358 344 !------------------------- 359 345 ! Heat content of new ice … … 363 349 ztmelts = - tmut * zs_newice(ji) + rtt ! Melting point (K) 364 350 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_b(ji) ) & 365 & + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt) ) &351 & + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_b(ji) - rtt, -epsi10 ) ) & 366 352 & - rcp * ( ztmelts - rtt ) ) 367 ze_newice(ji) = MAX( ze_newice(ji) , 0._wp ) &368 & + MAX( 0.0 , SIGN( 1.0 , - ze_newice(ji) ) ) * rhoic * lfus369 353 END DO ! ji 354 370 355 !---------------- 371 356 ! Age of new ice … … 375 360 END DO ! ji 376 361 377 !--------------------------378 ! Open water energy budget379 !--------------------------380 DO ji = 1, nbpac381 zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji) !<0382 END DO ! ji383 384 362 !------------------- 385 363 ! Volume of new ice 386 364 !------------------- 387 365 DO ji = 1, nbpac 388 zv_newice(ji) = - zqbgow(ji) / ze_newice(ji) 366 367 zEi = - ze_newice(ji) / rhoic ! specific enthalpy of forming ice [J/kg] 368 369 zEw = rcp * ( t_bo_b(ji) - rt0 ) ! specific enthalpy of seawater at t_bo_b [J/kg] 370 ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied) 371 372 zdE = zEi - zEw ! specific enthalpy difference [J/kg] 373 374 zfmdt = - qlead_1d(ji) / zdE ! Fm.dt [kg/m2] (<0) 375 ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point 376 zv_newice(ji) = - zfmdt / rhoic 377 378 zQm = zfmdt * zEw ! heat to the ocean >0 associated with mass flux 379 380 ! Contribution to heat flux to the ocean [W.m-2], >0 381 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice 382 ! Total heat flux used in this process [W.m-2] 383 hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_rdtice 384 ! mass flux 385 wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoic * r1_rdtice 386 ! salt flux 387 sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice 389 388 390 389 ! A fraction zfrazb of frazil ice is accreted at the ice bottom 391 zfrazb = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 392 zdh_frazb(ji) = zfrazb * zv_newice(ji) 390 zinda = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 391 zfrazb = zinda * ( TANH ( Cfrazb * ( zvrel_1d(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 392 zv_frazb(ji) = zfrazb * zv_newice(ji) 393 393 zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 394 394 END DO 395 396 !------------------------------------397 ! Diags for energy conservation test398 !------------------------------------399 DO ji = 1, nbpac400 ii = MOD( npac(ji) - 1 , jpi ) + 1401 ij = ( npac(ji) - 1 ) / jpi + 1402 !403 zde = ze_newice(ji) / unit_fac * area(ii,ij) * zv_newice(ji)404 !405 vt_i_init(ii,ij) = vt_i_init(ii,ij) + zv_newice(ji) ! volume406 et_i_init(ii,ij) = et_i_init(ii,ij) + zde ! Energy407 408 END DO409 410 ! keep new ice volume in memory411 CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , jpi, jpj )412 395 413 396 !----------------- … … 415 398 !----------------- 416 399 DO ji = 1, nbpac 417 ii = MOD( npac(ji) - 1 , jpi ) + 1418 ij = ( npac(ji) - 1 ) / jpi + 1419 400 za_newice(ji) = zv_newice(ji) / zh_newice(ji) 420 diag_lat_gr(ii,ij) = diag_lat_gr(ii,ij) + zv_newice(ji) * r1_rdtice ! clem 421 END DO !ji 401 END DO 422 402 423 403 !------------------------------------------------------------------------------! … … 425 405 !------------------------------------------------------------------------------! 426 406 427 !----------------------------------------- 428 ! Keep old ice areas and volume in memory 429 !----------------------------------------- 430 zv_old(:,:) = zv_i_ac(:,:) 431 za_old(:,:) = za_i_ac(:,:) 432 433 !------------------------------------------- 434 ! Compute excessive new ice area and volume 435 !------------------------------------------- 407 !------------------------ 408 ! 6.1) lateral ice growth 409 !------------------------ 436 410 ! If lateral ice growth gives an ice concentration gt 1, then 437 411 ! we keep the excessive volume in memory and attribute it later to bottom accretion 438 412 DO ji = 1, nbpac 439 IF ( za_newice(ji) > ( amax - zat_i_ ac(ji) ) ) THEN440 zda_res(ji) = za_newice(ji) - ( amax - zat_i_ ac(ji) )413 IF ( za_newice(ji) > ( amax - zat_i_1d(ji) ) ) THEN 414 zda_res(ji) = za_newice(ji) - ( amax - zat_i_1d(ji) ) 441 415 zdv_res(ji) = zda_res (ji) * zh_newice(ji) 442 416 za_newice(ji) = za_newice(ji) - zda_res (ji) … … 446 420 zdv_res(ji) = 0._wp 447 421 ENDIF 448 END DO ! ji 449 450 !------------------------------------------------ 451 ! Laterally redistribute new ice volume and area 452 !------------------------------------------------ 453 zat_i_ac(:) = 0._wp 422 END DO 423 424 ! find which category to fill 425 zat_i_1d(:) = 0._wp 454 426 DO jl = 1, jpl 455 427 DO ji = 1, nbpac 456 IF( hi_max (jl-1) < zh_newice(ji) .AND. & 457 & zh_newice(ji) <= hi_max (jl) ) THEN 458 za_i_ac (ji,jl) = za_i_ac (ji,jl) + za_newice(ji) 459 zv_i_ac (ji,jl) = zv_i_ac (ji,jl) + zv_newice(ji) 460 zat_i_ac(ji) = zat_i_ac(ji) + za_i_ac (ji,jl) 461 zcatac (ji) = jl 428 IF( zh_newice(ji) > hi_max(jl-1) .AND. zh_newice(ji) <= hi_max(jl) ) THEN 429 za_i_1d (ji,jl) = za_i_1d (ji,jl) + za_newice(ji) 430 zv_i_1d (ji,jl) = zv_i_1d (ji,jl) + zv_newice(ji) 431 jcat (ji) = jl 462 432 ENDIF 463 END DO 464 END DO 465 466 !---------------------------------- 467 ! Heat content - lateral accretion 468 !---------------------------------- 469 DO ji = 1, nbpac 470 jl = zcatac(ji) ! categroy in which new ice is put 471 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) + epsi10 ) ) ! zindb=1 if ice =0 otherwise 472 zhice_old(ji,jl) = zv_old(ji,jl) / MAX( za_old(ji,jl) , epsi10 ) * zindb ! old ice thickness 473 zdhex (ji) = MAX( 0._wp , zh_newice(ji) - zhice_old(ji,jl) ) ! difference in thickness 474 zswinew (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi10 ) ) ! ice totally new in jl category 433 zat_i_1d(ji) = zat_i_1d(ji) + za_i_1d (ji,jl) 434 END DO 435 END DO 436 437 ! Heat content 438 DO ji = 1, nbpac 439 jl = jcat(ji) ! categroy in which new ice is put 440 zswinew (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) ) ) ! 0 if old ice 475 441 END DO 476 442 477 443 DO jk = 1, nlay_i 478 444 DO ji = 1, nbpac 479 jl = zcatac(ji) 480 zqold = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 481 zalphai = MIN( zhice_old(ji,jl) * REAL( jk ) / REAL( nlay_i ), zh_newice(ji) ) & 482 & - MIN( zhice_old(ji,jl) * REAL( jk - 1 ) / REAL( nlay_i ), zh_newice(ji) ) 483 ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji) & 484 + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl) * zqold * zhice_old(ji,jl) / REAL( nlay_i ) & 485 + za_newice(ji) * ze_newice(ji) * zalphai & 486 + za_newice(ji) * ze_newice(ji) * zdhex(ji) / REAL( nlay_i ) ) / ( ( zv_i_ac(ji,jl) ) / REAL( nlay_i ) ) 487 END DO 488 END DO 489 490 !----------------------------------------------- 491 ! Add excessive volume of new ice at the bottom 492 !----------------------------------------------- 493 ! If the ice concentration exceeds 1, the remaining volume of new ice 494 ! is equally redistributed among all ice categories in which there is 495 ! ice 496 497 ! Fraction of level ice 498 jm = 1 499 zat_i_lev(:) = 0._wp 500 501 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 502 DO ji = 1, nbpac 503 zat_i_lev(ji) = zat_i_lev(ji) + za_i_ac(ji,jl) 504 END DO 505 END DO 506 507 IF( ln_nicep .AND. jiindex_1d > 0 ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 508 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 509 DO ji = 1, nbpac 510 zindb = MAX( 0._wp, SIGN( 1._wp , zdv_res(ji) ) ) 511 zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_lev(ji) - epsi10 ) ) ! clem 512 zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zindb * zinda * zdv_res(ji) * za_i_ac(ji,jl) / MAX( zat_i_lev(ji) , epsi10 ) 513 END DO 514 END DO 515 IF( ln_nicep .AND. jiindex_1d > 0 ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 516 517 !--------------------------------- 518 ! Heat content - bottom accretion 519 !--------------------------------- 520 jm = 1 521 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 522 DO ji = 1, nbpac 523 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) + epsi10 ) ) ! zindb=1 if ice =0 otherwise 524 zhice_old(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb 525 zdhicbot (ji,jl) = zdv_res(ji) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb & 526 & + zindb * zdh_frazb(ji) ! frazil ice may coalesce 527 zdummy(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb ! thickness of residual ice 528 END DO 529 END DO 530 531 ! old layers thicknesses and enthalpies 532 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 445 jl = jcat(ji) 446 zinda = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) ) 447 ze_i_1d(ji,jk,jl) = zswinew(ji) * ze_newice(ji) + & 448 & ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_old(ji,jl) ) & 449 & * zinda / MAX( zv_i_1d(ji,jl), epsi20 ) 450 END DO 451 END DO 452 453 !------------------------------------------------ 454 ! 6.2) bottom ice growth + ice enthalpy remapping 455 !------------------------------------------------ 456 DO jl = 1, jpl 457 458 ! for remapping 459 h_i_old (1:nbpac,0:nlay_i+1) = 0._wp 460 qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp 533 461 DO jk = 1, nlay_i 534 462 DO ji = 1, nbpac 535 zthick0(ji,jk,jl) = zhice_old(ji,jl) / REAL( nlay_i )536 zqm0 (ji,jk,jl) = ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl)463 h_i_old (ji,jk) = zv_i_1d(ji,jl) / REAL( nlay_i ) 464 qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk) 537 465 END DO 538 466 END DO 539 END DO 540 !!gm ??? why the previous do loop if ocerwriten by the following one ? 541 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 467 468 ! new volumes including lateral/bottom accretion + residual 542 469 DO ji = 1, nbpac 543 zthick0(ji,nlay_i+1,jl) = zdhicbot(ji,jl) 544 zqm0 (ji,nlay_i+1,jl) = ze_newice(ji) * zdhicbot(ji,jl) 545 END DO ! ji 546 END DO ! jl 547 548 ! Redistributing energy on the new grid 549 ze_i_ac(:,:,:) = 0._wp 550 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 551 DO jk = 1, nlay_i 552 DO layer = 1, nlay_i + 1 553 DO ji = 1, nbpac 554 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) ) 555 ! Redistributing energy on the new grid 556 zweight = MAX ( MIN( zhice_old(ji,jl) * REAL( layer ), zdummy(ji,jl) * REAL( jk ) ) & 557 & - MAX( zhice_old(ji,jl) * REAL( layer - 1 ) , zdummy(ji,jl) * REAL( jk - 1 ) ) , 0._wp ) & 558 & /( MAX(REAL(nlay_i) * zthick0(ji,layer,jl),epsi10) ) * zindb 559 ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl) 560 END DO ! ji 561 END DO ! layer 562 END DO ! jk 563 END DO ! jl 564 565 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 566 DO jk = 1, nlay_i 567 DO ji = 1, nbpac 568 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) ) 569 ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl) & 570 & / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * REAL( nlay_i ) * zindb 571 END DO 572 END DO 573 END DO 470 zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) ) 471 zv_newfra = zinda * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_1d(ji,jl) / MAX( zat_i_1d(ji) , epsi20 ) 472 za_i_1d(ji,jl) = zinda * za_i_1d(ji,jl) 473 zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra 474 475 ! for remapping 476 h_i_old (ji,nlay_i+1) = zv_newfra 477 qh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra 478 ENDDO 479 480 ! --- Ice enthalpy remapping --- ! 481 IF( zv_newfra > 0._wp ) THEN 482 CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) ) 483 ENDIF 484 485 ENDDO 574 486 575 487 !------------ … … 578 490 DO jl = 1, jpl 579 491 DO ji = 1, nbpac 580 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ ac(ji,jl) + epsi10 ) ) ! 0 if no ice and 1 if yes581 zoa_i_ ac(ji,jl) = za_old(ji,jl) * zoa_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb492 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_1d(ji,jl) + epsi20 ) ) ! 0 if no ice and 1 if yes 493 zoa_i_1d(ji,jl) = za_old(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * zindb 582 494 END DO 583 495 END DO … … 586 498 ! Update salinity 587 499 !----------------- 588 !clem IF( num_sal == 2 ) THEN589 DO jl = 1, jpl590 DO ji = 1, nbpac591 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) ) ! 0 if no ice and 1 if yes592 zdv = zv_i_ac(ji,jl) - zv_old(ji,jl)593 zsmv_i_ac(ji,jl) = zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) * zindb ! clem modif594 END DO595 END DO596 !clem ENDIF597 598 !--------------------------------599 ! Update mass/salt fluxes (clem)600 !--------------------------------601 500 DO jl = 1, jpl 602 501 DO ji = 1, nbpac 603 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) ) ! 0 if no ice and 1 if yes 604 zdv = zv_i_ac(ji,jl) - zv_old(ji,jl) 605 rdm_ice_1d(ji) = rdm_ice_1d(ji) + zdv * rhoic * zindb 606 sfx_thd_1d(ji) = sfx_thd_1d(ji) - zdv * rhoic * zs_newice(ji) * r1_rdtice * zindb 607 END DO 502 zdv = zv_i_1d(ji,jl) - zv_old(ji,jl) 503 zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji) 504 END DO 608 505 END DO 609 506 610 507 !------------------------------------------------------------------------------! 611 ! 8) Change 2D vectors to 1D vectors508 ! 7) Change 2D vectors to 1D vectors 612 509 !------------------------------------------------------------------------------! 613 510 DO jl = 1, jpl 614 CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_ac (1:nbpac,jl), jpi, jpj ) 615 CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj ) 616 CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj ) 617 !clem IF ( num_sal == 2 ) & 618 CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 511 CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj ) 512 CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj ) 513 CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_1d(1:nbpac,jl), jpi, jpj ) 514 CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj ) 619 515 DO jk = 1, nlay_i 620 CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_ac(1:nbpac,jk,jl), jpi, jpj ) 621 END DO 622 END DO 623 CALL tab_1d_2d( nbpac, sfx_thd, npac(1:nbpac), sfx_thd_1d(1:nbpac), jpi, jpj ) 624 CALL tab_1d_2d( nbpac, rdm_ice, npac(1:nbpac), rdm_ice_1d(1:nbpac), jpi, jpj ) 516 CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_1d(1:nbpac,jk,jl), jpi, jpj ) 517 END DO 518 END DO 519 CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj ) 520 CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 521 CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 522 523 CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj ) 524 CALL tab_1d_2d( nbpac, hfx_opw, npac(1:nbpac), hfx_opw_1d(1:nbpac), jpi, jpj ) 625 525 ! 626 526 ENDIF ! nbpac > 0 627 527 628 528 !------------------------------------------------------------------------------! 629 ! 9) Change units for e_i529 ! 8) Change units for e_i 630 530 !------------------------------------------------------------------------------! 631 531 DO jl = 1, jpl 632 DO jk = 1, nlay_i ! heat content in 10^9 Joules 633 e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / REAL( nlay_i ) / unit_fac 532 DO jk = 1, nlay_i 533 DO jj = 1, jpj 534 DO ji = 1, jpi 535 ! heat content in Joules 536 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ) * unit_fac ) 537 END DO 538 END DO 634 539 END DO 635 540 END DO 636 541 637 !------------------------------------------------------------------------------|638 ! 10) Conservation check and changes in each ice category639 !------------------------------------------------------------------------------|640 IF( con_i ) THEN641 CALL lim_column_sum (jpl, v_i, vt_i_final)642 fieldid = 'v_i, limthd_lac'643 CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid)644 !645 CALL lim_column_sum_energy(jpl, nlay_i, e_i, et_i_final)646 fieldid = 'e_i, limthd_lac'647 CALL lim_cons_check (et_i_final, et_i_final, 1.0e-3, fieldid)648 !649 CALL lim_column_sum (jpl, v_s, vt_s_final)650 fieldid = 'v_s, limthd_lac'651 CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)652 !653 ! CALL lim_column_sum (jpl, e_s(:,:,1,:) , et_s_init)654 ! fieldid = 'e_s, limthd_lac'655 ! CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid)656 IF( ln_nicep ) THEN657 DO ji = mi0(jiindx), mi1(jiindx)658 DO jj = mj0(jjindx), mj1(jjindx)659 WRITE(numout,*) ' vt_i_init : ', vt_i_init (ji,jj)660 WRITE(numout,*) ' vt_i_final: ', vt_i_final(ji,jj)661 WRITE(numout,*) ' et_i_init : ', et_i_init (ji,jj)662 WRITE(numout,*) ' et_i_final: ', et_i_final(ji,jj)663 END DO664 END DO665 ENDIF666 !667 ENDIF668 542 ! 669 CALL wrk_dealloc( jpij, zcatac) ! integer543 CALL wrk_dealloc( jpij, jcat ) ! integer 670 544 CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 671 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 672 CALL wrk_dealloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 673 CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_ac ) 674 CALL wrk_dealloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 675 CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 545 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zat_i_lev, zv_frazb, zvrel_1d ) 546 CALL wrk_dealloc( jpij,jpl, zv_old, za_old, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 547 CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_1d ) 548 CALL wrk_dealloc( jpi,jpj, zvrel ) 676 549 ! 677 550 END SUBROUTINE lim_thd_lac -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r4897 r4900 53 53 ! 54 54 INTEGER :: ji, jk ! dummy loop indices 55 REAL(wp) :: zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch, ztmelts ! local scalars 56 REAL(wp) :: zaaa, zbbb, zccc, zdiscrim ! local scalars 57 REAL(wp), POINTER, DIMENSION(:) :: ze_init, zhiold, zsiold 55 REAL(wp) :: iflush, igravdr ! local scalars 58 56 !!--------------------------------------------------------------------- 59 57 60 CALL wrk_alloc( jpij, ze_init, zhiold, zsiold ) 61 58 !--------------------------------------------------------- 59 ! 0) Update ice salinity from snow-ice and bottom growth 60 !--------------------------------------------------------- 61 DO ji = kideb, kiut 62 sm_i_b(ji) = sm_i_b(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 63 END DO 64 62 65 !------------------------------------------------------------------------------| 63 66 ! 1) Constant salinity, constant in time | … … 74 77 ! Module 2 : Constant salinity varying in time | 75 78 !------------------------------------------------------------------------------| 76 77 79 IF( num_sal == 2 ) THEN 78 79 !---------------------------------80 ! Thickness at previous time step81 !---------------------------------82 DO ji = kideb, kiut83 zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji)84 zsiold(ji) = sm_i_b(ji)85 END DO86 87 !---------------------88 ! Global heat content89 !---------------------90 ze_init(:) = 0._wp91 DO jk = 1, nlay_i92 DO ji = kideb, kiut93 ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / REAL (nlay_i )94 END DO95 END DO96 80 97 81 DO ji = kideb, kiut … … 99 83 ! Switches 100 84 !---------- 101 iflush = MAX( 0._wp , SIGN( 1.0 , t_su_b(ji) - rtt ) ) ! =1 if summer 102 igravdr = MAX( 0._wp , SIGN( 1.0 , t_bo_b(ji) - t_su_b(ji) ) ) ! =1 if t_su < t_bo 103 iaccrbo = MAX( 0._wp , SIGN( 1.0 , dh_i_bott(ji) ) ) ! =1 if bottom accretion 104 i_ice_switch = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - ht_i_b(ji) + 1.e-2 ) ) 105 isnowic = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - dh_snowice(ji) ) ) * i_ice_switch ! =1 if snow ice formation 85 iflush = MAX( 0._wp , SIGN( 1._wp , t_su_b(ji) - rtt ) ) ! =1 if summer 86 igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_b(ji) - t_su_b(ji) ) ) ! =1 if t_su < t_bo 106 87 107 88 !--------------------- 108 89 ! Salinity tendencies 109 90 !--------------------- 110 ! !drainage by gravity drainage91 ! drainage by gravity drainage 111 92 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice 112 ! !drainage by flushing93 ! drainage by flushing 113 94 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 114 95 … … 120 101 sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 121 102 122 ! if no ice, salinity = 0.1123 i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) )124 sm_i_b(ji) = i_ice_switch * sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch )125 126 !----------------------------127 ! Heat flux - brine drainage128 !----------------------------129 fhbri_1d(ji) = 0._wp130 131 103 !---------------------------- 132 104 ! Salt flux - brine drainage 133 105 !---------------------------- 134 sfx_bri_1d(ji) = sfx_bri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) * ( sm_i_b(ji) - zsiold(ji) ) * r1_rdtice106 sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_b(ji) * ht_i_b(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice 135 107 136 108 END DO … … 138 110 ! Salinity profile 139 111 CALL lim_var_salprof1d( kideb, kiut ) 140 141 142 ! Only necessary for conservation check since salinity is modified143 !--------------------144 ! Temperature update145 !--------------------146 DO jk = 1, nlay_i147 DO ji = kideb, kiut148 ztmelts = -tmut*s_i_b(ji,jk) + rtt149 !Conversion q(S,T) -> T (second order equation)150 zaaa = cpic151 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus152 zccc = lfus * ( ztmelts - rtt )153 zdiscrim = SQRT( MAX( zbbb*zbbb - 4.0*zaaa*zccc, 0._wp ) )154 t_i_b(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa )155 END DO156 END DO157 112 ! 158 113 ENDIF … … 161 116 ! Module 3 : Profile of salinity, constant in time | 162 117 !------------------------------------------------------------------------------| 163 164 118 IF( num_sal == 3 ) CALL lim_var_salprof1d( kideb, kiut ) 165 119 166 !167 CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold )168 120 ! 169 121 END SUBROUTINE lim_thd_sal -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r4333 r4900 30 30 USE limvar ! clem for ice thickness correction 31 31 USE timing ! Timing 32 USE limcons ! conservation tests 32 33 33 34 IMPLICIT NONE … … 37 38 38 39 REAL(wp) :: epsi10 = 1.e-10_wp 39 REAL(wp) :: rzero = 0._wp 40 REAL(wp) :: rone = 1._wp 40 REAL(wp) :: epsi20 = 1.e-20_wp 41 41 42 42 !! * Substitution … … 67 67 INTEGER :: ierr ! error status 68 68 REAL(wp) :: zindb , zindsn , zindic, zindh, zinda ! local scalar 69 REAL(wp) :: zusvosn, zusvoic, zbigval ! - -70 69 REAL(wp) :: zcfl , zusnit ! - - 71 REAL(wp) :: z e , zsal , zage ! - -70 REAL(wp) :: zsal , zage ! - - 72 71 ! 73 72 REAL(wp), POINTER, DIMENSION(:,:) :: zui_u, zvi_v, zsm, zs0at, zs0ow 74 73 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 75 74 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zs0e 76 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset)77 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax, zchk_umax ! Check errors (C Rousset)78 75 ! mass and salt flux (clem) 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold ! old ice volume... 80 ! correct ice thickness (clem) 76 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold ! old ice volume... 81 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zaiold, zhimax ! old ice concentration and thickness 82 REAL(wp) :: zdv, zda, zvi, zvs, zsmv 78 REAL(wp), POINTER, DIMENSION(:,:) :: zeiold, zesold ! old enthalpies 79 REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei 80 ! 81 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 83 82 !!--------------------------------------------------------------------- 84 83 IF( nn_timing == 1 ) CALL timing_start('limtrp') 85 84 86 CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow )85 CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 87 86 CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 88 87 CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e ) 89 88 90 CALL wrk_alloc( jpi,jpj,jpl,zviold ) ! clem 91 CALL wrk_alloc( jpi,jpj,jpl,zaiold, zhimax ) ! clem 92 93 ! ------------------------------- 94 !- check conservation (C Rousset) 95 IF( ln_limdiahsb ) THEN 96 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 97 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 98 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 99 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 100 ENDIF 101 !- check conservation (C Rousset) 102 ! ------------------------------- 89 CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold ) ! clem 103 90 104 91 IF( numit == nstart .AND. lwp ) THEN … … 115 102 IF( ln_limdyn ) THEN ! Advection of sea ice properties ! 116 103 ! !-------------------------------------! 104 105 ! conservation test 106 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 107 117 108 ! mass and salt flux init (clem) 118 109 zviold(:,:,:) = v_i(:,:,:) 110 zeiold(:,:) = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) 111 zesold(:,:) = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) 119 112 120 113 !--- Thickness correction init. (clem) ------------------------------- … … 167 160 ! ENDIF 168 161 !!gm end 169 initad = 1 + NINT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) )162 initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) ) 170 163 zusnit = 1.0 / REAL( initad ) 171 164 IF( zcfl > 0.5 .AND. lwp ) & … … 175 168 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! 176 169 DO jk = 1,initad 177 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area170 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area 178 171 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 179 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:), &172 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:), & 180 173 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 181 174 DO jl = 1, jpl 182 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume ---175 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 183 176 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 184 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), &177 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 185 178 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 186 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---179 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 187 180 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 188 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), &181 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 189 182 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 190 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---183 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 191 184 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 192 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), &185 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 193 186 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 194 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---187 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 195 188 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 196 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), &189 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 197 190 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 198 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---191 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 199 192 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 200 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a (:,:,jl), sxa (:,:,jl), &193 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), & 201 194 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 202 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---195 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 203 196 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 204 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), &197 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 205 198 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 206 199 DO layer = 1, nlay_i !--- ice heat contents --- 207 CALL lim_adv_x( zusnit, u_ice, rone, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &200 CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 208 201 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 209 202 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 210 CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &203 CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 211 204 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 212 205 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) … … 216 209 ELSE 217 210 DO jk = 1, initad 218 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area211 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:), & !--- ice open water area 219 212 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 220 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:), &213 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:), & 221 214 & sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:) ) 222 215 DO jl = 1, jpl 223 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume ---216 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl), & !--- ice volume --- 224 217 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 225 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl), &218 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl), & 226 219 & sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl) ) 227 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume ---220 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & !--- snow volume --- 228 221 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 229 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), &222 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl), & 230 223 & sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl) ) 231 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity ---224 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & !--- ice salinity --- 232 225 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 233 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), &226 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl), & 234 227 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 235 228 236 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age ---229 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 237 230 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 238 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl), &231 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl), & 239 232 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) 240 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations ---233 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0a (:,:,jl), sxa (:,:,jl), & !--- ice concentrations --- 241 234 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 242 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0a (:,:,jl), sxa (:,:,jl), &235 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0a (:,:,jl), sxa (:,:,jl), & 243 236 & sxxa (:,:,jl), sya (:,:,jl), syya (:,:,jl), sxya (:,:,jl) ) 244 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents ---237 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & !--- snow heat contents --- 245 238 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 246 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), &239 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl), & 247 240 & sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl) ) 248 241 DO layer = 1, nlay_i !--- ice heat contents --- 249 CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &242 CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 250 243 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 251 244 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 252 CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), &245 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl), & 253 246 & sxxe(:,:,layer,jl), sye (:,:,layer,jl), & 254 247 & syye(:,:,layer,jl), sxye(:,:,layer,jl) ) … … 268 261 zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:) 269 262 zs0a (:,:,jl) = zs0a (:,:,jl) / area(:,:) 270 zs0c0 (:,:,jl) = zs0c0 (:,:,jl) / area(:,:) 271 DO jk = 1, nlay_i 272 zs0e(:,:,jk,jl) = zs0e(:,:,jk,jl) / area(:,:) 273 END DO 263 ! 274 264 END DO 275 265 … … 289 279 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 290 280 DO ji = 1 , fs_jpim1 ! vector opt. 291 pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji ,jj) ) ) ) &292 & * ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj)293 pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji,jj ) ) ) ) &294 & * ( 1._wp - MAX( rzero, SIGN( rone,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj)281 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji ,jj) ) ) ) & 282 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 283 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji,jj ) ) ) ) & 284 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 295 285 END DO 296 286 END DO … … 305 295 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 306 296 DO ji = 1 , fs_jpim1 ! vector opt. 307 pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji ,jj,jl) ) ) ) &308 & * ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)309 pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji,jj ,jl) ) ) ) &310 & * ( 1._wp - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)297 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji ,jj,jl) ) ) ) & 298 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 299 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji,jj ,jl) ) ) ) & 300 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 311 301 END DO 312 302 END DO … … 334 324 DO jj = 1, jpj 335 325 DO ji = 1, jpi 336 zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl) )337 zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl) )338 zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl) )339 zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl) )340 zs0a (ji,jj,jl) = MAX( rzero, zs0a (ji,jj,jl) )341 zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl) )326 zs0sn (ji,jj,jl) = MAX( 0._wp, zs0sn (ji,jj,jl) ) 327 zs0ice(ji,jj,jl) = MAX( 0._wp, zs0ice(ji,jj,jl) ) 328 zs0sm (ji,jj,jl) = MAX( 0._wp, zs0sm (ji,jj,jl) ) 329 zs0oi (ji,jj,jl) = MAX( 0._wp, zs0oi (ji,jj,jl) ) 330 zs0a (ji,jj,jl) = MAX( 0._wp, zs0a (ji,jj,jl) ) 331 zs0c0 (ji,jj,jl) = MAX( 0._wp, zs0c0 (ji,jj,jl) ) 342 332 zs0at (ji,jj) = zs0at(ji,jj) + zs0a(ji,jj,jl) 343 333 END DO … … 346 336 347 337 !--------------------------------------------------------- 348 ! 5.2) Snow thickness, Ice thickness, Ice concentrations338 ! 5.2) Update and mask variables 349 339 !--------------------------------------------------------- 350 DO jj = 1, jpj 351 DO ji = 1, jpi 352 zindb = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - epsi10) ) 353 zs0ow(ji,jj) = ( 1._wp - zindb ) + zindb * MAX( zs0ow(ji,jj), 0._wp ) 354 ato_i(ji,jj) = zs0ow(ji,jj) 355 END DO 356 END DO 357 358 DO jl = 1, jpl ! Remove very small areas 340 DO jl = 1, jpl 359 341 DO jj = 1, jpj 360 342 DO ji = 1, jpi 361 zvi = zs0ice(ji,jj,jl) 362 zvs = zs0sn(ji,jj,jl) 343 zindb= MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 344 345 zvi = zs0ice(ji,jj,jl) 346 zvs = zs0sn (ji,jj,jl) 347 zes = zs0c0 (ji,jj,jl) 348 zsmv = zs0sm (ji,jj,jl) 363 349 ! 364 zindb = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - epsi10) ) 365 ! 366 v_s(ji,jj,jl) = zindb * zs0sn (ji,jj,jl) 367 v_i(ji,jj,jl) = zindb * zs0ice(ji,jj,jl) 368 ! 369 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 370 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 371 zindb = MAX( zindsn, zindic ) 372 ! 373 zs0a(ji,jj,jl) = zindb * zs0a(ji,jj,jl) !ice concentration 374 a_i (ji,jj,jl) = zs0a(ji,jj,jl) 375 v_s (ji,jj,jl) = zindsn * v_s(ji,jj,jl) 376 v_i (ji,jj,jl) = zindic * v_i(ji,jj,jl) 377 ! 378 ! Update mass fluxes (clem) 379 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 380 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 350 ! Remove very small areas 351 v_s(ji,jj,jl) = zindb * zs0sn (ji,jj,jl) 352 v_i(ji,jj,jl) = zindb * zs0ice(ji,jj,jl) 353 a_i(ji,jj,jl) = zindb * zs0a (ji,jj,jl) 354 e_s(ji,jj,1,jl) = zindb * zs0c0 (ji,jj,jl) 355 ! Ice salinity and age 356 IF( num_sal == 2 ) THEN 357 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 358 ENDIF 359 oa_i(ji,jj,jl) = MAX( zindb * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl) 360 361 ! Update fluxes 362 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 363 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 364 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 365 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 381 366 END DO 382 367 END DO 383 368 END DO 369 370 DO jl = 1, jpl 371 DO jk = 1, nlay_i 372 DO jj = 1, jpj 373 DO ji = 1, jpi 374 zindb = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 375 zei = zs0e(ji,jj,jk,jl) 376 e_i(ji,jj,jk,jl) = zindb * MAX( 0._wp, zs0e(ji,jj,jk,jl) ) 377 ! Update fluxes 378 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 379 END DO !ji 380 END DO ! jj 381 END DO ! jk 382 END DO ! jl 384 383 385 384 !--- Thickness correction in case too high (clem) -------------------------------------------------------- … … 390 389 391 390 IF ( v_i(ji,jj,jl) > 0._wp ) THEN 392 zvi = v_i(ji,jj,jl) 393 zvs = v_s(ji,jj,jl) 394 zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl) 391 zvi = v_i (ji,jj,jl) 392 zvs = v_s (ji,jj,jl) 393 zsmv = smv_i(ji,jj,jl) 394 zes = e_s (ji,jj,1,jl) 395 zei = SUM( e_i(ji,jj,:,jl) ) 396 zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl) 395 397 !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl) 396 398 … … 399 401 & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN 400 402 ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) 401 zindh = MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) )402 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi 10 )403 zindh = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 404 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 403 405 ELSE 404 406 ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) ) 405 zindh = MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) )406 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi 10 )407 zindh = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 408 a_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 407 409 ENDIF 408 410 409 411 ! small correction due to *zindh for a_i 410 v_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) 411 v_s(ji,jj,jl) = zindh * v_s(ji,jj,jl) 412 v_i (ji,jj,jl) = zindh * v_i (ji,jj,jl) 413 v_s (ji,jj,jl) = zindh * v_s (ji,jj,jl) 414 smv_i(ji,jj,jl) = zindh * smv_i(ji,jj,jl) 415 e_s(ji,jj,1,jl) = zindh * e_s(ji,jj,1,jl) 416 e_i(ji,jj,:,jl) = zindh * e_i(ji,jj,:,jl) 412 417 413 418 ! Update mass fluxes 414 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 415 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 419 wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 420 wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 421 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 422 hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 423 hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,:,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 416 424 417 425 ENDIF 418 426 419 427 diag_trp_vi(ji,jj) = diag_trp_vi(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 420 421 END DO 422 END DO 423 END DO 424 425 ! --- 428 diag_trp_vs(ji,jj) = diag_trp_vs(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * r1_rdtice 429 430 END DO 431 END DO 432 END DO 433 ! ------------------------------------------------- 434 435 ! --- diags --- 426 436 DO jj = 1, jpj 427 437 DO ji = 1, jpi 428 zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) ! clem@useless??429 END DO430 END DO431 432 !---------------------- 433 ! 5.3) Ice properties434 !----------------------435 436 zbigval = 1.e+13437 438 diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 439 diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 440 END DO 441 END DO 442 443 ! --- agglomerate variables (clem) ----------------- 444 vt_i (:,:) = 0._wp 445 vt_s (:,:) = 0._wp 446 at_i (:,:) = 0._wp 447 ! 438 448 DO jl = 1, jpl 439 449 DO jj = 1, jpj 440 450 DO ji = 1, jpi 441 zsmv = zs0sm(ji,jj,jl) 442 443 ! Switches and dummy variables 444 zusvosn = 1.0/MAX( v_s(ji,jj,jl) , epsi10 ) 445 zusvoic = 1.0/MAX( v_i(ji,jj,jl) , epsi10 ) 446 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 447 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 448 zindb = MAX( zindsn, zindic ) 449 450 ! Ice salinity and age 451 !clem zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj), zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 452 IF( num_sal == 2 ) THEN 453 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 454 ENDIF 455 456 zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) ), 0._wp ) * a_i(ji,jj,jl) 457 oa_i (ji,jj,jl) = zindic * zage 458 459 ! Snow heat content 460 ze = MIN( MAX( 0.0, zs0c0(ji,jj,jl)*area(ji,jj) ), zbigval ) 461 e_s(ji,jj,1,jl) = zindsn * ze 462 463 ! Update salt fluxes (clem) 464 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 465 END DO !ji 466 END DO !jj 467 END DO ! jl 468 469 DO jl = 1, jpl 470 DO jk = 1, nlay_i 471 DO jj = 1, jpj 472 DO ji = 1, jpi 473 ! Ice heat content 474 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 475 ze = MIN( MAX( 0.0, zs0e(ji,jj,jk,jl)*area(ji,jj) ), zbigval ) 476 e_i(ji,jj,jk,jl) = zindic * ze 477 END DO !ji 478 END DO ! jj 479 END DO ! jk 480 END DO ! jl 481 482 483 ! --- agglomerate variables (clem) ----------------- 484 vt_i (:,:) = 0._wp 485 vt_s (:,:) = 0._wp 486 at_i (:,:) = 0._wp 487 ! 488 DO jl = 1, jpl 451 ! 452 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 453 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 454 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 455 END DO 456 END DO 457 END DO 458 ! ------------------------------------------------- 459 460 ! open water 489 461 DO jj = 1, jpj 490 462 DO ji = 1, jpi 491 ! 492 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 493 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 494 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 495 ! 496 zinda = MAX( rzero , SIGN( rone , at_i(ji,jj) - epsi10 ) ) 497 icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda ! ice thickness 498 END DO 499 END DO 500 END DO 501 ! ------------------------------------------------- 502 503 463 ! open water = 1 if at_i=0 464 zindb = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 465 ato_i(ji,jj) = zindb + (1._wp - zindb ) * zs0ow(ji,jj) 466 END DO 467 END DO 468 469 ! conservation test 470 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 504 471 505 472 ENDIF … … 536 503 END DO 537 504 ENDIF 538 ! -------------------------------539 !- check conservation (C Rousset)540 IF( ln_limdiahsb ) THEN541 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b542 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b543 544 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice545 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic )546 547 zchk_vmin = glob_min(v_i)548 zchk_amax = glob_max(SUM(a_i,dim=3))549 zchk_amin = glob_min(a_i)550 zchk_umax = glob_max(SQRT(u_ice**2 + v_ice**2))551 552 IF(lwp) THEN553 IF ( ABS( zchk_v_i ) > 1.e-5 ) THEN554 WRITE(numout,*) 'violation volume [m3/day] (limtrp) = ',(zchk_v_i * rday)555 WRITE(numout,*) 'u_ice max [m/s] (limtrp) = ',zchk_umax556 WRITE(numout,*) 'number of time steps (limtrp) =',kt557 ENDIF558 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limtrp) = ',(zchk_smv * rday)559 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limtrp) = ',(zchk_vmin * 1.e-3)560 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limtrp) = ',zchk_amin561 ENDIF562 ENDIF563 !- check conservation (C Rousset)564 ! -------------------------------565 505 ! 566 CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow )506 CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 567 507 CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 568 508 CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e ) 569 509 570 CALL wrk_dealloc( jpi, jpj,jpl,zaiold, zhimax ) ! clem510 CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax ) ! clem 571 511 ! 572 512 IF( nn_timing == 1 ) CALL timing_stop('limtrp') -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r4333 r4900 5 5 !!====================================================================== 6 6 !! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code 7 !! 3.6 ! 2014-06 (C. Rousset) Complete rewriting/cleaning 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_lim3 … … 32 33 USE par_ice 33 34 USE limitd_th 35 USE limitd_me 34 36 USE limvar 35 37 USE prtctl ! Print control … … 37 39 USE wrk_nemo ! work arrays 38 40 USE lib_fortran ! glob_sum 39 ! Check budget (Rousset)40 41 USE in_out_manager ! I/O manager 41 42 USE iom ! I/O manager 42 43 USE lib_mpp ! MPP library 43 44 USE timing ! Timing 45 USE limcons ! conservation tests 44 46 45 47 IMPLICIT NONE … … 49 51 50 52 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 51 REAL(wp) :: rzero = 0._wp ! - -52 REAL(wp) :: rone = 1._wp ! - -53 53 54 54 !! * Substitutions … … 66 66 !! 67 67 !! ** Purpose : Computes update of sea-ice global variables at 68 !! the end of the time step. 69 !! Address pathological cases 70 !! This place is very important 68 !! the end of the dynamics. 71 69 !! 72 !! ** Method :73 !! Ice speed from ice dynamics74 !! Ice thickness, Snow thickness, Temperatures, Lead fraction75 !! from advection and ice thermodynamics76 !!77 !! ** Action : -78 70 !!--------------------------------------------------------------------- 79 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 80 INTEGER :: jbnd1, jbnd2 81 INTEGER :: i_ice_switch 82 INTEGER :: ind_im, layer ! indices for internal melt 83 REAL(wp) :: zweight, zesum, z_da_i, zhimax 84 REAL(wp) :: zinda, zindb, zindsn, zindic 85 REAL(wp) :: zindg, zh, zdvres, zviold2 86 REAL(wp) :: zbigvalue, zvsold2, z_da_ex 87 REAL(wp) :: z_prescr_hi, zat_i_old, ztmelts, ze_s 88 89 REAL(wp), POINTER, DIMENSION(:) :: zthick0, zqm0 ! thickness of the layers and heat contents for 90 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 91 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 92 ! mass and salt flux (clem) 93 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume... 71 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 72 INTEGER :: jbnd1, jbnd2 73 INTEGER :: i_ice_switch 74 REAL(wp) :: zsal 75 ! 76 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 94 77 !!------------------------------------------------------------------- 95 78 IF( nn_timing == 1 ) CALL timing_start('limupdate1') 96 79 97 CALL wrk_alloc( jkmax, zthick0, zqm0 ) 98 99 CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem 100 101 !------------------------------------------------------------------------------ 102 ! 1. Update of Global variables | 103 !------------------------------------------------------------------------------ 104 105 !----------------- 106 ! Trend terms 107 !----------------- 108 d_u_ice_dyn(:,:) = u_ice(:,:) - old_u_ice(:,:) 109 d_v_ice_dyn(:,:) = v_ice(:,:) - old_v_ice(:,:) 110 d_a_i_trp (:,:,:) = a_i (:,:,:) - old_a_i (:,:,:) 111 d_v_s_trp (:,:,:) = v_s (:,:,:) - old_v_s (:,:,:) 112 d_v_i_trp (:,:,:) = v_i (:,:,:) - old_v_i (:,:,:) 113 d_e_s_trp (:,:,:,:) = e_s (:,:,:,:) - old_e_s (:,:,:,:) 114 d_e_i_trp (:,:,:,:) = e_i (:,:,:,:) - old_e_i (:,:,:,:) 115 d_oa_i_trp (:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:) 116 d_smv_i_trp(:,:,:) = 0._wp 117 IF( num_sal == 2 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 118 119 ! mass and salt flux init (clem) 120 zviold(:,:,:) = v_i(:,:,:) 121 zvsold(:,:,:) = v_s(:,:,:) 122 zsmvold(:,:,:) = smv_i(:,:,:) 123 124 ! ------------------------------- 125 !- check conservation (C Rousset) 126 IF (ln_limdiahsb) THEN 127 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 128 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 129 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 130 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 131 ENDIF 132 !- check conservation (C Rousset) 133 ! ------------------------------- 80 IF( ln_limdyn ) THEN 81 82 ! conservation test 83 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 84 85 !----------------- 86 ! zap small values 87 !----------------- 88 CALL lim_itd_me_zapsmall 134 89 135 90 CALL lim_var_glo2eqv 136 137 !--------------------------------------138 ! 2. Review of all pathological cases139 !--------------------------------------140 141 ! clem: useless now142 !-------------------------------------------143 ! 2.1) Advection of ice in an ice-free cell144 !-------------------------------------------145 ! should be removed since it is treated after dynamics now146 ! zhimax = 5._wp147 ! ! first category148 ! DO jj = 1, jpj149 ! DO ji = 1, jpi150 ! !--- the thickness of such an ice is often out of bounds151 ! !--- thus we recompute a new area while conserving ice volume152 ! zat_i_old = SUM( old_a_i(ji,jj,:) )153 ! zindb = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_trp(ji,jj,1) ) - epsi10 ) )154 ! IF( ( ABS( d_v_i_trp(ji,jj,1) ) / MAX( ABS( d_a_i_trp(ji,jj,1) ), epsi10 ) * zindb .GT. zhimax ) &155 ! & .AND.( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) &156 ! & .AND.( zat_i_old .LT. 1.e-6 ) ) THEN ! new line157 ! ht_i(ji,jj,1) = hi_max(1) * 0.5_wp158 ! a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1)159 ! ENDIF160 ! END DO161 ! END DO162 !163 ! zhimax = 20._wp164 ! ! other categories165 ! DO jl = 2, jpl166 ! jm = ice_types(jl)167 ! DO jj = 1, jpj168 ! DO ji = 1, jpi169 ! zindb = MAX( rzero, SIGN( rone, ABS( d_a_i_trp(ji,jj,jl) ) - epsi10 ) )170 ! ! this correction is very tricky... sometimes, advection gets wrong i don't know why171 ! ! it makes problems when the advected volume and concentration do not seem to be172 ! ! related with each other173 ! ! the new thickness is sometimes very big!174 ! ! and sometimes d_a_i_trp and d_v_i_trp have different sign175 ! ! which of course is plausible176 ! ! but fuck! it fucks everything up :)177 ! IF ( ( ABS( d_v_i_trp(ji,jj,jl) ) / MAX( ABS( d_a_i_trp(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) &178 ! & .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN179 ! ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp180 ! a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl)181 ! ENDIF182 ! END DO ! ji183 ! END DO !jj184 ! END DO !jl185 91 186 at_i(:,:) = 0._wp187 DO jl = 1, jpl188 at_i(:,:) = a_i(:,:,jl) + at_i(:,:)189 END DO190 191 92 !---------------------------------------------------- 192 ! 2.2)Rebin categories with thickness out of bounds93 ! Rebin categories with thickness out of bounds 193 94 !---------------------------------------------------- 194 95 DO jm = 1, jpm … … 203 104 END DO 204 105 205 zbigvalue = 1.0e+20 206 207 DO jl = 1, jpl 208 DO jj = 1, jpj 106 !---------------------------------------------------- 107 ! ice concentration should not exceed amax 108 !----------------------------------------------------- 109 DO jl = 1, jpl 110 DO jj = 1, jpj 209 111 DO ji = 1, jpi 210 211 !switches 212 zindb = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 213 !switch = 1 if a_i > 1e-06 and 0 if not 214 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 215 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 216 ! bug fix 25 avril 2007 217 zindb = zindb*zindic 218 219 !--- 2.3 Correction to ice age 220 !------------------------------ 221 ! IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 222 ! o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 223 ! ENDIF 224 IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 225 oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 112 IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 113 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 114 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 226 115 ENDIF 227 oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 228 229 !--- 2.4 Correction to snow thickness 230 !------------------------------------- 231 ! ! snow thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hs = 0 232 ! v_s(ji,jj,jl) = MAX( zindb * v_s(ji,jj,jl), 0.0) 233 ! snow thickness cannot be smaller than 1e-6 234 zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 235 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 236 237 !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 238 239 !--- 2.5 Correction to ice thickness 240 !------------------------------------- 241 zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 242 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 243 244 !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 245 !sfx_res(ji,jj) = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 246 247 !--- 2.6 Snow is transformed into ice if the original ice cover disappears 248 !---------------------------------------------------------------------------- 249 zindg = tms(ji,jj) * MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 250 zdvres = zindg * rhosn * v_s(ji,jj,jl) / rau0 251 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 252 253 zdvres = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 254 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 255 256 !--- 2.7 Correction to ice concentrations 257 !-------------------------------------------- 258 ! if greater than 0, ice concentration cannot be smaller than 1e-10 259 a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 260 261 !------------------------- 262 ! 2.8) Snow heat content 263 !------------------------- 264 e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0._wp, e_s(ji,jj,1,jl) ), zbigvalue ) ) 265 266 END DO ! ji 267 END DO ! jj 268 END DO ! jl 269 270 !------------------------ 271 ! 2.9) Ice heat content 272 !------------------------ 273 274 DO jl = 1, jpl 275 DO jk = 1, nlay_i 276 DO jj = 1, jpj 277 DO ji = 1, jpi 278 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 279 e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 280 END DO ! ji 281 END DO ! jj 282 END DO !jk 283 END DO !jl 284 116 END DO 117 END DO 118 END DO 119 285 120 at_i(:,:) = 0._wp 286 121 DO jl = 1, jpl 287 122 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 288 123 END DO 289 290 !--- 2.13 ice concentration should not exceed amax 291 ! (it should not be the case) 292 !----------------------------------------------------- 293 DO jj = 1, jpj 294 DO ji = 1, jpi 295 z_da_ex = MAX( at_i(ji,jj) - amax , 0.0 ) 296 zindb = MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) ) 297 DO jl = 1, jpl 298 z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 299 a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 300 ! 301 zinda = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 302 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 303 !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 304 END DO 305 END DO 306 END DO 307 at_i(:,:) = a_i(:,:,1) 308 DO jl = 2, jpl 309 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 310 END DO 311 312 124 125 ! -------------------------------------- 313 126 ! Final thickness distribution rebinning 314 127 ! -------------------------------------- … … 321 134 END DO 322 135 136 !----------------- 137 ! zap small values 138 !----------------- 139 CALL lim_itd_me_zapsmall 323 140 324 141 !--------------------- 325 ! 2.11) Ice salinity142 ! Ice salinity bounds 326 143 !--------------------- 327 ! clem correct bug on smv_i 328 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 329 330 IF ( num_sal == 2 ) THEN ! general case 144 IF ( num_sal == 2 ) THEN 331 145 DO jl = 1, jpl 332 !DO jk = 1, nlay_i 333 DO jj = 1, jpj 334 DO ji = 1, jpi 335 ! salinity stays in bounds 336 !clem smv_i(ji,jj,jl) = MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) ) 337 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 338 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 339 smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 340 END DO ! ji 341 END DO ! jj 342 !END DO !jk 343 END DO !jl 344 ENDIF 345 346 at_i(:,:) = a_i(:,:,1) 347 DO jl = 2, jpl 348 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 349 END DO 350 351 352 !-------------------------------- 353 ! Update mass/salt fluxes (clem) 354 !-------------------------------- 355 DO jl = 1, jpl 356 DO jj = 1, jpj 357 DO ji = 1, jpi 358 diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice 359 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic 360 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn 361 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice 146 DO jj = 1, jpj 147 DO ji = 1, jpi 148 zsal = smv_i(ji,jj,jl) 149 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 150 ! salinity stays in bounds 151 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 152 smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 153 ! associated salt flux 154 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 155 END DO 362 156 END DO 363 157 END DO 364 END DO365 366 ! -------------------------------367 !- check conservation (C Rousset)368 IF (ln_limdiahsb) THEN369 370 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b371 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b372 373 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice374 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic )375 376 zchk_vmin = glob_min(v_i)377 zchk_amax = glob_max(SUM(a_i,dim=3))378 zchk_amin = glob_min(a_i)379 380 IF(lwp) THEN381 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limupdate1) = ',(zchk_v_i * rday)382 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate1) = ',(zchk_smv * rday)383 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limupdate1) = ',(zchk_vmin * 1.e-3)384 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limupdate1) = ',zchk_amax385 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limupdate1) = ',zchk_amin386 ENDIF387 158 ENDIF 388 !- check conservation (C Rousset) 389 ! ------------------------------- 159 160 ! ------------------------------------------------- 161 ! Diagnostics 162 ! ------------------------------------------------- 163 d_u_ice_dyn(:,:) = u_ice(:,:) - old_u_ice(:,:) 164 d_v_ice_dyn(:,:) = v_ice(:,:) - old_v_ice(:,:) 165 d_a_i_trp (:,:,:) = a_i (:,:,:) - old_a_i (:,:,:) 166 d_v_s_trp (:,:,:) = v_s (:,:,:) - old_v_s (:,:,:) 167 d_v_i_trp (:,:,:) = v_i (:,:,:) - old_v_i (:,:,:) 168 d_e_s_trp (:,:,:,:) = e_s (:,:,:,:) - old_e_s (:,:,:,:) 169 d_e_i_trp (:,:,1:nlay_i,:) = e_i (:,:,1:nlay_i,:) - old_e_i(:,:,1:nlay_i,:) 170 d_oa_i_trp (:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:) 171 d_smv_i_trp(:,:,:) = 0._wp 172 IF( num_sal == 2 ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 173 174 ! conservation test 175 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 390 176 391 177 IF(ln_ctl) THEN ! Control print … … 446 232 CALL prt_ctl_info(' - Heat / FW fluxes : ') 447 233 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ') 448 CALL prt_ctl(tab2d_1=fmmec , clinfo1= ' lim_update1 : fmmec : ', tab2d_2=fhmec , clinfo2= ' fhmec : ')449 234 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update1 : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 450 CALL prt_ctl(tab2d_1=fhbri , clinfo1= ' lim_update1 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ')451 235 452 236 CALL prt_ctl_info(' ') … … 458 242 ENDIF 459 243 460 461 CALL wrk_dealloc( jkmax, zthick0, zqm0 ) 462 463 CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem 244 ENDIF ! ln_limdyn 464 245 465 246 IF( nn_timing == 1 ) CALL timing_stop('limupdate1') -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r4333 r4900 5 5 !!====================================================================== 6 6 !! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code 7 !! 3.6 ! 2014-06 (C. Rousset) Complete rewriting/cleaning 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_lim3 … … 39 40 USE lib_fortran ! glob_sum 40 41 USE timing ! Timing 42 USE limcons ! conservation tests 41 43 42 44 IMPLICIT NONE … … 45 47 PUBLIC lim_update2 ! routine called by ice_step 46 48 47 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 48 REAL(wp) :: rzero = 0._wp ! - - 49 REAL(wp) :: rone = 1._wp ! - - 50 49 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 50 REAL(wp) :: epsi20 = 1.e-20_wp 51 51 52 !! * Substitutions 52 53 # include "vectopt_loop_substitute.h90" … … 64 65 !! ** Purpose : Computes update of sea-ice global variables at 65 66 !! the end of the time step. 66 !! Address pathological cases67 !! This place is very important68 !!69 !! ** Method :70 !! Ice speed from ice dynamics71 !! Ice thickness, Snow thickness, Temperatures, Lead fraction72 !! from advection and ice thermodynamics73 67 !! 74 !! ** Action : -75 68 !!--------------------------------------------------------------------- 76 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 77 INTEGER :: jbnd1, jbnd2 78 INTEGER :: i_ice_switch 79 INTEGER :: ind_im, layer ! indices for internal melt 80 REAL(wp) :: zweight, zesum, zhimax, z_da_i 81 REAL(wp) :: zinda, zindb, zindsn, zindic 82 REAL(wp) :: zindg, zh, zdvres, zviold2 83 REAL(wp) :: zbigvalue, zvsold2, z_da_ex 84 REAL(wp) :: z_prescr_hi, zat_i_old, ztmelts, ze_s 85 86 INTEGER , POINTER, DIMENSION(:,:,:) :: internal_melt 87 REAL(wp), POINTER, DIMENSION(:) :: zthick0, zqm0 ! thickness of the layers and heat contents for 88 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 89 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 90 ! mass and salt flux (clem) 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold, zvsold, zsmvold ! old ice volume... 69 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 70 INTEGER :: jbnd1, jbnd2 71 INTEGER :: i_ice_switch 72 REAL(wp) :: zh, zsal 73 ! 74 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 92 75 !!------------------------------------------------------------------- 93 76 IF( nn_timing == 1 ) CALL timing_start('limupdate2') 94 77 95 CALL wrk_alloc( jpi,jpj,jpl, internal_melt ) ! integer 96 CALL wrk_alloc( jkmax, zthick0, zqm0 ) 97 98 CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem 99 100 !---------------------------------------------------------------------------------------- 101 ! 1. Computation of trend terms 102 !---------------------------------------------------------------------------------------- 103 !- Trend terms 104 d_a_i_thd(:,:,:) = a_i(:,:,:) - old_a_i(:,:,:) 105 d_v_s_thd(:,:,:) = v_s(:,:,:) - old_v_s(:,:,:) 106 d_v_i_thd(:,:,:) = v_i(:,:,:) - old_v_i(:,:,:) 107 d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:) 108 d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 109 !?? d_oa_i_thd(:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:) 110 d_smv_i_thd(:,:,:) = 0._wp 111 IF( num_sal == 2 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 112 ! diag only (clem) 113 dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 114 115 ! mass and salt flux init (clem) 116 zviold(:,:,:) = v_i(:,:,:) 117 zvsold(:,:,:) = v_s(:,:,:) 118 zsmvold(:,:,:) = smv_i(:,:,:) 119 120 ! ------------------------------- 121 !- check conservation (C Rousset) 122 IF (ln_limdiahsb) THEN 123 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 124 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 125 zchk_fw_b = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 126 zchk_fs_b = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 127 ENDIF 128 !- check conservation (C Rousset) 129 ! ------------------------------- 78 ! conservation test 79 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 80 81 !----------------- 82 ! zap small values 83 !----------------- 84 CALL lim_itd_me_zapsmall 130 85 131 86 CALL lim_var_glo2eqv 132 87 133 !--------------------------------------134 ! 2. Review of all pathological cases135 !--------------------------------------136 137 ! clem: useless now138 !-------------------------------------------139 ! 2.1) Advection of ice in an ice-free cell140 !-------------------------------------------141 ! should be removed since it is treated after dynamics now142 ! zhimax = 5._wp143 ! ! first category144 ! DO jj = 1, jpj145 ! DO ji = 1, jpi146 ! !--- the thickness of such an ice is often out of bounds147 ! !--- thus we recompute a new area while conserving ice volume148 ! zat_i_old = SUM( old_a_i(ji,jj,:) )149 ! zindb = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_thd(ji,jj,1) ) - epsi10 ) )150 ! IF ( ( ABS( d_v_i_thd(ji,jj,1) ) / MAX( ABS( d_a_i_thd(ji,jj,1) ),epsi10 ) * zindb .GT. zhimax ) &151 ! & .AND. ( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) &152 ! & .AND. ( zat_i_old .LT. 1.e-6 ) ) THEN ! new line153 ! ht_i(ji,jj,1) = hi_max(1) * 0.5_wp154 ! a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1)155 ! ENDIF156 ! END DO157 ! END DO158 159 ! zhimax = 20._wp160 ! ! other categories161 ! DO jl = 2, jpl162 ! jm = ice_types(jl)163 ! DO jj = 1, jpj164 ! DO ji = 1, jpi165 ! zindb = MAX( rzero, SIGN( rone, ABS( d_a_i_thd(ji,jj,jl)) - epsi10 ) )166 ! ! this correction is very tricky... sometimes, advection gets wrong i don't know why167 ! ! it makes problems when the advected volume and concentration do not seem to be168 ! ! related with each other169 ! ! the new thickness is sometimes very big!170 ! ! and sometimes d_a_i_trp and d_v_i_trp have different sign171 ! ! which of course is plausible172 ! ! but fuck! it fucks everything up :)173 ! IF ( ( ABS( d_v_i_thd(ji,jj,jl) ) / MAX( ABS( d_a_i_thd(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) &174 ! & .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN175 ! ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp176 ! a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl)177 ! ENDIF178 ! END DO ! ji179 ! END DO !jj180 ! END DO !jl181 182 at_i(:,:) = 0._wp183 DO jl = 1, jpl184 at_i(:,:) = a_i(:,:,jl) + at_i(:,:)185 END DO186 187 88 !---------------------------------------------------- 188 ! 2.2)Rebin categories with thickness out of bounds89 ! Rebin categories with thickness out of bounds 189 90 !---------------------------------------------------- 190 91 DO jm = 1, jpm … … 194 95 END DO 195 96 196 !--------------------------------- 197 ! 2.3) Melt of an internal layer 198 !--------------------------------- 199 internal_melt(:,:,:) = 0 200 201 DO jl = 1, jpl 202 DO jk = 1, nlay_i 203 DO jj = 1, jpj 204 DO ji = 1, jpi 205 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 206 IF ( ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) & 207 & .AND. ( v_i(ji,jj,jl) .GT. 0.0 ) .AND. ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 208 internal_melt(ji,jj,jl) = 1 209 ENDIF 210 END DO ! ji 211 END DO ! jj 212 END DO !jk 213 END DO !jl 214 215 DO jl = 1, jpl 216 DO jj = 1, jpj 217 DO ji = 1, jpi 218 IF( internal_melt(ji,jj,jl) == 1 ) THEN 219 ! initial ice thickness 220 !----------------------- 221 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 222 223 ! reduce ice thickness 224 !----------------------- 225 ind_im = 0 226 zesum = 0.0 227 DO jk = 1, nlay_i 228 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 229 IF ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) ind_im = ind_im + 1 230 zesum = zesum + e_i(ji,jj,jk,jl) 231 END DO 232 ht_i(ji,jj,jl) = ht_i(ji,jj,jl) - REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) 233 v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 234 235 !CLEM 236 zdvres = REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) * a_i(ji,jj,jl) 237 !rdm_ice(ji,jj) = rdm_ice(ji,jj) - zdvres * rhoic 238 !sfx_res(ji,jj) = sfx_res(ji,jj) + sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 239 240 ! redistribute heat 241 !----------------------- 242 ! old thicknesses and enthalpies 243 ind_im = 0 244 DO jk = 1, nlay_i 245 ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 246 IF ( ( e_i(ji,jj,jk,jl) .GT. 0.0 ) .AND. & 247 ( t_i(ji,jj,jk,jl) .LT. ztmelts ) ) THEN 248 ind_im = ind_im + 1 249 zthick0(ind_im) = ht_i(ji,jj,jl) * REAL(ind_im / nlay_i) 250 zqm0 (ind_im) = MAX( e_i(ji,jj,jk,jl) , 0.0 ) 251 ENDIF 252 END DO 253 254 ! Redistributing energy on the new grid 255 IF ( ind_im .GT. 0 ) THEN 256 257 DO jk = 1, nlay_i 258 e_i(ji,jj,jk,jl) = 0.0 259 DO layer = 1, ind_im 260 zweight = MAX ( & 261 MIN( ht_i(ji,jj,jl) * REAL(layer/ind_im) , ht_i(ji,jj,jl) * REAL(jk / nlay_i) ) - & 262 MAX( ht_i(ji,jj,jl) * REAL((layer-1)/ind_im) , ht_i(ji,jj,jl) * REAL((jk-1) / nlay_i) ) , 0.0 ) & 263 / ( ht_i(ji,jj,jl) / REAL(ind_im) ) 264 265 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) + zweight*zqm0(layer) 266 END DO !layer 267 END DO ! jk 268 269 zesum = 0.0 270 DO jk = 1, nlay_i 271 zesum = zesum + e_i(ji,jj,jk,jl) 272 END DO 273 274 ELSE ! ind_im .EQ. 0, total melt 275 e_i(ji,jj,jk,jl) = 0.0 276 ENDIF 277 278 ENDIF ! internal_melt 279 280 END DO ! ji 281 END DO !jj 282 END DO !jl 283 284 internal_melt(:,:,:) = 0 285 286 287 ! Melt of snow 288 !-------------- 289 DO jl = 1, jpl 290 DO jj = 1, jpj 291 DO ji = 1, jpi 292 ! snow energy of melting 293 zinda = MAX( 0._wp, SIGN( 1._wp, v_s(ji,jj,jl) - epsi10 ) ) 294 ze_s = zinda * e_s(ji,jj,1,jl) * unit_fac / area(ji,jj) / MAX( v_s(ji,jj,jl), epsi10 ) ! snow energy of melting 295 296 ! If snow energy of melting smaller then Lf 297 ! Then all snow melts and meltwater, heat go to the ocean 298 IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = 1 299 300 END DO 301 END DO 302 END DO 303 304 DO jl = 1, jpl 305 DO jj = 1, jpj 306 DO ji = 1, jpi 307 IF ( internal_melt(ji,jj,jl) == 1 ) THEN 308 zdvres = v_s(ji,jj,jl) 309 ! release heat 310 fheat_res(ji,jj) = fheat_res(ji,jj) + ze_s * zdvres / rdt_ice 311 ! release mass 312 !rdm_snw(ji,jj) = rdm_snw(ji,jj) - zdvres * rhosn 313 ! 314 v_s(ji,jj,jl) = 0.0 315 e_s(ji,jj,1,jl) = 0.0 316 ENDIF 317 END DO 318 END DO 319 END DO 320 321 zbigvalue = 1.0e+20 322 DO jl = 1, jpl 323 DO jj = 1, jpj 324 DO ji = 1, jpi 325 326 !switches 327 zindb = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 328 !switch = 1 if a_i > 1e-06 and 0 if not 329 zindsn = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 330 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 331 ! bug fix 25 avril 2007 332 zindb = zindb*zindic 333 334 !--- 2.3 Correction to ice age 335 !------------------------------ 336 ! IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 337 ! o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 338 ! ENDIF 339 IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 340 oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 341 ENDIF 342 oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 343 344 !--- 2.4 Correction to snow thickness 345 !------------------------------------- 346 zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 347 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 348 349 !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 350 351 !--- 2.5 Correction to ice thickness 352 !------------------------------------- 353 zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 354 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 355 356 !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 357 !sfx_res(ji,jj) = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 358 359 !--- 2.6 Snow is transformed into ice if the original ice cover disappears 360 !---------------------------------------------------------------------------- 361 zindg = tms(ji,jj) * MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 362 zdvres = zindg * rhosn * v_s(ji,jj,jl) / rau0 363 v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 364 365 zdvres = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 366 v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 367 368 !--- 2.7 Correction to ice concentrations 369 !-------------------------------------------- 370 a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 371 372 !------------------------- 373 ! 2.8) Snow heat content 374 !------------------------- 375 e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0.0, e_s(ji,jj,1,jl) ), zbigvalue ) ) 376 377 END DO ! ji 378 END DO ! jj 379 END DO ! jl 380 381 !------------------------ 382 ! 2.9) Ice heat content 383 !------------------------ 384 385 DO jl = 1, jpl 386 DO jk = 1, nlay_i 387 DO jj = 1, jpj 388 DO ji = 1, jpi 389 zindic = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 390 e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 391 END DO ! ji 392 END DO ! jj 393 END DO !jk 394 END DO !jl 395 396 97 !---------------------------------------------------------------------- 98 ! Constrain the thickness of the smallest category above hiclim 99 !---------------------------------------------------------------------- 397 100 DO jm = 1, jpm 398 101 DO jj = 1, jpj 399 102 DO ji = 1, jpi 400 103 jl = ice_cat_bounds(jm,1) 401 !--- 2.12 Constrain the thickness of the smallest category above 5 cm 402 !---------------------------------------------------------------------- 403 zindb = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 404 ht_i(ji,jj,jl) = zindb*v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl), epsi10) 405 zh = MAX( rone , zindb * hiclim / MAX( ht_i(ji,jj,jl) , epsi10 ) ) 406 ht_s(ji,jj,jl) = ht_s(ji,jj,jl)* zh 407 ht_i(ji,jj,jl) = ht_i(ji,jj,jl)* zh 408 a_i (ji,jj,jl) = a_i(ji,jj,jl) / zh 409 !CLEM 410 v_i (ji,jj,jl) = a_i(ji,jj,jl) * ht_i(ji,jj,jl) 411 v_s (ji,jj,jl) = a_i(ji,jj,jl) * ht_s(ji,jj,jl) 104 IF( v_i(ji,jj,jl) > 0._wp .AND. ht_i(ji,jj,jl) < hiclim ) THEN 105 zh = hiclim / ht_i(ji,jj,jl) 106 ht_s(ji,jj,jl) = ht_s(ji,jj,jl) * zh 107 ht_i(ji,jj,jl) = ht_i(ji,jj,jl) * zh 108 a_i (ji,jj,jl) = a_i(ji,jj,jl) / zh 109 ENDIF 412 110 END DO !ji 413 111 END DO !jj 414 112 END DO !jm 113 114 !----------------------------------------------------- 115 ! ice concentration should not exceed amax 116 !----------------------------------------------------- 117 at_i(:,:) = 0._wp 118 DO jl = 1, jpl 119 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 120 END DO 121 122 DO jl = 1, jpl 123 DO jj = 1, jpj 124 DO ji = 1, jpi 125 IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 126 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 127 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 128 ENDIF 129 END DO 130 END DO 131 END DO 415 132 416 133 at_i(:,:) = 0.0 … … 418 135 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 419 136 END DO 420 421 !--- 2.13 ice concentration should not exceed amax 422 ! (it should not be the case) 423 !----------------------------------------------------- 424 DO jj = 1, jpj 425 DO ji = 1, jpi 426 z_da_ex = MAX( at_i(ji,jj) - amax , 0.0 ) 427 zindb = MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) ) 428 DO jl = 1, jpl 429 z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 430 a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 431 ! 432 zinda = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) ) 433 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 434 !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 435 END DO 436 END DO 437 END DO 438 at_i(:,:) = 0.0 439 DO jl = 1, jpl 440 at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 441 END DO 442 137 138 ! -------------------------------------- 443 139 ! Final thickness distribution rebinning 444 140 ! -------------------------------------- … … 451 147 END DO 452 148 149 !----------------- 150 ! zap small values 151 !----------------- 152 CALL lim_itd_me_zapsmall 153 453 154 !--------------------- 454 155 ! 2.11) Ice salinity 455 156 !--------------------- 456 ! clem correct bug on smv_i 457 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 458 459 IF ( num_sal == 2 ) THEN ! general case 157 IF ( num_sal == 2 ) THEN 460 158 DO jl = 1, jpl 461 !DO jk = 1, nlay_i462 DO j j = 1, jpj463 DO ji = 1, jpi464 ! salinity stays in bounds465 !clem smv_i(ji,jj,jl) = MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) )466 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) )467 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ))468 smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl)469 END DO ! ji470 END DO ! j j471 !END DO !jk159 DO jj = 1, jpj 160 DO ji = 1, jpi 161 zsal = smv_i(ji,jj,jl) 162 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 163 ! salinity stays in bounds 164 i_ice_switch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 165 smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 166 ! associated salt flux 167 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 168 END DO ! ji 169 END DO ! jj 472 170 END DO !jl 473 171 ENDIF 474 475 ! -------------------476 at_i(:,:) = a_i(:,:,1)477 DO jl = 2, jpl478 at_i(:,:) = a_i(:,:,jl) + at_i(:,:)479 END DO480 172 481 173 !------------------------------------------------------------------------------ … … 486 178 DO jj = 2, jpjm1 487 179 DO ji = 2, jpim1 488 IF ( at_i(ji,jj) .EQ. 0.0) THEN ! what to do if there is no ice489 IF ( at_i(ji+1,jj) .EQ. 0.0 ) u_ice(ji,jj) = 0.0! right side490 IF ( at_i(ji-1,jj) .EQ. 0.0 ) u_ice(ji-1,jj) = 0.0! left side491 IF ( at_i(ji,jj+1) .EQ. 0.0 ) v_ice(ji,jj) = 0.0! upper side492 IF ( at_i(ji,jj-1) .EQ. 0.0 ) v_ice(ji,jj-1) = 0.0! bottom side180 IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice 181 IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji,jj) = 0._wp ! right side 182 IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side 183 IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj) = 0._wp ! upper side 184 IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side 493 185 ENDIF 494 186 END DO … … 501 193 v_ice(:,:) = v_ice(:,:) * tmv(:,:) 502 194 503 !-------------------------------- 504 ! Update mass/salt fluxes (clem) 505 !-------------------------------- 506 DO jl = 1, jpl 507 DO jj = 1, jpj 508 DO ji = 1, jpi 509 diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice 510 rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic 511 rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn 512 sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice 513 END DO 514 END DO 515 END DO 516 517 ! ------------------------------- 518 !- check conservation (C Rousset) 519 IF (ln_limdiahsb) THEN 520 521 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 522 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 523 524 zchk_v_i = ( glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 525 zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 526 527 zchk_vmin = glob_min(v_i) 528 zchk_amax = glob_max(SUM(a_i,dim=3)) 529 zchk_amin = glob_min(a_i) 530 531 IF(lwp) THEN 532 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limupdate2) = ',(zchk_v_i * rday) 533 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate2) = ',(zchk_smv * rday) 534 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limupdate2) = ',(zchk_vmin * 1.e-3) 535 IF ( zchk_amax > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax (limupdate2) = ',zchk_amax 536 IF ( zchk_amin < 0. ) WRITE(numout,*) 'violation a_i<0 (limupdate2) = ',zchk_amin 537 ENDIF 538 ENDIF 539 !- check conservation (C Rousset) 540 ! ------------------------------- 195 ! ------------------------------------------------- 196 ! Diagnostics 197 ! ------------------------------------------------- 198 d_a_i_thd(:,:,:) = a_i(:,:,:) - old_a_i(:,:,:) 199 d_v_s_thd(:,:,:) = v_s(:,:,:) - old_v_s(:,:,:) 200 d_v_i_thd(:,:,:) = v_i(:,:,:) - old_v_i(:,:,:) 201 d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:) 202 d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - old_e_i(:,:,1:nlay_i,:) 203 !?? d_oa_i_thd(:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:) 204 d_smv_i_thd(:,:,:) = 0._wp 205 IF( num_sal == 2 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 206 ! diag only (clem) 207 dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 208 209 ! heat content variation (W.m-2) 210 DO jj = 1, jpj 211 DO ji = 1, jpi 212 diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) + & 213 & SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) ) ) * unit_fac * r1_rdtice / area(ji,jj) 214 END DO 215 END DO 216 217 ! conservation test 218 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 541 219 542 220 IF(ln_ctl) THEN ! Control print … … 596 274 CALL prt_ctl_info(' - Heat / FW fluxes : ') 597 275 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ') 598 CALL prt_ctl(tab2d_1=fmmec , clinfo1= ' lim_update2 : fmmec : ', tab2d_2=fhmec , clinfo2= ' fhmec : ')599 276 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update2 : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 600 CALL prt_ctl(tab2d_1=fhbri , clinfo1= ' lim_update2 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ')601 277 602 278 CALL prt_ctl_info(' ') … … 608 284 ENDIF 609 285 610 CALL wrk_dealloc( jpi,jpj,jpl, internal_melt ) ! integer611 CALL wrk_dealloc( jkmax, zthick0, zqm0 )612 613 CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold ) ! clem614 615 286 IF( nn_timing == 1 ) CALL timing_stop('limupdate2') 287 616 288 END SUBROUTINE lim_update2 617 289 #else -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r4333 r4900 67 67 68 68 REAL(wp) :: epsi10 = 1.e-10_wp ! - - 69 REAL(wp) :: zzero = 0.e0 ! - -70 REAL(wp) :: zone = 1.e0 ! - -71 69 72 70 !!---------------------------------------------------------------------- … … 113 111 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 114 112 ! 115 zinda = MAX( zzero , SIGN( zone, at_i(ji,jj) - epsi10 ) )113 zinda = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 116 114 icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda ! ice thickness 117 115 END DO … … 134 132 DO jj = 1, jpj 135 133 DO ji = 1, jpi 136 zinda = MAX( zzero , SIGN( zone, vt_i(ji,jj) - epsi10 ) )137 zindb = MAX( zzero , SIGN( zone, at_i(ji,jj) - epsi10 ) )134 zinda = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 135 zindb = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 138 136 et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content 139 137 smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * zinda ! ice salinity … … 205 203 DO ji = 1, jpi 206 204 ! ! Energy of melting q(S,T) [J.m-3] 207 zq_i = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)208 205 zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) ) ! zindb = 0 if no ice and 1 if yes 209 zq_i = zq_i * unit_fac * zindb !convert units 206 zq_i = zindb * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp) 207 zq_i = zq_i * unit_fac !convert units 210 208 ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt ! Ice layer melt temperature 211 209 ! … … 231 229 DO ji = 1, jpi 232 230 !Energy of melting q(S,T) [J.m-3] 233 zq_s = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp)234 231 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) ) ! zindb = 0 if no ice and 1 if yes 235 zq_s = zq_s * unit_fac * zindb ! convert units 232 zq_s = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 233 zq_s = zq_s * unit_fac ! convert units 236 234 ! 237 235 t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 ) … … 320 318 DO jj = 1, jpj 321 319 DO ji = 1, jpi 322 z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01, ht_i(ji,jj,jl) )320 z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) ) 323 321 END DO 324 322 END DO … … 475 473 ! 476 474 DO ji = kideb, kiut ! Slope of the linear profile zs_zero 477 z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( 0.01, ht_i_b(ji) )475 z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( epsi10 , ht_i_b(ji) ) 478 476 END DO 479 477 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r4897 r4900 9 9 !!---------------------------------------------------------------------- 10 10 !! lim_wri : write of the diagnostics variables in ouput file 11 !! lim_wri_init : initialization and namelist read12 11 !! lim_wri_state : write for initial state or/and abandon 13 12 !!---------------------------------------------------------------------- … … 36 35 PUBLIC lim_wri_state ! called by dia_wri_state 37 36 38 INTEGER, PARAMETER :: jpnoumax = 43 !: maximum number of variable for ice output39 40 INTEGER :: noumef ! number of fields41 INTEGER :: noumefa ! number of additional fields42 INTEGER :: add_diag_swi ! additional diagnostics43 INTEGER :: nz ! dimension for the itd field44 45 REAL(wp) , DIMENSION(jpnoumax) :: cmulti ! multiplicative constant46 REAL(wp) , DIMENSION(jpnoumax) :: cadd ! additive constant47 REAL(wp) , DIMENSION(jpnoumax) :: cmultia ! multiplicative constant48 REAL(wp) , DIMENSION(jpnoumax) :: cadda ! additive constant49 CHARACTER(len = 35), DIMENSION(jpnoumax) :: titn, titna ! title of the field50 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: nam , nama ! name of the field51 CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: uni , unia ! unit of the field52 INTEGER , DIMENSION(jpnoumax) :: nc , nca ! switch for saving field ( = 1 ) or not ( = 0 )53 54 37 REAL(wp) :: epsi06 = 1.e-6_wp 55 REAL(wp) :: zzero = 0._wp56 REAL(wp) :: zone = 1._wp57 38 !!---------------------------------------------------------------------- 58 39 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) … … 78 59 INTEGER, INTENT(in) :: kindic ! if kindic < 0 there has been an error somewhere 79 60 ! 80 INTEGER :: ji, jj, jk, jl, jf, ipl ! dummy loop indices 81 INTEGER :: ierr 82 REAL(wp),DIMENSION(1) :: zdept 83 REAL(wp) :: zsto, zjulian, zout, zindh, zinda, zindb, zindc 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zcmo, zcmoa 85 REAL(wp), POINTER, DIMENSION(:,: ) :: zfield 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmaskitd, zoi, zei 87 88 CHARACTER(len = 60) :: clhstnam, clop, clhstnama 89 90 INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid 91 INTEGER , SAVE :: nicea, nhorida, ndimitd 92 INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndex51 93 INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndexitd 61 INTEGER :: ji, jj, jk, jl ! dummy loop indices 62 REAL(wp) :: zinda, zindb, z1_365 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: zoi, zei 64 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, z2da, z2db, zind ! 2D workspace 94 65 !!------------------------------------------------------------------- 95 66 96 67 IF( nn_timing == 1 ) CALL timing_start('limwri') 97 68 98 CALL wrk_alloc( jpi, jpj, zfield ) 99 CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 100 CALL wrk_alloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 101 102 ipl = jpl 103 104 IF( numit == nstart ) THEN 105 106 ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), STAT=ierr ) 107 IF( lk_mpp ) CALL mpp_sum ( ierr ) 108 IF( ierr /= 0 ) THEN 109 CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' ) ; RETURN 110 ENDIF 111 112 CALL lim_wri_init 113 114 IF(lwp) WRITE(numout,*) ' lim_wri, first time step ' 115 IF(lwp) WRITE(numout,*) ' add_diag_swi ', add_diag_swi 116 117 !-------------------- 118 ! 1) Initialization 119 !-------------------- 120 121 !------------- 122 ! Normal file 123 !------------- 124 niter = ( nit000 - 1 ) / nn_fsbc 125 CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) 126 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 127 !clem 128 ! zsto = rdt_ice 129 ! IF( ln_mskland ) THEN ; clop = "ave(only(x))" ! put 1.e+20 on land (very expensive!!) 130 ! ELSE ; clop = "ave(x)" ! no use of the mask value (require less cpu time) 131 ! ENDIF 132 ! zout = nwrite * rdt_ice / nn_fsbc 133 ! zdept(1) = 0. 134 ! 135 ! CALL dia_nam ( clhstnam, nwrite, 'icemod_old' ) 136 ! CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice, & 137 ! & nhorid, nice, domain_id=nidom, snc4chunks=snc4set ) 138 ! CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down") 139 ! CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 140 ! 141 ! DO jf = 1 , noumef 142 ! IF(lwp) WRITE(numout,*) 'jf', jf 143 ! IF ( nc(jf) == 1 ) THEN 144 ! CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj & 145 ! , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 146 ! IF(lwp) WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout' 147 ! IF(lwp) WRITE(numout,*) nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout 148 ! ENDIF 149 ! END DO 150 ! 151 ! CALL histend(nice, snc4set) 152 !clem 153 ! 154 !----------------- 155 ! ITD file output 156 !----------------- 157 zsto = rdt_ice 158 clop = "ave(x)" 159 zout = nwrite * rdt_ice / nn_fsbc 160 zdept(1) = 0. 161 162 CALL dia_nam ( clhstnama, nwrite, 'icemoa' ) 163 CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit, & 164 1, jpi, 1, jpj, & ! zoom 165 niter, zjulian, rdt_ice, & ! time 166 nhorida, & ! ? linked with horizontal ... 167 nicea , domain_id=nidom, snc4chunks=snc4set) ! file 168 CALL histvert( nicea, "icethi", "L levels","m", ipl , hi_mean , nz ) 69 CALL wrk_alloc( jpi, jpj, jpl, zoi, zei ) 70 CALL wrk_alloc( jpi, jpj , z2d, z2da, z2db, zind ) 71 72 !----------------------------- 73 ! Mean category values 74 !----------------------------- 75 76 CALL lim_var_icetm ! mean sea ice temperature 77 78 CALL lim_var_bv ! brine volume 79 80 DO jj = 1, jpj ! presence indicator of ice 81 DO ji = 1, jpi 82 zind(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) 83 END DO 84 END DO 85 ! 86 ! 87 ! 88 IF ( iom_use( "icethic_cea" ) ) THEN ! mean ice thickness 89 DO jj = 1, jpj 90 DO ji = 1, jpi 91 z2d(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zind(ji,jj) 92 END DO 93 END DO 94 CALL iom_put( "icethic_cea" , z2d ) 95 ENDIF 96 97 IF ( iom_use( "snowthic_cea" ) ) THEN ! snow thickness = mean snow thickness over the cell 98 DO jj = 1, jpj 99 DO ji = 1, jpi 100 z2d(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zind(ji,jj) 101 END DO 102 END DO 103 CALL iom_put( "snowthic_cea" , z2d ) 104 ENDIF 105 ! 106 IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN 107 DO jj = 2 , jpjm1 108 DO ji = 2 , jpim1 109 z2da(ji,jj) = ( u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 110 z2db(ji,jj) = ( v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 111 END DO 112 END DO 113 CALL lbc_lnk( z2da, 'T', -1. ) 114 CALL lbc_lnk( z2db, 'T', -1. ) 115 CALL iom_put( "uice_ipa" , z2da ) ! ice velocity u component 116 CALL iom_put( "vice_ipa" , z2db ) ! ice velocity v component 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 z2d(ji,jj) = SQRT( z2da(ji,jj) * z2da(ji,jj) + z2db(ji,jj) * z2db(ji,jj) ) 120 END DO 121 END DO 122 CALL iom_put( "icevel" , z2d ) ! ice velocity module 123 ENDIF 124 ! 125 IF ( iom_use( "miceage" ) ) THEN 126 z2d(:,:) = 0.e0 169 127 DO jl = 1, jpl 170 zmaskitd(:,:,jl) = tmask(:,:,1) 171 END DO 172 CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 173 CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd ) 174 CALL histdef( nicea, "iice_itd", "Ice area in categories" , "-" , & 175 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 176 CALL histdef( nicea, "iice_hid", "Ice thickness in categories" , "m" , & 177 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 178 CALL histdef( nicea, "iice_hsd", "Snow depth in in categories" , "m" , & 179 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 180 CALL histdef( nicea, "iice_std", "Ice salinity distribution" , "ppt" , & 181 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 182 CALL histdef( nicea, "iice_otd", "Ice age distribution" , "days", & 183 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 184 CALL histdef( nicea, "iice_etd", "Brine volume distr. " , "%" , & 185 jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 186 CALL histend(nicea, snc4set) 187 ENDIF 188 189 ! !-----------------------------------------------------------------------! 190 ! !--2. Computation of instantaneous values ! 191 ! !-----------------------------------------------------------------------! 192 193 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 194 !IF( ln_nicep ) THEN 195 ! WRITE(numout,*) 196 ! WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit 197 ! WRITE(numout,*) '~~~~~~~ ' 198 ! WRITE(numout,*) ' kindic = ', kindic 199 !ENDIF 200 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 201 202 !-- calculs des valeurs instantanees 203 zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 204 zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 205 206 ! Ice surface temperature and some fluxes 207 DO jl = 1, jpl 128 DO jj = 1, jpj 129 DO ji = 1, jpi 130 z2d(ji,jj) = z2d(ji,jj) + zind(ji,jj) * oa_i(ji,jj,jl) 131 END DO 132 END DO 133 END DO 134 z1_365 = 1._wp / 365._wp 135 CALL iom_put( "miceage" , z2d * z1_365 ) ! mean ice age 136 ENDIF 137 138 IF ( iom_use( "micet" ) ) THEN 208 139 DO jj = 1, jpj 209 140 DO ji = 1, jpi 210 zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 211 zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl) 212 zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl) 213 zcmo(ji,jj,27) = zcmo(ji,jj,27) + zinda*(t_su(ji,jj,jl)-rtt)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 214 zcmo(ji,jj,21) = zcmo(ji,jj,21) + zinda*oa_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 215 END DO 216 END DO 217 END DO 218 219 ! Mean sea ice temperature 220 CALL lim_var_icetm 221 222 ! Brine volume 223 CALL lim_var_bv 224 225 DO jj = 2 , jpjm1 226 DO ji = 2 , jpim1 227 zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 228 zindb = MAX( zzero , SIGN( zone , at_i(ji,jj) ) ) 229 230 zcmo(ji,jj,1) = at_i(ji,jj) 231 zcmo(ji,jj,2) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 232 zcmo(ji,jj,3) = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 233 zcmo(ji,jj,4) = diag_bot_gr(ji,jj) * rday ! Bottom thermodynamic ice production 234 zcmo(ji,jj,5) = diag_dyn_gr(ji,jj) * rday ! Dynamic ice production (rid/raft) 235 zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * rday ! Lateral thermodynamic ice production 236 zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * rday ! Snow ice production ice production 237 zcmo(ji,jj,24) = (tm_i(ji,jj) - rtt) * zinda 238 239 zcmo(ji,jj,6) = fbif(ji,jj)*at_i(ji,jj) 240 zcmo(ji,jj,7) = ( u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 241 zcmo(ji,jj,8) = ( v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 242 zcmo(ji,jj,9) = sst_m(ji,jj) 243 zcmo(ji,jj,10) = sss_m(ji,jj) 244 245 zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 246 zcmo(ji,jj,12) = qsr(ji,jj) 247 zcmo(ji,jj,13) = qns(ji,jj) 248 zcmo(ji,jj,14) = fhbri(ji,jj) 249 zcmo(ji,jj,15) = utau_ice(ji,jj) 250 zcmo(ji,jj,16) = vtau_ice(ji,jj) 251 zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj) 252 zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj) 253 zcmo(ji,jj,19) = sprecip(ji,jj) 254 zcmo(ji,jj,20) = smt_i(ji,jj) 255 zcmo(ji,jj,25) = et_i(ji,jj) 256 zcmo(ji,jj,26) = et_s(ji,jj) 257 zcmo(ji,jj,28) = sfx_bri(ji,jj) 258 zcmo(ji,jj,29) = sfx_thd(ji,jj) 259 260 zcmo(ji,jj,30) = bv_i(ji,jj) 261 zcmo(ji,jj,31) = hicol(ji,jj) * zindb 262 zcmo(ji,jj,32) = strength(ji,jj) 263 zcmo(ji,jj,33) = SQRT( zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8) ) 264 zcmo(ji,jj,34) = diag_sur_me(ji,jj) * rday ! Surface melt 265 zcmo(ji,jj,35) = diag_bot_me(ji,jj) * rday ! Bottom melt 266 zcmo(ji,jj,36) = divu_i(ji,jj) 267 zcmo(ji,jj,37) = shear_i(ji,jj) 268 zcmo(ji,jj,38) = diag_res_pr(ji,jj) * rday ! Bottom melt 269 zcmo(ji,jj,39) = vt_i(ji,jj) ! ice volume 270 zcmo(ji,jj,40) = vt_s(ji,jj) ! snow volume 271 272 zcmo(ji,jj,41) = sfx_mec(ji,jj) 273 zcmo(ji,jj,42) = sfx_res(ji,jj) 274 275 zcmo(ji,jj,43) = diag_trp_vi(ji,jj) * rday ! transport of ice volume 276 277 END DO 278 END DO 279 280 ! 281 ! ecriture d'un fichier netcdf 282 ! 283 niter = niter + 1 284 !clem 285 ! DO jf = 1 , noumef 286 ! ! 287 ! zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) 288 ! ! 289 ! IF( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN ; CALL lbc_lnk( zfield, 'T', -1. ) 290 ! ELSE ; CALL lbc_lnk( zfield, 'T', 1. ) 291 ! ENDIF 292 ! ! 293 ! IF( ln_nicep ) THEN 294 ! WRITE(numout,*) 295 ! WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim' 296 ! WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim 297 ! ENDIF 298 ! IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 299 ! ! 300 ! END DO 301 ! 302 ! IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 303 ! IF( lwp) WRITE(numout,*) ' Closing the icemod file ' 304 ! CALL histclo( nice ) 305 ! ENDIF 306 !clem 307 ! 308 CALL iom_put ('iceconc', zcmo(:,:,1) ) ! field1: ice concentration 309 CALL iom_put ('icethic_cea', zcmo(:,:,2) ) ! field2: ice thickness (i.e. icethi(:,:)) 310 CALL iom_put ('snowthic_cea', zcmo(:,:,3)) ! field3: snow thickness 311 CALL iom_put ('icebopr', zcmo(:,:,4) ) ! field4: daily bottom thermo ice production 312 CALL iom_put ('icedypr', zcmo(:,:,5) ) ! field5: daily dynamic ice production 313 CALL iom_put ('ioceflxb', zcmo(:,:,6) ) ! field6: Oceanic flux at the ice base 314 CALL iom_put ('uice_ipa', zcmo(:,:,7) ) ! field7: ice velocity u component 315 CALL iom_put ('vice_ipa', zcmo(:,:,8) ) ! field8: ice velocity v component 316 CALL iom_put ('isst', zcmo(:,:,9) ) ! field 9: sea surface temperature 317 CALL iom_put ('isss', zcmo(:,:,10) ) ! field 10: sea surface salinity 318 CALL iom_put ('qt_oce', zcmo(:,:,11) ) ! field 11: total flux at ocean surface 319 CALL iom_put ('qsr_oce', zcmo(:,:,12) ) ! field 12: solar flux at ocean surface 320 CALL iom_put ('qns_oce', zcmo(:,:,13) ) ! field 13: non-solar flux at ocean surface 321 !CALL iom_put ('hfbri', fhbri ) ! field 14: heat flux due to brine release 322 CALL iom_put( 'utau_ice', zcmo(:,:,15) ) ! Wind stress over ice along i-axis at I-point 323 CALL iom_put( 'vtau_ice', zcmo(:,:,16) ) ! Wind stress over ice along j-axis at I-point 324 CALL iom_put ('qsr_io', zcmo(:,:,17) ) ! field 17: solar flux at ice/ocean surface 325 CALL iom_put ('qns_io', zcmo(:,:,18) ) ! field 18: non-solar flux at ice/ocean surface 326 !CALL iom_put ('snowpre', zcmo(:,:,19) * rday ! field 19 :snow precip 327 CALL iom_put ('micesalt', zcmo(:,:,20) ) ! field 20 :mean ice salinity 328 CALL iom_put ('miceage', zcmo(:,:,21) / 365) ! field 21: mean ice age 329 CALL iom_put ('icelapr',zcmo(:,:,22) ) ! field 22: daily lateral thermo ice prod. 330 CALL iom_put ('icesipr',zcmo(:,:,23) ) ! field 23: daily snowice ice prod. 331 CALL iom_put ('micet', zcmo(:,:,24) ) ! field 24: mean ice temperature 332 CALL iom_put ('icehc', zcmo(:,:,25) ) ! field 25: ice total heat content 333 CALL iom_put ('isnowhc', zcmo(:,:,26) ) ! field 26: snow total heat content 334 CALL iom_put ('icest', zcmo(:,:,27) ) ! field 27: ice surface temperature 335 CALL iom_put ('sfxbri', zcmo(:,:,28) * rday ) ! field 28: brine salt flux 336 CALL iom_put ('sfxthd', zcmo(:,:,29) * rday ) ! field 29: equivalent FW salt flux 337 CALL iom_put ('ibrinv', zcmo(:,:,30) *100 ) ! field 30: brine volume 338 CALL iom_put ('icecolf', zcmo(:,:,31) ) ! field 31: frazil ice collection thickness 339 CALL iom_put ('icestr', zcmo(:,:,32) * 0.001 ) ! field 32: ice strength 340 CALL iom_put ('icevel', zcmo(:,:,33) ) ! field 33: ice velocity 341 CALL iom_put ('isume', zcmo(:,:,34) ) ! field 34: surface melt 342 CALL iom_put ('ibome', zcmo(:,:,35) ) ! field 35: bottom melt 343 CALL iom_put ('idive', zcmo(:,:,36) * 1.0e8) ! field 36: divergence 344 CALL iom_put ('ishear', zcmo(:,:,37) * 1.0e8 ) ! field 37: shear 345 CALL iom_put ('icerepr', zcmo(:,:,38) ) ! field 38: daily prod./melting due to limupdate 346 CALL iom_put ('icevolu', zcmo(:,:,39) ) ! field 39: ice volume 347 CALL iom_put ('snowvol', zcmo(:,:,40) ) ! field 40: snow volume 348 CALL iom_put ('sfxmec', zcmo(:,:,41) * rday ) ! field 41: salt flux from ridging rafting 349 CALL iom_put ('sfxres', zcmo(:,:,42) * rday ) ! field 42: salt flux from limupdate (resultant) 350 CALL iom_put ('icetrp', zcmo(:,:,43) ) ! field 43: ice volume transport 351 352 !----------------------------- 353 ! Thickness distribution file 354 !----------------------------- 355 IF( add_diag_swi == 1 ) THEN 356 357 DO jl = 1, jpl 358 CALL lbc_lnk( a_i(:,:,jl) , 'T' , 1. ) 359 CALL lbc_lnk( sm_i(:,:,jl) , 'T' , 1. ) 360 CALL lbc_lnk( oa_i(:,:,jl) , 'T' , 1. ) 361 CALL lbc_lnk( ht_i(:,:,jl) , 'T' , 1. ) 362 CALL lbc_lnk( ht_s(:,:,jl) , 'T' , 1. ) 363 END DO 364 365 ! Compute ice age 141 z2d(ji,jj) = ( tm_i(ji,jj) - rtt ) * zind(ji,jj) 142 END DO 143 END DO 144 CALL iom_put( "micet" , z2d ) ! mean ice temperature 145 ENDIF 146 ! 147 IF ( iom_use( "icest" ) ) THEN 148 z2d(:,:) = 0.e0 149 DO jl = 1, jpl 150 DO jj = 1, jpj 151 DO ji = 1, jpi 152 z2d(ji,jj) = z2d(ji,jj) + zind(ji,jj) * ( t_su(ji,jj,jl) - rtt ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 ) 153 END DO 154 END DO 155 END DO 156 CALL iom_put( "icest" , z2d ) ! ice surface temperature 157 ENDIF 158 159 IF ( iom_use( "icecolf" ) ) THEN 160 DO jj = 1, jpj 161 DO ji = 1, jpi 162 zindb = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) ) 163 z2d(ji,jj) = hicol(ji,jj) * zindb 164 END DO 165 END DO 166 CALL iom_put( "icecolf" , z2d ) ! frazil ice collection thickness 167 ENDIF 168 169 CALL iom_put( "isst" , sst_m ) ! sea surface temperature 170 CALL iom_put( "isss" , sss_m ) ! sea surface salinity 171 CALL iom_put( "iceconc" , at_i ) ! ice concentration 172 CALL iom_put( "icevolu" , vt_i ) ! ice volume = mean ice thickness over the cell 173 CALL iom_put( "icehc" , et_i ) ! ice total heat content 174 CALL iom_put( "isnowhc" , et_s ) ! snow total heat content 175 CALL iom_put( "ibrinv" , bv_i * 100._wp ) ! brine volume 176 CALL iom_put( "utau_ice" , utau_ice ) ! wind stress over ice along i-axis at I-point 177 CALL iom_put( "vtau_ice" , vtau_ice ) ! wind stress over ice along j-axis at I-point 178 CALL iom_put( "snowpre" , sprecip ) ! snow precipitation 179 CALL iom_put( "micesalt" , smt_i ) ! mean ice salinity 180 181 CALL iom_put( "icestr" , strength * 0.001 ) ! ice strength 182 CALL iom_put( "idive" , divu_i * 1.0e8 ) ! divergence 183 CALL iom_put( "ishear" , shear_i * 1.0e8 ) ! shear 184 CALL iom_put( "snowvol" , vt_s ) ! snow volume 185 186 CALL iom_put( "icetrp" , diag_trp_vi * rday ) ! ice volume transport 187 CALL iom_put( "snwtrp" , diag_trp_vs * rday ) ! snw volume transport 188 CALL iom_put( "deitrp" , diag_trp_ei ) ! advected ice enthalpy (W/m2) 189 CALL iom_put( "destrp" , diag_trp_es ) ! advected snw enthalpy (W/m2) 190 191 CALL iom_put( "sfxbog" , sfx_bog * rday ) ! salt flux from brines 192 CALL iom_put( "sfxbom" , sfx_bom * rday ) ! salt flux from brines 193 CALL iom_put( "sfxsum" , sfx_sum * rday ) ! salt flux from brines 194 CALL iom_put( "sfxsni" , sfx_sni * rday ) ! salt flux from brines 195 CALL iom_put( "sfxopw" , sfx_opw * rday ) ! salt flux from brines 196 CALL iom_put( "sfxdyn" , sfx_dyn * rday ) ! salt flux from ridging rafting 197 CALL iom_put( "sfxres" , sfx_res * rday ) ! salt flux from limupdate (resultant) 198 CALL iom_put( "sfxbri" , sfx_bri * rday ) ! salt flux from brines 199 CALL iom_put( "sfx" , sfx * rday ) ! total salt flux 200 201 CALL iom_put( "vfxres" , wfx_res * rday / rhoic ) ! daily prod./melting due to limupdate 202 CALL iom_put( "vfxopw" , wfx_opw * rday / rhoic ) ! daily lateral thermodynamic ice production 203 CALL iom_put( "vfxsni" , wfx_sni * rday / rhoic ) ! daily snowice ice production 204 CALL iom_put( "vfxbog" , wfx_bog * rday / rhoic ) ! daily bottom thermodynamic ice production 205 CALL iom_put( "vfxdyn" , wfx_dyn * rday / rhoic ) ! daily dynamic ice production (rid/raft) 206 CALL iom_put( "vfxsum" , wfx_sum * rday / rhoic ) ! surface melt 207 CALL iom_put( "vfxbom" , wfx_bom * rday / rhoic ) ! bottom melt 208 CALL iom_put( "vfxice" , wfx_ice * rday / rhoic ) ! total ice growth/melt 209 CALL iom_put( "vfxsnw" , wfx_snw * rday / rhoic ) ! total snw growth/melt 210 CALL iom_put( "vfxsub" , wfx_sub * rday / rhoic ) ! sublimation (snow) 211 CALL iom_put( "vfxspr" , wfx_spr * rday / rhoic ) ! precip (snow) 212 213 CALL iom_put ('hfxthd', hfx_thd(:,:) ) ! 214 CALL iom_put ('hfxdyn', hfx_dyn(:,:) ) ! 215 CALL iom_put ('hfxres', hfx_res(:,:) ) ! 216 CALL iom_put ('hfxout', hfx_out(:,:) ) ! 217 CALL iom_put ('hfxin' , hfx_in(:,:) ) ! 218 CALL iom_put ('hfxsnw', hfx_snw(:,:) ) ! 219 CALL iom_put ('hfxsub', hfx_sub(:,:) ) ! 220 CALL iom_put ('hfxerr', hfx_err(:,:) ) ! 221 CALL iom_put ('hfxerr_rem', hfx_err_rem(:,:) ) ! 222 223 CALL iom_put ('hfxsum', hfx_sum(:,:) ) ! 224 CALL iom_put ('hfxbom', hfx_bom(:,:) ) ! 225 CALL iom_put ('hfxbog', hfx_bog(:,:) ) ! 226 CALL iom_put ('hfxdif', hfx_dif(:,:) ) ! 227 CALL iom_put ('hfxopw', hfx_opw(:,:) ) ! 228 CALL iom_put ('hfxtur', fhtur(:,:) * at_i(:,:) ) ! turbulent heat flux at ice base 229 CALL iom_put ('hfxdhc', diag_heat_dhc(:,:) ) ! Heat content variation in snow and ice 230 CALL iom_put ('hfxspr', hfx_spr(:,:) ) ! Heat content of snow precip 231 232 !-------------------------------- 233 ! Output values for each category 234 !-------------------------------- 235 CALL iom_put( "iceconc_cat" , a_i ) ! area for categories 236 CALL iom_put( "icethic_cat" , ht_i ) ! thickness for categories 237 CALL iom_put( "snowthic_cat" , ht_s ) ! snow depth for categories 238 CALL iom_put( "salinity_cat" , sm_i ) ! salinity for categories 239 240 ! Compute ice age 241 IF ( iom_use( "iceage_cat" ) ) THEN 366 242 DO jl = 1, jpl 367 243 DO jj = 1, jpj 368 244 DO ji = 1, jpi 369 zinda = MAX( zzero , SIGN( zone, a_i(ji,jj,jl) - epsi06 ) )245 zinda = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 370 246 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda 371 247 END DO 372 248 END DO 373 249 END DO 374 375 ! Compute brine volume 250 CALL iom_put( "iceage_cat" , zoi ) ! ice age for categories 251 ENDIF 252 253 ! Compute brine volume 254 IF ( iom_use( "brinevol_cat" ) ) THEN 376 255 zei(:,:,:) = 0._wp 377 256 DO jl = 1, jpl … … 379 258 DO jj = 1, jpj 380 259 DO ji = 1, jpi 381 zinda = MAX( zzero , SIGN( zone, a_i(ji,jj,jl) - epsi06 ) )260 zinda = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 382 261 zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 383 262 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * & … … 387 266 END DO 388 267 END DO 389 390 DO jl = 1, jpl 391 CALL lbc_lnk( zei(:,:,jl) , 'T' , 1. ) 392 END DO 393 394 CALL histwrite( nicea, "iice_itd", niter, a_i , ndimitd , ndexitd ) ! area 395 CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd ) ! thickness 396 CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd ) ! snow depth 397 CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd ) ! salinity 398 CALL histwrite( nicea, "iice_otd", niter, zoi , ndimitd , ndexitd ) ! age 399 CALL histwrite( nicea, "iice_etd", niter, zei , ndimitd , ndexitd ) ! brine volume 400 401 ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 402 ! IF( kindic < 0 ) CALL lim_wri_state( 'output.abort' ) 403 ! not yet implemented 404 405 IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 406 IF(lwp) WRITE(numout,*) ' Closing the icemod file ' 407 CALL histclo( nicea ) 408 ENDIF 409 ! 410 ENDIF 411 412 CALL wrk_dealloc( jpi, jpj, zfield ) 413 CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 414 CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 268 CALL iom_put( "brinevol_cat" , zei ) ! brine volume for categories 269 ENDIF 270 271 ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 272 ! IF( kindic < 0 ) CALL lim_wri_state( 'output.abort' ) 273 ! not yet implemented 274 275 CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei ) 276 CALL wrk_dealloc( jpi, jpj , z2d, zind, z2da, z2db ) 415 277 416 278 IF( nn_timing == 1 ) CALL timing_stop('limwri') … … 419 281 #endif 420 282 421 SUBROUTINE lim_wri_init422 !!-------------------------------------------------------------------423 !! *** ROUTINE lim_wri_init ***424 !!425 !! ** Purpose : ???426 !!427 !! ** Method : Read the namicewri namelist and check the parameter428 !! values called at the first timestep (nit000)429 !!430 !! ** input : Namelist namicewri431 !!-------------------------------------------------------------------432 INTEGER :: nf ! ???433 INTEGER :: ios ! Local integer output status for namelist read434 435 TYPE FIELD436 CHARACTER(len = 35) :: ztitle437 CHARACTER(len = 8 ) :: zname438 CHARACTER(len = 8 ) :: zunit439 INTEGER :: znc440 REAL :: zcmulti441 REAL :: zcadd442 END TYPE FIELD443 444 TYPE(FIELD) :: &445 field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &446 field_7 , field_8 , field_9 , field_10, field_11, field_12, &447 field_13, field_14, field_15, field_16, field_17, field_18, &448 field_19, field_20, field_21, field_22, field_23, field_24, &449 field_25, field_26, field_27, field_28, field_29, field_30, &450 field_31, field_32, field_33, field_34, field_35, field_36, &451 field_37, field_38, field_39, field_40, field_41, field_42, field_43452 453 TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield454 !455 NAMELIST/namiceout/ noumef, &456 field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &457 field_7 , field_8 , field_9 , field_10, field_11, field_12, &458 field_13, field_14, field_15, field_16, field_17, field_18, &459 field_19, field_20, field_21, field_22, field_23, field_24, &460 field_25, field_26, field_27, field_28, field_29, field_30, &461 field_31, field_32, field_33, field_34, field_35, field_36, &462 field_37, field_38, field_39, field_40, field_41, field_42, field_43, add_diag_swi463 !!-------------------------------------------------------------------464 REWIND( numnam_ice_ref ) ! Namelist namiceout in reference namelist : Ice outputs465 READ ( numnam_ice_ref, namiceout, IOSTAT = ios, ERR = 901)466 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in reference namelist', lwp )467 468 REWIND( numnam_ice_cfg ) ! Namelist namiceout in configuration namelist : Ice outputs469 READ ( numnam_ice_cfg, namiceout, IOSTAT = ios, ERR = 902 )470 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in configuration namelist', lwp )471 IF(lwm) WRITE ( numoni, namiceout )472 473 zfield(1) = field_1474 zfield(2) = field_2475 zfield(3) = field_3476 zfield(4) = field_4477 zfield(5) = field_5478 zfield(6) = field_6479 zfield(7) = field_7480 zfield(8) = field_8481 zfield(9) = field_9482 zfield(10) = field_10483 zfield(11) = field_11484 zfield(12) = field_12485 zfield(13) = field_13486 zfield(14) = field_14487 zfield(15) = field_15488 zfield(16) = field_16489 zfield(17) = field_17490 zfield(18) = field_18491 zfield(19) = field_19492 zfield(20) = field_20493 zfield(21) = field_21494 zfield(22) = field_22495 zfield(23) = field_23496 zfield(24) = field_24497 zfield(25) = field_25498 zfield(26) = field_26499 zfield(27) = field_27500 zfield(28) = field_28501 zfield(29) = field_29502 zfield(30) = field_30503 zfield(31) = field_31504 zfield(32) = field_32505 zfield(33) = field_33506 zfield(34) = field_34507 zfield(35) = field_35508 zfield(36) = field_36509 zfield(37) = field_37510 zfield(38) = field_38511 zfield(39) = field_39512 zfield(40) = field_40513 zfield(41) = field_41514 zfield(42) = field_42515 zfield(43) = field_43516 517 DO nf = 1, noumef518 titn (nf) = zfield(nf)%ztitle519 nam (nf) = zfield(nf)%zname520 uni (nf) = zfield(nf)%zunit521 nc (nf) = zfield(nf)%znc522 cmulti(nf) = zfield(nf)%zcmulti523 cadd (nf) = zfield(nf)%zcadd524 END DO525 526 IF(lwp) THEN ! control print527 WRITE(numout,*)528 WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs'529 WRITE(numout,*) '~~~~~~~~~~~~'530 WRITE(numout,*) ' number of fields to be stored noumef = ', noumef531 WRITE(numout,*) ' title name unit Saving (1/0) ', &532 & ' multiplicative constant additive constant '533 DO nf = 1 , noumef534 WRITE(numout,*) ' ', titn(nf), ' ' , nam (nf), ' ' , uni (nf), &535 & ' ' , nc (nf),' ', cmulti(nf), ' ', cadd(nf)536 END DO537 WRITE(numout,*) ' add_diag_swi ', add_diag_swi538 ENDIF539 !540 END SUBROUTINE lim_wri_init541 283 542 284 SUBROUTINE lim_wri_state( kt, kid, kh_i ) … … 555 297 INTEGER, INTENT( in ) :: kid , kh_i 556 298 !!---------------------------------------------------------------------- 557 !CALL histvert( kid, "icethi", "L levels","m", jpl , hi_mean , nz )558 299 559 300 CALL histdef( kid, "iicethic", "Ice thickness" , "m" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) … … 577 318 CALL histdef( kid, "iicebome", "Ice bottom melt" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 578 319 CALL histdef( kid, "iicesume", "Ice surface melt" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 579 CALL histdef( kid, "iisfxthd", "Salt flux from thermo" , "" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 580 CALL histdef( kid, "iisfxmec", "Salt flux from dynmics" , "" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 320 CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics" , "" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 581 321 CALL histdef( kid, "iisfxres", "Salt flux from limupdate", "" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 582 583 584 !CALL histdef( kid, "iice_itd", "Ice concentration by cat", "%" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )585 !CALL histdef( kid, "iice_hid", "Ice thickness by cat" , "m" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )586 !CALL histdef( kid, "iice_hsd", "Snow thickness by cat" , "m" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )587 !CALL histdef( kid, "iice_std", "Ice salinity by cat" , "PSU" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )588 322 589 323 CALL histend( kid, snc4set ) ! end of the file definition … … 603 337 CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8 , jpi*jpj, (/1/) ) 604 338 605 CALL histwrite( kid, "iicebopr", kt, diag_bot_gr , jpi*jpj, (/1/) ) 606 CALL histwrite( kid, "iicedypr", kt, diag_dyn_gr , jpi*jpj, (/1/) ) 607 CALL histwrite( kid, "iicelapr", kt, diag_lat_gr , jpi*jpj, (/1/) ) 608 CALL histwrite( kid, "iicesipr", kt, diag_sni_gr , jpi*jpj, (/1/) ) 609 CALL histwrite( kid, "iicerepr", kt, diag_res_pr , jpi*jpj, (/1/) ) 610 CALL histwrite( kid, "iicebome", kt, diag_bot_me , jpi*jpj, (/1/) ) 611 CALL histwrite( kid, "iicesume", kt, diag_sur_me , jpi*jpj, (/1/) ) 612 CALL histwrite( kid, "iisfxthd", kt, sfx_thd , jpi*jpj, (/1/) ) 613 CALL histwrite( kid, "iisfxmec", kt, sfx_mec , jpi*jpj, (/1/) ) 339 CALL histwrite( kid, "iicebopr", kt, wfx_bog , jpi*jpj, (/1/) ) 340 CALL histwrite( kid, "iicedypr", kt, wfx_dyn , jpi*jpj, (/1/) ) 341 CALL histwrite( kid, "iicelapr", kt, wfx_opw , jpi*jpj, (/1/) ) 342 CALL histwrite( kid, "iicesipr", kt, wfx_sni , jpi*jpj, (/1/) ) 343 CALL histwrite( kid, "iicerepr", kt, wfx_res , jpi*jpj, (/1/) ) 344 CALL histwrite( kid, "iicebome", kt, wfx_bom , jpi*jpj, (/1/) ) 345 CALL histwrite( kid, "iicesume", kt, wfx_sum , jpi*jpj, (/1/) ) 346 CALL histwrite( kid, "iisfxdyn", kt, sfx_dyn , jpi*jpj, (/1/) ) 614 347 CALL histwrite( kid, "iisfxres", kt, sfx_res , jpi*jpj, (/1/) ) 615 348 616 !CALL histwrite( kid, "iice_itd", kt, a_i , jpi*jpj*jpl, (/1/) ) ! area 617 !CALL histwrite( kid, "iice_hid", kt, ht_i , jpi*jpj*jpl, (/1/) ) ! thickness 618 !CALL histwrite( kid, "iice_hsd", kt, ht_s , jpi*jpj*jpl, (/1/) ) ! snow depth 619 !CALL histwrite( kid, "iice_std", kt, sm_i , jpi*jpj*jpl, (/1/) ) ! salinity 349 ! Close the file 350 ! ----------------- 351 !CALL histclo( kid ) 620 352 621 353 END SUBROUTINE lim_wri_state -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
r3764 r4900 89 89 DO jj = 2 , jpjm1 90 90 DO ji = 2 , jpim1 ! NO vector opt. 91 zindh = MAX( zzero , SIGN( zone, ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )92 zinda = MAX( zzero , SIGN( zone, ( 1.0 - frld(ji,jj) ) - 0.10 ) )91 zindh = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 92 zinda = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 93 93 zindb = zindh * zinda 94 ztmu = MAX( 0.5 * zone, ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )94 ztmu = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 95 95 zcmo(ji,jj,1) = ht_s (ji,jj,1) 96 96 zcmo(ji,jj,2) = ht_i (ji,jj,1) 97 zcmo(ji,jj,3) = hicifp(ji,jj)97 zcmo(ji,jj,3) = 0. 98 98 zcmo(ji,jj,4) = frld (ji,jj) 99 99 zcmo(ji,jj,5) = sist (ji,jj) 100 zcmo(ji,jj,6) = f bif(ji,jj)100 zcmo(ji,jj,6) = fhtur (ji,jj) 101 101 zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 102 102 + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & … … 132 132 DO jj = 2 , jpjm1 133 133 DO ji = 2 , jpim1 ! NO vector opt. 134 zindh = MAX( zzero , SIGN( zone, ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) )135 zinda = MAX( zzero , SIGN( zone, ( 1.0 - frld(ji,jj) ) - 0.10 ) )134 zindh = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 135 zinda = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 136 136 zindb = zindh * zinda 137 ztmu = MAX( 0.5 * zone, ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )137 ztmu = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 138 138 rcmoy(ji,jj,1) = ht_s (ji,jj,1) 139 139 rcmoy(ji,jj,2) = ht_i (ji,jj,1) 140 rcmoy(ji,jj,3) = hicifp(ji,jj)140 rcmoy(ji,jj,3) = 0. 141 141 rcmoy(ji,jj,4) = frld (ji,jj) 142 142 rcmoy(ji,jj,5) = sist (ji,jj) 143 rcmoy(ji,jj,6) = f bif(ji,jj)143 rcmoy(ji,jj,6) = fhtur (ji,jj) 144 144 rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) & 145 145 + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90
r2528 r4900 13 13 ! !!! ice thermodynamics 14 14 INTEGER, PUBLIC, PARAMETER :: jkmax = 6 !: maximum number of ice layers 15 INTEGER, PUBLIC, PARAMETER :: nlay_i = 5 !: number of ice layers 15 16 INTEGER, PUBLIC, PARAMETER :: nlay_s = 1 !: number of snow layers 16 17 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r4205 r4900 20 20 ! !!! ** ice-thermo namelist (namicethd) ** 21 21 REAL(wp), PUBLIC :: hmelt !: maximum melting at the bottom; active only for one category 22 REAL(wp), PUBLIC :: hicmin !: (REMOVE)23 22 REAL(wp), PUBLIC :: hiclim !: minimum ice thickness 24 REAL(wp), PUBLIC :: sbeta !: numerical scheme for diffusion in ice (REMOVE)25 REAL(wp), PUBLIC :: parlat !: (REMOVE)26 REAL(wp), PUBLIC :: hakspl !: (REMOVE)27 REAL(wp), PUBLIC :: hibspl !: (REMOVE)28 REAL(wp), PUBLIC :: exld !: (REMOVE)29 REAL(wp), PUBLIC :: hakdif !: (REMOVE)30 REAL(wp), PUBLIC :: thth !: (REMOVE)31 23 REAL(wp), PUBLIC :: hnzst !: thick. of the surf. layer in temp. comp. 32 24 REAL(wp), PUBLIC :: parsub !: switch for snow sublimation or not 33 REAL(wp), PUBLIC :: alphs !: coef. for snow density when snow-ice formation34 REAL(wp), PUBLIC :: fraz_swi !: use of frazil ice collection in function of wind (1.0) or not (0.0)35 25 REAL(wp), PUBLIC :: maxfrazb !: maximum portion of frazil ice collecting at the ice bottom 36 26 REAL(wp), PUBLIC :: vfrazb !: threshold drift speed for collection of bottom frazil ice 37 27 REAL(wp), PUBLIC :: Cfrazb !: squeezing coefficient for collection of bottom frazil ice 28 REAL(wp), PUBLIC :: hiccrit !: ice th. for lateral accretion in the NH (SH) (m) 38 29 39 REAL(wp), PUBLIC, DIMENSION(2) :: hiccrit !: ice th. for lateral accretion in the NH (SH) (m)30 INTEGER , PUBLIC :: fraz_swi !: use of frazil ice collection in function of wind (1) or not (0) 40 31 41 32 !!----------------------------- … … 49 40 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npac !: correspondance between points (lateral accretion) 50 41 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qldif_1d !: <==> the 2D qldif 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qcmif_1d !: <==> the 2D qcmif 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fstbif_1d !: <==> the 2D fstric 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fltbif_1d !: <==> the 2D ffltbif 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fscbq_1d !: <==> the 2D fscmcbq 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlead_1d !: <==> the 2D qlead 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftr_ice_1d !: <==> the 2D ftr_ice 56 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qsr_ice_1d !: <==> the 2D qsr_ice 57 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr1_i0_1d !: <==> the 2D fr1_i0 58 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr2_i0_1d !: <==> the 2D fr2_i0 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qnsr_ice_1d !: <==> the 2D qns_ice 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qfvbq_1d !: <==> the 2D qfvbq 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qns_ice_1d !: <==> the 2D qns_ice 61 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_bo_b !: <==> the 2D t_bo 49 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_sum_1d 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_bom_1d 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_bog_1d 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_dif_1d 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_opw_1d 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_snw_1d 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_1d 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_rem_1d 58 59 ! heat flux associated with ice-atmosphere mass exchange 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_sub_1d 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_spr_1d 62 63 ! heat flux associated with ice-ocean mass exchange 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_thd_1d 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_res_1d 66 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_ice_1d !: <==> the 2D wfx_ice 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_snw_1d !: <==> the 2D wfx_snw 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sub_1d !: <==> the 2D wfx_sub 70 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_bog_1d !: <==> the 2D wfx_ice 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_bom_1d !: <==> the 2D wfx_ice 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sum_1d !: <==> the 2D wfx_ice 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sni_1d !: <==> the 2D wfx_ice 75 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_opw_1d !: <==> the 2D wfx_ice 76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_res_1d !: <==> the 2D wfx_ice 77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_spr_1d !: <==> the 2D wfx_ice 78 79 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bri_1d !: <==> the 2D sfx_bri 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bog_1d !: 81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bom_1d !: 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_sum_1d !: 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_sni_1d !: 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_opw_1d !: 85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_res_1d !: 62 86 63 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sprecip_1d !: <==> the 2D sprecip 64 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: frld_1d !: <==> the 2D frld 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: at_i_b !: <==> the 2D frld 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fbif_1d !: <==> the 2D fbif 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdm_ice_1d !: <==> the 2D rdm_ice 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdm_snw_1d !: <==> the 2D rdm_snw 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlbbq_1d !: <==> the 2D qlbsbq 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dmgwi_1d !: <==> the 2D dmgwi 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvsbq_1d !: <==> the 2D rdvosif 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvbbq_1d !: <==> the 2D rdvobif 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvlbq_1d !: <==> the 2D rdvolif 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dvnbq_1d !: <==> the 2D rdvolif 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: at_i_b !: <==> the 2D at_i 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhtur_1d !: <==> the 2D fhtur 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhld_1d !: <==> the 2D fhld 75 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqns_ice_1d !: <==> the 2D dqns_ice 76 93 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qla_ice_1d !: <==> the 2D qla_ice … … 78 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tatm_ice_1d !: <==> the 2D tatm_ice 79 96 ! ! to reintegrate longwave flux inside the ice thermodynamics 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fsup !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: focea !: Remaining energy in case of total ablation82 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: old_ht_i_b !: Ice thickness at the beginnning of the time step [m]84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: old_ht_s_b !: Snow thickness at the beginning of the time step [m]85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bri_1d !: <==> the 2D sfx_bri86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhbri_1d !: Heat flux due to brine drainage87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_thd_1d !: <==> the 2D sfx_thd88 98 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_fl_1d !: Ice salinity variations due to flushing 89 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_gd_1d !: Ice salinity variations due to gravity drainage … … 104 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sm_i_b !: Ice bulk salinity [ppt] 105 115 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_new !: Salinity of new ice at the bottom 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_snowice !: Salinity of new snow ice on top of the ice107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: o_i_b !: Ice age [days]108 116 109 117 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: iatte_1d !: clem attenuation coef of the input solar flux (unitless) … … 116 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_s_b !: Snow enthalpy per unit volume 117 125 118 ! Clean the following ... 119 ! These variables are coded for conservation checks 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_i_in !: ice energy summed over categories (initial) 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_i_fin !: ice energy summed over categories (final) 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_s_in, qt_s_fin !: snow energy summed over categories 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dq_i, sum_fluxq !: increment of energy, sum of fluxes 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fatm, foce !: atmospheric, oceanic, heat flux 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cons_error, surf_error !: conservation, surface error 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qh_i_old !: ice heat content (q*h, J.m-2) 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h_i_old !: ice thickness layer (m) 126 128 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_layer_in !: goes to trash128 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_layer_fin !: goes to trash129 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dq_i_layer, radab !: goes to trash130 131 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftotal_in !: initial total heat flux132 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftotal_fin !: final total heat flux133 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fc_s135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fc_i136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: de_s_lay137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: de_i_lay138 139 129 INTEGER , PUBLIC :: jiindex_1d ! 1D index of debugging point 140 130 … … 151 141 !!---------------------------------------------------------------------! 152 142 INTEGER :: thd_ice_alloc ! return value 153 INTEGER :: ierr( 4)143 INTEGER :: ierr(3) 154 144 !!---------------------------------------------------------------------! 155 145 156 146 ALLOCATE( npb (jpij) , npac (jpij), & 157 147 ! ! 158 & qldif_1d (jpij) , qcmif_1d (jpij) , fstbif_1d (jpij) , & 159 & fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) , & 160 & fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) , & 161 & qfvbq_1d (jpij) , t_bo_b (jpij) , iatte_1d (jpij) , & 162 & oatte_1d (jpij) , STAT=ierr(1) ) 148 & qlead_1d (jpij) , ftr_ice_1d (jpij) , & 149 & qsr_ice_1d (jpij) , & 150 & fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) , & 151 & t_bo_b (jpij) , iatte_1d (jpij) , oatte_1d (jpij) , & 152 & hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , & 153 & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 154 & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , hfx_res_1d(jpij) , hfx_err_rem_1d(jpij), STAT=ierr(1) ) 163 155 ! 164 156 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_b (jpij) , & 165 & fbif_1d (jpij) , rdm_ice_1d (jpij) , rdm_snw_1d (jpij) , & 166 & qlbbq_1d (jpij) , dmgwi_1d (jpij) , dvsbq_1d (jpij) , & 167 & dvbbq_1d (jpij) , dvlbq_1d (jpij) , dvnbq_1d (jpij) , & 157 & fhtur_1d (jpij) , wfx_ice_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) , & 158 & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d (jpij) , & 168 159 & dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) , & 169 & tatm_ice_1d(jpij) , fsup (jpij) , focea (jpij) ,&170 & i0 (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) ,&171 & sfx_bri_1d (jpij) , fhbri_1d (jpij) , sfx_thd_1d (jpij) ,&160 & tatm_ice_1d(jpij) , & 161 & i0 (jpij) , & 162 & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) ,sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , & 172 163 & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , & 173 164 & dsm_i_si_1d(jpij) , hicol_b (jpij) , STAT=ierr(2) ) … … 176 167 & ht_s_b (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 177 168 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) , & 178 & dh_snowice(jpij) , sm_i_b (jpij) , s_i_new (jpij) , & 179 & s_snowice (jpij) , o_i_b (jpij) , & 180 ! ! 169 & dh_snowice(jpij) , sm_i_b (jpij) , s_i_new (jpij) , & 181 170 & t_s_b(jpij,nlay_s), & 182 ! !183 171 & t_i_b(jpij,jkmax), s_i_b(jpij,jkmax) , & 184 & q_i_b(jpij,jkmax), q_s_b(jpij,jkmax) , STAT=ierr(3)) 172 & q_i_b(jpij,jkmax), q_s_b(jpij,jkmax) , & 173 & qh_i_old(jpij,0:jkmax), h_i_old(jpij,0:jkmax) , STAT=ierr(3)) 185 174 ! 186 ALLOCATE( qt_i_in (jpij,jpl) , qt_i_fin(jpij,jpl) , qt_s_in (jpij,jpl) , &187 & qt_s_fin (jpij,jpl) , dq_i (jpij,jpl) , sum_fluxq (jpij,jpl) , &188 & fatm (jpij,jpl) , foce (jpij,jpl) , cons_error(jpij,jpl) , &189 & surf_error(jpij,jpl) , &190 ! !191 & q_i_layer_in(jpij,jkmax) , q_i_layer_fin(jpij,jkmax) , &192 & dq_i_layer (jpij,jkmax) , radab (jpij,jkmax) , &193 ! !194 & ftotal_in(jpij), ftotal_fin(jpij) , &195 ! !196 & fc_s(jpij,0:nlay_s) , de_s_lay(jpij,nlay_s) , &197 & fc_i(jpij,0:jkmax) , de_i_lay(jpij,jkmax) , STAT=ierr(4) )198 199 175 thd_ice_alloc = MAXVAL( ierr ) 200 176 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r4608 r4900 104 104 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp_out !: Damping time scale in days at radiation outflow points 105 105 106 #if ( defined key_lim2 || defined key_lim3 )107 106 CHARACTER(len=20), DIMENSION(jp_bdy) :: cn_ice_lim ! Choice of boundary condition for sea ice variables 108 107 INTEGER, DIMENSION(jp_bdy) :: nn_ice_lim_dta !: = 0 use the initial state as bdy dta ; 109 108 !: = 1 read it in a NetCDF file 110 #endif 109 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_tem !: choice of the temperature of incoming sea ice 110 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_sal !: choice of the salinity of incoming sea ice 111 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_age !: choice of the age of incoming sea ice 111 112 ! 112 113 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r4897 r4900 676 676 CALL iom_close ( inum ) 677 677 !CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. ) 678 !CALL iom_open ( bn_a_i 678 !CALL iom_open ( bn_a_i%clname, inum ) 679 679 !id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 680 680 IF ( zndims == 4 ) THEN … … 907 907 !!============================================================================== 908 908 END MODULE bdydta 909 910 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r4370 r4900 30 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 31 USE in_out_manager ! 32 USE domvvl 32 USE domvvl ! variable volume 33 33 34 34 IMPLICIT NONE -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
r4333 r4900 99 99 REAL(wp) :: zinda, ztmelts, zdh 100 100 101 REAL(wp), PARAMETER :: zsal = 6.3 ! arbitrary salinity for incoming ice102 REAL(wp), PARAMETER :: ztem = 270.0 ! arbitrary temperature for incoming ice103 REAL(wp), PARAMETER :: zage = 30.0 ! arbitrary age for incoming ice104 101 !!------------------------------------------------------------------------------ 105 102 ! … … 233 230 234 231 ! Ice salinity, age, temperature 235 sm_i(ji,jj,jl) = zinda * zsal+ ( 1.0 - zinda ) * s_i_min236 o_i(ji,jj,jl) = zinda * zage+ ( 1.0 - zinda )237 t_su(ji,jj,jl) = zinda * ztem + ( 1.0 - zinda ) * ztem232 sm_i(ji,jj,jl) = zinda * rn_ice_sal(ib_bdy) + ( 1.0 - zinda ) * s_i_min 233 o_i(ji,jj,jl) = zinda * rn_ice_age(ib_bdy) + ( 1.0 - zinda ) 234 t_su(ji,jj,jl) = zinda * rn_ice_tem(ib_bdy) + ( 1.0 - zinda ) * rn_ice_tem(ib_bdy) 238 235 DO jk = 1, nlay_s 239 t_s(ji,jj,jk,jl) = zinda * ztem+ ( 1.0 - zinda ) * rtt236 t_s(ji,jj,jk,jl) = zinda * rn_ice_tem(ib_bdy) + ( 1.0 - zinda ) * rtt 240 237 END DO 241 238 DO jk = 1, nlay_i 242 t_i(ji,jj,jk,jl) = zinda * ztem+ ( 1.0 - zinda ) * rtt243 s_i(ji,jj,jk,jl) = zinda * zsal+ ( 1.0 - zinda ) * s_i_min239 t_i(ji,jj,jk,jl) = zinda * rn_ice_tem(ib_bdy) + ( 1.0 - zinda ) * rtt 240 s_i(ji,jj,jk,jl) = zinda * rn_ice_sal(ib_bdy) + ( 1.0 - zinda ) * s_i_min 244 241 END DO 245 242 … … 259 256 260 257 END SELECT 258 259 ! if salinity is constant, then overwrite rn_ice_sal 260 IF( num_sal == 1 ) THEN 261 sm_i(ji,jj,jl) = bulk_sal 262 s_i (ji,jj,:,jl) = bulk_sal 263 ENDIF 261 264 262 265 ! contents … … 338 341 DO ib_bdy=1, nb_bdy 339 342 ! 340 SELECT CASE( nn_ice_lim(ib_bdy) )343 SELECT CASE( cn_ice_lim(ib_bdy) ) 341 344 342 345 CASE('none') … … 355 358 ji = idx_bdy(ib_bdy)%nbi(jb,jgrd) 356 359 jj = idx_bdy(ib_bdy)%nbj(jb,jgrd) 357 zflag = idx_bdy(ib_bdy)%flagu(jb )360 zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd) 358 361 359 362 IF ( ABS( zflag ) == 1. ) THEN ! eastern and western boundaries … … 384 387 ji = idx_bdy(ib_bdy)%nbi(jb,jgrd) 385 388 jj = idx_bdy(ib_bdy)%nbj(jb,jgrd) 386 zflag = idx_bdy(ib_bdy)%flagv(jb )389 zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd) 387 390 388 391 IF ( ABS( zflag ) == 1. ) THEN ! northern and southern boundaries -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r4897 r4900 100 100 & cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, & 101 101 & ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 102 #if ( defined key_lim2 || defined key_lim3 )103 102 & cn_ice_lim, nn_ice_lim_dta, & 104 #endif 103 & rn_ice_tem, rn_ice_sal, rn_ice_age, & 105 104 & ln_vol, nn_volctl, nn_rimwidth 106 105 !! … … 359 358 ENDIF 360 359 IF(lwp) WRITE(numout,*) 360 IF(lwp) WRITE(numout,*) ' tem of bdy sea-ice = ', rn_ice_tem(ib_bdy) 361 IF(lwp) WRITE(numout,*) ' sal of bdy sea-ice = ', rn_ice_sal(ib_bdy) 362 IF(lwp) WRITE(numout,*) ' age of bdy sea-ice = ', rn_ice_age(ib_bdy) 361 363 #endif 362 364 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
r4897 r4900 18 18 USE daymod 19 19 USE tide_mod 20 ! 20 21 USE in_out_manager ! I/O units 21 22 USE iom ! I/0 library … … 34 35 INTEGER, PARAMETER :: jpdimsparse = jpincomax*300*24 35 36 36 ! !!!namelist variables37 ! !!** namelist variables ** 37 38 INTEGER :: nit000_han ! First time step used for harmonic analysis 38 39 INTEGER :: nitend_han ! Last time step used for harmonic analysis 39 40 INTEGER :: nstep_han ! Time step frequency for harmonic analysis 40 INTEGER :: nb_ana 41 INTEGER :: nb_ana ! Number of harmonics to analyse 41 42 42 43 INTEGER , ALLOCATABLE, DIMENSION(:) :: name … … 119 120 ENDIF 120 121 END DO 121 END DO122 END DO 122 123 ! 123 124 IF(lwp) THEN … … 158 159 ! ---------------------------- 159 160 ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 160 ana_temp(:,:,:,:) = 0. e0161 ana_temp(:,:,:,:) = 0._wp 161 162 162 163 END SUBROUTINE dia_harm_init … … 179 180 IF( nn_timing == 1 ) CALL timing_start('dia_harm') 180 181 181 IF ( kt == nit000 ) CALL dia_harm_init 182 183 IF ( ((kt.GE.nit000_han).AND.(kt.LE.nitend_han)).AND. & 184 (MOD(kt,nstep_han).EQ.0) ) THEN 185 186 ztime = (kt-nit000+1)*rdt 182 IF( kt == nit000 ) CALL dia_harm_init 183 184 IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN 185 186 ztime = (kt-nit000+1) * rdt 187 187 188 nhc = 0189 DO jh = 1,nb_ana190 DO jc = 1,2191 nhc = nhc+1192 ztemp =( MOD(jc,2) * ft(jh) *COS(ana_freq(jh)*ztime + vt(jh) + ut(jh)) &193 +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh)))194 195 DO jj = 1,jpj196 DO ji = 1,jpi197 ! Elevation198 ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj) *tmask(ji,jj,1)188 nhc = 0 189 DO jh = 1, nb_ana 190 DO jc = 1, 2 191 nhc = nhc+1 192 ztemp =( MOD(jc,2) * ft(jh) *COS(ana_freq(jh)*ztime + vt(jh) + ut(jh)) & 193 & +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) 194 195 DO jj = 1, jpj 196 DO ji = 1, jpi 197 ! Elevation 198 ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj) *tmask(ji,jj,1) 199 199 #if defined key_dynspg_ts 200 ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*umask(ji,jj,1)201 ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask(ji,jj,1)202 #endif 203 END DO204 END DO205 206 END DO207 END DO208 200 ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*umask(ji,jj,1) 201 ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask(ji,jj,1) 202 #endif 203 END DO 204 END DO 205 ! 206 END DO 207 END DO 208 ! 209 209 END IF 210 210 … … 249 249 keq = keq + 1 250 250 kun = 0 251 DO jh = 1, nb_ana252 DO jc = 1, 2251 DO jh = 1, nb_ana 252 DO jc = 1, 2 253 253 kun = kun + 1 254 254 ksp = ksp + 1 … … 296 296 out_eta(ji,jj,jh ) = X1 * tmask(ji,jj,1) 297 297 out_eta(ji,jj,jh+nb_ana) = X2 * tmask(ji,jj,1) 298 END DO299 END DO300 END DO298 END DO 299 END DO 300 END DO 301 301 302 302 ! ubar: … … 309 309 kun = kun + 1 310 310 ztmp4(kun)=ana_temp(ji,jj,kun,2) 311 END DO312 END DO311 END DO 312 END DO 313 313 314 314 CALL SUR_DETERMINE(jj+1) … … 316 316 ! Fill output array 317 317 DO jh = 1, nb_ana 318 ana_amp(ji,jj,jh,1) =ztmp7((jh-1)*2+1)319 ana_amp(ji,jj,jh,2) =ztmp7((jh-1)*2+2)318 ana_amp(ji,jj,jh,1) = ztmp7((jh-1)*2+1) 319 ana_amp(ji,jj,jh,2) = ztmp7((jh-1)*2+2) 320 320 END DO 321 321 … … 326 326 DO ji = 1, jpi 327 327 DO jh = 1, nb_ana 328 X1 =ana_amp(ji,jj,jh,1)329 X2 =-ana_amp(ji,jj,jh,2)330 out_u(ji,jj,jh ) = X1 * umask(ji,jj,1)331 out_u 332 END DO333 END DO334 END DO328 X1 = ana_amp(ji,jj,jh,1) 329 X2 =-ana_amp(ji,jj,jh,2) 330 out_u(ji,jj,jh ) = X1 * umask(ji,jj,1) 331 out_u(ji,jj,nb_ana+jh) = X2 * umask(ji,jj,1) 332 END DO 333 END DO 334 END DO 335 335 336 336 ! vbar: … … 343 343 kun = kun + 1 344 344 ztmp4(kun)=ana_temp(ji,jj,kun,3) 345 END DO346 END DO345 END DO 346 END DO 347 347 348 348 CALL SUR_DETERMINE(jj+1) … … 364 364 out_v(ji,jj,jh)=X1 * vmask(ji,jj,1) 365 365 out_v(ji,jj,nb_ana+jh)=X2 * vmask(ji,jj,1) 366 END DO367 END DO368 END DO366 END DO 367 END DO 368 END DO 369 369 370 370 CALL dia_wri_harm ! Write results in files … … 437 437 #else 438 438 DO jh = 1, nb_ana 439 CALL iom_put( TRIM(tname(jh))//'x_v', out_ u(:,:,jh ) )440 CALL iom_put( TRIM(tname(jh))//'y_v', out_ u(:,:,jh+nb_ana) )441 END DO 442 #endif 443 439 CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh ) ) 440 CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,jh+nb_ana) ) 441 END DO 442 #endif 443 ! 444 444 END SUBROUTINE dia_wri_harm 445 445 446 446 447 447 SUBROUTINE SUR_DETERMINE(init) 448 !!---------------------------------------------------------------------------------449 !! *** ROUTINE SUR_DETERMINE ***450 !!451 !!452 !!453 !!---------------------------------------------------------------------------------454 INTEGER, INTENT(in) :: init455 !456 INTEGER :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd457 REAL(wp) :: zval1, zval2, zx1458 REAL(wp), POINTER, DIMENSION(:) :: ztmpx, zcol1, zcol2459 INTEGER , POINTER, DIMENSION(:) :: ipos2, ipivot460 !---------------------------------------------------------------------------------461 CALL wrk_alloc( jpincomax , ztmpx , zcol1 , zcol2 )462 CALL wrk_alloc( jpincomax , ipos2 , ipivot )448 !!--------------------------------------------------------------------------------- 449 !! *** ROUTINE SUR_DETERMINE *** 450 !! 451 !! 452 !! 453 !!--------------------------------------------------------------------------------- 454 INTEGER, INTENT(in) :: init 455 ! 456 INTEGER :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 457 REAL(wp) :: zval1, zval2, zx1 458 REAL(wp), POINTER, DIMENSION(:) :: ztmpx, zcol1, zcol2 459 INTEGER , POINTER, DIMENSION(:) :: ipos2, ipivot 460 !--------------------------------------------------------------------------------- 461 CALL wrk_alloc( jpincomax , ztmpx , zcol1 , zcol2 ) 462 CALL wrk_alloc( jpincomax , ipos2 , ipivot ) 463 463 464 IF( init == 1 ) THEN 465 IF( nsparse > jpdimsparse ) CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse') 466 IF( ninco > jpincomax ) CALL ctl_stop( 'STOP', 'SUR_DETERMINE : ninco .GT. jpincomax') 467 ! 468 ztmp3(:,:) = 0._wp 469 ! 470 DO jk1_sd = 1, nsparse 471 DO jk2_sd = 1, nsparse 472 nisparse(jk2_sd) = nisparse(jk2_sd) 473 njsparse(jk2_sd) = njsparse(jk2_sd) 474 IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN 475 ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) & 476 + valuesparse(jk1_sd)*valuesparse(jk2_sd) 477 ENDIF 478 END DO 479 END DO 480 481 DO jj_sd = 1 ,ninco 482 ipos1(jj_sd) = jj_sd 483 ipos2(jj_sd) = jj_sd 484 ENDDO 485 486 DO ji_sd = 1 , ninco 487 488 !find greatest non-zero pivot: 489 zval1 = ABS(ztmp3(ji_sd,ji_sd)) 490 491 ipivot(ji_sd) = ji_sd 492 DO jj_sd = ji_sd, ninco 493 zval2 = ABS(ztmp3(ji_sd,jj_sd)) 494 IF( zval2.GE.zval1 )THEN 495 ipivot(ji_sd) = jj_sd 496 zval1 = zval2 497 ENDIF 498 ENDDO 499 500 DO ji1_sd = 1, ninco 501 zcol1(ji1_sd) = ztmp3(ji1_sd,ji_sd) 502 zcol2(ji1_sd) = ztmp3(ji1_sd,ipivot(ji_sd)) 503 ztmp3(ji1_sd,ji_sd) = zcol2(ji1_sd) 504 ztmp3(ji1_sd,ipivot(ji_sd)) = zcol1(ji1_sd) 505 ENDDO 506 507 ipos2(ji_sd) = ipos1(ipivot(ji_sd)) 508 ipos2(ipivot(ji_sd)) = ipos1(ji_sd) 509 ipos1(ji_sd) = ipos2(ji_sd) 510 ipos1(ipivot(ji_sd)) = ipos2(ipivot(ji_sd)) 511 zpivot(ji_sd) = ztmp3(ji_sd,ji_sd) 512 DO jj_sd = 1, ninco 513 ztmp3(ji_sd,jj_sd) = ztmp3(ji_sd,jj_sd) / zpivot(ji_sd) 514 ENDDO 515 464 IF( init == 1 ) THEN 465 IF( nsparse > jpdimsparse ) CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse') 466 IF( ninco > jpincomax ) CALL ctl_stop( 'STOP', 'SUR_DETERMINE : ninco .GT. jpincomax') 467 ! 468 ztmp3(:,:) = 0._wp 469 ! 470 DO jk1_sd = 1, nsparse 471 DO jk2_sd = 1, nsparse 472 nisparse(jk2_sd) = nisparse(jk2_sd) 473 njsparse(jk2_sd) = njsparse(jk2_sd) 474 IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN 475 ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) & 476 & + valuesparse(jk1_sd)*valuesparse(jk2_sd) 477 ENDIF 478 END DO 479 END DO 480 ! 481 DO jj_sd = 1 ,ninco 482 ipos1(jj_sd) = jj_sd 483 ipos2(jj_sd) = jj_sd 484 END DO 485 ! 486 DO ji_sd = 1 , ninco 487 ! 488 !find greatest non-zero pivot: 489 zval1 = ABS(ztmp3(ji_sd,ji_sd)) 490 ! 491 ipivot(ji_sd) = ji_sd 492 DO jj_sd = ji_sd, ninco 493 zval2 = ABS(ztmp3(ji_sd,jj_sd)) 494 IF( zval2.GE.zval1 )THEN 495 ipivot(ji_sd) = jj_sd 496 zval1 = zval2 497 ENDIF 498 END DO 499 ! 500 DO ji1_sd = 1, ninco 501 zcol1(ji1_sd) = ztmp3(ji1_sd,ji_sd) 502 zcol2(ji1_sd) = ztmp3(ji1_sd,ipivot(ji_sd)) 503 ztmp3(ji1_sd,ji_sd) = zcol2(ji1_sd) 504 ztmp3(ji1_sd,ipivot(ji_sd)) = zcol1(ji1_sd) 505 END DO 506 ! 507 ipos2(ji_sd) = ipos1(ipivot(ji_sd)) 508 ipos2(ipivot(ji_sd)) = ipos1(ji_sd) 509 ipos1(ji_sd) = ipos2(ji_sd) 510 ipos1(ipivot(ji_sd)) = ipos2(ipivot(ji_sd)) 511 zpivot(ji_sd) = ztmp3(ji_sd,ji_sd) 512 DO jj_sd = 1, ninco 513 ztmp3(ji_sd,jj_sd) = ztmp3(ji_sd,jj_sd) / zpivot(ji_sd) 514 END DO 515 ! 516 DO ji2_sd = ji_sd+1, ninco 517 zpilier(ji2_sd,ji_sd)=ztmp3(ji2_sd,ji_sd) 518 DO jj_sd=1,ninco 519 ztmp3(ji2_sd,jj_sd)= ztmp3(ji2_sd,jj_sd) - ztmp3(ji_sd,jj_sd) * zpilier(ji2_sd,ji_sd) 520 END DO 521 END DO 522 ! 523 END DO 524 ! 525 ENDIF ! End init==1 526 527 DO ji_sd = 1, ninco 528 ztmp4(ji_sd) = ztmp4(ji_sd) / zpivot(ji_sd) 516 529 DO ji2_sd = ji_sd+1, ninco 517 zpilier(ji2_sd,ji_sd)=ztmp3(ji2_sd,ji_sd) 518 DO jj_sd=1,ninco 519 ztmp3(ji2_sd,jj_sd)= ztmp3(ji2_sd,jj_sd) - ztmp3(ji_sd,jj_sd) * zpilier(ji2_sd,ji_sd) 520 ENDDO 521 ENDDO 522 523 ENDDO 524 525 ENDIF ! End init==1 526 527 DO ji_sd = 1, ninco 528 ztmp4(ji_sd) = ztmp4(ji_sd) / zpivot(ji_sd) 529 DO ji2_sd = ji_sd+1, ninco 530 ztmp4(ji2_sd) = ztmp4(ji2_sd) - ztmp4(ji_sd) * zpilier(ji2_sd,ji_sd) 531 ENDDO 532 ENDDO 533 534 !system solving: 535 ztmpx(ninco) = ztmp4(ninco) / ztmp3(ninco,ninco) 536 ji_sd = ninco 537 DO ji_sd = ninco-1, 1, -1 538 zx1=0. 539 DO jj_sd = ji_sd+1, ninco 540 zx1 = zx1 + ztmpx(jj_sd) * ztmp3(ji_sd,jj_sd) 541 ENDDO 542 ztmpx(ji_sd) = ztmp4(ji_sd)-zx1 543 ENDDO 544 545 DO jj_sd =1, ninco 546 ztmp7(ipos1(jj_sd))=ztmpx(jj_sd) 547 ENDDO 548 549 CALL wrk_dealloc( jpincomax , ztmpx , zcol1 , zcol2 ) 550 CALL wrk_dealloc( jpincomax , ipos2 , ipivot ) 551 552 END SUBROUTINE SUR_DETERMINE 530 ztmp4(ji2_sd) = ztmp4(ji2_sd) - ztmp4(ji_sd) * zpilier(ji2_sd,ji_sd) 531 END DO 532 END DO 533 534 !system solving: 535 ztmpx(ninco) = ztmp4(ninco) / ztmp3(ninco,ninco) 536 ji_sd = ninco 537 DO ji_sd = ninco-1, 1, -1 538 zx1 = 0._wp 539 DO jj_sd = ji_sd+1, ninco 540 zx1 = zx1 + ztmpx(jj_sd) * ztmp3(ji_sd,jj_sd) 541 END DO 542 ztmpx(ji_sd) = ztmp4(ji_sd)-zx1 543 END DO 544 545 DO jj_sd =1, ninco 546 ztmp7(ipos1(jj_sd))=ztmpx(jj_sd) 547 END DO 548 549 CALL wrk_dealloc( jpincomax , ztmpx , zcol1 , zcol2 ) 550 CALL wrk_dealloc( jpincomax , ipos2 , ipivot ) 551 ! 552 END SUBROUTINE SUR_DETERMINE 553 553 554 554 #else -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r4897 r4900 1445 1445 DO jk = 1, jpkm1 1446 1446 IF( scobot(ji,jj) >= fsdept(ji,jj,jk) ) mbathy(ji,jj) = MAX( 2, jk ) 1447 IF( scobot(ji,jj) == 0._wp ) mbathy(ji,jj) = 01448 END DO1447 END DO 1448 IF( scobot(ji,jj) == 0._wp ) mbathy(ji,jj) = 0 1449 1449 END DO 1450 1450 END DO -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4897 r4900 105 105 END FUNCTION dyn_spg_ts_alloc 106 106 107 108 107 SUBROUTINE dyn_spg_ts( kt ) 109 108 !!---------------------------------------------------------------------- 110 !! *** routine dyn_spg_ts ***111 109 !! 112 !! ** Purpose : Compute the now trend due to the explicit time stepping 113 !! of the quasi-linear barotropic system. 110 !! ** Purpose : 111 !! -Compute the now trend due to the explicit time stepping 112 !! of the quasi-linear barotropic system. 114 113 !! 115 114 !! ** Method : … … 129 128 !! -Update 3d trend (ua, va) with barotropic component. 130 129 !! 131 !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005 130 !! References : Shchepetkin, A.F. and J.C. McWilliams, 2005: 131 !! The regional oceanic modeling system (ROMS): 132 !! a split-explicit, free-surface, 133 !! topography-following-coordinate oceanic model. 134 !! Ocean Modelling, 9, 347-404. 132 135 !!--------------------------------------------------------------------- 136 ! 133 137 INTEGER, INTENT(in) :: kt ! ocean time-step index 134 138 ! … … 286 290 ! 287 291 DO jk = 1, jpkm1 288 DO jj = 1, jpj 289 DO ji = 1, jpi 290 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 291 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 292 END DO 293 END DO 292 zu_frc(:,:) = zu_frc(:,:) + fse3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 293 zv_frc(:,:) = zv_frc(:,:) + fse3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 294 294 END DO 295 295 ! … … 455 455 ! ! ==================== ! 456 456 ! Initialize barotropic variables: 457 IF( kt==nit000 .AND. .NOT. ln_rstart )THEN 458 sshbb_e(:,:) = 0._wp 459 ubb_e (:,:) = 0._wp 460 vbb_e (:,:) = 0._wp 461 sshb_e (:,:) = 0._wp 462 ub_e (:,:) = 0._wp 463 vb_e (:,:) = 0._wp 464 ENDIF 465 ! 457 466 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 458 467 sshn_e(:,:) = sshn (:,:) … … 899 908 END SUBROUTINE dyn_spg_ts 900 909 901 902 910 SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2) 903 911 !!--------------------------------------------------------------------- … … 1029 1037 ! 1030 1038 END SUBROUTINE ts_rst 1031 1032 1039 1033 1040 SUBROUTINE dyn_spg_ts_init( kt ) … … 1165 1172 !!====================================================================== 1166 1173 END MODULE dynspg_ts 1174 1175 1176 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r4897 r4900 32 32 USE trc_oce, ONLY : nn_dttrc ! !: frequency of step on passive tracers 33 33 USE icb_oce, ONLY : nclasses, class_num ! !: iceberg classes 34 #if defined key_lim3 35 USE par_ice 36 #elif defined key_lim2 37 USE par_ice_2 38 #endif 34 39 USE domngb ! ocean space and time domain 35 40 USE phycst ! physical constants … … 49 54 #endif 50 55 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 51 PUBLIC iom_getatt, iom_ context_finalize56 PUBLIC iom_getatt, iom_use, iom_context_finalize 52 57 53 58 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d … … 143 148 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 144 149 # endif 150 #if defined key_lim3 || defined key_lim2 151 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 152 #endif 145 153 CALL iom_set_axis_attr( "icbcla", class_num ) 146 154 … … 1015 1023 CHARACTER(LEN=*), INTENT(in) :: cdname 1016 1024 REAL(wp) , INTENT(in) :: pfield0d 1025 REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1017 1026 #if defined key_iomput 1018 CALL xios_send_field(cdname, (/pfield0d/)) 1027 zz(:,:)=pfield0d 1028 CALL xios_send_field(cdname, zz) 1029 !CALL xios_send_field(cdname, (/pfield0d/)) 1019 1030 #else 1020 1031 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings … … 1207 1218 !! 1208 1219 !!---------------------------------------------------------------------- 1209 REAL(wp), DIMENSION(1 ,1) :: zz = 1.1220 REAL(wp), DIMENSION(1) :: zz = 1. 1210 1221 !!---------------------------------------------------------------------- 1211 1222 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 1212 CALL iom_set_domain_attr('scalarpoint', data_dim=1) 1213 CALL iom_set_domain_attr('scalarpoint', lonvalue=(/ zz /), latvalue=(/ zz /)) 1223 CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 1224 zz=REAL(narea,wp) 1225 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 1214 1226 1215 1227 END SUBROUTINE set_scalar … … 1499 1511 1500 1512 #endif 1513 1514 LOGICAL FUNCTION iom_use( cdname ) 1515 CHARACTER(LEN=*), INTENT(in) :: cdname 1516 #if defined key_iomput 1517 iom_use = xios_field_is_active( cdname ) 1518 #else 1519 iom_use = .FALSE. 1520 #endif 1521 END FUNCTION iom_use 1501 1522 1502 1523 !!====================================================================== -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r4292 r4900 217 217 CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo) ! dimensions ids 218 218 iom_file(kiomid)%luld(kiv) = .FALSE. ! default value 219 iom_file(kiomid)%dimsz(:,kiv) = 0 ! reset dimsz in case previously used219 iom_file(kiomid)%dimsz(:,kiv) = 0 ! reset dimsz in case previously used 220 220 DO ji = 1, i_nvd ! dimensions size 221 221 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r4896 r4900 120 120 CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb ) 121 121 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb ) 122 IF( lk_lim3 ) CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 122 123 ! 123 124 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields … … 213 214 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb ) 214 215 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 216 IF( lk_lim3 ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 215 217 ELSE 216 218 neuler = 0 … … 248 250 hdivb(:,:,:) = hdivn(:,:,:) 249 251 sshb (:,:) = sshn (:,:) 250 ENDIF 251 ! 252 IF( lk_lim3 ) THEN 252 IF( lk_lim3 ) THEN 253 DO jk = 1, jpk 254 fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 255 END DO 256 ENDIF 257 ENDIF 258 ! 259 IF( lk_lim3 ) THEN 253 260 CALL iom_get( numror, jpdom_autoglo, 'iatte' , iatte ) ! clem modif 254 261 CALL iom_get( numror, jpdom_autoglo, 'oatte' , oatte ) ! clem modif -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r4897 r4900 423 423 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 424 424 END DO 425 IF(nimpp .eq. 1) THEN 426 pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk) 427 ENDIF 425 428 END DO 426 429 … … 459 462 pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk) 460 463 END DO 464 IF(nimpp .eq. 1) THEN 465 pt3dl( 1 ,ijpj,jk) = psgn * pt3dl( 2 ,ijpj-2,jk) 466 ENDIF 467 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 468 pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk) 469 ENDIF 461 470 END DO 462 471 … … 500 509 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(ijt,ijpj-3,jk) 501 510 END DO 511 IF(nimpp .eq. 1) THEN 512 pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk) 513 ENDIF 502 514 END DO 503 515 CASE ( 'F' ) ! F-point … … 513 525 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-3,jk) 514 526 END DO 527 IF(nimpp .eq. 1) THEN 528 pt3dl( 1 ,ijpj,jk) = psgn * pt3dl( 2 ,ijpj-3,jk) 529 ENDIF 530 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 531 pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk) 532 ENDIF 515 533 END DO 516 534 END SELECT … … 539 557 pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk) 540 558 END DO 559 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 560 pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk) 561 ENDIF 541 562 END DO 542 563 … … 576 597 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk) 577 598 END DO 599 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 600 pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk) 601 ENDIF 578 602 END DO 579 603 … … 664 688 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 665 689 END DO 690 IF (nimpp .eq. 1) THEN 691 pt2dl(1,ijpj) = psgn * pt2dl(3,ijpj-2) 692 ENDIF 666 693 667 694 IF(nimpp .ge. (jpiglo/2+1)) THEN … … 694 721 END DO 695 722 723 IF (nimpp .eq. 1) THEN 724 pt2dl( 1 ,ijpj ) = psgn * pt2dl( 2 ,ijpj-2) 725 pt2dl(1 ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1) 726 ENDIF 727 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 728 pt2dl(nlci,ijpj ) = psgn * pt2dl(nlci-1,ijpj-2) 729 ENDIF 730 696 731 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 697 732 endloop = nlci … … 728 763 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2) 729 764 END DO 765 IF (nimpp .eq. 1) THEN 766 pt2dl( 1 ,ijpj) = psgn * pt2dl( 3 ,ijpj-3) 767 ENDIF 730 768 731 769 CASE ( 'F' ) ! F-point … … 740 778 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2) 741 779 END DO 780 IF (nimpp .eq. 1) THEN 781 pt2dl( 1 ,ijpj) = psgn * pt2dl( 2 ,ijpj-3) 782 pt2dl( 1 ,ijpj-1) = psgn * pt2dl( 2 ,ijpj-2) 783 ENDIF 784 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 785 pt2dl(nlci,ijpj) = psgn * pt2dl(nlci-1,ijpj-3) 786 pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2) 787 ENDIF 742 788 743 789 CASE ( 'I' ) ! ice U-V point (I-point) … … 798 844 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 799 845 END DO 846 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 847 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1) 848 ENDIF 800 849 801 850 CASE ( 'V' ) ! V-point … … 826 875 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 827 876 END DO 877 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 878 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2) 879 ENDIF 828 880 829 881 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r4897 r4900 272 272 ii = 1 + MOD( jn-1, jpni ) 273 273 ij = 1 + (jn-1) / jpni 274 nfipproc(ii,ij) = jn - 1 274 275 nimppt(jn) = iimppt(ii,ij) 275 276 njmppt(jn) = ijmppt(ii,ij) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r4347 r4900 57 57 !! =1 global mean of emp set to zero at each nn_fsbc time step 58 58 !! =2 annual global mean corrected from previous year 59 !! =3 global mean of emp set to zero at each nn_fsbc time step 60 !! & spread out over erp area depending its sign 59 61 !! Note: if sea ice is embedded it is taken into account when computing the budget 60 62 !!---------------------------------------------------------------------- … … 81 83 IF( kn_fwb == 1 ) WRITE(numout,*) ' instantaneously set to zero' 82 84 IF( kn_fwb == 2 ) WRITE(numout,*) ' adjusted from previous year budget' 83 ENDIF 85 IF( kn_fwb == 3 ) WRITE(numout,*) ' fwf set to zero and spread out over erp area' 86 ENDIF 87 ! 88 IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' ) 84 89 ! 85 90 area = glob_sum( e1e2t(:,:) ) ! interior global domain surface … … 142 147 ENDIF 143 148 ! 149 CASE ( 3 ) !== global fwf set to zero and spread out over erp area ==! 150 ! 151 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 152 ztmsk_pos(:,:) = tmask_i(:,:) ! Select <0 and >0 area of erp 153 WHERE( erp < 0._wp ) ztmsk_pos = 0._wp 154 ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 155 ! 156 zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp 157 zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 158 ! ! fwf global mean (excluding ocean to ice/snow exchanges) 159 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area 160 ! 161 IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation 162 zsurf_tospread = zsurf_pos 163 ztmsk_tospread(:,:) = ztmsk_pos(:,:) 164 ELSE ! spread out over <0 erp area to increase precipitation 165 zsurf_tospread = zsurf_neg 166 ztmsk_tospread(:,:) = ztmsk_neg(:,:) 167 ENDIF 168 ! 169 zsum_fwf = glob_sum( e1e2t(:,:) * z_fwf ) ! fwf global mean over <0 or >0 erp area 170 !!gm : zsum_fwf = z_fwf * area ??? it is right? I think so.... 171 z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall ) 172 ! ! weight to respect erp field 2D structure 173 zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 174 z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 175 ! ! final correction term to apply 176 zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:) 177 ! 178 !!gm ===>>>> lbc_lnk should be useless as all the computation is done over the whole domain ! 179 CALL lbc_lnk( zerp_cor, 'T', 1. ) 180 ! 181 emp(:,:) = emp(:,:) + zerp_cor(:,:) 182 qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:) ! account for change to the heat budget due to fw correction 183 erp(:,:) = erp(:,:) + zerp_cor(:,:) 184 ! 185 IF( nprint == 1 .AND. lwp ) THEN ! control print 186 IF( z_fwf < 0._wp ) THEN 187 WRITE(numout,*)' z_fwf < 0' 188 WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 189 ELSE 190 WRITE(numout,*)' z_fwf >= 0' 191 WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 192 ENDIF 193 WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv' 194 WRITE(numout,*)' z_fwf = ', z_fwf ,' Kg/m2/s' 195 WRITE(numout,*)' z_fwf_nsrf = ', z_fwf_nsrf ,' Kg/m2/s' 196 WRITE(numout,*)' MIN(zerp_cor) = ', MINVAL(zerp_cor) 197 WRITE(numout,*)' MAX(zerp_cor) = ', MAXVAL(zerp_cor) 198 ENDIF 199 ENDIF 200 ! 144 201 CASE DEFAULT !== you should never be there ==! 145 CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1 or 2' )202 CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' ) 146 203 ! 147 204 END SELECT -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r4896 r4900 59 59 USE prtctl ! Print control 60 60 USE lib_fortran ! 61 USE cpl_oasis3, ONLY : lk_cpl 61 62 62 63 #if defined key_bdy … … 68 69 69 70 PUBLIC sbc_ice_lim ! routine called by sbcmod.F90 71 PUBLIC lim_prt_state 70 72 71 73 !! * Substitutions … … 133 135 INTEGER, INTENT(in) :: kblk ! type of bulk (=3 CLIO, =4 CORE) 134 136 !! 135 INTEGER :: j l! dummy loop index137 INTEGER :: ji, jj, jl, jk ! dummy loop index 136 138 REAL(wp) :: zcoef ! local scalar 137 139 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice_os, zalb_ice_cs ! albedo of the ice under overcast/clear sky … … 146 148 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all ! Mean d(qns)/dT over all categories 147 149 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all ! Mean d(qla)/dT over all categories 150 REAL(wp) :: ztmelts ! clem 2014: for HC diags 151 REAL(wp) :: epsi20 = 1.e-20 ! 148 152 !!---------------------------------------------------------------------- 149 153 … … 152 156 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 153 157 154 CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 155 156 #if defined key_coupled 157 IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_alloc( jpi,jpj,jpl, zalb_ice) 158 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 159 & CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 160 #endif 158 CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 159 160 IF( lk_cpl ) THEN 161 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 162 & CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 163 ENDIF 161 164 162 165 IF( kt == nit000 ) THEN … … 168 171 ! 169 172 IF( ln_nicep ) THEN ! control print at a given point 170 jiindx = 1 77 ; jjindx = 112173 jiindx = 15 ; jjindx = 44 171 174 IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 172 175 ENDIF … … 176 179 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only ! 177 180 ! !----------------------! 178 ! ! Bulk Formul ea!181 ! ! Bulk Formulae ! 179 182 ! !----------------! 180 183 ! … … 182 185 v_oce(:,:) = ssv_m(:,:) ! (C-grid dynamics : U- & V-points as the ocean) 183 186 ! 184 t_bo(:,:) = eos_fzp( sss_m ) + rt0! masked sea surface freezing temperature [Kelvin]185 ! ! (set to rt0 over land)187 t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) ) ! masked sea surface freezing temperature [Kelvin] 188 ! ! (set to rt0 over land) 186 189 CALL albedo_ice( t_su, ht_i, ht_s, zalb_ice_cs, zalb_ice_os ) ! ... ice albedo 187 190 … … 192 195 IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) + zalb_ice_os (:,:,:) ) 193 196 194 #if defined key_coupled 195 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 196 ! 197 ! Compute mean albedo and temperature 198 zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) ) 199 ztem_ice_all (:,:) = fice_ice_ave ( tn_ice (:,:,:) ) 200 ! 197 IF( lk_cpl ) THEN 198 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 199 ! 200 ! Compute mean albedo and temperature 201 zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) ) 202 ztem_ice_all (:,:) = fice_ice_ave ( tn_ice (:,:,:) ) 203 ! 204 ENDIF 201 205 ENDIF 202 #endif203 206 ! Bulk formulea - provides the following fields: 204 207 ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] … … 218 221 ! 219 222 CASE( 4 ) ! CORE bulk formulation 220 CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice_cs, & 223 ! MV 2014 224 ! We must account for cloud fraction in the computation of the albedo 225 ! The present ref just uses the clear sky value 226 ! The overcast sky value is 0.06 higher, and polar skies are mostly overcast 227 ! CORE has no cloud fraction, hence we must prescribe it 228 ! Mean summer cloud fraction computed from CLIO = 0.81 229 zalb_ice(:,:,:) = 0.19 * zalb_ice_cs(:,:,:) + 0.81 * zalb_ice_os(:,:,:) 230 ! Following line, we replace zalb_ice_cs by simply zalb_ice 231 CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice , & 221 232 & utau_ice , vtau_ice , qns_ice , qsr_ice , & 222 233 & qla_ice , dqns_ice , dqla_ice , & … … 239 250 240 251 ! Average over all categories 241 #if defined key_coupled 252 IF( lk_cpl ) THEN 242 253 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 243 254 … … 269 280 END IF 270 281 END IF 271 #endif 282 ENDIF 272 283 ! !----------------------! 273 284 ! ! LIM-3 time-stepping ! … … 285 296 old_smv_i(:,:,:) = smv_i(:,:,:) ! salt content 286 297 old_oa_i (:,:,:) = oa_i (:,:,:) ! areal age content 287 !288 old_ u_ice(:,:) = u_ice(:,:)289 old_v_ice(:,:) = v_ice(:,:) 290 ! ! intialisation to zero!!gm is it truly necessary ???298 old_u_ice(:,:) = u_ice(:,:) 299 old_v_ice(:,:) = v_ice(:,:) 300 301 ! trends !!gm is it truly necessary ??? 291 302 d_a_i_thd (:,:,:) = 0._wp ; d_a_i_trp (:,:,:) = 0._wp 292 303 d_v_i_thd (:,:,:) = 0._wp ; d_v_i_trp (:,:,:) = 0._wp … … 296 307 d_smv_i_thd(:,:,:) = 0._wp ; d_smv_i_trp(:,:,:) = 0._wp 297 308 d_oa_i_thd (:,:,:) = 0._wp ; d_oa_i_trp (:,:,:) = 0._wp 298 ! 299 d_u_ice_dyn(:,:) = 0._wp 300 d_v_ice_dyn(:,:) = 0._wp 301 ! 302 sfx (:,:) = 0._wp ; sfx_thd (:,:) = 0._wp 303 sfx_bri(:,:) = 0._wp ; sfx_mec (:,:) = 0._wp ; sfx_res (:,:) = 0._wp 304 fhbri (:,:) = 0._wp ; fheat_mec(:,:) = 0._wp ; fheat_res(:,:) = 0._wp 305 fhmec (:,:) = 0._wp ; 306 fmmec (:,:) = 0._wp 307 fmmflx (:,:) = 0._wp 308 focea2D(:,:) = 0._wp 309 fsup2D (:,:) = 0._wp 310 311 ! used in limthd.F90 312 rdvosif(:,:) = 0._wp ! variation of ice volume at surface 313 rdvobif(:,:) = 0._wp ! variation of ice volume at bottom 314 fdvolif(:,:) = 0._wp ! total variation of ice volume 315 rdvonif(:,:) = 0._wp ! lateral variation of ice volume 316 fstric (:,:) = 0._wp ! part of solar radiation transmitted through the ice 317 ffltbif(:,:) = 0._wp ! linked with fstric 318 qfvbq (:,:) = 0._wp ! linked with fstric 319 rdm_snw(:,:) = 0._wp ! variation of snow mass per unit area 320 rdm_ice(:,:) = 0._wp ! variation of ice mass per unit area 321 hicifp (:,:) = 0._wp ! daily thermodynamic ice production. 322 ! 323 diag_sni_gr(:,:) = 0._wp ; diag_lat_gr(:,:) = 0._wp 324 diag_bot_gr(:,:) = 0._wp ; diag_dyn_gr(:,:) = 0._wp 325 diag_bot_me(:,:) = 0._wp ; diag_sur_me(:,:) = 0._wp 326 diag_res_pr(:,:) = 0._wp ; diag_trp_vi(:,:) = 0._wp 309 d_u_ice_dyn(:,:) = 0._wp ; d_v_ice_dyn(:,:) = 0._wp 310 311 ! salt, heat and mass fluxes 312 sfx (:,:) = 0._wp ; 313 sfx_bri(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp 314 sfx_sni(:,:) = 0._wp ; sfx_opw(:,:) = 0._wp 315 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp 316 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 317 sfx_res(:,:) = 0._wp 318 319 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp 320 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp 321 wfx_bog(:,:) = 0._wp ; wfx_dyn(:,:) = 0._wp 322 wfx_bom(:,:) = 0._wp ; wfx_sum(:,:) = 0._wp 323 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 324 wfx_spr(:,:) = 0._wp ; 325 326 hfx_in (:,:) = 0._wp ; hfx_out(:,:) = 0._wp 327 hfx_thd(:,:) = 0._wp ; 328 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp 329 hfx_bog(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp 330 hfx_bom(:,:) = 0._wp ; hfx_sum(:,:) = 0._wp 331 hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp 332 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 333 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 334 335 ! 336 fhld (:,:) = 0._wp 337 fmmflx(:,:) = 0._wp 338 ! part of solar radiation transmitted through the ice 339 ftr_ice(:,:,:) = 0._wp 340 341 ! diags 342 diag_trp_vi (:,:) = 0._wp ; diag_trp_vs(:,:) = 0._wp ; diag_trp_ei(:,:) = 0._wp ; diag_trp_es(:,:) = 0._wp 343 diag_heat_dhc(:,:) = 0._wp 344 327 345 ! dynamical invariants 328 346 delta_i(:,:) = 0._wp ; divu_i(:,:) = 0._wp ; shear_i(:,:) = 0._wp … … 375 393 zcoef = rdt_ice /rday ! Ice natural aging 376 394 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 377 CALL lim_var_glo2eqv ! this CALL is maybe not necessary (Martin)378 395 IF( ln_nicep ) CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' ) ! control print 379 396 CALL lim_itd_th( kt ) ! Remap ice categories, lateral accretion ! … … 391 408 ! ! Diagnostics and outputs 392 409 IF (ln_limdiaout) CALL lim_diahsb 393 !clem # if ! defined key_iomput 410 394 411 CALL lim_wri( 1 ) ! Ice outputs 395 !clem # endif 412 396 413 IF( kt == nit000 .AND. ln_rstart ) & 397 414 & CALL iom_close( numrir ) ! clem: close input ice restart file … … 413 430 414 431 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! 415 ! 416 CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 417 418 #if defined key_coupled 419 IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice) 420 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 421 & CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 422 #endif 432 CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 433 434 IF( lk_cpl ) THEN 435 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 436 & CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 437 ENDIF 423 438 ! 424 439 IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim') … … 534 549 ! WRITE(numout,*) ' sst : ', sst_m(ji,jj) 535 550 ! WRITE(numout,*) ' sss : ', sss_m(ji,jj) 536 ! WRITE(numout,*) ' s_i_newice : ', s_i_newice(ji,jj,1:jpl)537 551 ! WRITE(numout,*) 538 552 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 591 605 !WRITE(numout,*) ' sst : ', sst_m(ji,jj) 592 606 !WRITE(numout,*) ' sss : ', sss_m(ji,jj) 593 !WRITE(numout,*) ' qcmif : ', qcmif(ji,jj)594 !WRITE(numout,*) ' qldif : ', qldif(ji,jj)595 !WRITE(numout,*) ' qcmif : ', qcmif(ji,jj) / rdt_ice596 !WRITE(numout,*) ' qldif : ', qldif(ji,jj) / rdt_ice597 !WRITE(numout,*) ' qfvbq : ', qfvbq(ji,jj)598 !WRITE(numout,*) ' qdtcn : ', qdtcn(ji,jj)599 !WRITE(numout,*) ' qfvbq / dt: ', qfvbq(ji,jj) / rdt_ice600 !WRITE(numout,*) ' qdtcn / dt: ', qdtcn(ji,jj) / rdt_ice601 !WRITE(numout,*) ' fdtcn : ', fdtcn(ji,jj)602 !WRITE(numout,*) ' fhmec : ', fhmec(ji,jj)603 !WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj)604 !WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj)605 !WRITE(numout,*) ' fhbri : ', fhbri(ji,jj)606 607 ! 607 608 !CALL lim_prt_state( kt, ji, jj, 2, ' ') … … 790 791 WRITE(numout,*) ' - Heat / FW fluxes ' 791 792 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 792 WRITE(numout,*) ' emp : ', emp (ji,jj) 793 WRITE(numout,*) ' sfx : ', sfx (ji,jj) 794 WRITE(numout,*) ' sfx_thd : ', sfx_thd(ji,jj) 795 WRITE(numout,*) ' sfx_bri : ', sfx_bri (ji,jj) 796 WRITE(numout,*) ' sfx_mec : ', sfx_mec (ji,jj) 797 WRITE(numout,*) ' sfx_res : ', sfx_res(ji,jj) 798 WRITE(numout,*) ' fmmec : ', fmmec (ji,jj) 799 WRITE(numout,*) ' fhmec : ', fhmec (ji,jj) 800 WRITE(numout,*) ' fhbri : ', fhbri (ji,jj) 801 WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj) 793 WRITE(numout,*) ' - Heat fluxes in and out the ice ***' 794 WRITE(numout,*) ' qsr_ini : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( old_a_i(ji,jj,:) * qsr_ice(ji,jj,:) ) 795 WRITE(numout,*) ' qns_ini : ', pfrld(ji,jj) * qns(ji,jj) + SUM( old_a_i(ji,jj,:) * qns_ice(ji,jj,:) ) 796 WRITE(numout,*) 802 797 WRITE(numout,*) 803 798 WRITE(numout,*) ' sst : ', sst_m(ji,jj) … … 829 824 WRITE(numout,*) ' qsr : ', qsr(ji,jj) 830 825 WRITE(numout,*) ' qns : ', qns(ji,jj) 831 WRITE(numout,*) ' fdtcn : ', fdtcn(ji,jj) 832 WRITE(numout,*) ' qcmif : ', qcmif(ji,jj) * r1_rdtice 833 WRITE(numout,*) ' qldif : ', qldif(ji,jj) * r1_rdtice 826 WRITE(numout,*) 827 WRITE(numout,*) ' hfx_mass : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj) 828 WRITE(numout,*) ' hfx_in : ', hfx_in(ji,jj) 829 WRITE(numout,*) ' hfx_out : ', hfx_out(ji,jj) 830 WRITE(numout,*) ' dhc : ', diag_heat_dhc(ji,jj) 831 WRITE(numout,*) 832 WRITE(numout,*) ' hfx_dyn : ', hfx_dyn(ji,jj) 833 WRITE(numout,*) ' hfx_thd : ', hfx_thd(ji,jj) 834 WRITE(numout,*) ' hfx_res : ', hfx_res(ji,jj) 835 WRITE(numout,*) ' fhtur : ', fhtur(ji,jj) 836 WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_rdtice 834 837 WRITE(numout,*) 835 838 WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 836 839 WRITE(numout,*) ' emp : ', emp (ji,jj) 837 WRITE(numout,*) ' sfx_bri : ', sfx_bri(ji,jj)838 840 WRITE(numout,*) ' sfx : ', sfx (ji,jj) 839 841 WRITE(numout,*) ' sfx_res : ', sfx_res(ji,jj) 840 WRITE(numout,*) ' sfx_mec : ', sfx_mec(ji,jj) 841 WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 842 WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj) 842 WRITE(numout,*) ' sfx_bri : ', sfx_bri(ji,jj) 843 WRITE(numout,*) ' sfx_dyn : ', sfx_dyn(ji,jj) 843 844 WRITE(numout,*) 844 845 WRITE(numout,*) ' - Momentum fluxes ' 845 846 WRITE(numout,*) ' utau : ', utau(ji,jj) 846 847 WRITE(numout,*) ' vtau : ', vtau(ji,jj) 847 ENDIF 848 ENDIF 848 849 WRITE(numout,*) ' ' 849 850 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
r4897 r4900 121 121 IF(lwp) WRITE(numout,*) 122 122 IF(lwp) WRITE(numout,*) ' convection :' 123 ! 124 IF( ln_zdfnpc ) CALL ctl_stop( ' zdf_init: non penetrative convective scheme is not working', & 125 & ' set ln_zdfnpc to FALSE' ) 126 ! 123 127 ioptio = 0 124 128 IF( ln_zdfnpc ) THEN -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4897 r4900 560 560 ENDIF 561 561 ! 562 IF( lk_c1d .AND. .NOT.lk_iomput ) CALL ctl_stop( 'nemo_ctl: The 1D configuration must be used ', &563 & 'with the IOM Input/Output manager. ' , &564 & 'Compile with key_iomput enabled' )565 !566 562 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 567 563 & 'f2003 standard. ' , & -
branches/2014/dev_CNRS_2014/NEMOGCM/SETTE/prepare_job.sh
r4373 r4900 182 182 fi 183 183 184 # example for NOCS Altix system using PBSbatch submission (requires ${SETTE_DIR}/sette_batch_template file)184 # example for NOCS ClusterVision system using SLURM batch submission (requires ${SETTE_DIR}/sette_batch_template file) 185 185 # 186 186 # if [ ${MPI_FLAG} == "no" ] ; then 187 187 case ${COMPILER} in 188 ALTIX_NAUTILUS_MPT)189 NB_REM=$( echo $NB_PROC $NXIO_PROC | awk '{print ( $1 + $2 ) % 4}')188 X64_MOBILIS) 189 NB_REM=$( echo $NB_PROC $NXIO_PROC | awk '{print ( $1 + $2 ) % 16}') 190 190 if [ ${NB_REM} == 0 ] ; then 191 # number of processes required is an integer multiple of 4191 # number of processes required is an integer multiple of 16 192 192 # 193 NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{print ($1 + $2 ) / 4}')193 NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{print ($1 + $2 ) / 16}') 194 194 else 195 195 # 196 # number of processes required is not an integer multiple of 4196 # number of processes required is not an integer multiple of 16 197 197 # round up the number of nodes required. 198 198 # 199 NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{printf("%d",($1 + $2 ) / 4+ 1 )}')199 NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{printf("%d",($1 + $2 ) / 16 + 1 )}') 200 200 fi 201 201 ;; -
branches/2014/dev_CNRS_2014/NEMOGCM/SETTE/sette_rpt
r3725 r4900 17 17 cd $NEMO_VALID 18 18 # 19 # The script also needs the date or revision tag. Currently this is taken from the latest sub-directory 20 # found in the WGYRE_LONG directory 21 # 22 set dorv = `ls -1rtd ./WGYRE_LONG/{$mach}/* | tail -1l ` 23 set dorv = $dorv:t 19 # The script also needs the date or revision tag. Currently this is taken from the latest sub-directory found in each directory 20 # 24 21 # 25 22 # Now loop through all the test directories. On the second pass the user can optionally examine any mismatched … … 30 27 foreach pass (0 1 ) 31 28 if ( -d ./WGYRE_LONG ) then 29 set dorv = `ls -1rtd ./WGYRE_LONG/{$mach}/* | tail -1l ` 30 set dorv = $dorv:t 32 31 set f1o = ./WGYRE_LONG/{$mach}/{$dorv}/LONG/ocean.output 33 32 set f1s = ./WGYRE_LONG/{$mach}/{$dorv}/LONG/solver.stat … … 39 38 cmp -s f1.tmp$$ $f2s 40 39 if ( $status == 0 ) then 41 echo "GYRE restartability passed"42 else 43 echo "GYRE restartability FAILED"40 echo "GYRE restartability passed" 41 else 42 echo "GYRE restartability FAILED" 44 43 if ( $pass == 1 ) then 45 44 echo "<return> to view solver.stat differences" … … 57 56 58 57 if ( -d ./WORCA2LIMPIS_LONG ) then 58 set dorv = `ls -1rtd ./WORCA2LIMPIS_LONG/{$mach}/* | tail -1l ` 59 set dorv = $dorv:t 59 60 set f1o = ./WORCA2LIMPIS_LONG/{$mach}/{$dorv}/LONG/ocean.output 60 61 set f1s = ./WORCA2LIMPIS_LONG/{$mach}/{$dorv}/LONG/solver.stat … … 84 85 85 86 if ( -d ./WORCA2OFFPIS_LONG ) then 87 set dorv = `ls -1rtd ./WORCA2OFFPIS_LONG/{$mach}/* | tail -1l ` 88 set dorv = $dorv:t 86 89 set f1o = ./WORCA2OFFPIS_LONG/{$mach}/{$dorv}/LONG/ocean.output 87 90 set f1s = ./WORCA2OFFPIS_LONG/{$mach}/{$dorv}/LONG/tracer.stat … … 111 114 112 115 if ( -d ./WAMM12_LONG ) then 116 set dorv = `ls -1rtd ./WAMM12_LONG/{$mach}/* | tail -1l ` 117 set dorv = $dorv:t 113 118 set f1o = ./WAMM12_LONG/{$mach}/{$dorv}/LONG/ocean.output 114 119 set f1s = ./WAMM12_LONG/{$mach}/{$dorv}/LONG/solver.stat … … 136 141 rm f1.tmp$$ 137 142 endif 138 143 NEXT0: 144 if ( -d ./WSAS_LONG ) then 145 set dorv = `ls -1rtd ./WSAS_LONG/{$mach}/* | tail -1l ` 146 set dorv = $dorv:t 147 set f1o = ./WSAS_LONG/{$mach}/{$dorv}/LONG/ocean.output 148 set f1s = ./WSAS_LONG/{$mach}/{$dorv}/LONG/solver.stat 149 set f2o = ./WSAS_LONG/{$mach}/{$dorv}/SHORT/ocean.output 150 set f2s = ./WSAS_LONG/{$mach}/{$dorv}/SHORT/solver.stat 151 152 foreach f ( $f1o $f1s $f2o $f2s ) 153 if ( ! -f $f ) then 154 echo 'SAS restartability inconclusive ( ' $f:t ' not found )' 155 goto NEXT 156 endif 157 end 158 159 set nl = `wc -l $f2s` 160 tail -$nl[1] $f1s > f1.tmp$$ 161 cmp -s f1.tmp$$ $f2s 162 if ( $status == 0 ) then 163 echo "SAS restartability passed" 164 else 165 echo "SAS restartability FAILED" 166 if ( $pass == 1 ) then 167 echo "<return> to view solver.stat differences" 168 set y = $< 169 sdiff f1.tmp$$ $f2s 170 echo "<return> to view ocean.output differences" 171 set y = $< 172 sdiff $f1o $f2o | grep "|" 173 echo "<return> to continue" 174 set y = $< 175 endif 176 endif 177 rm f1.tmp$$ 178 endif 179 180 NEXT: 139 181 echo 140 182 141 183 if ( -d ./WGYRE_4 ) then 184 set dorv = `ls -1rtd ./WGYRE_4/{$mach}/* | tail -1l ` 185 set dorv = $dorv:t 142 186 set f1o = ./WGYRE_4/{$mach}/{$dorv}/REPRO_1_4/ocean.output 143 187 set f1s = ./WGYRE_4/{$mach}/{$dorv}/REPRO_1_4/solver.stat … … 147 191 cmp -s $f1s $f2s 148 192 if ( $status == 0 ) then 149 echo "GYRE reproducibility passed"150 else 151 echo "GYRE reproducibility FAILED"193 echo "GYRE reproducibility passed" 194 else 195 echo "GYRE reproducibility FAILED" 152 196 if ( $pass == 1 ) then 153 197 echo "<return> to view solver.stat differences" … … 164 208 165 209 if ( -d ./WORCA2LIMPIS_16 ) then 210 set dorv = `ls -1rtd ./WORCA2LIMPIS_16/{$mach}/* | tail -1l ` 211 set dorv = $dorv:t 166 212 set f1o = ./WORCA2LIMPIS_16/{$mach}/{$dorv}/REPRO_2_8/ocean.output 167 213 set f1s = ./WORCA2LIMPIS_16/{$mach}/{$dorv}/REPRO_2_8/solver.stat … … 188 234 189 235 if ( -d ./WORCA2OFFPIS_16 ) then 236 set dorv = `ls -1rtd ./WORCA2OFFPIS_16/{$mach}/* | tail -1l ` 237 set dorv = $dorv:t 190 238 set f1o = ./WORCA2OFFPIS_16/{$mach}/{$dorv}/REPRO_2_8/ocean.output 191 239 set f1s = ./WORCA2OFFPIS_16/{$mach}/{$dorv}/REPRO_2_8/tracer.stat … … 212 260 213 261 if ( -d ./WAMM12_32 ) then 262 set dorv = `ls -1rtd ./WAMM12_32/{$mach}/* | tail -1l ` 263 set dorv = $dorv:t 214 264 set f1o = ./WAMM12_32/{$mach}/{$dorv}/REPRO_4_8/ocean.output 215 265 set f1s = ./WAMM12_32/{$mach}/{$dorv}/REPRO_4_8/solver.stat … … 235 285 endif 236 286 287 if ( -d ./WSAS_32 ) then 288 set dorv = `ls -1rtd ./WSAS_32/{$mach}/* | tail -1l ` 289 set dorv = $dorv:t 290 set f1o = ./WSAS_32/{$mach}/{$dorv}/REPRO_4_8/ocean.output 291 set f1s = ./WSAS_32/{$mach}/{$dorv}/REPRO_4_8/solver.stat 292 set f2o = ./WSAS_32/{$mach}/{$dorv}/REPRO_8_4/ocean.output 293 set f2s = ./WSAS_32/{$mach}/{$dorv}/REPRO_8_4/solver.stat 294 295 foreach f ( $f1o $f1s $f2o $f2s ) 296 if ( ! -f $f ) then 297 echo 'SAS reproducibility inconclusive ( ' $f:t ' not found )' 298 goto NEXT1 299 endif 300 end 301 302 cmp -s $f1s $f2s 303 if ( $status == 0 ) then 304 echo "SAS reproducibility passed" 305 else 306 echo "SAS reproducibility FAILED" 307 if ( $pass == 1 ) then 308 echo "<return> to view solver.stat differences" 309 set y = $< 310 sdiff $f1s $f2s 311 echo "<return> to view ocean.output differences" 312 set y = $< 313 sdiff $f1o $f2o | grep "|" 314 echo "<return> to continue" 315 set y = $< 316 endif 317 endif 318 endif 319 NEXT1: 320 237 321 if ( -d ./WORCA2AGUL_1_2 ) then 322 set dorv = `ls -1rtd ./WORCA2AGUL_1_2/{$mach}/* | tail -1l ` 323 set dorv = $dorv:t 238 324 set f1o = ./WORCA2AGUL_1_2/{$mach}/{$dorv}/SHORT/ocean.output 239 325 set f1s = ./WORCA2AGUL_1_2/{$mach}/{$dorv}/SHORT/solver.stat -
branches/2014/dev_CNRS_2014/NEMOGCM/SETTE/sette_xios.sh
r4373 r4900 1 1 #!/bin/bash 2 2 ############################################################ 3 # Author : Simona Flavoni for NEMO4 # Contact: sflod@locean-ipsl.upmc.fr5 # 201 3 : A.C. Coward added options for testing with XIOS in dettached mode6 # 7 # sette .sh : principal script of SET TEsts for NEMO (SETTE)3 # Author : Italo Epicoco - CMCC 4 # Contact: italo.epicoco@unisalento.it 5 # 2014 : A.C. Coward added new namelist settings for GYRE configuration 6 # 7 # sette_xios.sh : additional script of SET TEsts for XIOS within NEMO 8 8 # ---------------------------------------------------------------------- 9 # NEMO/SETTE , NEMO Consortium (201 0)9 # NEMO/SETTE , NEMO Consortium (2014) 10 10 # Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 11 11 # ---------------------------------------------------------------------- … … 29 29 # MPIRUN_FLAG : flag to run in parallel (MPI) "yes" 30 30 # to run in sequential mode (NB_PROC = 1) "no" 31 # USING_XIOS : flag to control the activation of key_iomput32 # "yes" to compile using key_iomput and link to the external XIOS library33 # "no" to compile without key_iomput and link to the old IOIPSL library34 31 # USING_MPMD : flag to control the use of stand-alone IO servers 35 # requires USING_XIOS="yes" 36 # "yes" to run in MPMD (detached) mode with stand-alone IO servers 37 # "no" to run in SPMD (attached) mode without separate IO servers 32 # "true" to run in MPMD (detached) mode with stand-alone IO servers 33 # "false" to run in SPMD (attached) mode without separate IO servers 38 34 # NUM_XIOSERVERS : number of stand-alone IO servers to employ 39 # set to zero if USING_MPMD=" no"40 # 41 # Principal script is sette .sh, that calls35 # set to zero if USING_MPMD="false" 36 # 37 # Principal script is sette_xios.sh, that calls 42 38 # 43 39 # makenemo : to create successive exectuables in ${CONFIG_NAME}/BLD/bin/nemo.exe … … 81 77 # executed commands 82 78 # 83 # NOTE: if sette .sh is stopped in output.sette there is written the last command84 # executed by sette .sh85 # 86 # example use: ./sette .sh79 # NOTE: if sette_xios.sh is stopped in output.sette there is written the last command 80 # executed by sette_xios.sh 81 # 82 # example use: ./sette_xios.sh 87 83 ######################################################################################### 88 84 # … … 103 99 104 100 CMP_NAM=${1:-$COMPILER} 101 # 102 #================================================================================= 105 103 # Copy job_batch_COMPILER file for specific compiler into job_batch_template 104 # Note this batch template needs to be capable of launching both SPMD and MPMD 105 # tasks with internal selection depending on the value of NUM_XIOSERVERS 106 # (0=SPMD; >0 = MPMD) 107 #================================================================================= 108 # 106 109 cd ${SETTE_DIR} 107 110 cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit 108 111 109 for config in 2112 for config in 1 2 110 113 111 114 do 112 115 113 # TESTS FOR GYRE CONFIGURATION 116 #========================================================== 117 # TESTS FOR XIOS USING GYRE CONFIGURATION AT LOW RESOLUTION 118 #========================================================== 119 114 120 if [ ${config} -eq 1 ] ; then 115 ## Restartability tests for GYRE 121 ## Test of XIOS configured in attached mode with multiple output files (one for each process). 122 ## $NPROC processes are used 116 123 117 124 NPROC=4 125 jp_cfg=1 126 jpni=2 127 jpnj=2 118 128 export NUM_XIOSERVERS=0 119 129 export USING_MPMD="false" … … 124 134 . ../CONFIG/makenemo -m ${CMP_NAM} -n GYRE_XIOS_LR -r GYRE_XIOS -j 8 125 135 cd ${SETTE_DIR} 126 . param.cfg127 . all_functions.sh128 . prepare_exe_dir.sh136 . ./param.cfg 137 . ./all_functions.sh 138 . ./prepare_exe_dir.sh 129 139 JOB_FILE=${EXE_DIR}/run_job.sh 130 140 if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi … … 133 143 set_namelist namelist_cfg nn_it000 1 134 144 set_namelist namelist_cfg nn_itend 120 135 set_namelist namelist_cfg nn_stock 60 136 set_namelist namelist_cfg ln_clobber .true. 137 set_namelist namelist_cfg jp_cfg 1 138 set_namelist namelist_cfg jpni 2 139 set_namelist namelist_cfg jpnj 2 145 set_namelist namelist_cfg nn_stock 120 146 set_namelist namelist_cfg ln_clobber .true. 147 set_namelist namelist_cfg jp_cfg $jp_cfg 148 set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 149 set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 150 set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 151 set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 152 set_namelist namelist_cfg jpni $jpni 153 set_namelist namelist_cfg jpnj $jpnj 140 154 set_namelist namelist_cfg jpnij $NPROC 141 155 … … 149 163 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 150 164 165 166 ## Test of XIOS configured in attached mode with a single output file. 151 167 152 168 export TEST_NAME="ATTACHED_ONE" … … 154 170 export USING_MPMD="false" 155 171 cd ${SETTE_DIR} 156 . prepare_exe_dir.sh172 . ./prepare_exe_dir.sh 157 173 JOB_FILE=${EXE_DIR}/run_job.sh 158 174 if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi … … 161 177 set_namelist namelist_cfg nn_it000 1 162 178 set_namelist namelist_cfg nn_itend 120 163 set_namelist namelist_cfg nn_stock 60 164 set_namelist namelist_cfg ln_clobber .true. 165 set_namelist namelist_cfg jp_cfg 1 166 set_namelist namelist_cfg jpni 2 167 set_namelist namelist_cfg jpnj 2 179 set_namelist namelist_cfg nn_stock 120 180 set_namelist namelist_cfg ln_clobber .true. 181 set_namelist namelist_cfg jp_cfg $jp_cfg 182 set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 183 set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 184 set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 185 set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 186 set_namelist namelist_cfg jpni $jpni 187 set_namelist namelist_cfg jpnj $jpnj 168 188 set_namelist namelist_cfg jpnij $NPROC 169 189 … … 177 197 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 178 198 199 200 ## Test of XIOS configured in detached mode with a single output file. 201 ## $NUM_XIOSERVERS IO server are used. 202 ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC 179 203 180 204 export TEST_NAME="DETACHED_ONE" … … 182 206 export USING_MPMD="true" 183 207 cd ${SETTE_DIR} 184 . prepare_exe_dir.sh 208 # 209 . ./prepare_exe_dir.sh 185 210 JOB_FILE=${EXE_DIR}/run_job.sh 186 211 if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi … … 189 214 set_namelist namelist_cfg nn_it000 1 190 215 set_namelist namelist_cfg nn_itend 120 191 set_namelist namelist_cfg nn_stock 60 192 set_namelist namelist_cfg ln_clobber .true. 193 set_namelist namelist_cfg jp_cfg 1 194 set_namelist namelist_cfg jpni 2 195 set_namelist namelist_cfg jpnj 2 216 set_namelist namelist_cfg nn_stock 120 217 set_namelist namelist_cfg ln_clobber .true. 218 set_namelist namelist_cfg jp_cfg $jp_cfg 219 set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 220 set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 221 set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 222 set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 223 set_namelist namelist_cfg jpni $jpni 224 set_namelist namelist_cfg jpnj $jpnj 196 225 set_namelist namelist_cfg jpnij $NPROC 197 226 … … 204 233 cd ${SETTE_DIR} 205 234 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 235 236 ## Test of XIOS configured in detached mode with multiple output files (one for each IO server). 237 ## $NUM_XIOSERVERS IO server are used. 238 ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC 239 206 240 207 241 export TEST_NAME="DETACHED_MULTIPLE" … … 209 243 export USING_MPMD="true" 210 244 cd ${SETTE_DIR} 211 . prepare_exe_dir.sh245 . ./prepare_exe_dir.sh 212 246 JOB_FILE=${EXE_DIR}/run_job.sh 213 247 if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi … … 216 250 set_namelist namelist_cfg nn_it000 1 217 251 set_namelist namelist_cfg nn_itend 120 218 set_namelist namelist_cfg nn_stock 60 219 set_namelist namelist_cfg ln_clobber .true. 220 set_namelist namelist_cfg jp_cfg 1 221 set_namelist namelist_cfg jpni 2 222 set_namelist namelist_cfg jpnj 2 252 set_namelist namelist_cfg nn_stock 120 253 set_namelist namelist_cfg ln_clobber .true. 254 set_namelist namelist_cfg jp_cfg $jp_cfg 255 set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 256 set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 257 set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 258 set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 259 set_namelist namelist_cfg jpni $jpni 260 set_namelist namelist_cfg jpnj $jpnj 223 261 set_namelist namelist_cfg jpnij $NPROC 224 262 … … 234 272 fi 235 273 274 #========================================================== 275 # TESTS FOR XIOS USING GYRE CONFIGURATION AT HIGH RESOLUTION 276 #========================================================== 277 236 278 if [ ${config} -eq 2 ] ; then 237 ## Restartability tests for GYRE 238 239 NPROC=152 279 ## Test of XIOS configured in attached mode with multiple output files (one for each process). 280 ## $NPROC processes are used 281 282 NPROC=64 283 jp_cfg=30 284 jpni=8 285 jpnj=8 240 286 export NUM_XIOSERVERS=0 241 287 export USING_MPMD="false" … … 246 292 . ../CONFIG/makenemo -m ${CMP_NAM} -n GYRE_XIOS_HR -r GYRE_XIOS -j 8 247 293 cd ${SETTE_DIR} 248 . param.cfg 249 . all_functions.sh 250 . prepare_exe_dir.sh 294 # 295 . ./param.cfg 296 . ./all_functions.sh 297 . ./prepare_exe_dir.sh 298 # 251 299 JOB_FILE=${EXE_DIR}/run_job.sh 252 300 if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi … … 258 306 set_namelist namelist_cfg nn_bench 1 259 307 set_namelist namelist_cfg ln_clobber .true. 260 set_namelist namelist_cfg jp_cfg 144 261 set_namelist namelist_cfg jpni 19 262 set_namelist namelist_cfg jpnj 8 308 set_namelist namelist_cfg jp_cfg $jp_cfg 309 set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 310 set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 311 set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 312 set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 313 set_namelist namelist_cfg jpni $jpni 314 set_namelist namelist_cfg jpnj $jpnj 263 315 set_namelist namelist_cfg jpnij $NPROC 264 316 … … 273 325 274 326 327 ## Test of XIOS configured in attached mode with a single output file. 275 328 276 329 export TEST_NAME="ATTACHED_ONE" … … 278 331 export USING_MPMD="false" 279 332 cd ${SETTE_DIR} 280 . prepare_exe_dir.sh 333 # 334 . ./prepare_exe_dir.sh 335 # 281 336 JOB_FILE=${EXE_DIR}/run_job.sh 282 337 if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi … … 288 343 set_namelist namelist_cfg nn_bench 1 289 344 set_namelist namelist_cfg ln_clobber .true. 290 set_namelist namelist_cfg jp_cfg 144 291 set_namelist namelist_cfg jpni 19 292 set_namelist namelist_cfg jpnj 8 345 set_namelist namelist_cfg jp_cfg $jp_cfg 346 set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 347 set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 348 set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 349 set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 350 set_namelist namelist_cfg jpni $jpni 351 set_namelist namelist_cfg jpnj $jpnj 293 352 set_namelist namelist_cfg jpnij $NPROC 294 353 … … 301 360 cd ${SETTE_DIR} 302 361 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 362 363 364 ## Test of XIOS configured in detached mode with a single output file. 365 ## $NUM_XIOSERVERS IO server are used. 366 ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC 303 367 304 368 export TEST_NAME="DETACHED_ONE" … … 306 370 export USING_MPMD="true" 307 371 cd ${SETTE_DIR} 308 . prepare_exe_dir.sh 372 # 373 . ./prepare_exe_dir.sh 374 # 309 375 JOB_FILE=${EXE_DIR}/run_job.sh 310 376 if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi … … 316 382 set_namelist namelist_cfg nn_bench 1 317 383 set_namelist namelist_cfg ln_clobber .true. 318 set_namelist namelist_cfg jp_cfg 144 319 set_namelist namelist_cfg jpni 19 320 set_namelist namelist_cfg jpnj 8 384 set_namelist namelist_cfg jp_cfg $jp_cfg 385 set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 386 set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 387 set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 388 set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 389 set_namelist namelist_cfg jpni $jpni 390 set_namelist namelist_cfg jpnj $jpnj 321 391 set_namelist namelist_cfg jpnij $NPROC 322 392 … … 329 399 cd ${SETTE_DIR} 330 400 . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 401 402 ## Test of XIOS configured in detached mode with multiple output files (one for each IO server). 403 ## $NUM_XIOSERVERS IO server are used. 404 ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC 331 405 332 406 export TEST_NAME="DETACHED_MULTIPLE" … … 334 408 export USING_MPMD="true" 335 409 cd ${SETTE_DIR} 336 . prepare_exe_dir.sh410 . ./prepare_exe_dir.sh 337 411 JOB_FILE=${EXE_DIR}/run_job.sh 338 412 if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi … … 344 418 set_namelist namelist_cfg nn_bench 1 345 419 set_namelist namelist_cfg ln_clobber .true. 346 set_namelist namelist_cfg jp_cfg 144 347 set_namelist namelist_cfg jpni 19 348 set_namelist namelist_cfg jpnj 8 420 set_namelist namelist_cfg jp_cfg $jp_cfg 421 set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 422 set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 423 set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 424 set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 425 set_namelist namelist_cfg jpni $jpni 426 set_namelist namelist_cfg jpnj $jpnj 349 427 set_namelist namelist_cfg jpnij $NPROC 350 428
Note: See TracChangeset
for help on using the changeset viewer.