Changeset 7483 for branches/CNRS
- Timestamp:
- 2016-12-10T14:27:17+01:00 (7 years ago)
- Location:
- branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM
- Files:
-
- 56 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml
r6316 r7483 88 88 <field field_ref="u_masstr" name="vozomatr" /> 89 89 <field field_ref="u_heattr" name="sozohetr" /> 90 90 <field field_ref="u_salttr" name="sozosatr" /> 91 91 </file> 92 92 … … 99 99 <field field_ref="v_masstr" name="vomematr" /> 100 100 <field field_ref="v_heattr" name="somehetr" /> 101 101 <field field_ref="v_salttr" name="somesatr" /> 102 102 </file> 103 103 … … 116 116 <field field_ref="iceconc" name="siconc" /> 117 117 118 <field field_ref="vfxbog" name="vfxbog" />119 <field field_ref="vfxdyn" name="vfxdyn" />120 <field field_ref="vfxopw" name="vfxopw" />121 <field field_ref="vfxsni" name="vfxsni" />122 <field field_ref="vfxsum" name="vfxsum" />123 <field field_ref="vfxbom" name="vfxbom" />124 <field field_ref="vfxres" name="vfxres" />125 118 <field field_ref="vfxice" name="vfxice" /> 126 119 <field field_ref="vfxsnw" name="vfxsnw" /> 127 120 <field field_ref="vfxsub" name="vfxsub" /> 121 <field field_ref="vfxsub_err" name="vfxsub_err" /> 128 122 <field field_ref="vfxspr" name="vfxspr" /> 129 123 … … 134 128 <field field_ref="destrp" name="destrp" /> 135 129 136 <field field_ref="sfxbri" name="sfxbri" />137 <field field_ref="sfxdyn" name="sfxdyn" />138 <field field_ref="sfxres" name="sfxres" />139 <field field_ref="sfxbog" name="sfxbog" />140 <field field_ref="sfxbom" name="sfxbom" />141 <field field_ref="sfxsum" name="sfxsum" />142 <field field_ref="sfxsni" name="sfxsni" />143 <field field_ref="sfxopw" name="sfxopw" />144 130 <field field_ref="sfx" name="sfx" /> 145 131 146 <field field_ref="hfxsum" name="hfxsum" />147 <field field_ref="hfxbom" name="hfxbom" />148 <field field_ref="hfxbog" name="hfxbog" />149 <field field_ref="hfxdif" name="hfxdif" />150 <field field_ref="hfxopw" name="hfxopw" />151 132 <field field_ref="hfxout" name="hfxout" /> 152 133 <field field_ref="hfxin" name="hfxin" /> 153 <field field_ref="hfxsnw" name="hfxsnw" /> 154 <field field_ref="hfxerr" name="hfxerr" /> 155 <field field_ref="hfxerr_rem" name="hfxerr_rem" /> 156 157 <!-- ice-ocean heat flux from mass exchange --> 158 <field field_ref="hfxdyn" name="hfxdyn" /> 159 <field field_ref="hfxres" name="hfxres" /> 160 <field field_ref="hfxthd" name="hfxthd" /> 161 <!-- ice-atm. heat flux from mass exchange --> 162 <field field_ref="hfxsub" name="hfxsub" /> 163 <field field_ref="hfxspr" name="hfxspr" /> 134 164 135 165 136 <!-- diags --> 166 <field field_ref="hfxdhc" name="hfxdhc" />167 <field field_ref="hfxtur" name="hfxtur" />168 169 137 <field field_ref="isst" name="sst" /> 170 138 <field field_ref="isss" name="sss" /> … … 209 177 <field field_ref="bgsaline" name="bgsaline" /> 210 178 <field field_ref="bgheatco" name="bgheatco" /> 179 <field field_ref="bgheatfx" name="bgheatfx" /> 211 180 <field field_ref="bgsaltco" name="bgsaltco" /> 212 181 <field field_ref="bgvolssh" name="bgvolssh" /> … … 214 183 <field field_ref="bgfrcvol" name="bgfrcvol" /> 215 184 <field field_ref="bgfrctem" name="bgfrctem" /> 185 <field field_ref="bgfrchfx" name="bgfrchfx" /> 216 186 <field field_ref="bgfrcsal" name="bgfrcsal" /> 217 187 218 <field field_ref="ibgvoltot" name="ibgvoltot" /> 219 <field field_ref="sbgvoltot" name="sbgvoltot" /> 220 <field field_ref="ibgarea" name="ibgarea" /> 221 <field field_ref="ibgsaline" name="ibgsaline" /> 222 <field field_ref="ibgtemper" name="ibgtemper" /> 223 <field field_ref="ibgheatco" name="ibgheatco" /> 224 <field field_ref="sbgheatco" name="sbgheatco" /> 225 <field field_ref="ibgsaltco" name="ibgsaltco" /> 226 227 <field field_ref="ibgvfx" name="ibgvfx" /> 228 <field field_ref="ibgvfxbog" name="ibgvfxbog" /> 229 <field field_ref="ibgvfxopw" name="ibgvfxopw" /> 230 <field field_ref="ibgvfxsni" name="ibgvfxsni" /> 231 <field field_ref="ibgvfxdyn" name="ibgvfxdyn" /> 232 <field field_ref="ibgvfxbom" name="ibgvfxbom" /> 233 <field field_ref="ibgvfxsum" name="ibgvfxsum" /> 234 <field field_ref="ibgvfxres" name="ibgvfxres" /> 235 <field field_ref="ibgvfxspr" name="ibgvfxspr" /> 236 <field field_ref="ibgvfxsnw" name="ibgvfxsnw" /> 237 <field field_ref="ibgvfxsub" name="ibgvfxsub" /> 238 239 <field field_ref="ibgsfx" name="ibgsfx" /> 240 <field field_ref="ibgsfxbri" name="ibgsfxbri" /> 241 <field field_ref="ibgsfxdyn" name="ibgsfxdyn" /> 242 <field field_ref="ibgsfxres" name="ibgsfxres" /> 243 <field field_ref="ibgsfxbog" name="ibgsfxbog" /> 244 <field field_ref="ibgsfxopw" name="ibgsfxopw" /> 245 <field field_ref="ibgsfxsni" name="ibgsfxsni" /> 246 <field field_ref="ibgsfxbom" name="ibgsfxbom" /> 247 <field field_ref="ibgsfxsum" name="ibgsfxsum" /> 248 249 <field field_ref="ibghfxdhc" name="ibghfxdhc" /> 250 <field field_ref="ibghfxspr" name="ibghfxspr" /> 251 252 <field field_ref="ibghfxres" name="ibghfxres" /> 253 <field field_ref="ibghfxsub" name="ibghfxsub" /> 254 <field field_ref="ibghfxdyn" name="ibghfxdyn" /> 255 <field field_ref="ibghfxthd" name="ibghfxthd" /> 256 <field field_ref="ibghfxsum" name="ibghfxsum" /> 257 <field field_ref="ibghfxbom" name="ibghfxbom" /> 258 <field field_ref="ibghfxbog" name="ibghfxbog" /> 259 <field field_ref="ibghfxdif" name="ibghfxdif" /> 260 <field field_ref="ibghfxopw" name="ibghfxopw" /> 261 <field field_ref="ibghfxout" name="ibghfxout" /> 262 <field field_ref="ibghfxin" name="ibghfxin" /> 263 <field field_ref="ibghfxsnw" name="ibghfxsnw" /> 264 265 <field field_ref="ibgfrcvol" name="ibgfrcvol" /> 266 <field field_ref="ibgfrcsfx" name="ibgfrcsfx" /> 267 <field field_ref="ibgvolgrm" name="ibgvolgrm" /> 188 <field field_ref="ibgvol_tot" name="ibgvol_tot" /> 189 <field field_ref="sbgvol_tot" name="sbgvol_tot" /> 190 <field field_ref="ibgarea_tot" name="ibgarea_tot" /> 191 <field field_ref="ibgsalt_tot" name="ibgsalt_tot" /> 192 <field field_ref="ibgheat_tot" name="ibgheat_tot" /> 193 <field field_ref="sbgheat_tot" name="sbgheat_tot" /> 194 195 <field field_ref="ibgvolume" name="ibgvolume" /> 196 <field field_ref="ibgsaltco" name="ibgsaltco" /> 197 <field field_ref="ibgheatco" name="ibgheatco" /> 198 <field field_ref="ibgheatfx" name="ibgheatfx" /> 199 200 <field field_ref="ibgfrcvoltop" name="ibgfrcvoltop" /> 201 <field field_ref="ibgfrcvolbot" name="ibgfrcvolbot" /> 202 <field field_ref="ibgfrctemtop" name="ibgfrctemtop" /> 203 <field field_ref="ibgfrctembot" name="ibgfrctembot" /> 204 <field field_ref="ibgfrcsal" name="ibgfrcsal" /> 205 <field field_ref="ibgfrchfxtop" name="ibgfrchfxtop" /> 206 <field field_ref="ibgfrchfxbot" name="ibgfrchfxbot" /> 268 207 269 208 </file> -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/CONFIG/SHARED/field_def.xml
r6471 r7483 225 225 <field id="hflx_rain_cea" long_name="heat flux due to rainfall" standard_name="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water" unit="W/m2" /> 226 226 <field id="hflx_evap_cea" long_name="heat flux due to evaporation" standard_name="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water" unit="W/m2" /> 227 <field id="hflx_snow_cea" long_name="heat flux due to snow falling over ice-free ocean" standard_name="heat_flux_into_sea_water_due_to_snow_thermodynamics" unit="W/m2" /> 227 <field id="hflx_snow_cea" long_name="heat flux due to snow falling" standard_name="heat_flux_onto_ocean_and_ice_due_to_snow_thermodynamics" unit="W/m2" /> 228 <field id="hflx_snow_ai_cea" long_name="heat flux due to snow falling over ice" standard_name="heat_flux_onto_ice_due_to_snow_thermodynamics" unit="W/m2" /> 229 <field id="hflx_snow_ao_cea" long_name="heat flux due to snow falling over ice-free ocean" standard_name="heat_flux_onto_sea_water_due_to_snow_thermodynamics" unit="W/m2" /> 228 230 <field id="hflx_ice_cea" long_name="heat flux due to ice thermodynamics" standard_name="heat_flux_into_sea_water_due_to_sea_ice_thermodynamics" unit="W/m2" /> 229 231 <field id="hflx_rnf_cea" long_name="heat flux due to runoffs" standard_name="temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water" unit="W/m2" /> … … 331 333 <field id="vfxsnw" long_name="snw melt/growth" unit="m/day" /> 332 334 <field id="vfxsub" long_name="snw sublimation" unit="m/day" /> 335 <field id="vfxsub_err" long_name="excess of snw sublimation sent to ocean" unit="m/day" /> 333 336 <field id="vfxspr" long_name="snw precipitation on ice" unit="m/day" /> 334 337 <field id="vfxthin" long_name="daily thermo ice prod. for thin ice(<20cm) + open water" unit="m/day" /> … … 499 502 <field id="bgtemper" long_name="drift in global mean temperature wrt timestep 1" standard_name="change_over_time_in_sea_water_potential_temperature" unit="degC" /> 500 503 <field id="bgsaline" long_name="drift in global mean salinity wrt timestep 1" standard_name="change_over_time_in_sea_water_practical_salinity" unit="1e-3" /> 501 <field id="bgheatco" long_name="drift in global mean heat content wrt timestep 1" unit="10^9J" /> 502 <field id="bgsaltco" long_name="drift in global mean salt content wrt timestep 1" unit="1e-3*m3" /> 504 <field id="bgheatco" long_name="drift in global mean heat content wrt timestep 1" unit="1.e20J" /> 505 <field id="bgheatfx" long_name="drift in global mean heat flux wrt timestep 1" unit="W/m2" /> 506 <field id="bgsaltco" long_name="drift in global mean salt content wrt timestep 1" unit="1e-3*km3" /> 503 507 <field id="bgvolssh" long_name="drift in global mean ssh volume wrt timestep 1" unit="km3" /> 504 508 <field id="bgvole3t" long_name="drift in global mean volume variation (e3t) wrt timestep 1" unit="km3" /> 505 <field id="bgvoltot" long_name="drift in global mean volume wrt timestep 1" unit="km3" /> 506 <!-- NOTE: No matching iom_put call --> 507 <field id="bgsshtot" long_name="drift in global mean ssh wrt timestep 1" standard_name="global_average_sea_level_change" unit="m" /> 508 <field id="bgfrcvol" long_name="drift in global mean volume from forcing wrt timestep 1" unit="km3" /> 509 <field id="bgfrctem" long_name="drift in global mean heat content from forcing wrt timestep 1" unit="10^9J" /> 510 <field id="bgfrcsal" long_name="drift in global mean salt content from forcing wrt timestep 1" unit="1e-3*km3" /> 511 <field id="bgmistem" long_name="global mean temperature error due to free surface" unit="degC" /> 512 <field id="bgmissal" long_name="global mean salinity error due to free surface" unit="1e-3" /> 509 <field id="bgfrcvol" long_name="global mean volume from forcing" unit="km3" /> 510 <field id="bgfrctem" long_name="global mean heat content from forcing" unit="1.e20J" /> 511 <field id="bgfrchfx" long_name="global mean heat flux from forcing" unit="W/m2" /> 512 <field id="bgfrcsal" long_name="global mean salt content from forcing" unit="1e-3*km3" /> 513 <field id="bgmistem" long_name="global mean temperature error due to free surface (no vvl)" unit="degC" /> 514 <field id="bgmissal" long_name="global mean salinity error due to free surface (no vvl)" unit="1e-3" /> 513 515 </field_group> 514 516 … … 517 519 <field_group id="SBC_scalar" domain_ref="1point" > 518 520 <!-- available with ln_limdiaout --> 519 <field id="ibgvoltot" long_name="global mean ice volume" unit="km3" /> 520 <field id="sbgvoltot" long_name="global mean snow volume" unit="km3" /> 521 <field id="ibgarea" long_name="global mean ice area" unit="km2" /> 522 <field id="ibgsaline" long_name="global mean ice salinity" unit="1e-3" /> 523 <field id="ibgtemper" long_name="global mean ice temperature" unit="degC" /> 524 <field id="ibgheatco" long_name="global mean ice heat content" unit="10^20J" /> 525 <field id="sbgheatco" long_name="global mean snow heat content" unit="10^20J" /> 526 <field id="ibgsaltco" long_name="global mean ice salt content" unit="1e-3*km3" /> 527 528 <field id="ibgvfx" long_name="global mean volume flux (emp)" unit="m/day" /> 529 <field id="ibgvfxbog" long_name="global mean volume flux (bottom growth)" unit="m/day" /> 530 <field id="ibgvfxopw" long_name="global mean volume flux (open water growth)" unit="m/day" /> 531 <field id="ibgvfxsni" long_name="global mean volume flux (snow-ice growth)" unit="m/day" /> 532 <field id="ibgvfxdyn" long_name="global mean volume flux (dynamic growth)" unit="m/day" /> 533 <field id="ibgvfxbom" long_name="global mean volume flux (bottom melt)" unit="m/day" /> 534 <field id="ibgvfxsum" long_name="global mean volume flux (surface melt)" unit="m/day" /> 535 <field id="ibgvfxres" long_name="global mean volume flux (resultant)" unit="m/day" /> 536 <field id="ibgvfxspr" long_name="global mean volume flux (snow precip)" unit="m/day" /> 537 <field id="ibgvfxsnw" long_name="global mean volume flux (snow melt)" unit="m/day" /> 538 <field id="ibgvfxsub" long_name="global mean volume flux (snow sublimation)" unit="m/day" /> 539 540 <field id="ibgsfx" long_name="global mean salt flux (total)" unit="1e-3*m/day" /> 541 <field id="ibgsfxbri" long_name="global mean salt flux (brines)" unit="1e-3*m/day" /> 542 <field id="ibgsfxdyn" long_name="global mean salt flux (dynamic)" unit="1e-3*m/day" /> 543 <field id="ibgsfxres" long_name="global mean salt flux (resultant)" unit="1e-3*m/day" /> 544 <field id="ibgsfxbog" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 545 <field id="ibgsfxopw" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 546 <field id="ibgsfxsni" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 547 <field id="ibgsfxbom" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 548 <field id="ibgsfxsum" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 549 <field id="ibgsfxsub" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 550 551 <field id="ibghfxdhc" long_name="Heat content variation in snow and ice" unit="W" /> 552 <field id="ibghfxspr" long_name="Heat content of snow precip" unit="W" /> 553 554 <field id="ibghfxthd" long_name="heat fluxes from ice-ocean exchange during thermo" unit="W" /> 555 <field id="ibghfxsum" long_name="heat fluxes causing surface ice melt" unit="W" /> 556 <field id="ibghfxbom" long_name="heat fluxes causing bottom ice melt" unit="W" /> 557 <field id="ibghfxbog" long_name="heat fluxes causing bottom ice growth" unit="W" /> 558 <field id="ibghfxdif" long_name="heat fluxes causing ice temperature change" unit="W" /> 559 <field id="ibghfxopw" long_name="heat fluxes causing open water ice formation" unit="W" /> 560 <field id="ibghfxdyn" long_name="heat fluxes from ice-ocean exchange during dynamic" unit="W" /> 561 <field id="ibghfxres" long_name="heat fluxes from ice-ocean exchange during resultant" unit="W" /> 562 <field id="ibghfxsub" long_name="heat fluxes from sublimation" unit="W" /> 563 <field id="ibghfxsnw" long_name="heat fluxes from snow-ocean exchange" unit="W" /> 564 <field id="ibghfxout" long_name="non solar heat fluxes received by the ocean" unit="W" /> 565 <field id="ibghfxin" long_name="total heat fluxes at the ice surface" unit="W" /> 566 567 <field id="ibgfrcvol" long_name="global mean forcing volume (emp)" unit="km3" /> 568 <field id="ibgfrcsfx" long_name="global mean forcing salt (sfx)" unit="1e-3*km3" /> 569 <field id="ibgvolgrm" long_name="global mean ice growth+melt volume" unit="km3" /> 521 <field id="ibgfrcvoltop" long_name="global mean ice/snow forcing at interface ice/snow-atm (volume equivalent ocean volume)" unit="km3" /> 522 <field id="ibgfrcvolbot" long_name="global mean ice/snow forcing at interface ice/snow-ocean (volume equivalent ocean volume)" unit="km3" /> 523 <field id="ibgfrctemtop" long_name="global mean heat on top of ice/snw/ocean-atm " unit="1e20J" /> 524 <field id="ibgfrctembot" long_name="global mean heat below ice (on top of ocean) " unit="1e20J" /> 525 <field id="ibgfrcsal" long_name="global mean ice/snow forcing (salt equivalent ocean volume)" unit="pss*km3" /> 526 <field id="ibgfrchfxtop" long_name="global mean heat flux on top of ice/snw/ocean-atm " unit="W/m2" /> 527 <field id="ibgfrchfxbot" long_name="global mean heat flux below ice (on top of ocean) " unit="W/m2" /> 528 529 <field id="ibgvolume" long_name="drift in ice/snow volume (equivalent ocean volume)" unit="km3" /> 530 <field id="ibgsaltco" long_name="drift in ice salt content (equivalent ocean volume)" unit="pss*km3" /> 531 <field id="ibgheatco" long_name="drift in ice/snow heat content" unit="1e20J" /> 532 <field id="ibgheatfx" long_name="drift in ice/snow heat flux" unit="W/m2" /> 533 534 <field id="ibgvol_tot" long_name="global mean ice volume" unit="km3" /> 535 <field id="sbgvol_tot" long_name="global mean snow volume" unit="km3" /> 536 <field id="ibgarea_tot" long_name="global mean ice area" unit="km2" /> 537 <field id="ibgsalt_tot" long_name="global mean ice salt content" unit="1e-3*km3" /> 538 <field id="ibgheat_tot" long_name="global mean ice heat content" unit="1e20J" /> 539 <field id="sbgheat_tot" long_name="global mean snow heat content" unit="1e20J" /> 570 540 </field_group> 571 541 -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref
r5385 r7483 66 66 qdfelim = 7.E-6 ! Optimal quota of diatoms 67 67 caco3r = 0.3 ! mean rain ratio 68 oxymin = 1.E-6 ! Half-saturation constant for anoxia 68 69 / 69 70 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' … … 162 163 xsiremlab = 0.03 ! fast remineralization rate of Si 163 164 xsilab = 0.5 ! Fraction of labile biogenic silica 164 oxymin = 1.E-6 ! Half-saturation constant for anoxia165 165 / 166 166 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r6477 r7483 243 243 ! 244 244 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sist !: Average Sea-Ice Surface Temperature [Kelvin] 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: icethi !: total ice thickness (for all categories) (diag only)246 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_bo !: Sea-Ice bottom temperature [Kelvin] 247 246 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frld !: Leads fraction = 1 - ice fraction … … 320 319 ! ! this is an extensive variable that has to be transported 321 320 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (days) 322 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ov_i !: Sea-Ice Age times volume per area (days.m)323 321 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (days) 322 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bv_i !: brine volume 324 323 325 324 !! Variables summed over all categories, or associated to all the ice in a single grid cell 326 325 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice !: components of the ice velocity (m/s) 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tio_u, tio_v !: components of the ice-ocean stress (N/m2)328 326 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_i , vt_s !: ice and snow total volume per unit area (m) 329 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i !: ice total fractional area (ice concentration) 330 328 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ato_i !: =1-at_i ; total open water fractional area 331 329 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: et_i , et_s !: ice and snow total heat content 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ot_i !: mean age over all categories 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories 334 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bv_i !: brine volume averaged over all categories 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: smt_i !: mean sea ice salinity averaged over all categories [PSU] 330 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories 331 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bvm_i !: brine volume averaged over all categories 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: smt_i !: mean sea ice salinity averaged over all categories [PSU] 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_su !: mean surface temperature over all categories 334 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htm_i !: mean ice thickness over all categories 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htm_s !: mean snow thickness over all categories 336 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: om_i !: mean ice age over all categories 336 337 337 338 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] … … 435 436 436 437 ii = ii + 1 437 ALLOCATE( sist (jpi,jpj) , icethi (jpi,jpj) ,t_bo (jpi,jpj) , &438 ALLOCATE( sist (jpi,jpj) , t_bo (jpi,jpj) , & 438 439 & frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , & 439 440 & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , & … … 456 457 & v_s (jpi,jpj,jpl) , ht_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) , & 457 458 & sm_i (jpi,jpj,jpl) , smv_i(jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , & 458 & o v_i (jpi,jpj,jpl) , oa_i (jpi,jpj,jpl), STAT=ierr(ii) )459 ii = ii + 1 460 ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , tio_u(jpi,jpj) , tio_v(jpi,jpj) ,&459 & oa_i (jpi,jpj,jpl) , bv_i (jpi,jpj,jpl) , STAT=ierr(ii) ) 460 ii = ii + 1 461 ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , & 461 462 & vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i (jpi,jpj) , ato_i(jpi,jpj) , & 462 & et_i (jpi,jpj) , et_s (jpi,jpj) , ot_i (jpi,jpj) , tm_i (jpi,jpj) , & 463 & bv_i (jpi,jpj) , smt_i(jpi,jpj) , STAT=ierr(ii) ) 463 & et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i (jpi,jpj) , bvm_i(jpi,jpj) , & 464 & smt_i(jpi,jpj) , tm_su(jpi,jpj) , htm_i(jpi,jpj) , htm_s(jpi,jpj) , & 465 & om_i (jpi,jpj) , STAT=ierr(ii) ) 464 466 ii = ii + 1 465 467 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r6399 r7483 288 288 #if ! defined key_bdy 289 289 ! heat flux 290 zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - SUM( qevap_ice * a_i_b, dim=3 ) ) & 291 & * e12t * tmask(:,:,1) * zconv ) 290 zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es & 291 ! & - SUM( qevap_ice * a_i_b, dim=3 ) & !!clem: I think this line must be commented (but need check) 292 & ) * e12t * tmask(:,:,1) * zconv ) 292 293 ! salt flux 293 294 zsfx = glob_sum( ( sfx + diag_smvi ) * e12t * tmask(:,:,1) * zconv ) * rday -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
r6417 r7483 31 31 32 32 PUBLIC lim_diahsb ! routine called by ice_step.F90 33 34 real(wp) :: frc_sal, frc_vol ! global forcing trends 35 real(wp) :: bg_grme ! global ice growth+melt trends 36 33 PUBLIC lim_diahsb_init ! routine called in sbcice_lim.F90 34 35 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents 36 REAL(wp) :: frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot ! global forcing trends 37 37 38 !! * Substitutions 38 39 # include "vectopt_loop_substitute.h90" … … 46 47 CONTAINS 47 48 48 SUBROUTINE lim_diahsb 49 SUBROUTINE lim_diahsb( kt ) 49 50 !!--------------------------------------------------------------------------- 50 51 !! *** ROUTINE lim_diahsb *** … … 53 54 !! 54 55 !!--------------------------------------------------------------------------- 56 INTEGER, INTENT(in) :: kt ! number of iteration 55 57 !! 56 real(wp) :: zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 57 real(wp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni, & 58 & zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn, zbg_sfx_sub 59 real(wp) :: zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 60 real(wp) :: zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub 61 real(wp) :: zbg_hfx_dhc, zbg_hfx_spr 62 real(wp) :: zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in 63 real(wp) :: zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 64 real(wp) :: z_frc_vol, z_frc_sal, z_bg_grme 65 real(wp) :: z1_area ! - - 66 REAL(wp) :: ztmp 58 real(wp) :: zbg_ivol, zbg_svol, zbg_area, zbg_isal, zbg_item ,zbg_stem 59 REAL(wp) :: z_frc_voltop, z_frc_volbot, z_frc_sal, z_frc_temtop, z_frc_tembot 60 REAL(wp) :: zdiff_vol, zdiff_sal, zdiff_tem 67 61 !!--------------------------------------------------------------------------- 68 62 IF( nn_timing == 1 ) CALL timing_start('lim_diahsb') 69 63 70 IF( numit == nstart ) CALL lim_diahsb_init 71 72 ! 1/area 73 z1_area = 1._wp / MAX( glob_sum( e12t(:,:) * tmask(:,:,1) ), epsi06 ) 74 75 rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e12t(:,:) * tmask(:,:,1) ) - epsi06 ) ) 76 ! ----------------------- ! 77 ! 1 - Content variations ! 78 ! ----------------------- ! 79 zbg_ivo = glob_sum( vt_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume ice 80 zbg_svo = glob_sum( vt_s(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume snow 81 zbg_are = glob_sum( at_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! area 82 zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) ) ! mean salt content 83 zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e12t(:,:) * tmask(:,:,1) ) ! mean temp content 84 85 !zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 86 !zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 87 88 ! Volume 89 ztmp = rswitch * z1_area * r1_rau0 * rday 90 zbg_vfx = ztmp * glob_sum( emp(:,:) * e12t(:,:) * tmask(:,:,1) ) 91 zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) 92 zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) 93 zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) ) 94 zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) 95 zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 96 zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 97 zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) 98 zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) 99 zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) 100 zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) 101 102 ! Salt 103 zbg_sfx = ztmp * glob_sum( sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) 104 zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e12t(:,:) * tmask(:,:,1) ) 105 zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) 106 zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) 107 108 zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) 109 zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) 110 zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e12t(:,:) * tmask(:,:,1) ) 111 zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) 112 zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) 113 zbg_sfx_sub = ztmp * glob_sum( sfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) 114 115 ! Heat budget 116 zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * 1.e-20 ) ! ice heat content [1.e20 J] 117 zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J] 118 zbg_hfx_dhc = glob_sum( diag_heat(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 119 zbg_hfx_spr = glob_sum( hfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 120 121 zbg_hfx_thd = glob_sum( hfx_thd(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 122 zbg_hfx_dyn = glob_sum( hfx_dyn(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 123 zbg_hfx_res = glob_sum( hfx_res(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 124 zbg_hfx_sub = glob_sum( hfx_sub(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 125 zbg_hfx_snw = glob_sum( hfx_snw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 126 zbg_hfx_sum = glob_sum( hfx_sum(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 127 zbg_hfx_bom = glob_sum( hfx_bom(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 128 zbg_hfx_bog = glob_sum( hfx_bog(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 129 zbg_hfx_dif = glob_sum( hfx_dif(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 130 zbg_hfx_opw = glob_sum( hfx_opw(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 131 zbg_hfx_out = glob_sum( hfx_out(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 132 zbg_hfx_in = glob_sum( hfx_in(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 133 134 ! --------------------------------------------- ! 135 ! 2 - Trends due to forcing and ice growth/melt ! 136 ! --------------------------------------------- ! 137 z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 138 z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * e12t(:,:) * tmask(:,:,1) ) ! salt fluxes 139 z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 140 & wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + & 141 & wfx_sub(:,:) ) * e12t(:,:) * tmask(:,:,1) ) ! volume fluxes 142 ! 143 frc_vol = frc_vol + z_frc_vol * rdt_ice 144 frc_sal = frc_sal + z_frc_sal * rdt_ice 145 bg_grme = bg_grme + z_bg_grme * rdt_ice 64 ! ----------------------- ! 65 ! 1 - Contents ! 66 ! ----------------------- ! 67 zbg_ivol = glob_sum( vt_i(:,:) * e12t(:,:) * tmask(:,:,1) * 1.e-9 ) ! ice volume (km3) 68 zbg_svol = glob_sum( vt_s(:,:) * e12t(:,:) * tmask(:,:,1) * 1.e-9 ) ! snow volume (km3) 69 zbg_area = glob_sum( at_i(:,:) * e12t(:,:) * tmask(:,:,1) * 1.e-6 ) ! area (km2) 70 zbg_isal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) * 1.e-9 ) ! salt content (pss*km3) 71 zbg_item = glob_sum( et_i * e12t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat content (1.e20 J) 72 zbg_stem = glob_sum( et_s * e12t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat content (1.e20 J) 146 73 147 ! difference 148 !frc_vol = zbg_ivo - frc_vol 149 !frc_sal = zbg_sal - frc_sal 150 151 ! ----------------------- ! 152 ! 3 - Diagnostics writing ! 153 ! ----------------------- ! 154 rswitch = MAX( 0._wp , SIGN( 1._wp , zbg_ivo - epsi06 ) ) 155 ! 156 IF( iom_use('ibgvoltot') ) & 157 CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9 ) ! ice volume (km3 equivalent liquid) 158 IF( iom_use('sbgvoltot') ) & 159 CALL iom_put( 'sbgvoltot' , zbg_svo * rhosn * r1_rau0 * 1.e-9 ) ! snw volume (km3 equivalent liquid) 160 IF( iom_use('ibgarea') ) & 161 CALL iom_put( 'ibgarea' , zbg_are * 1.e-6 ) ! ice area (km2) 162 IF( iom_use('ibgsaline') ) & 163 CALL iom_put( 'ibgsaline' , rswitch * zbg_sal / MAX( zbg_ivo, epsi06 ) ) ! ice saline (psu) 164 IF( iom_use('ibgtemper') ) & 165 CALL iom_put( 'ibgtemper' , rswitch * zbg_tem / MAX( zbg_ivo, epsi06 ) ) ! ice temper (C) 166 CALL iom_put( 'ibgheatco' , zbg_ihc ) ! ice heat content (1.e20 J) 167 CALL iom_put( 'sbgheatco' , zbg_shc ) ! snw heat content (1.e20 J) 168 IF( iom_use('ibgsaltco') ) & 169 CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9 ) ! ice salt content (psu*km3 equivalent liquid) 170 171 CALL iom_put( 'ibgvfx' , zbg_vfx ) ! volume flux emp (m/day liquid) 172 CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog ) ! volume flux bottom growth -(m/day equivalent liquid) 173 CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw ) ! volume flux open water growth - 174 CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni ) ! volume flux snow ice growth - 175 CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn ) ! volume flux dynamic growth - 176 CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom ) ! volume flux bottom melt - 177 CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum ) ! volume flux surface melt - 178 CALL iom_put( 'ibgvfxres' , zbg_vfx_res ) ! volume flux resultant - 179 CALL iom_put( 'ibgvfxspr' , zbg_vfx_spr ) ! volume flux from snow precip - 180 CALL iom_put( 'ibgvfxsnw' , zbg_vfx_snw ) ! volume flux from snow melt - 181 CALL iom_put( 'ibgvfxsub' , zbg_vfx_sub ) ! volume flux from sublimation - 182 183 CALL iom_put( 'ibgsfx' , zbg_sfx ) ! salt flux -(psu*m/day equivalent liquid) 184 CALL iom_put( 'ibgsfxbri' , zbg_sfx_bri ) ! salt flux brines - 185 CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn ) ! salt flux dynamic - 186 CALL iom_put( 'ibgsfxres' , zbg_sfx_res ) ! salt flux result - 187 CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog ) ! salt flux bottom growth 188 CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw ) ! salt flux open water growth - 189 CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni ) ! salt flux snow ice growth - 190 CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom ) ! salt flux bottom melt - 191 CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum ) ! salt flux surface melt - 192 CALL iom_put( 'ibgsfxsub' , zbg_sfx_sub ) ! salt flux sublimation - 193 194 CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc ) ! Heat content variation in snow and ice [W] 195 CALL iom_put( 'ibghfxspr' , zbg_hfx_spr ) ! Heat content of snow precip [W] 196 197 CALL iom_put( 'ibghfxres' , zbg_hfx_res ) ! 198 CALL iom_put( 'ibghfxsub' , zbg_hfx_sub ) ! 199 CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn ) ! 200 CALL iom_put( 'ibghfxthd' , zbg_hfx_thd ) ! 201 CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw ) ! 202 CALL iom_put( 'ibghfxsum' , zbg_hfx_sum ) ! 203 CALL iom_put( 'ibghfxbom' , zbg_hfx_bom ) ! 204 CALL iom_put( 'ibghfxbog' , zbg_hfx_bog ) ! 205 CALL iom_put( 'ibghfxdif' , zbg_hfx_dif ) ! 206 CALL iom_put( 'ibghfxopw' , zbg_hfx_opw ) ! 207 CALL iom_put( 'ibghfxout' , zbg_hfx_out ) ! 208 CALL iom_put( 'ibghfxin' , zbg_hfx_in ) ! 209 210 CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9 ) ! vol - forcing (km3 equivalent liquid) 211 CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9 ) ! sal - forcing (psu*km3 equivalent liquid) 212 IF( iom_use('ibgvolgrm') ) & 213 CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9 ) ! vol growth + melt (km3 equivalent liquid) 214 74 ! ---------------------------! 75 ! 2 - Trends due to forcing ! 76 ! ---------------------------! 77 z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e12t(:,:) * tmask(:,:,1) * 1.e-9 ) ! freshwater flux ice/snow-ocean 78 z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e12t(:,:) * tmask(:,:,1) * 1.e-9 ) ! freshwater flux ice/snow-atm 79 z_frc_sal = r1_rau0 * glob_sum( - sfx(:,:) * e12t(:,:) * tmask(:,:,1) * 1.e-9 ) ! salt fluxes ice/snow-ocean 80 z_frc_tembot = glob_sum( hfx_out(:,:) * e12t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat on top of ocean (and below ice) 81 z_frc_temtop = glob_sum( hfx_in (:,:) * e12t(:,:) * tmask(:,:,1) * 1.e-20 ) ! heat on top of ice-coean 82 ! 83 frc_voltop = frc_voltop + z_frc_voltop * rdt_ice ! km3 84 frc_volbot = frc_volbot + z_frc_volbot * rdt_ice ! km3 85 frc_sal = frc_sal + z_frc_sal * rdt_ice ! km3*pss 86 frc_temtop = frc_temtop + z_frc_temtop * rdt_ice ! 1.e20 J 87 frc_tembot = frc_tembot + z_frc_tembot * rdt_ice ! 1.e20 J 88 89 ! ----------------------- ! 90 ! 3 - Content variations ! 91 ! ----------------------- ! 92 zdiff_vol = r1_rau0 * glob_sum( ( rhoic * vt_i(:,:) + rhosn * vt_s(:,:) - vol_loc_ini(:,:) & ! freshwater trend (km3) 93 & ) * e12t(:,:) * tmask(:,:,1) * 1.e-9 ) 94 zdiff_sal = r1_rau0 * glob_sum( ( rhoic * SUM( smv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) & ! salt content trend (km3*pss) 95 & ) * e12t(:,:) * tmask(:,:,1) * 1.e-9 ) 96 zdiff_tem = glob_sum( ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) & ! heat content trend (1.e20 J) 97 ! & + SUM( qevap_ice * a_i_b, dim=3 ) & !! clem: I think this line should be commented (but needs a check) 98 & ) * e12t(:,:) * tmask(:,:,1) * 1.e-20 ) 99 100 ! ----------------------- ! 101 ! 4 - Drifts ! 102 ! ----------------------- ! 103 zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 104 zdiff_sal = zdiff_sal - frc_sal 105 zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 106 107 ! ----------------------- ! 108 ! 5 - Diagnostics writing ! 109 ! ----------------------- ! 110 ! 111 IF( iom_use('ibgvolume') ) CALL iom_put( 'ibgvolume' , zdiff_vol ) ! ice/snow volume drift (km3 equivalent ocean water) 112 IF( iom_use('ibgsaltco') ) CALL iom_put( 'ibgsaltco' , zdiff_sal ) ! ice salt content drift (psu*km3 equivalent ocean water) 113 IF( iom_use('ibgheatco') ) CALL iom_put( 'ibgheatco' , zdiff_tem ) ! ice/snow heat content drift (1.e20 J) 114 IF( iom_use('ibgheatfx') ) CALL iom_put( 'ibgheatfx' , zdiff_tem / & ! ice/snow heat flux drift (W/m2) 115 & glob_sum( e12t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 116 117 IF( iom_use('ibgfrcvoltop') ) CALL iom_put( 'ibgfrcvoltop' , frc_voltop ) ! vol forcing ice/snw-atm (km3 equivalent ocean water) 118 IF( iom_use('ibgfrcvolbot') ) CALL iom_put( 'ibgfrcvolbot' , frc_volbot ) ! vol forcing ice/snw-ocean (km3 equivalent ocean water) 119 IF( iom_use('ibgfrcsal') ) CALL iom_put( 'ibgfrcsal' , frc_sal ) ! sal - forcing (psu*km3 equivalent ocean water) 120 IF( iom_use('ibgfrctemtop') ) CALL iom_put( 'ibgfrctemtop' , frc_temtop ) ! heat on top of ice/snw/ocean (1.e20 J) 121 IF( iom_use('ibgfrctembot') ) CALL iom_put( 'ibgfrctembot' , frc_tembot ) ! heat on top of ocean(below ice) (1.e20 J) 122 IF( iom_use('ibgfrchfxtop') ) CALL iom_put( 'ibgfrchfxtop' , frc_temtop / & ! heat on top of ice/snw/ocean (W/m2) 123 & glob_sum( e12t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 124 IF( iom_use('ibgfrchfxbot') ) CALL iom_put( 'ibgfrchfxbot' , frc_tembot / & ! heat on top of ocean(below ice) (W/m2) 125 & glob_sum( e12t(:,:) * tmask(:,:,1) * 1.e-20 * kt*rdt ) ) 126 127 IF( iom_use('ibgvol_tot' ) ) CALL iom_put( 'ibgvol_tot' , zbg_ivol ) ! ice volume (km3) 128 IF( iom_use('sbgvol_tot' ) ) CALL iom_put( 'sbgvol_tot' , zbg_svol ) ! snow volume (km3) 129 IF( iom_use('ibgarea_tot') ) CALL iom_put( 'ibgarea_tot' , zbg_area ) ! ice area (km2) 130 IF( iom_use('ibgsalt_tot') ) CALL iom_put( 'ibgsalt_tot' , zbg_isal ) ! ice salinity content (pss*km3) 131 IF( iom_use('ibgheat_tot') ) CALL iom_put( 'ibgheat_tot' , zbg_item ) ! ice heat content (1.e20 J) 132 IF( iom_use('sbgheat_tot') ) CALL iom_put( 'sbgheat_tot' , zbg_stem ) ! snow heat content (1.e20 J) 215 133 ! 216 134 IF( lrst_ice ) CALL lim_diahsb_rst( numit, 'WRITE' ) 217 135 ! 218 136 IF( nn_timing == 1 ) CALL timing_stop('lim_diahsb') 219 !137 ! 220 138 END SUBROUTINE lim_diahsb 221 139 … … 233 151 !! - Compute coefficients for conversion 234 152 !!--------------------------------------------------------------------------- 235 INTEGER :: jk ! dummy loop indice236 153 INTEGER :: ierror ! local integer 237 154 !! … … 247 164 WRITE(numout,*) '~~~~~~~~~~~~' 248 165 ENDIF 249 ! 166 ! 167 ALLOCATE( vol_loc_ini(jpi,jpj), sal_loc_ini(jpi,jpj), tem_loc_ini(jpi,jpj), STAT=ierror ) 168 IF( ierror > 0 ) THEN 169 CALL ctl_stop( 'lim_diahsb: unable to allocate vol_loc_ini' ) 170 RETURN 171 ENDIF 172 250 173 CALL lim_diahsb_rst( nstart, 'READ' ) !* read or initialize all required files 251 174 ! … … 263 186 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 264 187 ! 265 INTEGER :: id1, id2, id3 ! local integers266 188 !!---------------------------------------------------------------------- 267 189 ! 268 190 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 269 191 IF( ln_rstart ) THEN !* Read the restart file 270 !id1 = iom_varid( numrir, 'frc_vol' , ldstop = .TRUE. )271 192 ! 272 193 IF(lwp) WRITE(numout,*) '~~~~~~~' 273 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst at it= ', kt,' date= ', ndastp 274 IF(lwp) WRITE(numout,*) '~~~~~~~' 275 CALL iom_get( numrir, 'frc_vol', frc_vol ) 276 CALL iom_get( numrir, 'frc_sal', frc_sal ) 277 CALL iom_get( numrir, 'bg_grme', bg_grme ) 194 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst read at it= ', kt,' date= ', ndastp 195 IF(lwp) WRITE(numout,*) '~~~~~~~' 196 CALL iom_get( numrir, 'frc_voltop' , frc_voltop ) 197 CALL iom_get( numrir, 'frc_volbot' , frc_volbot ) 198 CALL iom_get( numrir, 'frc_temtop' , frc_temtop ) 199 CALL iom_get( numrir, 'frc_tembot' , frc_tembot ) 200 CALL iom_get( numrir, 'frc_sal' , frc_sal ) 201 CALL iom_get( numrir, jpdom_autoglo, 'vol_loc_ini', vol_loc_ini ) 202 CALL iom_get( numrir, jpdom_autoglo, 'tem_loc_ini', tem_loc_ini ) 203 CALL iom_get( numrir, jpdom_autoglo, 'sal_loc_ini', sal_loc_ini ) 278 204 ELSE 279 205 IF(lwp) WRITE(numout,*) '~~~~~~~' 280 206 IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state ' 281 207 IF(lwp) WRITE(numout,*) '~~~~~~~' 282 frc_vol = 0._wp 283 frc_sal = 0._wp 284 bg_grme = 0._wp 208 ! set trends to 0 209 frc_voltop = 0._wp 210 frc_volbot = 0._wp 211 frc_temtop = 0._wp 212 frc_tembot = 0._wp 213 frc_sal = 0._wp 214 ! record initial ice volume, salt and temp 215 vol_loc_ini(:,:) = rhoic * vt_i(:,:) + rhosn * vt_s(:,:) ! ice/snow volume (kg/m2) 216 tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:) ! ice/snow heat content (J) 217 sal_loc_ini(:,:) = rhoic * SUM( smv_i(:,:,:), dim=3 ) ! ice salt content (pss*kg/m2) 218 285 219 ENDIF 286 220 … … 288 222 ! ! ------------------- 289 223 IF(lwp) WRITE(numout,*) '~~~~~~~' 290 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst at it= ', kt,' date= ', ndastp224 IF(lwp) WRITE(numout,*) ' lim_diahsb_rst write at it= ', kt,' date= ', ndastp 291 225 IF(lwp) WRITE(numout,*) '~~~~~~~' 292 CALL iom_rstput( kt, nitrst, numriw, 'frc_vol' , frc_vol ) 293 CALL iom_rstput( kt, nitrst, numriw, 'frc_sal' , frc_sal ) 294 CALL iom_rstput( kt, nitrst, numriw, 'bg_grme' , bg_grme ) 226 CALL iom_rstput( kt, nitrst, numriw, 'frc_voltop' , frc_voltop ) 227 CALL iom_rstput( kt, nitrst, numriw, 'frc_volbot' , frc_volbot ) 228 CALL iom_rstput( kt, nitrst, numriw, 'frc_temtop' , frc_temtop ) 229 CALL iom_rstput( kt, nitrst, numriw, 'frc_tembot' , frc_tembot ) 230 CALL iom_rstput( kt, nitrst, numriw, 'frc_sal' , frc_sal ) 231 CALL iom_rstput( kt, nitrst, numriw, 'vol_loc_ini', vol_loc_ini ) 232 CALL iom_rstput( kt, nitrst, numriw, 'tem_loc_ini', tem_loc_ini ) 233 CALL iom_rstput( kt, nitrst, numriw, 'sal_loc_ini', sal_loc_ini ) 295 234 ! 296 235 ENDIF -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r6469 r7483 247 247 ztest_1 = 1 248 248 ELSE 249 ! this write is useful250 IF(lwp) WRITE(numout,*) ' * TEST1 AREA NOT CONSERVED *** zA_cons = ', zA_cons,' zat_i_ini = ',zat_i_ini(i_hemis)251 249 ztest_1 = 0 252 250 ENDIF … … 259 257 ztest_2 = 1 260 258 ELSE 261 ! this write is useful262 IF(lwp) WRITE(numout,*) ' * TEST2 VOLUME NOT CONSERVED *** zV_cons = ', zV_cons, &263 ' zvt_i_ini = ', zvt_i_ini(i_hemis)264 259 ztest_2 = 0 265 260 ENDIF … … 269 264 ztest_3 = 1 270 265 ELSE 271 ! this write is useful272 IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', &273 zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1)274 266 ztest_3 = 0 275 267 ENDIF … … 279 271 DO jl = 1, jpl 280 272 IF ( za_i_ini(jl,i_hemis) .LT. 0._wp ) THEN 281 ! this write is useful282 IF(lwp) WRITE(numout,*) ' * TEST 4 POSITIVITY NOT OK FOR CAT ', jl, ' WITH A = ', za_i_ini(jl,i_hemis)283 273 ztest_4 = 0 284 274 ENDIF -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r6469 r7483 866 866 DO jj = 1, jpj 867 867 DO ji = 1, jpi 868 strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv _i(ji,jj),0.0)))868 strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bvm_i(ji,jj),0.0))) 869 869 END DO 870 870 END DO -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r5888 r7483 10 10 !! 3.4 ! 2011-01 (A. Porter) dynamical allocation 11 11 !! 3.5 ! 2012-08 (R. Benshila) AGRIF 12 !! 3.6 ! 2016-06 (C. Rousset) Rewriting (conserves energy) 12 13 !!---------------------------------------------------------------------- 13 14 #if defined key_lim3 || ( defined key_lim2 && ! defined key_lim2_vp ) … … 95 96 !! coriolis terms of the momentum equation 96 97 !! 3) Solve the momentum equation (iterative procedure) 97 !! 4) Prevent high velocities if the ice is thin 98 !! 5) Recompute invariants of the strain rate tensor 98 !! 4) Recompute invariants of the strain rate tensor 99 99 !! which are inputs of the ITD, store stress 100 100 !! for the next time step 101 !! 6) Control prints of residual (convergence)101 !! 5) Control prints of residual (convergence) 102 102 !! and charge ellipse. 103 103 !! The user should make sure that the parameters … … 106 106 !! e.g. in the Canadian Archipelago 107 107 !! 108 !! ** Notes : Boundary condition for ice is chosen no-slip 109 !! but can be adjusted with param rn_shlat 110 !! 108 111 !! References : Hunke and Dukowicz, JPO97 109 112 !! Bouillon et al., Ocean Modelling 2009 … … 115 118 INTEGER :: jter ! local integers 116 119 CHARACTER (len=50) :: charout 117 REAL(wp) :: zt11, zt12, zt21, zt22, ztagnx, ztagny, delta ! 118 REAL(wp) :: za, zstms ! local scalars 119 REAL(wp) :: zc1, zc2, zc3 ! ice mass 120 121 REAL(wp) :: dtevp , z1_dtevp ! time step for subcycling 122 REAL(wp) :: dtotel, z1_dtotel, ecc2, ecci ! square of yield ellipse eccenticity 123 REAL(wp) :: z0, zr, zcca, zccb ! temporary scalars 124 REAL(wp) :: zu_ice2, zv_ice1 ! 125 REAL(wp) :: zddc, zdtc ! delta on corners and on centre 126 REAL(wp) :: zdst ! shear at the center of the grid point 127 REAL(wp) :: zdsshx, zdsshy ! term for the gradient of ocean surface 128 REAL(wp) :: sigma1, sigma2 ! internal ice stress 129 130 REAL(wp) :: zresm ! Maximal error on ice velocity 131 REAL(wp) :: zintb, zintn ! dummy argument 132 133 REAL(wp), POINTER, DIMENSION(:,:) :: zpresh ! temporary array for ice strength 134 REAL(wp), POINTER, DIMENSION(:,:) :: zpreshc ! Ice strength on grid cell corners (zpreshc) 135 REAL(wp), POINTER, DIMENSION(:,:) :: zfrld1, zfrld2 ! lead fraction on U/V points 136 REAL(wp), POINTER, DIMENSION(:,:) :: zmass1, zmass2 ! ice/snow mass on U/V points 137 REAL(wp), POINTER, DIMENSION(:,:) :: zcorl1, zcorl2 ! coriolis parameter on U/V points 138 REAL(wp), POINTER, DIMENSION(:,:) :: za1ct , za2ct ! temporary arrays 139 REAL(wp), POINTER, DIMENSION(:,:) :: v_oce1 ! ocean u/v component on U points 140 REAL(wp), POINTER, DIMENSION(:,:) :: u_oce2 ! ocean u/v component on V points 141 REAL(wp), POINTER, DIMENSION(:,:) :: u_ice2, v_ice1 ! ice u/v component on V/U point 142 REAL(wp), POINTER, DIMENSION(:,:) :: zf1 , zf2 ! arrays for internal stresses 143 REAL(wp), POINTER, DIMENSION(:,:) :: zmask ! mask ocean grid points 120 121 REAL(wp) :: zdtevp, z1_dtevp ! time step for subcycling 122 REAL(wp) :: ecc2, z1_ecc2 ! square of yield ellipse eccenticity 123 REAL(wp) :: zbeta, zalph1, z1_alph1, zalph2, z1_alph2 ! alpha and beta from Bouillon 2009 and 2013 124 REAL(wp) :: zm1, zm2, zm3, zmassU, zmassV ! ice/snow mass 125 REAL(wp) :: zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2 ! temporary scalars 126 REAL(wp) :: zTauO, zTauE, zCor ! temporary scalars 127 128 REAL(wp) :: zsig1, zsig2 ! internal ice stress 129 REAL(wp) :: zresm ! Maximal error on ice velocity 130 REAL(wp) :: zintb, zintn ! dummy argument 144 131 145 REAL(wp), POINTER, DIMENSION(:,:) :: zdt ! tension at centre of grid cells 146 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! Shear on northeast corner of grid cells 147 REAL(wp), POINTER, DIMENSION(:,:) :: zs1 , zs2 ! Diagonal stress tensor components zs1 and zs2 148 REAL(wp), POINTER, DIMENSION(:,:) :: zs12 ! Non-diagonal stress tensor component zs12 149 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! Local error on velocity 150 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope: 151 ! ocean surface (ssh_m) if ice is not embedded 152 ! ice top surface if ice is embedded 153 154 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 155 REAL(wp), PARAMETER :: zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity 132 REAL(wp), POINTER, DIMENSION(:,:) :: zpresh ! temporary array for ice strength 133 REAL(wp), POINTER, DIMENSION(:,:) :: z1_e1t0, z1_e2t0 ! scale factors 134 REAL(wp), POINTER, DIMENSION(:,:) :: zp_delt ! P/delta at T points 135 ! 136 REAL(wp), POINTER, DIMENSION(:,:) :: zaU , zaV ! ice fraction on U/V points 137 REAL(wp), POINTER, DIMENSION(:,:) :: zmU_t, zmV_t ! ice/snow mass/dt on U/V points 138 REAL(wp), POINTER, DIMENSION(:,:) :: zmf ! coriolis parameter at T points 139 REAL(wp), POINTER, DIMENSION(:,:) :: zTauU_ia , ztauV_ia ! ice-atm. stress at U-V points 140 REAL(wp), POINTER, DIMENSION(:,:) :: zspgU , zspgV ! surface pressure gradient at U/V points 141 REAL(wp), POINTER, DIMENSION(:,:) :: v_oceU, u_oceV, v_iceU, u_iceV ! ocean/ice u/v component on V/U points 142 REAL(wp), POINTER, DIMENSION(:,:) :: zfU , zfV ! internal stresses 143 144 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! shear 145 REAL(wp), POINTER, DIMENSION(:,:) :: zs1, zs2, zs12 ! stress tensor components 146 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! check convergence 147 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope: 148 ! ocean surface (ssh_m) if ice is not embedded 149 ! ice top surface if ice is embedded 150 REAL(wp), POINTER, DIMENSION(:,:) :: zswitchU, zswitchV ! dummy arrays 151 REAL(wp), POINTER, DIMENSION(:,:) :: zmaskU, zmaskV ! mask for ice presence 152 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask, zwf ! mask at F points for the ice 153 154 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 155 REAL(wp), PARAMETER :: zmmin = 1._wp ! ice mass (kg/m2) below which ice velocity equals ocean velocity 156 REAL(wp), PARAMETER :: zshlat = 2._wp ! boundary condition for sea-ice velocity (2=no slip ; 0=free slip) 156 157 !!------------------------------------------------------------------- 157 158 158 CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 159 CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask ) 160 CALL wrk_alloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds ) 161 CALL wrk_alloc( jpi,jpj, zs1 , zs2 , zs12 , zresr , zpice ) 159 CALL wrk_alloc( jpi,jpj, zpresh, z1_e1t0, z1_e2t0, zp_delt ) 160 CALL wrk_alloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia ) 161 CALL wrk_alloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV ) 162 CALL wrk_alloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 163 CALL wrk_alloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf ) 162 164 163 165 #if defined key_lim2 && ! defined key_lim2_vp … … 176 178 ! 177 179 !------------------------------------------------------------------------------! 178 ! 1) Ice strength (zpresh) ! 179 !------------------------------------------------------------------------------! 180 ! 181 ! Put every vector to 0 182 delta_i(:,:) = 0._wp ; 183 zpresh (:,:) = 0._wp ; 184 zpreshc(:,:) = 0._wp 185 u_ice2 (:,:) = 0._wp ; v_ice1(:,:) = 0._wp 186 divu_i (:,:) = 0._wp ; zdt (:,:) = 0._wp ; zds(:,:) = 0._wp 187 shear_i(:,:) = 0._wp 188 180 ! 0) mask at F points for the ice (on the whole domain, not only k_j1,k_jpj) 181 !------------------------------------------------------------------------------! 182 ! ocean/land mask 183 DO jj = 1, jpjm1 184 DO ji = 1, jpim1 ! NO vector opt. 185 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 186 END DO 187 END DO 188 CALL lbc_lnk( zfmask, 'F', 1._wp ) 189 190 ! Lateral boundary conditions on velocity (modify zfmask) 191 zwf(:,:) = zfmask(:,:) 192 DO jj = 2, jpjm1 193 DO ji = fs_2, fs_jpim1 ! vector opt. 194 IF( zfmask(ji,jj) == 0._wp ) THEN 195 zfmask(ji,jj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) ) 196 ENDIF 197 END DO 198 END DO 199 DO jj = 2, jpjm1 200 IF( zfmask(1,jj) == 0._wp ) THEN 201 zfmask(1 ,jj) = zshlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 202 ENDIF 203 IF( zfmask(jpi,jj) == 0._wp ) THEN 204 zfmask(jpi,jj) = zshlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 205 ENDIF 206 END DO 207 DO ji = 2, jpim1 208 IF( zfmask(ji,1) == 0._wp ) THEN 209 zfmask(ji,1 ) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 210 ENDIF 211 IF( zfmask(ji,jpj) == 0._wp ) THEN 212 zfmask(ji,jpj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 213 ENDIF 214 END DO 215 CALL lbc_lnk( zfmask, 'F', 1._wp ) 216 217 !------------------------------------------------------------------------------! 218 ! 1) define some variables and initialize arrays 219 !------------------------------------------------------------------------------! 220 ! ecc2: square of yield ellipse eccenticrity 221 ecc2 = rn_ecc * rn_ecc 222 z1_ecc2 = 1._wp / ecc2 223 224 ! Time step for subcycling 225 zdtevp = rdt_ice / REAL( nn_nevp ) 226 z1_dtevp = 1._wp / zdtevp 227 228 ! alpha parameters (Bouillon 2009) 189 229 #if defined key_lim3 190 CALL lim_itd_me_icestrength( nn_icestr ) ! LIM-3: Ice strength on T-points 191 #endif 192 193 DO jj = k_j1 , k_jpj ! Ice mass and temp variables 194 DO ji = 1 , jpi 230 zalph1 = ( 2._wp * rn_relast * rdt_ice ) * z1_dtevp 231 #else 232 zalph1 = ( 2._wp * telast ) * z1_dtevp 233 #endif 234 zalph2 = zalph1 * z1_ecc2 235 236 z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 237 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 238 239 ! Initialise stress tensor 240 zs1 (:,:) = stress1_i (:,:) 241 zs2 (:,:) = stress2_i (:,:) 242 zs12(:,:) = stress12_i(:,:) 243 244 ! Ice strength 195 245 #if defined key_lim3 196 zpresh(ji,jj) = tmask(ji,jj,1) * strength(ji,jj) 197 #endif 198 #if defined key_lim2 199 zpresh(ji,jj) = tmask(ji,jj,1) * pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) ) 200 #endif 201 ! zmask = 1 where there is ice or on land 202 zmask(ji,jj) = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - zepsi ) ) ) * tmask(ji,jj,1) 246 CALL lim_itd_me_icestrength( nn_icestr ) 247 zpresh(:,:) = tmask(:,:,1) * strength(:,:) 248 #else 249 zpresh(:,:) = tmask(:,:,1) * pstar * vt_i(:,:) * EXP( -c_rhg * (1. - at_i(:,:) ) ) 250 #endif 251 252 ! scale factors 253 DO jj = k_j1+1, k_jpj-1 254 DO ji = fs_2, fs_jpim1 255 z1_e1t0(ji,jj) = 1._wp / ( e1t(ji+1,jj ) + e1t(ji,jj ) ) 256 z1_e2t0(ji,jj) = 1._wp / ( e2t(ji ,jj+1) + e2t(ji,jj ) ) 203 257 END DO 204 258 END DO 205 206 ! Ice strength on grid cell corners (zpreshc) 207 ! needed for calculation of shear stress 208 DO jj = k_j1+1, k_jpj-1 209 DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1) 210 zstms = tmask(ji+1,jj+1,1) * wght(ji+1,jj+1,2,2) + tmask(ji,jj+1,1) * wght(ji+1,jj+1,1,2) + & 211 & tmask(ji+1,jj,1) * wght(ji+1,jj+1,2,1) + tmask(ji,jj,1) * wght(ji+1,jj+1,1,1) 212 zpreshc(ji,jj) = ( zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + zpresh(ji,jj+1) * wght(ji+1,jj+1,1,2) + & 213 & zpresh(ji+1,jj) * wght(ji+1,jj+1,2,1) + zpresh(ji,jj) * wght(ji+1,jj+1,1,1) & 214 & ) / MAX( zstms, zepsi ) 215 END DO 216 END DO 217 CALL lbc_lnk( zpreshc(:,:), 'F', 1. ) 259 218 260 ! 219 261 !------------------------------------------------------------------------------! 220 262 ! 2) Wind / ocean stress, mass terms, coriolis terms 221 263 !------------------------------------------------------------------------------! 222 !223 ! Wind stress, coriolis and mass terms on the sides of the squares224 ! zfrld1: lead fraction on U-points225 ! zfrld2: lead fraction on V-points226 ! zmass1: ice/snow mass on U-points227 ! zmass2: ice/snow mass on V-points228 ! zcorl1: Coriolis parameter on U-points229 ! zcorl2: Coriolis parameter on V-points230 ! (ztagnx,ztagny): wind stress on U/V points231 ! v_oce1: ocean v component on u points232 ! u_oce2: ocean u component on v points233 264 234 265 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: compute representative ice top surface ==! … … 242 273 zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 243 274 ! 244 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:)) * r1_rau0275 zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 245 276 ! 246 277 ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==! … … 251 282 DO ji = fs_2, fs_jpim1 252 283 253 zc1 = tmask(ji ,jj ,1) * ( rhosn * vt_s(ji ,jj ) + rhoic * vt_i(ji ,jj ) ) 254 zc2 = tmask(ji+1,jj ,1) * ( rhosn * vt_s(ji+1,jj ) + rhoic * vt_i(ji+1,jj ) ) 255 zc3 = tmask(ji ,jj+1,1) * ( rhosn * vt_s(ji ,jj+1) + rhoic * vt_i(ji ,jj+1) ) 256 257 zt11 = tmask(ji ,jj,1) * e1t(ji ,jj) 258 zt12 = tmask(ji+1,jj,1) * e1t(ji+1,jj) 259 zt21 = tmask(ji,jj ,1) * e2t(ji,jj ) 260 zt22 = tmask(ji,jj+1,1) * e2t(ji,jj+1) 261 262 ! Leads area. 263 zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + zepsi ) 264 zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + zepsi ) 265 266 ! Mass, coriolis coeff. and currents 267 zmass1(ji,jj) = ( zt12 * zc1 + zt11 * zc2 ) / ( zt11 + zt12 + zepsi ) 268 zmass2(ji,jj) = ( zt22 * zc1 + zt21 * zc3 ) / ( zt21 + zt22 + zepsi ) 269 zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * fcor(ji,jj) + e1t(ji,jj) * fcor(ji+1,jj) ) & 270 & / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi ) 271 zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * fcor(ji,jj) + e2t(ji,jj) * fcor(ji,jj+1) ) & 272 & / ( e2t(ji,jj+1) + e2t(ji,jj) + zepsi ) 273 ! 274 ! Ocean has no slip boundary condition 275 v_oce1(ji,jj) = 0.5 * ( ( v_oce(ji ,jj) + v_oce(ji ,jj-1) ) * e1t(ji,jj) & 276 & + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 277 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 278 279 u_oce2(ji,jj) = 0.5 * ( ( u_oce(ji,jj ) + u_oce(ji-1,jj ) ) * e2t(ji,jj) & 280 & + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 281 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 282 283 ! Wind stress at U,V-point 284 ztagnx = ( 1. - zfrld1(ji,jj) ) * utau_ice(ji,jj) 285 ztagny = ( 1. - zfrld2(ji,jj) ) * vtau_ice(ji,jj) 286 287 ! Computation of the velocity field taking into account the ice internal interaction. 288 ! Terms that are independent of the velocity field. 289 290 ! SB On utilise maintenant le gradient de la pente de l'ocean 291 ! include it later 292 293 zdsshx = ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 294 zdsshy = ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 295 296 za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx 297 za2ct(ji,jj) = ztagny - zmass2(ji,jj) * grav * zdsshy 284 ! ice fraction at U-V points 285 zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e12t(ji,jj) + at_i(ji+1,jj) * e12t(ji+1,jj) ) * r1_e12u(ji,jj) * umask(ji,jj,1) 286 zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e12t(ji,jj) + at_i(ji,jj+1) * e12t(ji,jj+1) ) * r1_e12v(ji,jj) * vmask(ji,jj,1) 287 288 ! Ice/snow mass at U-V points 289 zm1 = ( rhosn * vt_s(ji ,jj ) + rhoic * vt_i(ji ,jj ) ) 290 zm2 = ( rhosn * vt_s(ji+1,jj ) + rhoic * vt_i(ji+1,jj ) ) 291 zm3 = ( rhosn * vt_s(ji ,jj+1) + rhoic * vt_i(ji ,jj+1) ) 292 zmassU = 0.5_wp * ( zm1 * e12t(ji,jj) + zm2 * e12t(ji+1,jj) ) * r1_e12u(ji,jj) * umask(ji,jj,1) 293 zmassV = 0.5_wp * ( zm1 * e12t(ji,jj) + zm3 * e12t(ji,jj+1) ) * r1_e12v(ji,jj) * vmask(ji,jj,1) 294 295 ! Ocean currents at U-V points 296 v_oceU(ji,jj) = 0.5_wp * ( ( v_oce(ji ,jj) + v_oce(ji ,jj-1) ) * e1t(ji+1,jj) & 297 & + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 298 299 u_oceV(ji,jj) = 0.5_wp * ( ( u_oce(ji,jj ) + u_oce(ji-1,jj ) ) * e2t(ji,jj+1) & 300 & + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 301 302 ! Coriolis at T points (m*f) 303 zmf(ji,jj) = zm1 * fcor(ji,jj) 304 305 ! m/dt 306 zmU_t(ji,jj) = zmassU * z1_dtevp 307 zmV_t(ji,jj) = zmassV * z1_dtevp 308 309 ! Drag ice-atm. 310 zTauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 311 zTauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 312 313 ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 314 zspgU(ji,jj) = - zmassU * grav * ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 315 zspgV(ji,jj) = - zmassV * grav * ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 316 317 ! masks 318 zmaskU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) ) ! 0 if no ice 319 zmaskV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) ) ! 0 if no ice 320 321 ! switches 322 zswitchU(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassU - zmmin ) ) ! 0 if ice mass < zmmin 323 zswitchV(ji,jj) = MAX( 0._wp, SIGN( 1._wp, zmassV - zmmin ) ) ! 0 if ice mass < zmmin 298 324 299 325 END DO 300 326 END DO 301 327 CALL lbc_lnk( zmf, 'T', 1. ) 302 328 ! 303 329 !------------------------------------------------------------------------------! … … 305 331 !------------------------------------------------------------------------------! 306 332 ! 307 ! Time step for subcycling308 dtevp = rdt_ice / nn_nevp309 #if defined key_lim3310 dtotel = dtevp / ( 2._wp * rn_relast * rdt_ice )311 #else312 dtotel = dtevp / ( 2._wp * telast )313 #endif314 z1_dtotel = 1._wp / ( 1._wp + dtotel )315 z1_dtevp = 1._wp / dtevp316 !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter)317 ecc2 = rn_ecc * rn_ecc318 ecci = 1. / ecc2319 320 !-Initialise stress tensor321 zs1 (:,:) = stress1_i (:,:)322 zs2 (:,:) = stress2_i (:,:)323 zs12(:,:) = stress12_i(:,:)324 325 333 ! !----------------------! 326 334 DO jter = 1 , nn_nevp ! loop over jter ! 327 335 ! !----------------------! 328 DO jj = k_j1, k_jpj-1 329 zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 330 zv_ice(:,jj) = v_ice(:,jj) 331 END DO 332 333 DO jj = k_j1+1, k_jpj-1 334 DO ji = fs_2, fs_jpim1 !RB bug no vect opt due to zmask 335 336 ! 337 !- Divergence, tension and shear (Section a. Appendix B of Hunke & Dukowicz, 2002) 338 !- divu_i(:,:), zdt(:,:): divergence and tension at centre of grid cells 339 !- zds(:,:): shear on northeast corner of grid cells 340 ! 341 !- IMPORTANT REMINDER: Dear Gurvan, note that, the way these terms are coded, 342 ! there are many repeated calculations. 343 ! Speed could be improved by regrouping terms. For 344 ! the moment, however, the stress is on clarity of coding to avoid 345 ! bugs (Martin, for Miguel). 346 ! 347 !- ALSO: arrays zdt, zds and delta could 348 ! be removed in the future to minimise memory demand. 349 ! 350 !- MORE NOTES: Note that we are calculating deformation rates and stresses on the corners of 351 ! grid cells, exactly as in the B grid case. For simplicity, the indexation on 352 ! the corners is the same as in the B grid. 353 ! 354 ! 355 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 356 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 357 & ) * r1_e12t(ji,jj) 358 359 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 360 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 361 & ) * r1_e12t(ji,jj) 362 363 ! 336 IF(ln_ctl) THEN ! Convergence test 337 DO jj = k_j1, k_jpj-1 338 zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 339 zv_ice(:,jj) = v_ice(:,jj) 340 END DO 341 ENDIF 342 343 ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 344 DO jj = k_j1, k_jpj-1 ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 345 DO ji = 1, jpim1 346 347 ! shear at F points 364 348 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 365 349 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 366 & ) * r1_e12f(ji,jj) * ( 2._wp - fmask(ji,jj,1) ) & 367 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 368 369 370 v_ice1(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji+1,jj) & 371 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) & 372 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 373 374 u_ice2(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) & 375 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) & 376 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 377 END DO 378 END DO 379 380 CALL lbc_lnk_multi( v_ice1, 'U', -1., u_ice2, 'V', -1. ) ! lateral boundary cond. 381 350 & ) * r1_e12f(ji,jj) * zfmask(ji,jj) 351 352 END DO 353 END DO 354 CALL lbc_lnk( zds, 'F', 1. ) 355 382 356 DO jj = k_j1+1, k_jpj-1 383 DO ji = fs_2, fs_jpim1 384 385 !- Calculate Delta at centre of grid cells 386 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 387 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) & 388 & ) * r1_e12t(ji,jj) 389 390 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) 391 delta_i(ji,jj) = delta + rn_creepl 392 393 !- Calculate Delta on corners 394 zddc = ( ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 395 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 396 & ) * r1_e12f(ji,jj) 397 398 zdtc = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 399 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 400 & ) * r1_e12f(ji,jj) 401 402 zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl 403 404 !-Calculate stress tensor components zs1 and zs2 at centre of grid cells (see section 3.5 of CICE user's guide). 405 zs1(ji,jj) = ( zs1 (ji,jj) + dtotel * ( divu_i(ji,jj) - delta ) / delta_i(ji,jj) * zpresh(ji,jj) & 406 & ) * z1_dtotel 407 zs2(ji,jj) = ( zs2 (ji,jj) + dtotel * ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) & 408 & ) * z1_dtotel 409 !-Calculate stress tensor component zs12 at corners 410 zs12(ji,jj) = ( zs12(ji,jj) + dtotel * ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) & 411 & ) * z1_dtotel 412 413 END DO 414 END DO 415 416 CALL lbc_lnk_multi( zs1 , 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 357 DO ji = 2, jpim1 ! no vector loop 358 359 ! shear**2 at T points (doc eq. A16) 360 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e12f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e12f(ji-1,jj ) & 361 & + zds(ji,jj-1) * zds(ji,jj-1) * e12f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e12f(ji-1,jj-1) & 362 & ) * 0.25_wp * r1_e12t(ji,jj) 363 364 ! divergence at T points 365 zdiv = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 366 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 367 & ) * r1_e12t(ji,jj) 368 zdiv2 = zdiv * zdiv 369 370 ! tension at T points 371 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 372 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 373 & ) * r1_e12t(ji,jj) 374 zdt2 = zdt * zdt 375 376 ! delta at T points 377 zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * usecc2 ) 378 379 ! P/delta at T points 380 zp_delt(ji,jj) = zpresh(ji,jj) / ( zdelta + rn_creepl ) 381 382 ! stress at T points 383 zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv - zdelta ) ) * z1_alph1 384 zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 ) ) * z1_alph2 385 386 END DO 387 END DO 388 CALL lbc_lnk( zp_delt, 'T', 1. ) 389 390 DO jj = k_j1, k_jpj-1 391 DO ji = 1, jpim1 392 393 ! P/delta at F points 394 zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) ) 395 396 ! stress at F points 397 zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 ) * 0.5_wp ) * z1_alph2 398 399 END DO 400 END DO 401 CALL lbc_lnk_multi( zs1, 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 417 402 418 ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002)403 ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 419 404 DO jj = k_j1+1, k_jpj-1 420 DO ji = fs_2, fs_jpim1 421 !- contribution of zs1, zs2 and zs12 to zf1 422 zf1(ji,jj) = 0.5 * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 423 & + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj) & 424 & + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj) & 425 & ) * r1_e12u(ji,jj) 426 ! contribution of zs1, zs2 and zs12 to zf2 427 zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 428 & - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj) & 429 & + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj) & 430 & ) * r1_e12v(ji,jj) 405 DO ji = fs_2, fs_jpim1 406 407 ! U points 408 zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & 409 & + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj) & 410 & ) * r1_e2u(ji,jj) & 411 & + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) & 412 & ) * 2._wp * r1_e1u(ji,jj) & 413 & ) * r1_e12u(ji,jj) 414 415 ! V points 416 zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 417 & - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj) & 418 & ) * r1_e1v(ji,jj) & 419 & + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) & 420 & ) * 2._wp * r1_e2v(ji,jj) & 421 & ) * r1_e12v(ji,jj) 422 423 ! u_ice at V point 424 u_iceV(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) & 425 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 426 427 ! v_ice at U point 428 v_iceU(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji+1,jj) & 429 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 430 431 431 END DO 432 432 END DO 433 433 ! 434 ! Computation of ice velocity 435 ! 436 ! Both the Coriolis term and the ice-ocean drag are solved semi-implicitly. 437 ! 438 IF (MOD(jter,2).eq.0) THEN 439 434 ! --- Computation of ice velocity --- ! 435 ! Bouillon et al. 2013 (eq 47-48) => unstable unless alpha, beta are chosen wisely and large nn_nevp 436 ! Bouillon et al. 2009 (eq 34-35) => stable 437 IF( MOD(jter,2) .EQ. 0 ) THEN ! even iterations 438 440 439 DO jj = k_j1+1, k_jpj-1 441 440 DO ji = fs_2, fs_jpim1 442 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1) 443 z0 = zmass1(ji,jj) * z1_dtevp 444 445 ! SB modif because ocean has no slip boundary condition 446 zv_ice1 = 0.5 * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji ,jj) & 447 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) ) & 448 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 449 za = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 + & 450 & ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) ) 451 zr = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj) 452 zcca = z0 + za 453 zccb = zcorl1(ji,jj) 454 u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch 441 442 ! tau_io/(v_oce - v_ice) 443 zTauO = zaV(ji,jj) * rhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 444 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 445 446 ! Coriolis at V-points (energy conserving formulation) 447 zCor = - 0.25_wp * r1_e2v(ji,jj) * & 448 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 449 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 450 451 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 452 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 453 454 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 455 v_ice(ji,jj) = ( ( zmV_t(ji,jj) * v_ice(ji,jj) + zTauE + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 456 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO ) * zswitchV(ji,jj) & ! m/dt + tau_io(only ice part) 457 & + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 458 & ) * zmaskV(ji,jj) 455 459 END DO 456 460 END DO 457 458 CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 461 CALL lbc_lnk( v_ice, 'V', -1. ) 462 463 #if defined key_agrif && defined key_lim2 464 CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 465 #endif 466 #if defined key_bdy 467 CALL bdy_ice_lim_dyn( 'V' ) 468 #endif 469 470 DO jj = k_j1+1, k_jpj-1 471 DO ji = fs_2, fs_jpim1 472 473 ! tau_io/(u_oce - u_ice) 474 zTauO = zaU(ji,jj) * rhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 475 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 476 477 ! Coriolis at U-points (energy conserving formulation) 478 zCor = 0.25_wp * r1_e1u(ji,jj) * & 479 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 480 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 481 482 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 483 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 484 485 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 486 u_ice(ji,jj) = ( ( zmU_t(ji,jj) * u_ice(ji,jj) + zTauE + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 487 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO ) * zswitchU(ji,jj) & ! m/dt + tau_io(only ice part) 488 & + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 489 & ) * zmaskU(ji,jj) 490 END DO 491 END DO 492 CALL lbc_lnk( u_ice, 'U', -1. ) 493 459 494 #if defined key_agrif && defined key_lim2 460 495 CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 461 496 #endif 462 497 #if defined key_bdy 463 CALL bdy_ice_lim_dyn( 'U' )498 CALL bdy_ice_lim_dyn( 'U' ) 464 499 #endif 500 501 ELSE ! odd iterations 465 502 466 503 DO jj = k_j1+1, k_jpj-1 467 504 DO ji = fs_2, fs_jpim1 468 469 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1) 470 z0 = zmass2(ji,jj) * z1_dtevp 471 ! SB modif because ocean has no slip boundary condition 472 zu_ice2 = 0.5 * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj) & 473 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) ) & 474 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 475 za = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 + & 476 & ( v_ice(ji,jj) - v_oce(ji,jj))**2 ) * ( 1.0 - zfrld2(ji,jj) ) 477 zr = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj) 478 zcca = z0 + za 479 zccb = zcorl2(ji,jj) 480 v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch 505 506 ! tau_io/(u_oce - u_ice) 507 zTauO = zaU(ji,jj) * rhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & 508 & + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 509 510 ! Coriolis at U-points (energy conserving formulation) 511 zCor = 0.25_wp * r1_e1u(ji,jj) * & 512 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 513 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 514 515 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 516 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 517 518 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 519 u_ice(ji,jj) = ( ( zmU_t(ji,jj) * u_ice(ji,jj) + zTauE + zTauO * u_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 520 & ) / MAX( zepsi, zmU_t(ji,jj) + zTauO ) * zswitchU(ji,jj) & ! m/dt + tau_io(only ice part) 521 & + u_oce(ji,jj) * ( 1._wp - zswitchU(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 522 & ) * zmaskU(ji,jj) 481 523 END DO 482 524 END DO 483 484 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 525 CALL lbc_lnk( u_ice, 'U', -1. ) 526 527 #if defined key_agrif && defined key_lim2 528 CALL agrif_rhg_lim2( jter, nn_nevp, 'U' ) 529 #endif 530 #if defined key_bdy 531 CALL bdy_ice_lim_dyn( 'U' ) 532 #endif 533 534 DO jj = k_j1+1, k_jpj-1 535 DO ji = fs_2, fs_jpim1 536 537 ! tau_io/(v_oce - v_ice) 538 zTauO = zaV(ji,jj) * rhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & 539 & + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 540 541 ! Coriolis at V-points (energy conserving formulation) 542 zCor = - 0.25_wp * r1_e2v(ji,jj) * & 543 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 544 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 545 546 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 547 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 548 549 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) 550 v_ice(ji,jj) = ( ( zmV_t(ji,jj) * v_ice(ji,jj) + zTauE + zTauO * v_ice(ji,jj) & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 551 & ) / MAX( zepsi, zmV_t(ji,jj) + zTauO ) * zswitchV(ji,jj) & ! m/dt + tau_io(only ice part) 552 & + v_oce(ji,jj) * ( 1._wp - zswitchV(ji,jj) ) & ! v_ice = v_oce if mass < zmmin 553 & ) * zmaskV(ji,jj) 554 END DO 555 END DO 556 CALL lbc_lnk( v_ice, 'V', -1. ) 557 485 558 #if defined key_agrif && defined key_lim2 486 559 CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) 487 560 #endif 488 561 #if defined key_bdy 489 CALL bdy_ice_lim_dyn( 'V' )562 CALL bdy_ice_lim_dyn( 'V' ) 490 563 #endif 491 564 492 ELSE 565 ENDIF 566 567 IF(ln_ctl) THEN ! Convergence test 493 568 DO jj = k_j1+1, k_jpj-1 494 DO ji = fs_2, fs_jpim1495 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass2(ji,jj) ) ) ) * vmask(ji,jj,1)496 z0 = zmass2(ji,jj) * z1_dtevp497 ! SB modif because ocean has no slip boundary condition498 zu_ice2 = 0.5 * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj) &499 & +( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj+1) ) &500 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1)501 502 za = rhoco * SQRT( ( zu_ice2 - u_oce2(ji,jj) )**2 + &503 & ( v_ice(ji,jj) - v_oce(ji,jj) )**2 ) * ( 1.0 - zfrld2(ji,jj) )504 zr = z0 * v_ice(ji,jj) + zf2(ji,jj) + za2ct(ji,jj) + za * v_oce(ji,jj)505 zcca = z0 + za506 zccb = zcorl2(ji,jj)507 v_ice(ji,jj) = ( zr - zccb * zu_ice2 ) / ( zcca + zepsi ) * rswitch508 END DO509 END DO510 511 CALL lbc_lnk( v_ice(:,:), 'V', -1. )512 #if defined key_agrif && defined key_lim2513 CALL agrif_rhg_lim2( jter, nn_nevp, 'V' )514 #endif515 #if defined key_bdy516 CALL bdy_ice_lim_dyn( 'V' )517 #endif518 519 DO jj = k_j1+1, k_jpj-1520 DO ji = fs_2, fs_jpim1521 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zmass1(ji,jj) ) ) ) * umask(ji,jj,1)522 z0 = zmass1(ji,jj) * z1_dtevp523 zv_ice1 = 0.5 * ( ( v_ice(ji ,jj) + v_ice(ji ,jj-1) ) * e1t(ji,jj) &524 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji+1,jj) ) &525 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1)526 527 za = rhoco * SQRT( ( u_ice(ji,jj) - u_oce(ji,jj) )**2 + &528 & ( zv_ice1 - v_oce1(ji,jj) )**2 ) * ( 1.0 - zfrld1(ji,jj) )529 zr = z0 * u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + za * u_oce(ji,jj)530 zcca = z0 + za531 zccb = zcorl1(ji,jj)532 u_ice(ji,jj) = ( zr + zccb * zv_ice1 ) / ( zcca + zepsi ) * rswitch533 END DO534 END DO535 536 CALL lbc_lnk( u_ice(:,:), 'U', -1. )537 #if defined key_agrif && defined key_lim2538 CALL agrif_rhg_lim2( jter, nn_nevp, 'U' )539 #endif540 #if defined key_bdy541 CALL bdy_ice_lim_dyn( 'U' )542 #endif543 544 ENDIF545 546 IF(ln_ctl) THEN547 !--- Convergence test.548 DO jj = k_j1+1 , k_jpj-1549 569 zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 550 570 END DO … … 552 572 IF( lk_mpp ) CALL mpp_max( zresm ) ! max over the global domain 553 573 ENDIF 554 574 ! 555 575 ! ! ==================== ! 556 576 END DO ! end loop over jter ! … … 558 578 ! 559 579 !------------------------------------------------------------------------------! 560 ! 4) Prevent ice velocities when the ice is thin 561 !------------------------------------------------------------------------------! 562 ! If the ice volume is below zvmin then ice velocity should equal the 563 ! ocean velocity. This prevents high velocity when ice is thin 564 DO jj = k_j1+1, k_jpj-1 565 DO ji = fs_2, fs_jpim1 566 IF ( vt_i(ji,jj) <= zvmin ) THEN 567 u_ice(ji,jj) = u_oce(ji,jj) 568 v_ice(ji,jj) = v_oce(ji,jj) 569 ENDIF 580 ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 581 !------------------------------------------------------------------------------! 582 DO jj = k_j1, k_jpj-1 583 DO ji = 1, jpim1 584 585 ! shear at F points 586 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 587 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 588 & ) * r1_e12f(ji,jj) * zfmask(ji,jj) 589 590 END DO 591 END DO 592 CALL lbc_lnk( zds, 'F', 1. ) 593 594 DO jj = k_j1+1, k_jpj-1 595 DO ji = 2, jpim1 ! no vector loop 596 597 ! tension**2 at T points 598 zdt = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 599 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 600 & ) * r1_e12t(ji,jj) 601 zdt2 = zdt * zdt 602 603 ! shear**2 at T points (doc eq. A16) 604 zds2 = ( zds(ji,jj ) * zds(ji,jj ) * e12f(ji,jj ) + zds(ji-1,jj ) * zds(ji-1,jj ) * e12f(ji-1,jj ) & 605 & + zds(ji,jj-1) * zds(ji,jj-1) * e12f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e12f(ji-1,jj-1) & 606 & ) * 0.25_wp * r1_e12t(ji,jj) 607 608 ! shear at T points 609 shear_i(ji,jj) = SQRT( zdt2 + zds2 ) 610 611 ! divergence at T points 612 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 613 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 614 & ) * r1_e12t(ji,jj) 615 616 ! delta at T points 617 zdelta = SQRT( divu_i(ji,jj) * divu_i(ji,jj) + ( zdt2 + zds2 ) * usecc2 ) 618 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 619 delta_i(ji,jj) = zdelta + rn_creepl * rswitch 620 570 621 END DO 571 622 END DO 572 573 CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. ) 574 575 #if defined key_agrif && defined key_lim2 576 CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' ) 577 CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'V' ) 578 #endif 579 #if defined key_bdy 580 CALL bdy_ice_lim_dyn( 'U' ) 581 CALL bdy_ice_lim_dyn( 'V' ) 582 #endif 583 584 DO jj = k_j1+1, k_jpj-1 585 DO ji = fs_2, fs_jpim1 586 IF ( vt_i(ji,jj) <= zvmin ) THEN 587 v_ice1(ji,jj) = 0.5_wp * ( ( v_ice(ji ,jj) + v_ice(ji, jj-1) ) * e1t(ji+1,jj) & 588 & + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji ,jj) ) & 589 & / ( e1t(ji+1,jj) + e1t(ji,jj) ) * umask(ji,jj,1) 590 591 u_ice2(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * e2t(ji,jj+1) & 592 & + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj ) ) & 593 & / ( e2t(ji,jj+1) + e2t(ji,jj) ) * vmask(ji,jj,1) 594 ENDIF 595 END DO 596 END DO 597 598 CALL lbc_lnk_multi( u_ice2(:,:), 'V', -1., v_ice1(:,:), 'U', -1. ) 599 600 ! Recompute delta, shear and div, inputs for mechanical redistribution 601 DO jj = k_j1+1, k_jpj-1 602 DO ji = fs_2, jpim1 !RB bug no vect opt due to zmask 603 !- divu_i(:,:), zdt(:,:): divergence and tension at centre 604 !- zds(:,:): shear on northeast corner of grid cells 605 IF ( vt_i(ji,jj) <= zvmin ) THEN 606 607 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj ) * u_ice(ji-1,jj ) & 608 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji ,jj-1) * v_ice(ji ,jj-1) & 609 & ) * r1_e12t(ji,jj) 610 611 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 612 & -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 613 & ) * r1_e12t(ji,jj) 614 ! 615 ! SB modif because ocean has no slip boundary condition 616 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 617 & +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 618 & ) * r1_e12f(ji,jj) * ( 2.0 - fmask(ji,jj,1) ) & 619 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 620 621 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 622 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) ) * r1_e12t(ji,jj) 623 624 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) 625 delta_i(ji,jj) = delta + rn_creepl 626 627 ENDIF 628 END DO 629 END DO 630 ! 631 !------------------------------------------------------------------------------! 632 ! 5) Store stress tensor and its invariants 633 !------------------------------------------------------------------------------! 634 ! * Invariants of the stress tensor are required for limitd_me 635 ! (accelerates convergence and improves stability) 636 DO jj = k_j1+1, k_jpj-1 637 DO ji = fs_2, fs_jpim1 638 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj ) * v_ice1(ji-1,jj) & 639 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e12t(ji,jj) 640 shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst ) 641 END DO 642 END DO 643 644 ! Lateral boundary condition 645 CALL lbc_lnk_multi( divu_i (:,:), 'T', 1., delta_i(:,:), 'T', 1., shear_i(:,:), 'T', 1. ) 646 647 ! * Store the stress tensor for the next time step 623 CALL lbc_lnk_multi( shear_i, 'T', 1., divu_i, 'T', 1., delta_i, 'T', 1. ) 624 625 ! --- Store the stress tensor for the next time step --- ! 648 626 stress1_i (:,:) = zs1 (:,:) 649 627 stress2_i (:,:) = zs2 (:,:) … … 652 630 ! 653 631 !------------------------------------------------------------------------------! 654 ! 6) Control prints of residual and charge ellipse632 ! 5) Control prints of residual and charge ellipse 655 633 !------------------------------------------------------------------------------! 656 634 ! … … 675 653 DO ji = 2, jpim1 676 654 IF (zpresh(ji,jj) > 1.0) THEN 677 sigma1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )678 sigma2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) )655 zsig1 = ( zs1(ji,jj) + (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) ) 656 zsig2 = ( zs1(ji,jj) - (zs2(ji,jj)**2 + 4*zs12(ji,jj)**2 )**0.5 ) / ( 2*zpresh(ji,jj) ) 679 657 WRITE(charout,FMT="('lim_rhg :', I4, I4, D23.16, D23.16, D23.16, D23.16, A10)") 680 658 CALL prt_ctl_info(charout) … … 687 665 ENDIF 688 666 ! 689 CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct ) 690 CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask ) 691 CALL wrk_dealloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds ) 692 CALL wrk_dealloc( jpi,jpj, zs1 , zs2 , zs12 , zresr , zpice ) 667 CALL wrk_dealloc( jpi,jpj, zpresh, z1_e1t0, z1_e2t0, zp_delt ) 668 CALL wrk_dealloc( jpi,jpj, zaU, zaV, zmU_t, zmV_t, zmf, zTauU_ia, ztauV_ia ) 669 CALL wrk_dealloc( jpi,jpj, zspgU, zspgV, v_oceU, u_oceV, v_iceU, u_iceV, zfU, zfV ) 670 CALL wrk_dealloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 671 CALL wrk_dealloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf ) 693 672 694 673 END SUBROUTINE lim_rhg -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r6399 r7483 110 110 !!--------------------------------------------------------------------- 111 111 112 ! make calls for heat fluxes before it is modified 113 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 114 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 115 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface 116 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 117 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 118 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 119 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) ) 120 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) & 121 & * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 122 IF( iom_use('qemp_oce') ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 123 IF( iom_use('qemp_ice') ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 124 IF( iom_use('emp_oce' ) ) CALL iom_put( "emp_oce" , emp_oce(:,:) ) ! emp over ocean (taking into account the snow blown away from the ice) 125 IF( iom_use('emp_ice' ) ) CALL iom_put( "emp_ice" , emp_ice(:,:) ) ! emp over ice (taking into account the snow blown away from the ice) 126 127 ! albedo output 112 ! make call for albedo output before it is modified 128 113 CALL wrk_alloc( jpi,jpj, zalb ) 129 114 -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r6469 r7483 54 54 PUBLIC lim_var_eqv2glo 55 55 PUBLIC lim_var_salprof 56 PUBLIC lim_var_icetm57 56 PUBLIC lim_var_bv 58 57 PUBLIC lim_var_salprof1d … … 89 88 ! Compute variables 90 89 !-------------------- 91 vt_i (:,:) = 0._wp 92 vt_s (:,:) = 0._wp 93 at_i (:,:) = 0._wp 94 ato_i(:,:) = 1._wp 95 ! 96 DO jl = 1, jpl 97 DO jj = 1, jpj 98 DO ji = 1, jpi 99 ! 100 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 101 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 102 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 103 ! 104 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 105 icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch ! ice thickness 106 END DO 107 END DO 108 END DO 109 90 ! integrated values 91 vt_i (:,:) = SUM( v_i, dim=3 ) 92 vt_s (:,:) = SUM( v_s, dim=3 ) 93 at_i (:,:) = SUM( a_i, dim=3 ) 94 et_s(:,:) = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 ) 95 et_i(:,:) = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 ) 96 ! 110 97 DO jj = 1, jpj 111 98 DO ji = 1, jpi … … 115 102 116 103 IF( kn > 1 ) THEN 117 et_s (:,:) = 0._wp 118 ot_i (:,:) = 0._wp 104 ! 105 ! mean ice/snow thickness 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 109 htm_i(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch 110 htm_s(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch 111 ENDDO 112 ENDDO 113 114 ! mean temperature (K), salinity and age 119 115 smt_i(:,:) = 0._wp 120 et_i (:,:) = 0._wp 121 ! 116 tm_i(:,:) = 0._wp 117 tm_su(:,:) = 0._wp 118 om_i (:,:) = 0._wp 122 119 DO jl = 1, jpl 120 123 121 DO jj = 1, jpj 124 122 DO ji = 1, jpi 125 et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content 126 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi20 ) ) 127 smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi20 ) * rswitch ! ice salinity 128 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi20 ) ) 129 ot_i(ji,jj) = ot_i(ji,jj) + oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi20 ) * rswitch ! ice age 130 END DO 131 END DO 132 END DO 133 ! 134 DO jl = 1, jpl 123 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 124 tm_su(ji,jj) = tm_su(ji,jj) + rswitch * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 ) 125 om_i (ji,jj) = om_i (ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 ) 126 END DO 127 END DO 128 135 129 DO jk = 1, nlay_i 136 et_i(:,:) = et_i(:,:) + e_i(:,:,jk,jl) ! ice heat content 137 END DO 138 END DO 130 DO jj = 1, jpj 131 DO ji = 1, jpi 132 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 133 tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) & 134 & / MAX( vt_i(ji,jj) , epsi10 ) 135 smt_i(ji,jj) = smt_i(ji,jj) + r1_nlay_i * rswitch * s_i(ji,jj,jk,jl) * v_i(ji,jj,jl) & 136 & / MAX( vt_i(ji,jj) , epsi10 ) 137 END DO 138 END DO 139 END DO 140 END DO 141 tm_i = tm_i + rt0 142 tm_su = tm_su + rt0 139 143 ! 140 144 ENDIF … … 246 250 ! Mean temperature 247 251 !------------------- 248 vt_i (:,:) = 0._wp249 DO jl = 1, jpl250 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl)251 END DO252 ! integrated values 253 vt_i (:,:) = SUM( v_i, dim=3 ) 254 vt_s (:,:) = SUM( v_s, dim=3 ) 255 at_i (:,:) = SUM( a_i, dim=3 ) 252 256 253 257 tm_i(:,:) = 0._wp … … 397 401 END SUBROUTINE lim_var_salprof 398 402 399 400 SUBROUTINE lim_var_icetm 401 !!------------------------------------------------------------------ 402 !! *** ROUTINE lim_var_icetm *** 403 !! 404 !! ** Purpose : computes mean sea ice temperature 403 SUBROUTINE lim_var_bv 404 !!------------------------------------------------------------------ 405 !! *** ROUTINE lim_var_bv *** 406 !! 407 !! ** Purpose : computes mean brine volume (%) in sea ice 408 !! 409 !! ** Method : e = - 0.054 * S (ppt) / T (C) 410 !! 411 !! References : Vancoppenolle et al., JGR, 2007 405 412 !!------------------------------------------------------------------ 406 413 INTEGER :: ji, jj, jk, jl ! dummy loop indices 407 414 !!------------------------------------------------------------------ 408 409 ! Mean sea ice temperature 410 vt_i (:,:) = 0._wp 411 DO jl = 1, jpl 412 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 413 END DO 414 415 tm_i(:,:) = 0._wp 415 ! 416 bvm_i(:,:) = 0._wp 417 bv_i (:,:,:) = 0._wp 416 418 DO jl = 1, jpl 417 419 DO jk = 1, nlay_i 418 420 DO jj = 1, jpj 419 421 DO ji = 1, jpi 420 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 421 tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) & 422 & / MAX( vt_i(ji,jj) , epsi10 ) 423 END DO 424 END DO 425 END DO 426 END DO 427 tm_i = tm_i + rt0 428 429 END SUBROUTINE lim_var_icetm 430 431 432 SUBROUTINE lim_var_bv 433 !!------------------------------------------------------------------ 434 !! *** ROUTINE lim_var_bv *** 435 !! 436 !! ** Purpose : computes mean brine volume (%) in sea ice 437 !! 438 !! ** Method : e = - 0.054 * S (ppt) / T (C) 439 !! 440 !! References : Vancoppenolle et al., JGR, 2007 441 !!------------------------------------------------------------------ 442 INTEGER :: ji, jj, jk, jl ! dummy loop indices 443 REAL(wp) :: zbvi ! local scalars 444 !!------------------------------------------------------------------ 445 ! 446 vt_i (:,:) = 0._wp 447 DO jl = 1, jpl 448 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 449 END DO 450 451 bv_i(:,:) = 0._wp 452 DO jl = 1, jpl 453 DO jk = 1, nlay_i 454 DO jj = 1, jpj 455 DO ji = 1, jpi 456 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) ) ) 457 zbvi = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 ) & 458 & * v_i(ji,jj,jl) * r1_nlay_i 459 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi20 ) ) ) 460 bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi / MAX( vt_i(ji,jj) , epsi20 ) 461 END DO 422 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) ) ) 423 bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rswitch * tmut * s_i(ji,jj,jk,jl) * r1_nlay_i & 424 & / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 ) 425 END DO 426 END DO 427 END DO 428 429 DO jj = 1, jpj 430 DO ji = 1, jpi 431 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 432 bvm_i(ji,jj) = bvm_i(ji,jj) + rswitch * bv_i(ji,jj,jl) * v_i(ji,jj,jl) / MAX( vt_i(ji,jj), epsi10 ) 462 433 END DO 463 434 END DO … … 715 686 zht_i(ji,1:jpl) = 0._wp 716 687 za_i (ji,1:jpl) = 0._wp 717 688 itest(:) = 0 689 718 690 ! *** case very thin ice: fill only category 1 719 691 IF ( i_fill == 1 ) THEN -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r6417 r7483 17 17 USE sbc_oce ! Surface boundary condition: ocean fields 18 18 USE sbc_ice ! Surface boundary condition: ice fields 19 USE dom_ice20 19 USE ice 21 20 USE limvar … … 40 39 !!---------------------------------------------------------------------- 41 40 CONTAINS 42 43 #if defined key_dimgout44 # include "limwri_dimg.h90"45 #else46 41 47 42 SUBROUTINE lim_wri( kindic ) … … 59 54 INTEGER :: ji, jj, jk, jl ! dummy loop indices 60 55 REAL(wp) :: z1_365 61 REAL(wp) :: z tmp62 REAL(wp), POINTER, DIMENSION(:,:,:) :: z oi, zei, zt_i, zt_s63 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, z 2da, z2db, zswi ! 2D workspace56 REAL(wp) :: z2da, z2db, ztmp 57 REAL(wp), POINTER, DIMENSION(:,:,:) :: zswi2 58 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, zswi ! 2D workspace 64 59 !!------------------------------------------------------------------- 65 60 66 61 IF( nn_timing == 1 ) CALL timing_start('limwri') 67 62 68 CALL wrk_alloc( jpi, jpj, jpl, z oi, zei, zt_i, zt_s)69 CALL wrk_alloc( jpi, jpj , z2d, z 2da, z2db, zswi )63 CALL wrk_alloc( jpi, jpj, jpl, zswi2 ) 64 CALL wrk_alloc( jpi, jpj , z2d, zswi ) 70 65 71 66 !----------------------------- … … 74 69 z1_365 = 1._wp / 365._wp 75 70 76 CALL lim_var_icetm ! mean sea ice temperature77 78 CALL lim_var_bv ! brine volume 79 80 DO jj = 1, jpj ! presence indicator of ice71 ! brine volume 72 CALL lim_var_bv 73 74 ! tresholds for outputs 75 DO jj = 1, jpj 81 76 DO ji = 1, jpi 82 77 zswi(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) 83 78 END DO 84 79 END DO 85 ! 86 ! 87 ! 88 IF ( iom_use( "icethic_cea" ) ) THEN ! mean ice thickness 89 DO jj = 1, jpj 80 DO jl = 1, jpl 81 DO jj = 1, jpj 90 82 DO ji = 1, jpi 91 z 2d(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj)83 zswi2(ji,jj,jl) = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 92 84 END DO 93 85 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 ) * zswi(ji,jj) 101 END DO 102 END DO 103 CALL iom_put( "snowthic_cea" , z2d ) 104 ENDIF 86 END DO 105 87 ! 88 ! fluxes 89 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 90 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 91 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface 92 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 93 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 94 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 95 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) ) 96 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) & 97 & * a_i_b(:,:,:),dim=3 ) + qemp_ice(:,:) ) 98 IF( iom_use('qemp_oce') ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 99 IF( iom_use('qemp_ice') ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 100 IF( iom_use('emp_oce' ) ) CALL iom_put( "emp_oce" , emp_oce(:,:) ) !emp over ocean (taking into account the snow blown away from the ice) 101 IF( iom_use('emp_ice' ) ) CALL iom_put( "emp_ice" , emp_ice(:,:) ) !emp over ice (taking into account the snow blown away from the ice) 102 103 ! velocity 106 104 IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN 107 105 DO jj = 2 , jpjm1 108 106 DO ji = 2 , jpim1 109 z2da(ji,jj) = ( u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp 110 z2db(ji,jj) = ( v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp 107 z2da = ( u_ice(ji,jj) * umask(ji,jj,1) + u_ice(ji-1,jj) * umask(ji-1,jj,1) ) * 0.5_wp 108 z2db = ( v_ice(ji,jj) * vmask(ji,jj,1) + v_ice(ji,jj-1) * vmask(ji,jj-1,1) ) * 0.5_wp 109 z2d(ji,jj) = SQRT( z2da * z2da + z2db * z2db ) 111 110 END DO 112 111 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 112 CALL lbc_lnk( z2d, 'T', 1. ) 113 CALL iom_put( "uice_ipa" , u_ice ) ! ice velocity u component 114 CALL iom_put( "vice_ipa" , v_ice ) ! ice velocity v component 115 CALL iom_put( "icevel" , z2d ) ! ice velocity module 123 116 ENDIF 124 117 ! 125 IF ( iom_use( "miceage" ) ) THEN 126 z2d(:,:) = 0.e0 127 DO jl = 1, jpl 128 DO jj = 1, jpj 129 DO ji = 1, jpi 130 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 131 z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 ) 132 END DO 133 END DO 134 END DO 135 CALL iom_put( "miceage" , z2d * z1_365 ) ! mean ice age 136 ENDIF 137 138 IF ( iom_use( "micet" ) ) THEN 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 z2d(ji,jj) = ( tm_i(ji,jj) - rt0 ) * zswi(ji,jj) 142 END DO 143 END DO 144 CALL iom_put( "micet" , z2d ) ! mean ice temperature 145 ENDIF 118 IF ( iom_use( "miceage" ) ) CALL iom_put( "miceage" , om_i * zswi * z1_365 ) ! mean ice age 119 IF ( iom_use( "icethic_cea" ) ) CALL iom_put( "icethic_cea" , htm_i * zswi ) ! ice thickness mean 120 IF ( iom_use( "snowthic_cea" ) ) CALL iom_put( "snowthic_cea", htm_s * zswi ) ! snow thickness mean 121 IF ( iom_use( "micet" ) ) CALL iom_put( "micet" , ( tm_i - rt0 ) * zswi ) ! ice mean temperature 122 IF ( iom_use( "icest" ) ) CALL iom_put( "icest" , ( tm_su - rt0 ) * zswi ) ! ice surface temperature 123 IF ( iom_use( "icecolf" ) ) CALL iom_put( "icecolf" , hicol ) ! frazil ice collection thickness 146 124 ! 147 IF ( iom_use( "icest" ) ) THEN148 z2d(:,:) = 0.e0149 DO jl = 1, jpl150 DO jj = 1, jpj151 DO ji = 1, jpi152 z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )153 END DO154 END DO155 END DO156 CALL iom_put( "icest" , z2d ) ! ice surface temperature157 ENDIF158 159 IF ( iom_use( "icecolf" ) ) CALL iom_put( "icecolf", hicol ) ! frazil ice collection thickness160 161 125 CALL iom_put( "isst" , sst_m ) ! sea surface temperature 162 126 CALL iom_put( "isss" , sss_m ) ! sea surface salinity 163 CALL iom_put( "iceconc" , at_i 164 CALL iom_put( "icevolu" , vt_i 165 CALL iom_put( "icehc" , et_i 166 CALL iom_put( "isnowhc" , et_s 167 CALL iom_put( "ibrinv" , bv _i * 100._wp) ! brine volume127 CALL iom_put( "iceconc" , at_i * zswi ) ! ice concentration 128 CALL iom_put( "icevolu" , vt_i * zswi ) ! ice volume = mean ice thickness over the cell 129 CALL iom_put( "icehc" , et_i * zswi ) ! ice total heat content 130 CALL iom_put( "isnowhc" , et_s * zswi ) ! snow total heat content 131 CALL iom_put( "ibrinv" , bvm_i * zswi * 100. ) ! brine volume 168 132 CALL iom_put( "utau_ice" , utau_ice ) ! wind stress over ice along i-axis at I-point 169 133 CALL iom_put( "vtau_ice" , vtau_ice ) ! wind stress over ice along j-axis at I-point 170 134 CALL iom_put( "snowpre" , sprecip * 86400. ) ! snow precipitation 171 CALL iom_put( "micesalt" , smt_i 172 173 CALL iom_put( "icestr" , strength * 0.001 )! ice strength174 CALL iom_put( "idive" , divu_i * 1.0e8 ) 175 CALL iom_put( "ishear" , shear_i * 1.0e8 ) 176 CALL iom_put( "snowvol" , vt_s 135 CALL iom_put( "micesalt" , smt_i * zswi ) ! mean ice salinity 136 137 CALL iom_put( "icestr" , strength * zswi ) ! ice strength 138 CALL iom_put( "idive" , divu_i * 1.0e8 ) ! divergence 139 CALL iom_put( "ishear" , shear_i * 1.0e8 ) ! shear 140 CALL iom_put( "snowvol" , vt_s * zswi ) ! snow volume 177 141 178 142 CALL iom_put( "icetrp" , diag_trp_vi * rday ) ! ice volume transport … … 183 147 184 148 CALL iom_put( "sfxbog" , sfx_bog * rday ) ! salt flux from bottom growth 185 CALL iom_put( "sfxbom" , sfx_bom * rday ) ! salt flux from bottom melt 186 CALL iom_put( "sfxsum" , sfx_sum * rday ) ! salt flux from surface melt 149 CALL iom_put( "sfxbom" , sfx_bom * rday ) ! salt flux from bottom melting 150 CALL iom_put( "sfxsum" , sfx_sum * rday ) ! salt flux from surface melting 187 151 CALL iom_put( "sfxsni" , sfx_sni * rday ) ! salt flux from snow ice formation 188 152 CALL iom_put( "sfxopw" , sfx_opw * rday ) ! salt flux from open water formation 189 153 CALL iom_put( "sfxdyn" , sfx_dyn * rday ) ! salt flux from ridging rafting 190 CALL iom_put( "sfxres" , sfx_res * rday ) ! salt flux from residual154 CALL iom_put( "sfxres" , sfx_res * rday ) ! salt flux from limupdate (resultant) 191 155 CALL iom_put( "sfxbri" , sfx_bri * rday ) ! salt flux from brines 192 156 CALL iom_put( "sfxsub" , sfx_sub * rday ) ! salt flux from sublimation … … 202 166 CALL iom_put( "vfxbom" , wfx_bom * ztmp ) ! bottom melt 203 167 CALL iom_put( "vfxice" , wfx_ice * ztmp ) ! total ice growth/melt 168 169 IF ( iom_use( "vfxthin" ) ) THEN ! ice production for open water + thin ice (<20cm) => comparable to observations 170 WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog 171 ELSEWHERE ; z2d = 0._wp 172 END WHERE 173 CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp ) 174 ENDIF 175 176 ztmp = rday / rhosn 177 CALL iom_put( "vfxspr" , wfx_spr * ztmp ) ! precip (snow) 204 178 CALL iom_put( "vfxsnw" , wfx_snw * ztmp ) ! total snw growth/melt 205 CALL iom_put( "vfxsub" , wfx_sub * ztmp ) ! sublimation (snow )206 CALL iom_put( "vfxs pr" , wfx_spr * ztmp ) ! precip (snow)207 179 CALL iom_put( "vfxsub" , wfx_sub * ztmp ) ! sublimation (snow/ice) 180 CALL iom_put( "vfxsub_err" , wfx_err_sub * ztmp ) ! "excess" of sublimation sent to ocean 181 208 182 CALL iom_put( "afxtot" , afx_tot * rday ) ! concentration tendency (total) 209 183 CALL iom_put( "afxdyn" , afx_dyn * rday ) ! concentration tendency (dynamics) … … 225 199 CALL iom_put ('hfxdif' , hfx_dif(:,:) ) ! 226 200 CALL iom_put ('hfxopw' , hfx_opw(:,:) ) ! 227 CALL iom_put ('hfxtur' , fhtur(:,:) * SUM( a_i_b(:,:,:), dim=3) ) ! turbulent heat flux at ice base201 CALL iom_put ('hfxtur' , fhtur(:,:) * SUM( a_i_b(:,:,:), dim=3 ) ) ! turbulent heat flux at ice base 228 202 CALL iom_put ('hfxdhc' , diag_heat(:,:) ) ! Heat content variation in snow and ice 229 203 CALL iom_put ('hfxspr' , hfx_spr(:,:) ) ! Heat content of snow precip 230 204 231 232 IF ( iom_use( "vfxthin" ) ) THEN ! ice production for open water + thin ice (<20cm) => comparable to observations233 DO jj = 1, jpj234 DO ji = 1, jpi235 z2d(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) ! mean ice thickness236 END DO237 END DO238 WHERE( z2d(:,:) < 0.2 .AND. z2d(:,:) > 0. ) ; z2da = wfx_bog239 ELSEWHERE ; z2da = 0._wp240 END WHERE241 CALL iom_put( "vfxthin", ( wfx_opw + z2da ) * ztmp )242 ENDIF243 205 244 206 !-------------------------------- 245 207 ! Output values for each category 246 208 !-------------------------------- 247 CALL iom_put( "iceconc_cat" , a_i ) ! area for categories 248 CALL iom_put( "icethic_cat" , ht_i ) ! thickness for categories 249 CALL iom_put( "snowthic_cat" , ht_s ) ! snow depth for categories 250 CALL iom_put( "salinity_cat" , sm_i ) ! salinity for categories 251 209 IF ( iom_use( "iceconc_cat" ) ) CALL iom_put( "iceconc_cat" , a_i * zswi2 ) ! area for categories 210 IF ( iom_use( "icethic_cat" ) ) CALL iom_put( "icethic_cat" , ht_i * zswi2 ) ! thickness for categories 211 IF ( iom_use( "snowthic_cat" ) ) CALL iom_put( "snowthic_cat" , ht_s * zswi2 ) ! snow depth for categories 212 IF ( iom_use( "salinity_cat" ) ) CALL iom_put( "salinity_cat" , sm_i * zswi2 ) ! salinity for categories 252 213 ! ice temperature 253 IF ( iom_use( "icetemp_cat" ) ) THEN 254 zt_i(:,:,:) = SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i 255 CALL iom_put( "icetemp_cat" , zt_i - rt0 ) 256 ENDIF 257 214 IF ( iom_use( "icetemp_cat" ) ) CALL iom_put( "icetemp_cat", ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zswi2 ) 258 215 ! snow temperature 259 IF ( iom_use( "snwtemp_cat" ) ) THEN 260 zt_s(:,:,:) = SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s 261 CALL iom_put( "snwtemp_cat" , zt_s - rt0 ) 262 ENDIF 263 264 ! Compute ice age 265 IF ( iom_use( "iceage_cat" ) ) THEN 266 DO jl = 1, jpl 267 DO jj = 1, jpj 268 DO ji = 1, jpi 269 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 270 rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) ) 271 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch 272 END DO 273 END DO 274 END DO 275 CALL iom_put( "iceage_cat" , zoi * z1_365 ) ! ice age for categories 276 ENDIF 277 278 ! Compute brine volume 279 IF ( iom_use( "brinevol_cat" ) ) THEN 280 zei(:,:,:) = 0._wp 281 DO jl = 1, jpl 282 DO jk = 1, nlay_i 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 286 zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 * & 287 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * & 288 rswitch * r1_nlay_i 289 END DO 290 END DO 291 END DO 292 END DO 293 CALL iom_put( "brinevol_cat" , zei ) ! brine volume for categories 294 ENDIF 216 IF ( iom_use( "snwtemp_cat" ) ) CALL iom_put( "snwtemp_cat", ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zswi2 ) 217 ! ice age 218 IF ( iom_use( "iceage_cat" ) ) CALL iom_put( "iceage_cat" , o_i * zswi2 * z1_365 ) 219 ! brine volume 220 IF ( iom_use( "brinevol_cat" ) ) CALL iom_put( "brinevol_cat", bv_i * 100. * zswi2 ) 295 221 296 222 ! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s … … 298 224 ! not yet implemented 299 225 300 CALL wrk_dealloc( jpi, jpj, jpl, z oi, zei, zt_i, zt_s)301 CALL wrk_dealloc( jpi, jpj , z2d, zswi , z2da, z2db)226 CALL wrk_dealloc( jpi, jpj, jpl, zswi2 ) 227 CALL wrk_dealloc( jpi, jpj , z2d, zswi ) 302 228 303 229 IF( nn_timing == 1 ) CALL timing_stop('limwri') 304 230 305 231 END SUBROUTINE lim_wri 306 #endif307 232 308 233 … … 319 244 !! 4.0 ! 2013-06 (C. Rousset) 320 245 !!---------------------------------------------------------------------- 321 INTEGER, INTENT( in ) :: kt ! ocean time-step index) 322 INTEGER, INTENT( in ) :: kid , kh_i 246 INTEGER, INTENT( in ) :: kt ! ocean time-step index) 247 INTEGER, INTENT( in ) :: kid , kh_i 248 INTEGER :: nz_i, jl 249 REAL(wp), DIMENSION(jpl) :: jcat 323 250 !!---------------------------------------------------------------------- 324 325 CALL histdef( kid, "iicethic", "Ice thickness" , "m" , & 326 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 327 CALL histdef( kid, "iiceconc", "Ice concentration" , "%" , & 328 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 329 CALL histdef( kid, "iicetemp", "Ice temperature" , "C" , & 330 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 331 CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)" , "m/s" , & 332 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 333 CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)" , "m/s" , & 334 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 335 CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", & 336 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 337 CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", & 338 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 339 CALL histdef( kid, "iicesflx", "Solar flux over ocean" , "w/m2" , & 340 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 341 CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" , & 251 DO jl = 1, jpl 252 jcat(jl) = REAL(jl) 253 ENDDO 254 255 CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up") 256 257 CALL histdef( kid, "sithic", "Ice thickness" , "m" , & 258 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 259 CALL histdef( kid, "siconc", "Ice concentration" , "%" , & 260 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 261 CALL histdef( kid, "sitemp", "Ice temperature" , "C" , & 262 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 263 CALL histdef( kid, "sivelu", "i-Ice speed " , "m/s" , & 264 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 265 CALL histdef( kid, "sivelv", "j-Ice speed " , "m/s" , & 266 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 267 CALL histdef( kid, "sistru", "i-Wind stress over ice " , "Pa" , & 268 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 269 CALL histdef( kid, "sistrv", "j-Wind stress over ice " , "Pa" , & 270 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 271 CALL histdef( kid, "sisflx", "Solar flux over ocean" , "w/m2" , & 272 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 273 CALL histdef( kid, "sinflx", "Non-solar flux over ocean" , "w/m2" , & 342 274 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 343 275 CALL histdef( kid, "isnowpre", "Snow precipitation" , "kg/m2/s", & 344 276 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 345 CALL histdef( kid, "iicesali", "Ice salinity" , "PSU" , & 346 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 347 CALL histdef( kid, "iicevolu", "Ice volume" , "m" , & 348 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 349 CALL histdef( kid, "iicedive", "Ice divergence" , "10-8s-1", & 350 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 351 CALL histdef( kid, "iicebopr", "Ice bottom production" , "m/s" , & 352 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 353 CALL histdef( kid, "iicedypr", "Ice dynamic production" , "m/s" , & 354 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 355 CALL histdef( kid, "iicelapr", "Ice open water prod" , "m/s" , & 277 CALL histdef( kid, "sisali", "Ice salinity" , "PSU" , & 278 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 279 CALL histdef( kid, "sivolu", "Ice volume" , "m" , & 280 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 281 CALL histdef( kid, "sidive", "Ice divergence" , "10-8s-1", & 282 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 283 284 CALL histdef( kid, "vfxbog", "Ice bottom production" , "m/s" , & 285 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 286 CALL histdef( kid, "vfxdyn", "Ice dynamic production" , "m/s" , & 287 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 288 CALL histdef( kid, "vfxopw", "Ice open water prod" , "m/s" , & 356 289 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 357 CALL histdef( kid, "iicesipr", "Snow ice production " , "m/s" , & 358 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 359 CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s" , & 360 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 361 CALL histdef( kid, "iicebome", "Ice bottom melt" , "m/s" , & 362 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 363 CALL histdef( kid, "iicesume", "Ice surface melt" , "m/s" , & 364 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 365 CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics" , "" , & 366 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 367 CALL histdef( kid, "iisfxres", "Salt flux from limupdate", "" , & 368 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 290 CALL histdef( kid, "vfxsni", "Snow ice production " , "m/s" , & 291 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 292 CALL histdef( kid, "vfxres", "Ice prod from limupdate" , "m/s" , & 293 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 294 CALL histdef( kid, "vfxbom", "Ice bottom melt" , "m/s" , & 295 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 296 CALL histdef( kid, "vfxsum", "Ice surface melt" , "m/s" , & 297 & jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 298 299 CALL histdef( kid, "sithicat", "Ice thickness" , "m" , & 300 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 301 CALL histdef( kid, "siconcat", "Ice concentration" , "%" , & 302 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 303 CALL histdef( kid, "sisalcat", "Ice salinity" , "" , & 304 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 305 CALL histdef( kid, "sitemcat", "Ice temperature" , "C" , & 306 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 307 CALL histdef( kid, "snthicat", "Snw thickness" , "m" , & 308 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 309 CALL histdef( kid, "sntemcat", "Snw temperature" , "C" , & 310 & jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt ) 369 311 370 312 CALL histend( kid, snc4set ) ! end of the file definition 371 313 372 CALL histwrite( kid, " iicethic", kt, icethi, jpi*jpj, (/1/) )373 CALL histwrite( kid, " iiceconc", kt, at_i , jpi*jpj, (/1/) )374 CALL histwrite( kid, " iicetemp", kt, tm_i - rt0 , jpi*jpj, (/1/) )375 CALL histwrite( kid, " iicevelu", kt, u_ice , jpi*jpj, (/1/) )376 CALL histwrite( kid, " iicevelv", kt, v_ice , jpi*jpj, (/1/) )377 CALL histwrite( kid, " iicestru", kt, utau_ice , jpi*jpj, (/1/) )378 CALL histwrite( kid, " iicestrv", kt, vtau_ice , jpi*jpj, (/1/) )379 CALL histwrite( kid, " iicesflx", kt, qsr , jpi*jpj, (/1/) )380 CALL histwrite( kid, " iicenflx", kt, qns , jpi*jpj, (/1/) )314 CALL histwrite( kid, "sithic", kt, htm_i , jpi*jpj, (/1/) ) 315 CALL histwrite( kid, "siconc", kt, at_i , jpi*jpj, (/1/) ) 316 CALL histwrite( kid, "sitemp", kt, tm_i - rt0 , jpi*jpj, (/1/) ) 317 CALL histwrite( kid, "sivelu", kt, u_ice , jpi*jpj, (/1/) ) 318 CALL histwrite( kid, "sivelv", kt, v_ice , jpi*jpj, (/1/) ) 319 CALL histwrite( kid, "sistru", kt, utau_ice , jpi*jpj, (/1/) ) 320 CALL histwrite( kid, "sistrv", kt, vtau_ice , jpi*jpj, (/1/) ) 321 CALL histwrite( kid, "sisflx", kt, qsr , jpi*jpj, (/1/) ) 322 CALL histwrite( kid, "sinflx", kt, qns , jpi*jpj, (/1/) ) 381 323 CALL histwrite( kid, "isnowpre", kt, sprecip , jpi*jpj, (/1/) ) 382 CALL histwrite( kid, "iicesali", kt, smt_i , jpi*jpj, (/1/) ) 383 CALL histwrite( kid, "iicevolu", kt, vt_i , jpi*jpj, (/1/) ) 384 CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8 , jpi*jpj, (/1/) ) 385 386 CALL histwrite( kid, "iicebopr", kt, wfx_bog , jpi*jpj, (/1/) ) 387 CALL histwrite( kid, "iicedypr", kt, wfx_dyn , jpi*jpj, (/1/) ) 388 CALL histwrite( kid, "iicelapr", kt, wfx_opw , jpi*jpj, (/1/) ) 389 CALL histwrite( kid, "iicesipr", kt, wfx_sni , jpi*jpj, (/1/) ) 390 CALL histwrite( kid, "iicerepr", kt, wfx_res , jpi*jpj, (/1/) ) 391 CALL histwrite( kid, "iicebome", kt, wfx_bom , jpi*jpj, (/1/) ) 392 CALL histwrite( kid, "iicesume", kt, wfx_sum , jpi*jpj, (/1/) ) 393 CALL histwrite( kid, "iisfxdyn", kt, sfx_dyn , jpi*jpj, (/1/) ) 394 CALL histwrite( kid, "iisfxres", kt, sfx_res , jpi*jpj, (/1/) ) 324 CALL histwrite( kid, "sisali", kt, smt_i , jpi*jpj, (/1/) ) 325 CALL histwrite( kid, "sivolu", kt, vt_i , jpi*jpj, (/1/) ) 326 CALL histwrite( kid, "sidive", kt, divu_i*1.0e8 , jpi*jpj, (/1/) ) 327 328 CALL histwrite( kid, "vfxbog", kt, wfx_bog , jpi*jpj, (/1/) ) 329 CALL histwrite( kid, "vfxdyn", kt, wfx_dyn , jpi*jpj, (/1/) ) 330 CALL histwrite( kid, "vfxopw", kt, wfx_opw , jpi*jpj, (/1/) ) 331 CALL histwrite( kid, "vfxsni", kt, wfx_sni , jpi*jpj, (/1/) ) 332 CALL histwrite( kid, "vfxres", kt, wfx_res , jpi*jpj, (/1/) ) 333 CALL histwrite( kid, "vfxbom", kt, wfx_bom , jpi*jpj, (/1/) ) 334 CALL histwrite( kid, "vfxsum", kt, wfx_sum , jpi*jpj, (/1/) ) 335 336 CALL histwrite( kid, "sithicat", kt, ht_i , jpi*jpj*jpl, (/1/) ) 337 CALL histwrite( kid, "siconcat", kt, a_i , jpi*jpj*jpl, (/1/) ) 338 CALL histwrite( kid, "sisalcat", kt, sm_i , jpi*jpj*jpl, (/1/) ) 339 CALL histwrite( kid, "sitemcat", kt, tm_i - rt0 , jpi*jpj*jpl, (/1/) ) 340 CALL histwrite( kid, "snthicat", kt, ht_s , jpi*jpj*jpl, (/1/) ) 341 CALL histwrite( kid, "sntemcat", kt, tm_su - rt0 , jpi*jpj*jpl, (/1/) ) 395 342 396 343 ! Close the file -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
r6204 r7483 392 392 INTEGER :: ji,jj,jn 393 393 REAL(wp) :: zalpha 394 REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr395 394 !!----------------------------------------------------------------------- 396 395 ! … … 529 528 END DO 530 529 END DO 530 ELSE 531 DO jj=MAX(j1,2),j2 532 DO ji=MAX(i1,2),i2 533 uice_agr(ji,jj) = tabres(ji,jj) 534 END DO 535 END DO 531 536 ENDIF 532 537 #else … … 541 546 END DO 542 547 END DO 548 ELSE 549 DO jj= j1, j2 550 DO ji= i1, i2 551 uice_agr(ji,jj) = tabres(ji,jj) 552 END DO 553 END DO 543 554 ENDIF 544 555 #endif … … 566 577 tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 567 578 ENDIF 579 END DO 580 END DO 581 ELSE 582 DO jj=MAX(j1,2),j2 583 DO ji=MAX(i1,2),i2 584 vice_agr(ji,jj) = tabres(ji,jj) 568 585 END DO 569 586 END DO … … 580 597 END DO 581 598 END DO 599 ELSE 600 DO jj= j1 ,j2 601 DO ji = i1, i2 602 vice_agr(ji,jj) = tabres(ji,jj) 603 END DO 604 END DO 582 605 ENDIF 583 606 #endif … … 585 608 586 609 587 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before )610 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, k1, k2, before ) 588 611 !!----------------------------------------------------------------------- 589 612 !! *** ROUTINE interp_adv_ice *** … … 593 616 !! put -9999 where no ice for correct extrapolation 594 617 !!----------------------------------------------------------------------- 595 INTEGER, INTENT(in) :: i1, i2, j1, j2 596 REAL(wp), DIMENSION(i1:i2,j1:j2, 7), INTENT(inout) :: tabres618 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 619 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 597 620 LOGICAL, INTENT(in) :: before 598 621 !! … … 601 624 ! 602 625 IF( before ) THEN 603 DO jj=j1,j2 604 DO ji=i1,i2 605 IF( tms(ji,jj) == 0. ) THEN 606 tabres(ji,jj,:) = -9999. 607 ELSE 608 tabres(ji,jj, 1) = frld (ji,jj) 609 tabres(ji,jj, 2) = hicif (ji,jj) 610 tabres(ji,jj, 3) = hsnif (ji,jj) 611 tabres(ji,jj, 4) = tbif (ji,jj,1) 612 tabres(ji,jj, 5) = tbif (ji,jj,2) 613 tabres(ji,jj, 6) = tbif (ji,jj,3) 614 tabres(ji,jj, 7) = qstoif(ji,jj) 615 ENDIF 616 END DO 617 END DO 626 DO jj=j1,j2 627 DO ji=i1,i2 628 IF( tms(ji,jj) == 0. ) THEN 629 tabres(ji,jj,:) = -9999 630 ELSE 631 tabres(ji,jj, 1) = frld (ji,jj) 632 tabres(ji,jj, 2) = hicif (ji,jj) 633 tabres(ji,jj, 3) = hsnif (ji,jj) 634 tabres(ji,jj, 4) = tbif (ji,jj,1) 635 tabres(ji,jj, 5) = tbif (ji,jj,2) 636 tabres(ji,jj, 6) = tbif (ji,jj,3) 637 tabres(ji,jj, 7) = qstoif(ji,jj) 638 ENDIF 639 END DO 640 END DO 641 ELSE 642 DO jj=j1,j2 643 DO ji=i1,i2 644 DO jk=k1, k2 645 tabice_agr(ji,jj,jk) = tabres(ji,jj,jk) 646 END DO 647 END DO 648 END DO 618 649 ENDIF 619 650 ! -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
r5412 r7483 60 60 61 61 indic = 0 ! reset to no error condition 62 IF( kstp == nit000 ) CALL iom_init( "nemo") ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)62 IF( kstp == nit000 ) CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 63 63 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 64 CALL iom_setkt( kstp - nit000 + 1, "nemo") ! say to iom that we are at time step kstp64 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! say to iom that we are at time step kstp 65 65 66 66 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r5253 r7483 211 211 REAL(wp) :: zztmp 212 212 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 213 ! reading initial file214 LOGICAL :: ln_tsd_init !: T & S data flag215 LOGICAL :: ln_tsd_tradmp !: internal damping toward input data flag216 CHARACTER(len=100) :: cn_dir217 TYPE(FLD_N) :: sn_tem,sn_sal218 INTEGER :: ios=0219 220 NAMELIST/namtsd/ ln_tsd_init,ln_tsd_tradmp,cn_dir,sn_tem,sn_sal221 !222 223 REWIND( numnam_ref ) ! Namelist namtsd in reference namelist :224 READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)225 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in reference namelist for dia_ar5', lwp )226 REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run227 READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )228 902 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in configuration namelist for dia_ar5', lwp )229 IF(lwm) WRITE ( numond, namtsd )230 213 ! 231 214 !!---------------------------------------------------------------------- … … 233 216 IF( nn_timing == 1 ) CALL timing_start('dia_ar5_init') 234 217 ! 235 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta )218 CALL wrk_alloc( jpi, jpj, jpk, 2, zsaldta ) 236 219 ! ! allocate dia_ar5 arrays 237 220 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) … … 249 232 IF( lk_mpp ) CALL mpp_sum( vol0 ) 250 233 251 CALL iom_open ( TRIM( cn_dir )//TRIM(sn_sal%clname), inum )252 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,1), 1 )253 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 )234 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 235 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 236 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 254 237 CALL iom_close( inum ) 238 255 239 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 256 240 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) … … 267 251 ENDIF 268 252 ! 269 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )253 CALL wrk_dealloc( jpi, jpj, jpk, 2, zsaldta ) 270 254 ! 271 255 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5_init') -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r5628 r7483 38 38 PUBLIC dia_hsb ! routine called by step.F90 39 39 PUBLIC dia_hsb_init ! routine called by nemogcm.F90 40 PUBLIC dia_hsb_rst ! routine called by step.F9041 40 42 41 LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets … … 86 85 !!--------------------------------------------------------------------------- 87 86 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') 87 ! 88 88 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 ) 89 89 ! … … 174 174 ENDDO 175 175 176 ! Substract forcing from heat content, salt content and volume variations 176 ! ------------------------ ! 177 ! 3 - Drifts ! 178 ! ------------------------ ! 177 179 zdiff_v1 = zdiff_v1 - frc_v 178 180 IF( lk_vvl ) zdiff_v2 = zdiff_v2 - frc_v … … 187 189 188 190 ! ----------------------- ! 189 ! 3- Diagnostics writing !191 ! 4 - Diagnostics writing ! 190 192 ! ----------------------- ! 191 193 zvol_tot = 0._wp ! total ocean volume (calculated with scale factors) … … 200 202 !!gm end 201 203 204 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 205 CALL iom_put( 'bgfrctem' , frc_t * rau0 * rcp * 1.e-20 ) ! hc - surface forcing (1.e20 J) 206 CALL iom_put( 'bgfrchfx' , frc_t * rau0 * rcp / & ! hc - surface forcing (W/m2) 207 & ( surf_tot * kt * rdt ) ) 208 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3) 209 202 210 IF( lk_vvl ) THEN 203 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C) 204 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity variation (psu) 205 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J) 206 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content variation (psu*km3) 207 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3) 208 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t variation (km3) 209 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 210 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 211 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 211 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C) 212 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity drift (pss) 213 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J) 214 CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp / & ! Heat flux drift (W/m2) 215 & ( surf_tot * kt * rdt ) ) 216 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content drift (psu*km3) 217 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 218 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t drift (km3) 212 219 ELSE 213 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content variation (C) 214 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content variation (psu) 215 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J) 216 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content variation (psu*km3) 217 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3) 218 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 219 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 220 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 220 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C) 221 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content drift (pss) 222 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J) 223 CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp / & ! Heat flux drift (W/m2) 224 & ( surf_tot * kt * rdt ) ) 225 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content drift (psu*km3) 226 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 221 227 CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C) 222 228 CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu) … … 244 250 ! 245 251 INTEGER :: ji, jj, jk ! dummy loop indices 246 INTEGER :: id1 ! local integers247 252 !!---------------------------------------------------------------------- 248 253 ! 249 254 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 250 255 IF( ln_rstart ) THEN !* Read the restart file 251 !id1 = iom_varid( numror, 'frc_vol' , ldstop = .FALSE. )252 256 ! 253 257 IF(lwp) WRITE(numout,*) '~~~~~~~' … … 261 265 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 262 266 ENDIF 263 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini )264 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini )265 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini )266 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini )267 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 268 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 269 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 270 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 267 271 IF( .NOT. lk_vvl ) THEN 268 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini )269 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini )272 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 273 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 270 274 ENDIF 271 275 ELSE … … 312 316 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 313 317 ENDIF 314 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini )315 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini )316 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini )317 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini )318 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) ) 319 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) ) 320 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 321 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 318 322 IF( .NOT. lk_vvl ) THEN 319 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini )320 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini )323 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 324 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 321 325 ENDIF 326 322 327 ! 323 328 ENDIF … … 338 343 !! - Compute coefficients for conversion 339 344 !!--------------------------------------------------------------------------- 340 INTEGER :: jk ! dummy loop indice341 345 INTEGER :: ierror ! local integer 342 346 INTEGER :: ios … … 344 348 NAMELIST/namhsb/ ln_diahsb 345 349 !!---------------------------------------------------------------------- 346 347 IF(lwp) THEN348 WRITE(numout,*)349 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets'350 WRITE(numout,*) '~~~~~~~~ '351 ENDIF352 350 353 351 REWIND( numnam_ref ) ! Namelist namhsb in reference namelist … … 360 358 IF(lwm) WRITE ( numond, namhsb ) 361 359 362 ! 363 IF(lwp) THEN ! Control print 360 IF(lwp) THEN 364 361 WRITE(numout,*) 365 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 366 WRITE(numout,*) '~~~~~~~~~~~~' 367 WRITE(numout,*) ' Namelist namhsb : set hsb parameters' 368 WRITE(numout,*) ' Switch for hsb diagnostic (T) or not (F) ln_diahsb = ', ln_diahsb 369 WRITE(numout,*) 370 ENDIF 371 362 WRITE(numout,*) 'dia_hsb_init' 363 WRITE(numout,*) '~~~~~~~~ ' 364 WRITE(numout,*) ' check the heat and salt budgets (T) or not (F) ln_diahsb = ', ln_diahsb 365 ENDIF 366 ! 372 367 IF( .NOT. ln_diahsb ) RETURN 373 368 ! IF( .NOT. lk_mpp_rep ) & … … 382 377 & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror ) 383 378 IF( ierror > 0 ) THEN 384 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 385 ENDIF 386 387 IF(.NOT. lk_vvl ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 388 IF( ierror > 0 ) THEN 389 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 379 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) 380 RETURN 381 ENDIF 382 383 IF( .NOT. lk_vvl ) THEN 384 ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj), STAT=ierror ) 385 IF( ierror > 0 ) THEN 386 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) 387 RETURN 388 ENDIF 390 389 ENDIF 391 390 … … 393 392 ! 2 - Time independant variables and file opening ! 394 393 ! ----------------------------------------------- ! 395 IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated"396 IF(lwp) WRITE(numout,*) '~~~~~~~'397 394 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 398 surf_tot = glob_sum( surf(:,:) ) 395 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 399 396 400 397 IF( lk_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' ) -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
r5506 r7483 158 158 CASE ( 025 ) ! ORCA_R025 configuration 159 159 ! ! ======================= 160 isrow = 1207 - jpjglo ! eORCA025 R025 - Using full isfextended 161 ! domain for reference. - Adjust jindices 160 162 ncsnr(1) = 1 ; ncstt(1) = 0 ! Caspian + Aral sea 161 ncsi1(1) = 1330 ; ncsj1(1) = 645162 ncsi2(1) = 1400 ; ncsj2(1) = 795163 ncsi1(1) = 1330 ; ncsj1(1) = 831 - isrow 164 ncsi2(1) = 1400 ; ncsj2(1) = 981 - isrow 163 165 ncsir(1,1) = 1 ; ncsjr(1,1) = 1 164 166 ! 165 167 ncsnr(2) = 1 ; ncstt(2) = 0 ! Azov Sea 166 ncsi1(2) = 1284 ; ncsj1(2) = 722167 ncsi2(2) = 1304 ; ncsj2(2) = 747168 ncsi1(2) = 1284 ; ncsj1(2) = 908 - isrow 169 ncsi2(2) = 1304 ; ncsj2(2) = 933 - isrow 168 170 ncsir(2,1) = 1 ; ncsjr(2,1) = 1 171 ! 172 ncsnr(3) = 1 ; ncstt(3) = 0 ! Great Lakes 173 ncsi1(3) = 775 ; ncsj1(3) = 866 - isrow 174 ncsi2(3) = 848 ; ncsj2(3) = 931 - isrow 175 ncsir(3,1) = 1 ; ncsjr(3,1) = 1 176 ! 177 ncsnr(4) = 1 ; ncstt(4) = 0 ! Lake Victoria 178 ncsi1(4) = 1270 ; ncsj1(4) = 661 - isrow 179 ncsi2(4) = 1295 ; ncsj2(4) = 696 - isrow 180 ncsir(4,1) = 1 ; ncsjr(4,1) = 1 181 ! 169 182 ! 170 183 END SELECT -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r5029 r7483 601 601 DO jk = 1, jpk 602 602 DO jj = 1, jpjm1 603 DO ji = 1, jpim1603 DO ji = 1, fs_jpim1 604 604 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 605 605 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 606 IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = 4.0_wp / ze3 606 IF ( ze3 /= 0._wp ) THEN ; ze3f(ji,jj,jk) = 4.0_wp / ze3 607 ELSE ; ze3f(ji,jj,jk) = 0.0_wp 608 ENDIF 607 609 END DO 608 610 END DO … … 611 613 DO jk = 1, jpk 612 614 DO jj = 1, jpjm1 613 DO ji = 1, jpim1615 DO ji = 1, fs_jpim1 614 616 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 615 617 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 616 618 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 617 619 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) 618 IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = zmsk / ze3 620 IF ( ze3 /= 0._wp ) THEN ; ze3f(ji,jj,jk) = zmsk / ze3 621 ELSE ; ze3f(ji,jj,jk) = 0.0_wp 622 ENDIF 619 623 END DO 620 624 END DO -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r5120 r7483 323 323 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl * fse3v_a(ji,jj,1) 324 324 va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 325 & / ( ze3va * rau0 ) 325 & / ( ze3va * rau0 ) * vmask(ji,jj,1) 326 326 #else 327 327 va(ji,jj,1) = vb(ji,jj,1) & 328 328 & + p2dt *(va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 329 & / ( fse3v(ji,jj,1) * rau0 ))329 & / ( fse3v(ji,jj,1) * rau0 ) * vmask(ji,jj,1) ) 330 330 #endif 331 331 END DO -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
r5215 r7483 120 120 ! first entry with narea for this processor is left hand interior index 121 121 ! last entry is right hand interior index 122 jj = jpj/2122 jj = nlcj/2 123 123 nicbdi = -1 124 124 nicbei = -1 … … 136 136 ! 137 137 ! repeat for j direction 138 ji = jpi/2138 ji = nlci/2 139 139 nicbdj = -1 140 140 nicbej = -1 … … 153 153 ! special for east-west boundary exchange we save the destination index 154 154 i1 = MAX( nicbdi-1, 1) 155 i3 = INT( src_calving(i1, jpj/2) )155 i3 = INT( src_calving(i1,nlcj/2) ) 156 156 jj = INT( i3/nicbpack ) 157 157 ricb_left = REAL( i3 - nicbpack*jj, wp ) 158 158 i1 = MIN( nicbei+1, jpi ) 159 i3 = INT( src_calving(i1, jpj/2) )159 i3 = INT( src_calving(i1,nlcj/2) ) 160 160 jj = INT( i3/nicbpack ) 161 161 ricb_right = REAL( i3 - nicbpack*jj, wp ) … … 196 196 WRITE(numicb,*) 'berg left ', ricb_left 197 197 WRITE(numicb,*) 'berg right ', ricb_right 198 jj = jpj/2198 jj = nlcj/2 199 199 WRITE(numicb,*) "central j line:" 200 200 WRITE(numicb,*) "i processor" … … 202 202 WRITE(numicb,*) "i point" 203 203 WRITE(numicb,*) (INT(src_calving(ji,jj)), ji=1,jpi) 204 ji = jpi/2204 ji = nlci/2 205 205 WRITE(numicb,*) "central i line:" 206 206 WRITE(numicb,*) "j processor" -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r4686 r7483 804 804 ELSE 805 805 startloop = 3 806 pt2dl(2,ijpj) = psgn * pt2d r(3,ijpjm1)806 pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 807 807 ENDIF 808 808 DO ji = startloop, nlci … … 816 816 ELSE 817 817 startloop = 3 818 pt2dl(2,ijpj) = psgn * pt2d r(3,ijpjm1)818 pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 819 819 ENDIF 820 820 DO ji = startloop, nlci … … 910 910 DO ji = startloop , endloop 911 911 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 912 pt2dl(ji,ijpj)= 0.5 * (pt2d r(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))912 pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 913 913 END DO 914 914 … … 926 926 DO ji = startloop , endloop 927 927 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 928 pt2dl(ji,ijpj) = pt2d r(ji,ijpjm1)928 pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1) 929 929 END DO 930 930 -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r6476 r7483 2654 2654 !!---------------------------------------------------------------------- 2655 2655 ! 2656 ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields), znorthgloio(jpi,4,num_fields,jpni) ) ! expanded to 3 dimensions 2656 ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields), & 2657 & znorthgloio(jpi,4,num_fields,jpni) ) ! expanded to 3 dimensions 2657 2658 ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) ) 2658 2659 ! -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
r4990 r7483 157 157 END DO 158 158 ENDIF 159 160 ! ORCA R1: Take the minimum between aeiw and aeiv0 161 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN 162 DO jj = 2, jpjm1 163 DO ji = fs_2, fs_jpim1 ! vector opt. 164 aeiw(ji,jj) = MIN( aeiw(ji,jj), aeiv0 ) 165 END DO 166 END DO 167 ENDIF 168 159 169 CALL lbc_lnk( aeiw, 'W', 1. ) ! lateral boundary condition on aeiw 160 170 -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r6399 r7483 206 206 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 207 207 qlw_ice(:,:,1) = sf(jp_qlw)%fnow(:,:,1) 208 qsr_ice(:,:,1) = sf(jp_qsr)%fnow(:,:,1) 208 IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 209 ELSE ; qsr_ice(:,:,1) = sf(jp_qsr)%fnow(:,:,1) 210 ENDIF 209 211 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 210 212 qatm_ice(:,:) = sf(jp_humi)%fnow(:,:,1) -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6399 r7483 1335 1335 !! *** ROUTINE sbc_cpl_ice_flx *** 1336 1336 !! 1337 !! ** Purpose : provide the heat and freshwater fluxes of the 1338 !! ocean-ice system. 1337 !! ** Purpose : provide the heat and freshwater fluxes of the ocean-ice system 1339 1338 !! 1340 1339 !! ** Method : transform the fields received from the atmosphere into 1341 1340 !! surface heat and fresh water boundary condition for the 1342 1341 !! ice-ocean system. The following fields are provided: 1343 !! * total non solar, solar and freshwater fluxes (qns_tot,1342 !! * total non solar, solar and freshwater fluxes (qns_tot, 1344 1343 !! qsr_tot and emp_tot) (total means weighted ice-ocean flux) 1345 1344 !! NB: emp_tot include runoffs and calving. 1346 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where1345 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where 1347 1346 !! emp_ice = sublimation - solid precipitation as liquid 1348 1347 !! precipitation are re-routed directly to the ocean and 1349 !! runoffs and calving directly enter the ocean.1350 !! * solid precipitation (sprecip), used to add to qns_tot1348 !! calving directly enter the ocean (runoffs are read but included in trasbc.F90) 1349 !! * solid precipitation (sprecip), used to add to qns_tot 1351 1350 !! the heat lost associated to melting solid precipitation 1352 1351 !! over the ocean fraction. 1353 !! ===>> CAUTION here this changes the net heat flux received from 1354 !! the atmosphere 1355 !! 1356 !! - the fluxes have been separated from the stress as 1357 !! (a) they are updated at each ice time step compare to 1358 !! an update at each coupled time step for the stress, and 1359 !! (b) the conservative computation of the fluxes over the 1360 !! sea-ice area requires the knowledge of the ice fraction 1361 !! after the ice advection and before the ice thermodynamics, 1362 !! so that the stress is updated before the ice dynamics 1363 !! while the fluxes are updated after it. 1352 !! * heat content of rain, snow and evap can also be provided, 1353 !! otherwise heat flux associated with these mass flux are 1354 !! guessed (qemp_oce, qemp_ice) 1355 !! 1356 !! - the fluxes have been separated from the stress as 1357 !! (a) they are updated at each ice time step compare to 1358 !! an update at each coupled time step for the stress, and 1359 !! (b) the conservative computation of the fluxes over the 1360 !! sea-ice area requires the knowledge of the ice fraction 1361 !! after the ice advection and before the ice thermodynamics, 1362 !! so that the stress is updated before the ice dynamics 1363 !! while the fluxes are updated after it. 1364 !! 1365 !! ** Details 1366 !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice => provided 1367 !! + qemp_oce + qemp_ice => recalculated and added up to qns 1368 !! 1369 !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice => provided 1370 !! 1371 !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce) 1372 !! river runoff (rnf) is provided but not included here 1364 1373 !! 1365 1374 !! ** Action : update at each nf_ice time step: 1366 1375 !! qns_tot, qsr_tot non-solar and solar total heat fluxes 1367 1376 !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice 1368 !! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)1369 !! emp_ice 1370 !! dqns_ice 1371 !! sprecip 1377 !! emp_tot total evaporation - precipitation(liquid and solid) (-calving) 1378 !! emp_ice ice sublimation - solid precipitation over the ice 1379 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1380 !! sprecip solid precipitation over the ocean 1372 1381 !!---------------------------------------------------------------------- 1373 1382 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] … … 1379 1388 INTEGER :: jl ! dummy loop index 1380 1389 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk, zsnw 1381 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice1390 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1382 1391 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1383 1392 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice … … 1387 1396 ! 1388 1397 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1389 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice )1398 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1390 1399 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1391 1400 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) … … 1396 1405 ! 1397 1406 ! ! ========================= ! 1398 ! ! freshwater budget ! (emp )1407 ! ! freshwater budget ! (emp_tot) 1399 1408 ! ! ========================= ! 1400 1409 ! 1401 ! ! total Precipitation - total Evaporation (emp_tot)1402 ! ! solid precipitation - sublimation (emp_ice)1403 ! ! solid Precipitation (sprecip)1404 ! ! liquid + solid Precipitation (tprecip)1410 ! ! solid Precipitation (sprecip) 1411 ! ! liquid + solid Precipitation (tprecip) 1412 ! ! total Evaporation - total Precipitation (emp_tot) 1413 ! ! sublimation - solid precipitation (cell average) (emp_ice) 1405 1414 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1406 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1407 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1408 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1409 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1410 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1411 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1415 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1416 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1417 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1418 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1419 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 1420 IF( iom_use('precip') ) & 1421 & CALL iom_put( 'precip' , frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) ! total precipitation 1422 IF( iom_use('rain') ) & 1423 & CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1412 1424 IF( iom_use('hflx_rain_cea') ) & 1413 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1414 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1415 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1425 & CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1416 1426 IF( iom_use('evap_ao_cea' ) ) & 1417 CALL iom_put( 'evap_ao_cea' , ztmp )! ice-free oce evap (cell average)1427 & CALL iom_put( 'evap_ao_cea' , frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! ice-free oce evap (cell average) 1418 1428 IF( iom_use('hflx_evap_cea') ) & 1419 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )! heat flux from from evap (cell average)1420 CASE( 'oce and ice' 1429 & CALL iom_put( 'hflx_evap_cea', ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1430 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1421 1431 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1422 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1432 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) 1423 1433 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1424 1434 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) … … 1426 1436 1427 1437 #if defined key_lim3 1428 ! zsnw = snow percentage over ice after wind blowing 1429 zsnw(:,:) = 0._wp 1430 CALL lim_thd_snwblow( p_frld, zsnw ) 1438 ! zsnw = snow fraction over ice after wind blowing 1439 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw ) 1431 1440 1432 ! --- evaporation (kg/m2/s) --- ! 1441 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1442 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1443 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1444 1445 ! --- evaporation over ocean (used later for qemp) --- ! 1446 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1447 1448 ! --- evaporation over ice (kg/m2/s) --- ! 1433 1449 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1434 1450 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 … … 1436 1452 zdevap_ice(:,:) = 0._wp 1437 1453 1438 ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- ! 1439 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw) 1440 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw) 1441 1442 ! Sublimation over sea-ice (cell average) 1443 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) 1444 ! runoffs and calving (put in emp_tot) 1454 ! --- runoffs (included in emp later on) --- ! 1445 1455 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1456 1457 ! --- calving (put in emp_tot and emp_oce) --- ! 1446 1458 IF( srcv(jpr_cal)%laction ) THEN 1447 1459 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1460 zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1) 1448 1461 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1449 1462 ENDIF … … 1471 1484 ENDIF 1472 1485 1473 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1474 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) ) ! Snow over ice-free ocean (cell average) 1475 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw ) ! Snow over sea-ice (cell average) 1486 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1487 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1488 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1489 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1476 1490 #else 1477 ! Sublimation over sea-ice (cell average)1478 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )1479 1491 ! runoffs and calving (put in emp_tot) 1480 1492 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) … … 1496 1508 ENDIF 1497 1509 1498 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1499 IF( iom_use('snow_ao_cea') ) & 1500 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1501 IF( iom_use('snow_ai_cea') ) & 1502 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1510 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1511 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1512 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1513 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1503 1514 #endif 1504 1515 … … 1506 1517 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1507 1518 ! ! ========================= ! 1508 CASE( 'oce only' ) 1509 zqns_tot(:,: 1510 CASE( 'conservative' ) 1511 zqns_tot(:,: 1519 CASE( 'oce only' ) ! the required field is directly provided 1520 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1521 CASE( 'conservative' ) ! the required fields are directly provided 1522 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1512 1523 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1513 1524 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1514 1525 ELSE 1515 ! Set all category values equal for the moment1516 1526 DO jl=1,jpl 1517 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1527 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal 1518 1528 ENDDO 1519 1529 ENDIF 1520 CASE( 'oce and ice' ) 1521 zqns_tot(:,: 1530 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1531 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1522 1532 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1523 1533 DO jl=1,jpl … … 1526 1536 ENDDO 1527 1537 ELSE 1528 qns_tot(:,: 1538 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1529 1539 DO jl=1,jpl 1530 1540 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) … … 1532 1542 ENDDO 1533 1543 ENDIF 1534 CASE( 'mixed oce-ice' ) 1544 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1535 1545 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1536 1546 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1537 1547 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1538 1548 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1539 & + pist(:,:,1)* zicefr(:,:) ) )1549 & + pist(:,:,1) * zicefr(:,:) ) ) 1540 1550 END SELECT 1541 1551 !!gm … … 1547 1557 !! similar job should be done for snow and precipitation temperature 1548 1558 ! 1549 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1550 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1551 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1552 IF( iom_use('hflx_cal_cea') ) & 1553 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1554 ENDIF 1555 1556 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1557 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1559 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1560 zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1561 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 1562 IF( iom_use('hflx_cal_cea') ) CALL iom_put( 'hflx_cal_cea', - frcv(jpr_cal)%z3(:,:,1) * lfus ) ! heat flux from calving 1563 ENDIF 1558 1564 1559 1565 #if defined key_lim3 1560 ! --- evaporation --- !1561 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean1562 1563 1566 ! --- non solar flux over ocean --- ! 1564 1567 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1567 1570 1568 1571 ! --- heat flux associated with emp (W/m2) --- ! 1569 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) &! evap1570 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip1571 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean1572 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn(:,:) & ! evap 1573 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1574 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean + snow melting 1572 1575 ! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1573 1576 ! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1574 1577 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 1575 ! qevap_ice=0 since we consider Tice=0 °C1578 ! qevap_ice=0 since we consider Tice=0degC 1576 1579 1577 ! --- heat content ofprecip over ice in J/m3 (to be used in 1D-thermo) --- !1580 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1578 1581 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1579 1582 1580 1583 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1581 1584 DO jl = 1, jpl 1582 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0 °C1585 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0degC 1583 1586 END DO 1584 1587 … … 1606 1609 qemp_ice (:,: ) = zqemp_ice (:,: ) 1607 1610 ENDIF 1611 1612 ! some more outputs 1613 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1614 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) ) ! heat flux from rain (cell average) 1615 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * ( zcptn(:,:) - Lfus ) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (cell average) 1616 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea',sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) ) ! heat flux from snow (cell average) 1617 1608 1618 #else 1609 1619 ! clem: this formulation is certainly wrong... but better than it was... … … 1611 1621 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1612 1622 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1613 & - zemp_ice(:,:) * zicefr(:,:)) * zcptn(:,:)1623 & - zemp_ice(:,:) ) * zcptn(:,:) 1614 1624 1615 1625 IF( ln_mixcpl ) THEN … … 1731 1741 1732 1742 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1733 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice )1743 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1734 1744 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1735 1745 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r6399 r7483 229 229 CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes 230 230 ! 231 IF(ln_limdiaout) CALL lim_diahsb 231 IF(ln_limdiaout) CALL lim_diahsb( kt ) ! Diagnostics and outputs 232 232 ! 233 233 CALL lim_wri( 1 ) ! Ice outputs … … 310 310 numit = nit000 - 1 311 311 ENDIF 312 CALL lim_var_agg( 1)312 CALL lim_var_agg(2) 313 313 CALL lim_var_glo2eqv 314 314 ! 315 315 CALL lim_sbc_init ! ice surface boundary condition 316 ! 317 IF( ln_limdiaout) CALL lim_diahsb_init ! initialization for diags 316 318 ! 317 319 fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r6204 r7483 173 173 DO jj = 2, jpjm1 174 174 DO ji = fs_2, fs_jpim1 ! vector opt. 175 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )176 175 ! total intermediate advective trends 177 ztra = - zbtr *( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &178 & 179 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1))176 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 177 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 178 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / e1e2t(ji,jj) 180 179 ! update and guess with monotonic sheme 181 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra* tmask(ji,jj,jk)182 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra) * tmask(ji,jj,jk)180 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) 181 zwi(ji,jj,jk) = ( fse3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + z2dtt * ztra ) / fse3t_a(ji,jj,jk) * tmask(ji,jj,jk) 183 182 END DO 184 183 END DO … … 410 409 DO jj = 2, jpjm1 411 410 DO ji = fs_2, fs_jpim1 ! vector opt. 412 zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )413 411 ! total intermediate advective trends 414 ztra = - zbtr *( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &415 & 416 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1))412 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 413 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 414 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / e1e2t(ji,jj) 417 415 ! update and guess with monotonic sheme 418 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra419 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra) * tmask(ji,jj,jk)416 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) 417 zwi(ji,jj,jk) = ( fse3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + z2dtt * ztra ) / fse3t_a(ji,jj,jk) * tmask(ji,jj,jk) 420 418 END DO 421 419 END DO … … 438 436 ! -------------------------------------------------- 439 437 ! antidiffusive flux on i and j 440 441 442 DO jk = 1, jpkm1 443 438 ! 439 DO jk = 1, jpkm1 440 ! 444 441 DO jj = 1, jpjm1 445 442 DO ji = 1, fs_jpim1 ! vector opt. … … 472 469 ! 473 470 ztrs(:,:,:,1) = ptb(:,:,:,jn) 471 ztrs(:,:,1,2) = ptb(:,:,1,jn) 472 ztrs(:,:,1,3) = ptb(:,:,1,jn) 474 473 zwzts(:,:,:) = 0._wp 475 474 … … 572 571 END SUBROUTINE tra_adv_tvd_zts 573 572 573 574 574 SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 575 575 !!--------------------------------------------------------------------- -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r6471 r7483 158 158 ELSE ! No restart or restart not found: Euler forward time stepping 159 159 zfact = 1._wp 160 sbc_tsc(:,:,:) = 0._wp 160 161 sbc_tsc_b(:,:,:) = 0._wp 161 162 ENDIF -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r4624 r7483 162 162 & + avmv(ji,jj,jk) + avmv(ji,jj-1,jk) ) & 163 163 & + avtb(jk) * tmask(ji,jj,jk) 164 ! ! Add the background coefficient on eddy viscosity 164 END DO 165 END DO 166 DO jj = 2, jpjm1 ! Add the background coefficient on eddy viscosity 167 DO ji = 2, jpim1 165 168 avmu(ji,jj,jk) = avmu(ji,jj,jk) + avmb(jk) * umask(ji,jj,jk) 166 169 avmv(ji,jj,jk) = avmv(ji,jj,jk) + avmb(jk) * vmask(ji,jj,jk) -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/step.F90
r6405 r7483 337 337 IF( lk_vvl ) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors 338 338 ! 339 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics 340 339 341 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 340 342 IF( ln_sto_eos ) CALL sto_rst_write( kstp ) ! write restart file for stochastic parameters … … 351 353 ENDIF 352 354 #endif 353 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics 354 IF( lk_diaobs ) CALL dia_obs( kstp ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 355 IF( lk_diaobs ) CALL dia_obs( kstp ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 355 356 356 357 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r6530 r7483 31 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sio3eq ! chemistry of Si 32 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fekeq ! chemistry of Fe 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ):: chemc ! Solubilities of O2 and CO233 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemc ! Solubilities of O2 and CO2 34 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemo2 ! Solubilities of O2 and CO2 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tempis ! In situ temperature 35 36 36 37 REAL(wp), PUBLIC :: atcox = 0.20946 ! units atm … … 39 40 REAL(wp) :: o2atm = 1. / ( 1000. * 0.20946 ) 40 41 41 REAL(wp) :: akcc1 = -171.9065 ! coeff. for apparent solubility equilibrium 42 REAL(wp) :: akcc2 = -0.077993 ! Millero et al. 1995 from Mucci 1983 43 REAL(wp) :: akcc3 = 2839.319 44 REAL(wp) :: akcc4 = 71.595 45 REAL(wp) :: akcc5 = -0.77712 46 REAL(wp) :: akcc6 = 0.00284263 47 REAL(wp) :: akcc7 = 178.34 48 REAL(wp) :: akcc8 = -0.07711 49 REAL(wp) :: akcc9 = 0.0041249 50 51 REAL(wp) :: rgas = 83.143 ! universal gas constants 42 REAL(wp) :: rgas = 83.14472 ! universal gas constants 52 43 REAL(wp) :: oxyco = 1. / 22.4144 ! converts from liters of an ideal gas to moles 53 44 54 45 REAL(wp) :: bor1 = 0.00023 ! borat constants 55 46 REAL(wp) :: bor2 = 1. / 10.82 56 57 REAL(wp) :: ca0 = -162.8301 ! WEISS & PRICE 1980, units mol/(kg atm)58 REAL(wp) :: ca1 = 218.296859 REAL(wp) :: ca2 = 90.924160 REAL(wp) :: ca3 = -1.4769661 REAL(wp) :: ca4 = 0.02569562 REAL(wp) :: ca5 = -0.02522563 REAL(wp) :: ca6 = 0.004986764 65 REAL(wp) :: c10 = -3670.7 ! Coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)66 REAL(wp) :: c11 = 62.00867 REAL(wp) :: c12 = -9.794468 REAL(wp) :: c13 = 0.011869 REAL(wp) :: c14 = -0.00011670 71 REAL(wp) :: c20 = -1394.7 ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)72 REAL(wp) :: c21 = -4.77773 REAL(wp) :: c22 = 0.018474 REAL(wp) :: c23 = -0.00011875 47 76 48 REAL(wp) :: st1 = 0.14 ! constants for calculate concentrations for sulfate … … 190 162 REAL(wp) :: ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5 191 163 REAL(wp) :: zpres, ztc , zcl , zcpexp, zoxy , zcpexp2 192 REAL(wp) :: zsqrt, ztr , zlogt , zcek1 193 REAL(wp) :: zis , zis2 , zsal15, zisqrt 164 REAL(wp) :: zsqrt, ztr , zlogt , zcek1, zc1, zplat 165 REAL(wp) :: zis , zis2 , zsal15, zisqrt, za1 , za2 194 166 REAL(wp) :: zckb , zck1 , zck2 , zckw , zak1 , zak2 , zakb , zaksp0, zakw 195 167 REAL(wp) :: zst , zft , zcks , zckf , zaksp1 … … 202 174 IF( nn_timing == 1 ) CALL timing_start('p4z_che') 203 175 ! 176 ! Computations of chemical constants require in situ temperature 177 ! Here a quite simple formulation is used to convert 178 ! potential temperature to in situ temperature. The errors is less than 179 ! 0.04°C relative to an exact computation 180 ! --------------------------------------------------------------------- 181 DO jk = 1, jpk 182 DO jj = 1, jpj 183 DO ji = 1, jpi 184 zpres = fsdept(ji,jj,jk) / 1000. 185 za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (tsn(ji,jj,jk,jp_sal) - 35.0) ) 186 za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 ) 187 tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2 188 END DO 189 END DO 190 END DO 191 ! 204 192 ! CHEMICAL CONSTANTS - SURFACE LAYER 205 193 ! ---------------------------------- … … 209 197 DO ji = 1, jpi 210 198 ! ! SET ABSOLUTE TEMPERATURE 211 ztkel = t sn(ji,jj,1,jp_tem) + 273.15199 ztkel = tempis(ji,jj,1) + 273.15 212 200 zt = ztkel * 0.01 213 201 zt2 = zt * zt … … 217 205 ! ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 218 206 ! ! AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 219 zcek1 = ca0 + ca1 / zt + ca2 * zlogt + ca3 * zt2 + zsal * ( ca4 + ca5 * zt + ca6 * zt2 ) 207 zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel & 208 & + 0.0047036e-4*ztkel**2) 220 209 ! ! SET SOLUBILITIES OF O2 AND CO2 221 chemc(ji,jj) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. ! mol/(L uatm) 210 chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. ! mol/(kg uatm) 211 chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3 212 chemc(ji,jj,3) = 57.7 - 0.118*ztkel 222 213 ! 223 214 END DO … … 232 223 !CDIR NOVERRCHK 233 224 DO ji = 1, jpi 234 ztkel = t sn(ji,jj,jk,jp_tem) + 273.15225 ztkel = tempis(ji,jj,jk) + 273.15 235 226 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.- tmask(ji,jj,jk) ) * 35. 236 227 zsal2 = zsal * zsal 237 ztgg = LOG( ( 298.15 - t sn(ji,jj,jk,jp_tem) ) / ztkel ) ! Set the GORDON & GARCIA scaled temperature228 ztgg = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel ) ! Set the GORDON & GARCIA scaled temperature 238 229 ztgg2 = ztgg * ztgg 239 230 ztgg3 = ztgg2 * ztgg … … 306 297 DO ji = 1, jpi 307 298 308 ! SET PRESSION 309 zpres = 1.025e-1 * fsdept(ji,jj,jk) 299 ! SET PRESSION ACCORDING TO SAUNDER (1980) 300 zplat = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 301 zc1 = 5.92E-3 + zplat**2 * 5.25E-3 302 zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*fsdept(ji,jj,jk)))) / 4.42E-6 303 zpres = zpres / 10.0 310 304 311 305 ! SET ABSOLUTE TEMPERATURE 312 ztkel = t sn(ji,jj,jk,jp_tem) + 273.15306 ztkel = tempis(ji,jj,jk) + 273.15 313 307 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35. 314 308 zsqrt = SQRT( zsal ) … … 319 313 zis2 = zis * zis 320 314 zisqrt = SQRT( zis ) 321 ztc = t sn(ji,jj,jk,jp_tem) + ( 1.- tmask(ji,jj,jk) ) * 20.315 ztc = tempis(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20. 322 316 323 317 ! CHLORINITY (WOOSTER ET AL., 1969) … … 352 346 353 347 354 zck1 = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal * zsal 355 zck2 = c20 * ztr + c21 + c22 * zsal + c23 * zsal**2 348 ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO 349 ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale 350 zck1 = -1.0*(3633.86*ztr - 61.2172 + 9.6777*zlogt & 351 - 0.011555*zsal + 0.0001152*zsal*zsal) 352 zck2 = -1.0*(471.78*ztr + 25.9290 - 3.16967*zlogt & 353 - 0.01781*zsal + 0.0001122*zsal*zsal) 356 354 357 355 ! PKW (H2O) (DICKSON AND RILEY, 1979) … … 362 360 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 363 361 ! (S=27-43, T=2-25 DEG C) at pres =0 (atmos. pressure) (MUCCI 1983) 364 zaksp0 = akcc1 + akcc2 * ztkel + akcc3 * ztr + akcc4 * LOG10( ztkel ) & 365 & + ( akcc5 + akcc6 * ztkel + akcc7 * ztr ) * zsqrt + akcc8 * zsal + akcc9 * zsal15 362 zaksp0 = -171.9065 -0.077993*ztkel + 2839.319*ztr + 71.595*LOG10( ztkel ) & 363 & + (-0.77712 + 0.00284263*ztkel + 178.34*ztr) * zsqrt & 364 & - 0.07711*zsal + 0.0041249*zsal15 366 365 367 366 ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) … … 436 435 437 436 ierr(:) = 0 438 ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj), chemo2(jpi,jpj,jpk), STAT= ierr(1) ) 437 ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), & 438 & tempis(jpi,jpj,jpk), STAT= ierr(1) ) 439 ! 439 440 IF (lk_gas) ALLOCATE ( chemcos(jpi,jpj,3), k_hydr(jpi,jpj,jpk), chemn2o(jpi,jpj), STAT= ierr(2) ) 440 441 ! 441 442 p4z_che_alloc = MAXVAL( ierr ) 442 443 !444 443 IF( p4z_che_alloc /= 0 ) CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') 445 444 ! -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r6532 r7483 90 90 REAL(wp) :: ztc, ztc2, ztc3, ztc4, zws, zkgwan 91 91 REAL(wp) :: zfld, zflu, zfld16, zflu16, zfact 92 REAL(wp) :: zvapsw, zsal, zfco2, zxc2, xCO2approx, ztkel, zfugcoeff 92 93 REAL(wp) :: zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 93 94 REAL(wp) :: zyr_dec, zdco2dt 94 95 CHARACTER (len=25) :: charout 95 REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx, zw2d 96 REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx, zw2d, zpco2atm 96 97 REAL(wp) :: zsch_dms, zfludms,zflddms 97 98 REAL(wp) :: zfldco, zfluco, zsch_co, zkin_vis, zD … … 108 109 IF( nn_timing == 1 ) CALL timing_start('p4z_flx') 109 110 ! 110 CALL wrk_alloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx )111 CALL wrk_alloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx, zpco2atm ) 111 112 IF( lk_gas ) THEN 112 113 CALL wrk_alloc( jpi, jpj, zkgco, zcoflx, zkgisp, zispflx ) … … 235 236 DO jj = 1, jpj 236 237 DO ji = 1, jpi 238 ztkel = tsn(ji,jj,1,jp_tem) + 273.15 239 zsal = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 240 zvapsw = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 241 zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 242 zxc2 = (1.0 - zpco2atm(ji,jj) * 1E-6 )**2 243 zfugcoeff = EXP(patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) ) & 244 & / (82.05736 * ztkel)) 245 zfco2 = zpco2atm(ji,jj) * zfugcoeff 246 237 247 ! Compute CO2 flux for the sea and air 238 zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj) * zkgco2(ji,jj)! (mol/L) * (m/s)239 zflu = zh2co3(ji,jj) * tmask(ji,jj,1) *zkgco2(ji,jj) ! (mol/L) (m/s) ?248 zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj) ! (mol/L) * (m/s) 249 zflu = zh2co3(ji,jj) * zkgco2(ji,jj) ! (mol/L) (m/s) ? 240 250 oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 241 251 ! compute the trend 242 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / fse3t(ji,jj,1) 252 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / fse3t(ji,jj,1) * tmask(ji,jj,1) 243 253 244 254 ! Compute O2 flux 245 zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * tmask(ji,jj,1) *zkgo2(ji,jj) ! (mol/L) * (m/s)246 zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) *zkgo2(ji,jj)247 zoflx(ji,jj) = zfld16 - zflu16255 zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj) ! (mol/L) * (m/s) 256 zflu16 = trb(ji,jj,1,jpoxy) * zkgo2(ji,jj) 257 zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 248 258 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / fse3t(ji,jj,1) 249 259 END DO … … 313 323 ENDIF 314 324 IF( iom_use( "Dpco2" ) ) THEN 315 zw2d(:,:) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:) + rtrn ) ) * tmask(:,:,1)325 zw2d(:,:) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 316 326 CALL iom_put( "Dpco2" , zw2d ) 317 327 ENDIF … … 356 366 trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1) 357 367 trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1) 358 trc2d(:,:,jp_pcs0_2d + 3) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:) + rtrn ) ) * tmask(:,:,1)359 ENDIF 360 ENDIF 361 ! 362 CALL wrk_dealloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx )368 trc2d(:,:,jp_pcs0_2d + 3) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 369 ENDIF 370 ENDIF 371 ! 372 CALL wrk_dealloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx, zpco2atm ) 363 373 ! 364 374 IF( nn_timing == 1 ) CALL timing_stop('p4z_flx') -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r6530 r7483 44 44 REAL(wp), PUBLIC :: xkdoc !: 2nd half-sat. of DOC remineralization 45 45 REAL(wp), PUBLIC :: concbfe !: Fe half saturation for bacteria 46 REAL(wp), PUBLIC :: oxymin !: half saturation constant for anoxia 46 47 REAL(wp), PUBLIC :: qnfelim !: optimal Fe quota for nanophyto 47 48 REAL(wp), PUBLIC :: qdfelim !: optimal Fe quota for diatoms … … 138 139 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 139 140 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 ) 140 zlim3 = trb(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) )141 zlim3 = biron(ji,jj,jk) / ( concbfe + biron(ji,jj,jk) ) 141 142 zlim4 = trb(ji,jj,jk,jpdoc) / ( xkdoc + trb(ji,jj,jk,jpdoc) ) 142 143 xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) … … 259 260 ENDIF 260 261 ! 262 DO jk = 1, jpkm1 263 DO jj = 1, jpj 264 DO ji = 1, jpi 265 ! denitrification factor computed from O2 levels 266 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - trb(ji,jj,jk,jpoxy) ) & 267 & / ( oxymin + trb(ji,jj,jk,jpoxy) ) ) 268 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 269 END DO 270 END DO 271 END DO 272 ! 261 273 IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics 262 274 IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) ) ! euphotic layer deptht … … 291 303 & xkdocdms, xknpo4, xkdpo4, & 292 304 #endif 293 & xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r 305 & xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r, oxymin 294 306 295 307 INTEGER :: ios ! Local integer output status for namelist read … … 325 337 WRITE(numout,*) ' Minimum size criteria for nanophyto xsizephy = ', xsizephy 326 338 WRITE(numout,*) ' Fe half saturation for bacteria concbfe = ', concbfe 339 WRITE(numout,*) ' halk saturation constant for anoxia oxymin =' , oxymin 327 340 WRITE(numout,*) ' optimal Fe quota for nano. qnfelim = ', qnfelim 328 341 WRITE(numout,*) ' Optimal Fe quota for diatoms qdfelim = ', qdfelim … … 341 354 ENDIF 342 355 ENDIF 343 356 ! 357 nitrfac (:,:,:) = 0._wp 358 ! 344 359 END SUBROUTINE p4z_lim_init 345 360 -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r6287 r7483 65 65 REAL(wp) :: zomegaca, zexcess, zexcess0 66 66 CHARACTER (len=25) :: charout 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zc aldiss67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zco3sat, zcaldiss 68 68 !!--------------------------------------------------------------------- 69 69 ! 70 70 IF( nn_timing == 1 ) CALL timing_start('p4z_lys') 71 71 ! 72 CALL wrk_alloc( jpi, jpj, jpk, zco3, zc aldiss )72 CALL wrk_alloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss ) 73 73 ! 74 74 zco3 (:,:,:) = 0. … … 120 120 zcalcon = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp ) 121 121 zfact = rhop(ji,jj,jk) / 1000._wp 122 zomegaca = ( zcalcon * zco3(ji,jj,jk) * zfact ) / aksp(ji,jj,jk) 122 zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn ) 123 zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zfact / ( zcalcon + rtrn ) 123 124 124 125 ! SET DEGREE OF UNDER-/SUPERSATURATION … … 149 150 IF( lk_iomput .AND. knt == nrdttrc ) THEN 150 151 IF( iom_use( "PH" ) ) CALL iom_put( "PH" , -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) ) 151 IF( iom_use( "CO3" ) ) CALL iom_put( "CO3" , zco3(:,:,:) * 1.e+3* tmask(:,:,:) )152 IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", aksp(:,:,:) * 1.e+3 / calcon* tmask(:,:,:) )153 IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r 152 IF( iom_use( "CO3" ) ) CALL iom_put( "CO3" , zco3(:,:,:) * 1.e+3 * tmask(:,:,:) ) 153 IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", zco3sat(:,:,:) * 1.e+3 * tmask(:,:,:) ) 154 IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 154 155 ELSE 155 156 IF( ln_diatrc ) THEN 156 157 trc3d(:,:,:,jp_pcs0_3d ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 157 158 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:) 158 trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon* tmask(:,:,:)159 trc3d(:,:,:,jp_pcs0_3d + 2) = zco3sat(:,:,:) * tmask(:,:,:) 159 160 ENDIF 160 161 ENDIF … … 166 167 ENDIF 167 168 ! 168 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zc aldiss )169 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss ) 169 170 ! 170 171 IF( nn_timing == 1 ) CALL timing_stop('p4z_lys') -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r6532 r7483 83 83 REAL(wp) :: zchl 84 84 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 85 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100 85 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 86 REAL(wp), POINTER, DIMENSION(:,: ) :: zqsr100, zqsr_corr 86 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 87 88 REAL(wp) :: za300, za400, za440, zpera440 … … 91 92 ! 92 93 ! Allocate temporary workspace 93 CALL wrk_alloc( jpi, jpj, zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 94 CALL wrk_alloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 95 CALL wrk_alloc( jpi, jpj, zqsr100, zqsr_corr ) 94 96 CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 95 97 … … 150 152 ! ! -------------------------------------- 151 153 IF( l_trcdm2dc ) THEN ! diurnal cycle 152 ! 1% of qsr to compute euphotic layer153 zqsr 100(:,:) = 0.01 * qsr_mean(:,:) ! daily mean qsr154 ! 155 CALL p4z_opt_par( kt, qsr_mean, ze1, ze2, ze3)154 ! 155 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn ) 156 ! 157 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 156 158 ! 157 159 DO jk = 1, nksrp … … 161 163 END DO 162 164 ! 163 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 ) 165 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 166 ! 167 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) 164 168 ! 165 169 DO jk = 1, nksrp … … 168 172 ! 169 173 ELSE 170 ! 1% of qsr to compute euphotic layer171 zqsr 100(:,:) = 0.01 * qsr(:,:)172 ! 173 CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3)174 ! 175 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 176 ! 177 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 174 178 ! 175 179 DO jk = 1, nksrp … … 216 220 DO jj = 1, jpj 217 221 DO ji = 1, jpi 218 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.43 *zqsr100(ji,jj) ) THEN222 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 219 223 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 220 224 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint … … 285 289 ENDIF 286 290 ! 287 CALL wrk_dealloc( jpi, jpj, zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 291 CALL wrk_dealloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 292 CALL wrk_dealloc( jpi, jpj, zqsr100, zqsr_corr ) 288 293 CALL wrk_dealloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 289 294 ! … … 292 297 END SUBROUTINE p4z_opt 293 298 294 SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 )299 SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pqsr100 ) 295 300 !!---------------------------------------------------------------------- 296 301 !! *** routine p4z_opt_par *** … … 301 306 !!---------------------------------------------------------------------- 302 307 !! * arguments 303 INTEGER, INTENT(in) :: kt ! ocean time-step 304 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: pqsr ! shortwave 305 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 306 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 308 INTEGER, INTENT(in) :: kt ! ocean time-step 309 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: pqsr ! shortwave 310 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 311 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 312 REAL(wp), DIMENSION(jpi,jpj) , INTENT(out) , OPTIONAL :: pqsr100 307 313 !! * local variables 308 314 INTEGER :: ji, jj, jk ! dummy loop indices … … 314 320 ELSE ; zqsr(:,:) = xparsw * pqsr(:,:) 315 321 ENDIF 322 323 ! Light at the euphotic depth 324 IF( PRESENT( pqsr100 ) ) pqsr100(:,:) = 0.01 * 3. * zqsr(:,:) 316 325 ! 317 326 IF( PRESENT( pe0 ) ) THEN ! W-level -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r6530 r7483 217 217 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 218 218 ! 219 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) ) 220 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) 221 222 zpislopen = zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) & 223 & / ( trb(ji,jj,jk,jpphy) * 12. + rtrn ) & 224 & / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 225 226 zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) & 227 & / ( trb(ji,jj,jk,jpdia) * 12. + rtrn ) & 228 & / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 219 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -znanotot ) ) & 220 & * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 221 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn ) & 222 & * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 229 223 230 224 ! Computation of production function for Carbon 231 225 ! --------------------------------------------- 226 zpislopen = zpislopead(ji,jj,jk) / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 227 zpislope2n = zpislopead2(ji,jj,jk) / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 232 228 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 233 229 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) … … 235 231 ! Computation of production function for Chlorophyll 236 232 !-------------------------------------------------- 237 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk)) )238 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk)) )233 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 234 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 239 235 ENDIF 240 236 END DO … … 242 238 END DO 243 239 ENDIF 244 245 240 246 241 ! Computation of a proxy of the N/C ratio 247 242 ! --------------------------------------- … … 293 288 zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 294 289 zmxlday = zmxltst * zmxltst * r1_rday 295 zmixnano(ji,jj) = 1. - zmxlday / ( 2. + zmxlday )296 zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday )290 zmixnano(ji,jj) = 1. - zmxlday / ( 1. + zmxlday ) 291 zmixdiat(ji,jj) = 1. - zmxlday / ( 2. + zmxlday ) 297 292 END DO 298 293 END DO 299 294 300 ! Mixed-layer effect on production 295 ! Mixed-layer effect on production 296 ! Sea-ice effect on production 297 301 298 DO jk = 1, jpkm1 302 299 DO jj = 1, jpj … … 306 303 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) 307 304 ENDIF 305 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 306 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 308 307 END DO 309 308 END DO … … 345 344 END DO 346 345 347 IF( ln_newprod ) THEN 348 !CDIR NOVERRCHK 349 DO jk = 1, jpkm1 350 !CDIR NOVERRCHK 351 DO jj = 1, jpj 352 !CDIR NOVERRCHK 353 DO ji = 1, jpi 354 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 355 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 356 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 357 ENDIF 358 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 359 ! production terms for nanophyto. ( chlorophyll ) 360 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 361 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 362 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 363 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 12. * zprod / & 364 & ( zpislopead(ji,jj,jk) * znanotot +rtrn) 365 ! production terms for diatomees ( chlorophyll ) 366 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 367 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 368 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 369 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / & 370 & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 371 ENDIF 372 END DO 373 END DO 374 END DO 375 ELSE 376 !CDIR NOVERRCHK 377 DO jk = 1, jpkm1 378 !CDIR NOVERRCHK 379 DO jj = 1, jpj 380 !CDIR NOVERRCHK 381 DO ji = 1, jpi 382 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 383 ! production terms for nanophyto. ( chlorophyll ) 384 znanotot = enano(ji,jj,jk) 385 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trb(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk) 386 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 387 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 144. * zprod & 388 & / ( zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) * znanotot +rtrn ) 389 ! production terms for diatomees ( chlorophyll ) 390 zdiattot = ediat(ji,jj,jk) 391 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trb(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk) 392 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 393 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 144. * zprod & 394 & / ( zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) * zdiattot +rtrn ) 395 ENDIF 396 END DO 397 END DO 398 END DO 399 ENDIF 346 !CDIR NOVERRCHK 347 DO jk = 1, jpkm1 348 !CDIR NOVERRCHK 349 DO jj = 1, jpj 350 !CDIR NOVERRCHK 351 DO ji = 1, jpi 352 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 353 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 354 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 355 ENDIF 356 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 357 ! production terms for nanophyto. ( chlorophyll ) 358 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 359 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 360 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 361 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 12. * zprod / & 362 & ( zpislopead(ji,jj,jk) * znanotot +rtrn) 363 ! production terms for diatomees ( chlorophyll ) 364 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 365 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 366 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 367 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / & 368 & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 369 ENDIF 370 END DO 371 END DO 372 END DO 400 373 401 374 ! Update the arrays TRA which contain the biological sources and sinks -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r7070 r7483 44 44 REAL(wp), PUBLIC :: xsiremlab !: fast remineralisation rate of POC 45 45 REAL(wp), PUBLIC :: xsilab !: fraction of labile biogenic silica 46 REAL(wp), PUBLIC :: oxymin !: halk saturation constant for anoxia47 46 #if defined key_gas 48 47 REAL(wp), PUBLIC :: xlightdms !: photodegradation rate constant of DMS … … 137 136 zdepprod(ji,jj,jk) = zdepmin**0.273 138 137 ENDIF 139 END DO140 END DO141 END DO142 143 DO jk = 1, jpkm1144 DO jj = 1, jpj145 DO ji = 1, jpi146 ! denitrification factor computed from O2 levels147 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - trb(ji,jj,jk,jpoxy) ) &148 & / ( oxymin + trb(ji,jj,jk,jpoxy) ) )149 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )150 138 END DO 151 139 END DO … … 513 501 !! 514 502 !!---------------------------------------------------------------------- 515 NAMELIST/nampisrem/ xremik, xremip, nitrif,xsirem, xsiremlab, xsilab, &503 NAMELIST/nampisrem/ xremik, xremip, xsirem, xsiremlab, xsilab, & 516 504 #if defined key_gas 517 505 & xlightdms, xsinkdms, xvsinkdms, xprodco, xsinkco, xsinkisp, & 518 506 #endif 519 & oxymin507 & nitrif 520 508 INTEGER :: ios ! Local integer output status for namelist read 521 509 … … 539 527 WRITE(numout,*) ' fraction of labile biogenic silica xsilab =', xsilab 540 528 WRITE(numout,*) ' NH4 nitrification rate nitrif =', nitrif 541 WRITE(numout,*) ' halk saturation constant for anoxia oxymin =', oxymin542 529 #if defined key_gas 543 530 WRITE(numout,*) ' photodegradation rate constant of DMS xlightdms =', xlightdms … … 550 537 ENDIF 551 538 ! 552 nitrfac (:,:,:) = 0._wp553 539 denitr (:,:,:) = 0._wp 554 540 denitnh4(:,:,:) = 0._wp -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r6204 r7483 159 159 IF( ln_ndepo ) THEN 160 160 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 161 CALL fld_read( kt, 1, sf_ndepo ) 162 DO jj = 1, jpj 163 DO ji = 1, jpi 164 nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn ) 165 END DO 166 END DO 161 zcoef = rno3 * 14E6 * ryyss 162 CALL fld_read( kt, 1, sf_ndepo ) 163 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / fse3t(:,:,1) 164 ENDIF 165 IF( lk_vvl ) THEN 166 zcoef = rno3 * 14E6 * ryyss 167 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / fse3t(:,:,1) 167 168 ENDIF 168 169 ENDIF … … 266 267 IF( lk_offline ) THEN 267 268 nk_rnf(:,:) = 1 268 h_rnf (:,:) = fsdept(:,:,1)269 h_rnf (:,:) = e3t_0(:,:,1) 269 270 ENDIF 270 271 … … 455 456 DO jj = 1, jpj 456 457 DO ji = 1, jpi 457 zexpide = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )458 zexpide = MIN( 8.,( gdept_0(ji,jj,jk) / 500. )**(-1.5) ) 458 459 zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 459 460 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) … … 465 466 ironsed(:,:,jpk) = 0._wp 466 467 DO jk = 1, jpkm1 467 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday )468 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday ) 468 469 END DO 469 470 DEALLOCATE( zcmask) … … 483 484 CALL iom_close( numhydro ) 484 485 ! 485 hydrofe(:,:,:) = ( hydrofe(:,:,:) * hratio ) / ( cvol(:,:,:) * ryyss + rtrn ) / 1000._wp 486 DO jk = 1, jpk 487 hydrofe(:,:,jk) = ( hydrofe(:,:,jk) * hratio ) / ( e1e2t(:,:) * e3t_0(:,:,jk) * ryyss + rtrn ) / 1000._wp 488 ENDDO 486 489 ! 487 490 ENDIF -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r6308 r7483 35 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: restotr ! restoring coeff. on tracers (s-1) 36 36 37 INTEGER, PARAMETER :: npncts = 5! number of closed sea37 INTEGER, PARAMETER :: npncts = 8 ! number of closed sea 38 38 INTEGER, DIMENSION(npncts) :: nctsi1, nctsj1 ! south-west closed sea limits (i,j) 39 39 INTEGER, DIMENSION(npncts) :: nctsi2, nctsj2 ! north-east closed sea limits (i,j) … … 107 107 108 108 jl = n_trc_index(jn) 109 CALL trc_dta( kt, sf_trcdta(jl) ) ! read tracer data at nit000 110 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl) 109 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 111 110 112 111 SELECT CASE ( nn_zdmp_tr ) … … 187 186 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 188 187 INTEGER :: isrow ! local index 188 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 189 189 190 190 !!---------------------------------------------------------------------- … … 207 207 ! 208 208 ! Caspian Sea 209 nctsi1(1) = 332 ; nctsj1(1) = 243 - isrow 210 nctsi2(1) = 344 ; nctsj2(1) = 275 - isrow 209 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow 210 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 211 ! ! Lake Superior 212 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow 213 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 214 ! ! Lake Michigan 215 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow 216 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 217 ! ! Lake Huron 218 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow 219 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 220 ! ! Lake Erie 221 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow 222 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 223 ! ! Lake Ontario 224 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow 225 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 226 ! ! Victoria Lake 227 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow 228 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 229 ! ! Baltic Sea 230 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow 231 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 211 232 ! 212 233 ! ! ======================= … … 277 298 IF(lwp) WRITE(numout,*) 278 299 ! 300 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 301 ! 279 302 DO jn = 1, jptra 280 303 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 281 304 jl = n_trc_index(jn) 282 CALL trc_dta( kt, sf_trcdta(jl) ) ! read tracer data at nit000305 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 283 306 DO jc = 1, npncts 284 307 DO jk = 1, jpkm1 285 308 DO jj = nctsj1(jc), nctsj2(jc) 286 309 DO ji = nctsi1(jc), nctsi2(jc) 287 trn(ji,jj,jk,jn) = sf_trcdta(jl)%fnow(ji,jj,jk) * tmask(ji,jj,jk) * rf_trfac(jl)310 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) 288 311 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 289 312 ENDDO … … 293 316 ENDIF 294 317 ENDDO 295 !318 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 296 319 ENDIF 297 320 ! … … 313 336 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init') 314 337 ! 338 !Allocate arrays 339 IF( trc_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_dmp_init: unable to allocate arrays' ) 315 340 316 341 IF( lzoom ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r6308 r7483 102 102 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 103 103 104 IF( ln_rsttr .AND. & ! Restart: read in restart file104 IF( ln_rsttr .AND. .NOT.ln_top_euler .AND. & ! Restart: read in restart file 105 105 iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 106 106 IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' … … 190 190 ! Write in the tracer restar file 191 191 ! ******************************* 192 IF( lrst_trc ) THEN192 IF( lrst_trc .AND. .NOT.ln_top_euler ) THEN 193 193 IF(lwp) WRITE(numout,*) 194 194 IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ', & -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r6308 r7483 68 68 IF( ln_trcdmp ) CALL trc_dmp( kstp ) ! internal damping trends 69 69 CALL trc_adv( kstp ) ! horizontal & vertical advection 70 IF( ln_zps ) THEN 71 IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kstp, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! both top & bottom 72 ELSE ; CALL zps_hde ( kstp, jptra, trb, gtru, gtrv ) ! only bottom 73 ENDIF 74 ENDIF 70 75 CALL trc_ldf( kstp ) ! lateral mixing 71 76 IF( .NOT. lk_offline .AND. lk_zdfkpp ) & … … 75 80 #endif 76 81 CALL trc_zdf( kstp ) ! vertical mixing and after tracer fields 82 ! 77 83 CALL trc_nxt( kstp ) ! tracer fields at next time step 78 84 IF( ln_trcrad ) CALL trc_rad( kstp ) ! Correct artificial negative concentrations … … 83 89 #endif 84 90 85 IF( ln_zps .AND. .NOT. ln_isfcav) &86 & CALL zps_hde ( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive87 IF( ln_zps .AND. ln_isfcav) &88 & CALL zps_hde_isf( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! Partial steps: now horizontal gradient of passive89 ! tracers at the bottom ocean level90 !91 91 ELSE ! 1D vertical configuration 92 92 CALL trc_sbc( kstp ) ! surface boundary condition … … 100 100 ! 101 101 IF( nn_timing == 1 ) CALL timing_stop('trc_trp') 102 ! 103 9400 FORMAT(a25,i4,D23.16) 102 104 ! 103 105 END SUBROUTINE trc_trp -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r6308 r7483 77 77 ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 78 78 IF( ierr0 > 0 ) THEN 79 CALL ctl_stop( 'trc_ nam: unable to allocate n_trc_index' ) ; RETURN79 CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' ) ; RETURN 80 80 ENDIF 81 81 nb_trcdta = 0 … … 91 91 IF(lwp) THEN 92 92 WRITE(numout,*) ' ' 93 WRITE(numout,*) 'trc_dta_init : Passive tracers Initial Conditions ' 94 WRITE(numout,*) '~~~~~~~~~~~~~~ ' 93 95 WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra 94 96 WRITE(numout,*) ' ' … … 107 109 DO jn = 1, ntrc 108 110 IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true 109 clndta = TRIM( sn_trcdta(jn)%clvar ) 110 clntrc = TRIM( ctrcnm (jn) ) 111 clndta = TRIM( sn_trcdta(jn)%clvar ) 112 if (jn > jptra) then 113 clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra 114 else 115 clntrc = TRIM( ctrcnm (jn) ) 116 endif 111 117 zfact = rn_trfac(jn) 112 IF( clndta /= clntrc ) THEN 113 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :', &114 & ' the variable name in the data file : '//clndta// &115 & ' must be the same than the name of the passive tracer : '//clntrc//' ')118 IF( clndta /= clntrc ) THEN 119 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation ', & 120 & 'Input name of data file : '//TRIM(clndta)// & 121 & ' differs from that of tracer : '//TRIM(clntrc)//' ') 116 122 ENDIF 117 WRITE(numout, *) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, &118 & ' multiplicativefactor : ', zfact123 WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', & 124 & jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 119 125 ENDIF 120 126 END DO … … 124 130 ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 125 131 IF( ierr1 > 0 ) THEN 126 CALL ctl_stop( 'trc_dta_ini : unable to allocate sf_trcdta structure' ) ; RETURN132 CALL ctl_stop( 'trc_dta_init: unable to allocate sf_trcdta structure' ) ; RETURN 127 133 ENDIF 128 134 ! … … 135 141 IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 136 142 IF( ierr2 + ierr3 > 0 ) THEN 137 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' ) ; RETURN143 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' ) ; RETURN 138 144 ENDIF 139 145 ENDIF … … 141 147 ENDDO 142 148 ! ! fill sf_trcdta with slf_i and control print 143 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta ', 'Passive tracer data', 'namtrc' )149 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 144 150 ! 145 151 ENDIF … … 151 157 152 158 153 SUBROUTINE trc_dta( kt, sf_dta 159 SUBROUTINE trc_dta( kt, sf_dta, ptrfac, ptrc) 154 160 !!---------------------------------------------------------------------- 155 161 !! *** ROUTINE trc_dta *** … … 164 170 !!---------------------------------------------------------------------- 165 171 INTEGER , INTENT(in ) :: kt ! ocean time-step 166 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read 172 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read 173 REAL(wp) , INTENT(in ) :: ptrfac ! multiplication factor 174 REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL , INTENT(out ) :: ptrc 167 175 ! 168 176 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 169 177 REAL(wp):: zl, zi 170 178 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace 179 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 171 180 CHARACTER(len=100) :: clndta 172 181 !!---------------------------------------------------------------------- … … 176 185 IF( nb_trcdta > 0 ) THEN 177 186 ! 187 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 188 ! 178 189 CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==! 190 ztrcdta(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 179 191 ! 180 192 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 185 197 ENDIF 186 198 ! 187 DO jj = 1, jpj ! vertical interpolation of T & S 199 DO jj = 1, jpj ! vertical interpolation of T & S 200 DO ji = 1, jpi 201 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 202 zl = fsdept_n(ji,jj,jk) 203 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 204 ztp(jk) = ztrcdta(ji,jj,1) 205 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 206 ztp(jk) = ztrcdta(ji,jj,jpkm1) 207 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 208 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 209 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 210 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 211 ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - & 212 ztrcdta(ji,jj,jkk) ) * zi 213 ENDIF 214 END DO 215 ENDIF 216 END DO 217 DO jk = 1, jpkm1 218 ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 219 END DO 220 ztrcdta(ji,jj,jpk) = 0._wp 221 END DO 222 END DO 223 ! 224 ELSE !== z- or zps- coordinate ==! 225 ! 226 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 227 DO jj = 1, jpj 188 228 DO ji = 1, jpi 189 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 190 zl = fsdept_n(ji,jj,jk) 191 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 192 ztp(jk) = sf_dta(1)%fnow(ji,jj,1) 193 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 194 ztp(jk) = sf_dta(1)%fnow(ji,jj,jpkm1) 195 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 196 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 197 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 198 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 199 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - & 200 sf_dta(1)%fnow(ji,jj,jkk) ) * zi 201 ENDIF 202 END DO 203 ENDIF 204 END DO 205 DO jk = 1, jpkm1 206 sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 207 END DO 208 sf_dta(1)%fnow(ji,jj,jpk) = 0._wp 229 ik = mbkt(ji,jj) 230 IF( ik > 1 ) THEN 231 zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 232 ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik-1) 233 ENDIF 234 ik = mikt(ji,jj) 235 IF( ik > 1 ) THEN 236 zl = ( fsdept_n(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 237 ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik+1) 238 ENDIF 209 239 END DO 210 240 END DO 211 ! 212 ELSE !== z- or zps- coordinate ==! 213 ! 214 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 215 ! 216 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 ik = mbkt(ji,jj) 220 IF( ik > 1 ) THEN 221 zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 222 sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1) 223 ENDIF 224 ik = mikt(ji,jj) 225 IF( ik > 1 ) THEN 226 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 227 sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik+1) 228 ENDIF 229 END DO 230 END DO 231 ENDIF 232 ! 233 ENDIF 241 ENDIF 242 ! 243 ENDIF 244 ! 245 ! Add multiplicative factor 246 ztrcdta(:,:,:) = ztrcdta(:,:,:) * ptrfac 247 ! 248 ! Data structure for trc_ini (and BFMv5.1 coupling) 249 IF( .NOT. PRESENT(ptrc) ) sf_dta(1)%fnow(:,:,:) = ztrcdta(:,:,:) 250 ! 251 ! Data structure for trc_dmp 252 IF( PRESENT(ptrc) ) ptrc(:,:,:) = ztrcdta(:,:,:) 234 253 ! 235 254 IF( lwp .AND. kt == nit000 ) THEN … … 238 257 WRITE(numout,*) 239 258 WRITE(numout,*)' level = 1' 240 CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )259 CALL prihre( ztrcdta(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 241 260 WRITE(numout,*)' level = ', jpk/2 242 CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )261 CALL prihre( ztrcdta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 243 262 WRITE(numout,*)' level = ', jpkm1 244 CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )263 CALL prihre( ztrcdta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 245 264 WRITE(numout,*) 246 265 ENDIF 266 ! 267 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 268 ! 247 269 ENDIF 248 270 ! … … 255 277 !!---------------------------------------------------------------------- 256 278 CONTAINS 257 SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac) ! Empty routine279 SUBROUTINE trc_dta( kt, sf_dta, ptrfac, ptrc) ! Empty routine 258 280 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 259 281 END SUBROUTINE trc_dta -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r6308 r7483 26 26 USE trcdta ! initialisation from files 27 27 USE daymod ! calendar manager 28 USE zpshde ! partial step: hor. derivative (zps_hde routine)29 28 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) 30 29 USE trcsub ! variables to substep passive tracers … … 123 122 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 124 123 jl = n_trc_index(jn) 125 CALL trc_dta( nit000, sf_trcdta(jl) ) ! read tracer data at nit000 126 trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl) 127 ! 124 CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl) ) ! read tracer data at nit000 125 trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) 128 126 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 129 127 ! (data used only for initialisation) … … 143 141 144 142 tra(:,:,:,:) = 0._wp 145 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav ) & ! Partial steps: before horizontal gradient of passive146 & CALL zps_hde ( nit000, jptra, trn, gtru, gtrv ) ! Partial steps: before horizontal gradient147 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav ) &148 & CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! tracers at the bottom ocean level149 150 151 143 ! 152 144 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r5513 r7483 304 304 IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift 305 305 END DO 306 WRITE(numout,*)306 IF(lwp) WRITE(numout,*) 307 307 9000 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, & 308 308 & ' max :',e18.10,' drift :',e18.10, ' %') -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r6204 r7483 33 33 REAL(wp) :: rdt_sampl 34 34 INTEGER :: nb_rec_per_day 35 INTEGER :: isecfst, iseclast35 REAL(wp) :: rsecfst, rseclast 36 36 LOGICAL :: llnew 37 37 … … 59 59 REAL(wp) :: ztrai 60 60 CHARACTER (len=25) :: charout 61 62 61 !!------------------------------------------------------------------- 63 62 ! … … 94 93 CALL trc_sms ( kt ) ! tracers: sinks and sources 95 94 CALL trc_trp ( kt ) ! transport of passive tracers 95 96 96 IF( kt == nittrc000 ) THEN 97 97 CALL iom_close( numrtr ) ! close input tracer restart file … … 105 105 ENDIF 106 106 ! 107 107 108 ztrai = 0._wp ! content of all tracers 108 109 DO jn = 1, jptra … … 110 111 END DO 111 112 IF( lwp ) WRITE(numstr,9300) kt, ztrai / areatot 112 9300 FORMAT(i10, e18.10)113 9300 FORMAT(i10,D23.16) 113 114 ! 114 115 IF( nn_timing == 1 ) CALL timing_stop('trc_stp') … … 130 131 INTEGER, INTENT(in) :: kt 131 132 INTEGER :: jn 133 REAL(wp) :: zkt 134 CHARACTER(len=1) :: cl1 ! 1 character 135 CHARACTER(len=2) :: cl2 ! 2 characters 132 136 133 137 IF( kt == nittrc000 ) THEN 134 138 IF( ln_cpl ) THEN 135 rdt_sampl = 86400./ ncpl_qsr_freq139 rdt_sampl = rday / ncpl_qsr_freq 136 140 nb_rec_per_day = ncpl_qsr_freq 137 141 ELSE 138 rdt_sampl = MAX( 3600., rdt * nn_dttrc)139 nb_rec_per_day = INT( 86400/ rdt_sampl )142 rdt_sampl = MAX( 3600., rdttrc(1) ) 143 nb_rec_per_day = INT( rday / rdt_sampl ) 140 144 ENDIF 141 145 ! … … 146 150 ENDIF 147 151 ! 152 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) ) 153 ! 148 154 ! !* Restart: read in restart file 149 IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean', ldstop = .FALSE. ) > 0 ) THEN 150 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file' 155 IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 .AND. & 156 iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0 .AND. & 157 iom_varid( numrtr, 'ktdcy' , ldstop = .FALSE. ) > 0 ) THEN 158 CALL iom_get( numrtr, 'ktdcy', zkt ) ! A mean of qsr 159 rsecfst = INT( zkt ) * rdttrc(1) 160 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s ' 151 161 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean ) ! A mean of qsr 162 DO jn = 1, nb_rec_per_day 163 IF( jn <= 9 ) THEN 164 WRITE(cl1,'(i1)') jn 165 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) ) ! A mean of qsr 166 ELSE 167 WRITE(cl2,'(i2.2)') jn 168 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) ! A mean of qsr 169 ENDIF 170 ENDDO 152 171 ELSE !* no restart: set from nit000 values 153 172 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean set to nit000 values' 173 rsecfst = kt * rdttrc(1) 174 ! 154 175 qsr_mean(:,:) = qsr(:,:) 155 ENDIF 156 ! 157 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) ) 158 DO jn = 1, nb_rec_per_day 159 qsr_arr(:,:,jn) = qsr_mean(:,:) 160 ENDDO 161 ! 162 isecfst = nsec_year + nsec1jan000 ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 163 iseclast = isecfst 164 ! 165 ENDIF 166 ! 167 iseclast = nsec_year + nsec1jan000 168 llnew = ( iseclast - isecfst ) > INT( rdt_sampl ) ! new shortwave to store 169 IF( kt /= nittrc000 .AND. llnew ) THEN 176 DO jn = 1, nb_rec_per_day 177 qsr_arr(:,:,jn) = qsr_mean(:,:) 178 ENDDO 179 ENDIF 180 ! 181 ENDIF 182 ! 183 rseclast = kt * rdttrc(1) 184 ! 185 llnew = ( rseclast - rsecfst ) .ge. rdt_sampl ! new shortwave to store 186 IF( llnew ) THEN 170 187 IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, & 171 & ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours '172 isecfst = iseclast188 & ' time = ', rseclast/3600.,'hours ' 189 rsecfst = rseclast 173 190 DO jn = 1, nb_rec_per_day - 1 174 191 qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) … … 182 199 IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file kt =', kt 183 200 IF(lwp) WRITE(numout,*) '~~~~~~~' 201 zkt = REAL( kt, wp ) 202 CALL iom_rstput( kt, nitrst, numrtw, 'ktdcy', zkt ) 203 DO jn = 1, nb_rec_per_day 204 IF( jn <= 9 ) THEN 205 WRITE(cl1,'(i1)') jn 206 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) ) 207 ELSE 208 WRITE(cl2,'(i2.2)') jn 209 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) 210 ENDIF 211 ENDDO 184 212 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) ) 185 213 ENDIF 186 !214 ! 187 215 END SUBROUTINE trc_mean_qsr 188 216 -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r5215 r7483 16 16 USE in_out_manager 17 17 USE lbclnk 18 #if defined key_zdftke19 USE zdftke ! twice TKE (en)20 #endif21 #if defined key_zdfgls22 USE zdfgls, ONLY: en23 #endif24 18 USE trabbl 25 19 USE zdf_oce -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/TOOLS/NESTING/agulhas
r6204 r7483 41 41 N = 31 42 42 ldbletanh = .FALSE. 43 p pa2= 0.043 pa2 = 0.0 44 44 ppkth2 = 0.0 45 45 ppacr2 = 0.0 -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90
r6204 r7483 76 76 NAMELIST /nesting/imin,imax,jmin,jmax,rho,rhot,bathy_update,updated_parent_file 77 77 ! 78 NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N,ldbletanh,p pa2,ppkth2,ppacr278 NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N,ldbletanh,pa2,ppkth2,ppacr2 79 79 ! 80 80 NAMELIST /partial_cells/partial_steps,parent_bathy_meter,parent_batmet_name,e3zps_min,e3zps_rat -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py
r6449 r7483 169 169 sys.exit(15) 170 170 fo = Dataset(pathout, 'w') 171 for dim in ['x','y','c' ]:171 for dim in ['x','y','c','k']: 172 172 indim = fi.dimensions[dim] 173 173 fo.createDimension(dim, len(indim)) 174 for var in [' calving','calving_hflx','stored_ice','stored_heat']:174 for var in ['kount','calving','calving_hflx','stored_ice','stored_heat']: 175 175 invar = fi.variables[var] 176 176 fo.createVariable(var, invar.datatype, invar.dimensions) 177 177 fo.variables[var][:] = invar[:] 178 fo.variables[var].long_name = invar.long_name 179 fo.variables[var].units = invar.units 178 if "long_name" in invar.ncattrs(): 179 fo.variables[var].long_name = invar.long_name 180 if "units" in invar.ncattrs(): 181 fo.variables[var].units = invar.units 180 182 os.remove(pathout.replace('.nc','_WORK.nc')) 181 183 # -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/TOOLS/SIREN/src/boundary.f90
r6392 r7483 1529 1529 !> @author J.Paul 1530 1530 !> @date November, 2013 - Initial Version 1531 ! 1531 !> @date June, 2016 1532 !> - Bug fix: take into account that boundaries are compute on T point, 1533 !> but expressed on U,V point 1534 !> 1532 1535 !> @param[inout] td_bdy boundary structure 1533 1536 !> @param[in] td_var variable structure … … 1552 1555 il_max(jp_west )=td_var%t_dim(2)%i_len 1553 1556 1554 il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost 1557 ! index expressed on U,V point, move on T point. 1558 il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost+1 1555 1559 il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost 1556 il_maxindex(jp_east )=td_var%t_dim(1)%i_len-ip_ghost 1560 il_maxindex(jp_east )=td_var%t_dim(1)%i_len-ip_ghost+1 1557 1561 il_maxindex(jp_west )=td_var%t_dim(1)%i_len-ip_ghost 1558 1562 -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/TOOLS/SIREN/src/docsrc/2_quickstart.md
r6467 r7483 35 35 Here after we briefly describe how to use each programs, 36 36 and so how to create your own regional configuration. 37 @note As demonstrator for a first start a set of GLORYS files (global reanalysis on *ORCA025* grid), as well as examples of namelists are available [here](https://cloud.mercator-ocean.fr/public.php?service=files&t= 877fb1b6e4f589340fc0df1ea6a53228).37 @note As demonstrator for a first start a set of GLORYS files (global reanalysis on *ORCA025* grid), as well as examples of namelists are available [here](https://cloud.mercator-ocean.fr/public.php?service=files&t=1658ec1aaeda2878f2b3915ed140af37). 38 38 39 39 <!-- ###################################################################### --> … … 440 440 Finally, this **namout** sub-namelist defines the output files.<br/> 441 441 Here we ask for output on 81 processors, with *restart_out.nc* as file "basename".<br/> 442 So SIREN computes the optimal layout for 81 p orcessors442 So SIREN computes the optimal layout for 81 processors 443 443 available,<br/> 444 and split restart on output files named *restart_out_num.nc*, where *num* is the p orc number.444 and split restart on output files named *restart_out_num.nc*, where *num* is the proc number. 445 445 446 446 @note SIREN could also create the other fields you may need for -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/TOOLS/SIREN/src/docsrc/5_changeLog.md
r6467 r7483 3 3 @tableofcontents 4 4 5 # Release 6 Initial release (2016-04-11) 5 # Release 2016-11-28 7 6 8 7 ## Changes 9 8 ## New Features 10 9 ## Bug fixes 10 - boundary.f90: take into account that boundaries are compute on T point, but expressed on U,V point 11 - iom_cdf.f90: define type cdf4 as cdf 12 13 release (2016-07-01) 14 15 ## Changes 16 ## New Features 17 ## Bug fixes 18 - correct check of boundary indices 19 20 # Release 21 Initial release (2016-04-11) 11 22 12 23 <HR> -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/TOOLS/SIREN/src/file.f90
r6392 r7483 495 495 END SELECT 496 496 ELSE 497 CALL logger_debug("FILE INIT: look for file type "//TRIM(file_init%c_name)) 497 498 file_init%c_type=TRIM(file_get_type(cd_file)) 498 499 ENDIF … … 572 573 CASE('.nc','.cdf') 573 574 CALL logger_debug(" FILE GET TYPE: file "//TRIM(cd_file)//" is cdf") 575 ! Warning : type could be change to cdf4 when opening file. 574 576 file_get_type='cdf' 575 577 CASE('.dimg') -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/TOOLS/SIREN/src/grid.f90
r6392 r7483 1341 1341 il_dim(:)=td_var%t_dim(:)%i_len 1342 1342 1343 CALL logger_debug("GRID GET PERIO: use vari bale "//TRIM(td_var%c_name))1343 CALL logger_debug("GRID GET PERIO: use variable "//TRIM(td_var%c_name)) 1344 1344 CALL logger_debug("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill))) 1345 1345 CALL logger_debug("GRID GET PERIO: first value "//TRIM(fct_str(td_var%d_value(1,1,1,1)))) -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/TOOLS/SIREN/src/iom.f90
r5616 r7483 174 174 CASE('cdf') 175 175 CALL iom_cdf_open(td_file) 176 !CASE('cdf4') 176 177 CASE('dimg') 177 178 CALL iom_rstdimg_open(td_file) … … 240 241 CALL iom_rstdimg_close(td_file) 241 242 CASE DEFAULT 243 CALL logger_debug( "IOM CLOSE: type "//TRIM(td_file%c_type)) 242 244 CALL logger_error( "IOM CLOSE: can't close file "//& 243 245 & TRIM(td_file%c_name)//": type unknown " ) -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90
r6392 r7483 340 340 td_file%c_type='cdf' 341 341 CASE(nf90_format_netcdf4, nf90_format_netcdf4_classic) 342 td_file%c_type='cdf4' 342 td_file%c_type='cdf' 343 !td_file%c_type='cdf4' 343 344 END SELECT 345 CALL logger_debug("IOM CDF GET INFO: type "//TRIM(td_file%c_type)) 344 346 345 347 ! record header infos
Note: See TracChangeset
for help on using the changeset viewer.