Changeset 6851 for branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM
- Timestamp:
- 2016-08-08T10:34:39+02:00 (8 years ago)
- Location:
- branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM
- Files:
-
- 83 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm
r6140 r6851 34 34 35 35 # required modules 36 # module load INTEL/intel_xe_2013 NETCDF/netcdf-4.3_parallel _shared NETCDF/parallel-netcdf-1.3.1 HDF5/hdf5-1.8.11_parallel_shared36 # module load INTEL/intel_xe_2013 NETCDF/netcdf-4.3_parallel NETCDF/parallel-netcdf-1.7.0 HDF5/hdf5-1.8.11_parallel 37 37 38 # Environment variables set by user. Others should automatically define when loading modules. 38 # NETCDF and PNETCDF should be set automatically when loading modules. 39 # The following environment variables must be set by the user. 39 40 #export XIOS=/users/home/models/nemo/xios 40 #export HDF5=/users/home/opt/hdf5/hdf5-1.8.11_parallel_shared 41 #export NETCDF=/users/home/opt/netcdf/netcdf-4.3_parallel_shared 41 #export HDF5=/users/home/opt/hdf5/hdf5-1.8.11_parallel 42 42 43 %NCDF_INC -I${NETCDF}/include 44 %NCDF_LIB -L${NETCDF}/lib -lnetcdff -lnetcdf 43 %NCDF_INC -I${NETCDF}/include -I${PNETCDF}/include 44 %NCDF_LIB -L${NETCDF}/lib -lnetcdff -lnetcdf -L${PNETCDF}/lib -lpnetcdf 45 45 %HDF5_INC -I${HDF5}/include 46 46 %HDF5_LIB -L${HDF5}/lib -lhdf5_hl -lhdf5 … … 49 49 %CPP cpp 50 50 %FC mpiifort 51 %FCFLAGS -r8 -O3 -xHost -fp-model source -traceback ${CFLAGS}51 %FCFLAGS -r8 -O3 -xHost -fp-model source -traceback 52 52 %FFLAGS %FCFLAGS 53 53 %LD mpiifort 54 54 %FPPFLAGS -P -C -traditional 55 %LDFLAGS -lstdc++ -lz -lgpfs -lcurl ${LDFLAGS}55 %LDFLAGS -lstdc++ -lz -lgpfs -lcurl 56 56 %AR ar 57 57 %ARFLAGS -r -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/ARCH/arch-macport_osx.fcm
r5656 r6851 54 54 %CPP cpp-mp-4.8 55 55 %FC mpif90 56 %FCFLAGS -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer 56 %FCFLAGS -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer -ffree-line-length-none 57 57 %FFLAGS %FCFLAGS 58 58 %LD %FC -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
r6140 r6851 257 257 &nameos ! ocean physical parameters 258 258 !----------------------------------------------------------------------- 259 ln_teos10 = .true. ! = Use TEOS-10 equation of state 259 260 / 260 261 !----------------------------------------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
r6140 r6851 205 205 &nameos ! ocean physical parameters 206 206 !----------------------------------------------------------------------- 207 nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency 208 ! =-1, TEOS-10 209 ! = 0, EOS-80 210 ! = 1, S-EOS (simplified eos) 211 ln_useCT = .false. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 207 ln_eos80 = .true. ! = Use EOS80 equation of state 212 208 / 213 209 !----------------------------------------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
r6140 r6851 187 187 &nameos ! ocean physical parameters 188 188 !----------------------------------------------------------------------- 189 nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency 190 ! =-1, TEOS-10 191 ! = 0, EOS-80 192 ! = 1, S-EOS (simplified eos) 193 ln_useCT = .false. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 189 ln_eos80 = .true. ! = Use EOS80 equation of state 194 190 ! ! 195 ! ! S-EOS coefficients : 196 ! ! rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 197 rn_a0 = 1.6550e-1 ! thermal expension coefficient (nn_eos= 1) 198 rn_b0 = 7.6554e-1 ! saline expension coefficient (nn_eos= 1) 199 rn_lambda1 = 5.9520e-2 ! cabbeling coeff in T^2 (=0 for linear eos) 200 rn_lambda2 = 7.4914e-4 ! cabbeling coeff in S^2 (=0 for linear eos) 201 rn_mu1 = 1.4970e-4 ! thermobaric coeff. in T (=0 for linear eos) 202 rn_mu2 = 1.1090e-5 ! thermobaric coeff. in S (=0 for linear eos) 203 rn_nu = 2.4341e-3 ! cabbeling coeff in T*S (=0 for linear eos) 191 ln_leos = .false. ! = Use linear equation of state (L-EOS) 192 ! ! rd(T,S,Z)*rau0 = -al*(T-10) + bl*(S-35) 193 rn_al = 1.6550e-1 ! al, thermal expension coefficient 194 rn_bl = 7.6554e-1 ! bl, saline expension coefficient 204 195 !!org GYRE rn_alpha = 2.0e-4 ! thermal expension coefficient (nn_eos= 1 or 2) 205 196 !!org GYRE rn_beta = 7.7e-4 ! saline expension coefficient (nn_eos= 2) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
r6140 r6851 190 190 &nameos ! ocean physical parameters 191 191 !----------------------------------------------------------------------- 192 nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency 193 ! =-1, TEOS-10 194 ! = 0, EOS-80 195 ! = 1, S-EOS (simplified eos) 196 ln_useCT = .false. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 192 ln_eos80 = .true. ! = Use EOS80 equation of state 197 193 ! ! 198 ! ! S-EOS coefficients : 199 ! ! rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 200 rn_a0 = 1.6550e-1 ! thermal expension coefficient (nn_eos= 1) 201 rn_b0 = 7.6554e-1 ! saline expension coefficient (nn_eos= 1) 202 rn_lambda1 = 5.9520e-2 ! cabbeling coeff in T^2 (=0 for linear eos) 203 rn_lambda2 = 7.4914e-4 ! cabbeling coeff in S^2 (=0 for linear eos) 204 rn_mu1 = 1.4970e-4 ! thermobaric coeff. in T (=0 for linear eos) 205 rn_mu2 = 1.1090e-5 ! thermobaric coeff. in S (=0 for linear eos) 206 rn_nu = 2.4341e-3 ! cabbeling coeff in T*S (=0 for linear eos) 194 ln_leos = .false. ! = Use linear equation of state (L-EOS) 195 ! ! rd(T,S,Z)*rau0 = -al*(T-10) + bl*(S-35) 196 rn_al = 1.6550e-1 ! al, thermal expension coefficient 197 rn_bl = 7.6554e-1 ! bl, saline expension coefficient 207 198 !!org GYRE rn_alpha = 2.0e-4 ! thermal expension coefficient (nn_eos= 1 or 2) 208 199 !!org GYRE rn_beta = 7.7e-4 ! saline expension coefficient (nn_eos= 2) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg
r6140 r6851 109 109 &nameos ! ocean physical parameters 110 110 !----------------------------------------------------------------------- 111 nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency 112 ! =-1, TEOS-10 113 ! = 0, EOS-80 114 ! = 1, S-EOS (simplified eos) 115 ln_useCT = .false. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 111 ln_eos80 = .true. ! = Use EOS80 equation of state 116 112 ! ! 117 ! ! S-EOS coefficients : 118 ! ! rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 119 rn_a0 = 1.6550e-1 ! thermal expension coefficient (nn_eos= 1) 120 rn_b0 = 7.6554e-1 ! saline expension coefficient (nn_eos= 1) 121 rn_lambda1 = 5.9520e-2 ! cabbeling coeff in T^2 (=0 for linear eos) 122 rn_lambda2 = 7.4914e-4 ! cabbeling coeff in S^2 (=0 for linear eos) 123 rn_mu1 = 1.4970e-4 ! thermobaric coeff. in T (=0 for linear eos) 124 rn_mu2 = 1.1090e-5 ! thermobaric coeff. in S (=0 for linear eos) 125 rn_nu = 2.4341e-3 ! cabbeling coeff in T*S (=0 for linear eos) 113 ln_leos = .false. ! = Use linear equation of state (L-EOS) 114 ! ! rd(T,S,Z)*rau0 = -al*(T-10) + bl*(S-35) 115 rn_al = 1.6550e-1 ! al, thermal expension coefficient 116 rn_bl = 7.6554e-1 ! bl, saline expension coefficient 126 117 !!org GYRE rn_alpha = 2.0e-4 ! thermal expension coefficient (nn_eos= 1 or 2) 127 118 !!org GYRE rn_beta = 7.7e-4 ! saline expension coefficient (nn_eos= 2) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg
r6140 r6851 183 183 &nameos ! ocean physical parameters 184 184 !----------------------------------------------------------------------- 185 nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency 185 ln_eos80 = .true. ! = Use EOS80 equation of state 186 ! ! 187 ln_leos = .false. ! = Use linear equation of state (L-EOS) 188 ! ! rd(T,S,Z)*rau0 = -al*(T-10) + bl*(S-35) 189 rn_al = 1.6550e-1 ! al, thermal expension coefficient 190 rn_bl = 7.6554e-1 ! bl, saline expension coefficient 191 !!org GYRE rn_alpha = 2.0e-4 ! thermal expension coefficient (nn_eos= 1 or 2) 192 !!org GYRE rn_beta = 7.7e-4 ! saline expension coefficient (nn_eos= 2) 193 !!org caution now a0 = alpha / rau0 with rau0 = 1026 186 194 / 187 195 !----------------------------------------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg
r6140 r6851 132 132 &nameos ! ocean physical parameters 133 133 !----------------------------------------------------------------------- 134 ln_teos10 = .true. ! = Use TEOS-10 equation of state 134 135 / 135 136 !----------------------------------------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg
r6140 r6851 110 110 &nameos ! ocean physical parameters 111 111 !----------------------------------------------------------------------- 112 ln_teos10 = .true. ! = Use TEOS-10 equation of state 112 113 / 113 114 !----------------------------------------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg
r6140 r6851 109 109 &nameos ! ocean physical parameters 110 110 !----------------------------------------------------------------------- 111 ln_teos10 = .true. ! = Use TEOS-10 equation of state 111 112 / 112 113 !----------------------------------------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg
r6140 r6851 169 169 &nameos ! ocean physical parameters 170 170 !----------------------------------------------------------------------- 171 ln_teos10 = .true. ! = Use TEOS-10 equation of state 171 172 / 172 173 !----------------------------------------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg
r6140 r6851 106 106 &nameos ! ocean physical parameters 107 107 !----------------------------------------------------------------------- 108 ln_teos10 = .true. ! = Use TEOS-10 equation of state 108 109 / 109 110 !----------------------------------------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg
r6140 r6851 85 85 &nameos ! ocean physical parameters 86 86 !----------------------------------------------------------------------- 87 ln_teos10 = .true. ! = Use TEOS-10 equation of state 87 88 / 88 89 !---------------------------------------------------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/namelist_cfg
r6140 r6851 87 87 &nameos ! ocean physical parameters 88 88 !----------------------------------------------------------------------- 89 ln_teos10 = .true. ! = Use TEOS-10 equation of state 89 90 / 90 91 !----------------------------------------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/SHARED/field_def.xml
r6347 r6851 23 23 <field_group id="grid_T" grid_ref="grid_T_2D" > 24 24 <field id="e3t" long_name="T-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_T_3D"/> 25 <field id="e3t_0" long_name="Initial T-cell thickness" standard_name="ref_cell_thickness" unit="m" grid_ref="grid_T_3D"/> 25 26 26 27 <field id="toce" long_name="temperature" standard_name="sea_water_potential_temperature" unit="degC" grid_ref="grid_T_3D"/> … … 181 182 <field_group id="SBC" grid_ref="grid_T_2D" > <!-- time step automaticaly defined based on nn_fsbc --> 182 183 <field id="empmr" long_name="Net Upward Water Flux" standard_name="water_flux_out_of_sea_ice_and_sea_water" unit="kg/m2/s" /> 184 <field id="empbmr" long_name="Net Upward Water Flux at pre. tstep" standard_name="water_flux_out_of_sea_ice_and_sea_water" unit="kg/m2/s" /> 185 <field id="emp_oce" long_name="Evap minus Precip over ocean" standard_name="evap_minus_precip_over_sea_water" unit="kg/m2/s" /> 186 <field id="emp_ice" long_name="Evap minus Precip over ice" standard_name="evap_minus_precip_over_sea_ice" unit="kg/m2/s" /> 183 187 <field id="saltflx" long_name="Downward salt flux" unit="1e-3/m2/s" /> 184 188 <field id="fmmflx" long_name="Water flux due to freezing/melting" unit="kg/m2/s" /> … … 273 277 <field id="emp_x_sst" long_name="Concentration/Dilution term on SST" unit="kg*degC/m2/s" /> 274 278 <field id="emp_x_sss" long_name="Concentration/Dilution term on SSS" unit="kg*1e-3/m2/s" /> 279 <field id="rnf_x_sst" long_name="Runoff term on SST" unit="kg*degC/m2/s" /> 280 <field id="rnf_x_sss" long_name="Runoff term on SSS" unit="kg*1e-3/m2/s" /> 275 281 276 282 <field id="iceconc" long_name="ice concentration" standard_name="sea_ice_area_fraction" unit="%" /> … … 287 293 <field id="micesalt" long_name="Mean ice salinity" unit="1e-3" /> 288 294 <field id="miceage" long_name="Mean ice age" unit="years" /> 295 <field id="alb_ice" long_name="Mean albedo over sea ice" unit="" /> 296 <field id="albedo" long_name="Mean albedo over sea ice and ocean" unit="" /> 289 297 290 298 <field id="iceage_cat" long_name="Ice age for categories" unit="days" axis_ref="ncatice" /> … … 324 332 <field id="sfxsni" long_name="salt flux from snow-ice formation" unit="1e-3*kg/m2/day" /> 325 333 <field id="sfxopw" long_name="salt flux from open water ice formation" unit="1e-3*kg/m2/day" /> 334 <field id="sfxsub" long_name="salt flux from sublimation" unit="1e-3*kg/m2/day" /> 326 335 <field id="sfx" long_name="salt flux total" unit="1e-3*kg/m2/day" /> 327 336 … … 337 346 <field id="vfxsub" long_name="snw sublimation" unit="m/day" /> 338 347 <field id="vfxspr" long_name="snw precipitation on ice" unit="m/day" /> 348 <field id="vfxthin" long_name="daily thermo ice prod. for thin ice(<20cm) + open water" unit="m/day" /> 339 349 340 350 <field id="afxtot" long_name="area tendency (total)" unit="day-1" /> … … 378 388 <field_group id="grid_U" grid_ref="grid_U_2D"> 379 389 <field id="e3u" long_name="U-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_U_3D" /> 390 <field id="e3u_0" long_name="Initial U-cell thickness" standard_name="ref_cell_thickness" unit="m" grid_ref="grid_U_3D"/> 380 391 <field id="utau" long_name="Wind Stress along i-axis" standard_name="surface_downward_x_stress" unit="N/m2" /> 381 392 <field id="uoce" long_name="ocean current along i-axis" standard_name="sea_water_x_velocity" unit="m/s" grid_ref="grid_U_3D" /> … … 419 430 <field_group id="grid_V" grid_ref="grid_V_2D"> 420 431 <field id="e3v" long_name="V-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_V_3D" /> 432 <field id="e3v_0" long_name="Initial V-cell thickness" standard_name="ref_cell_thickness" unit="m" grid_ref="grid_V_3D"/> 421 433 <field id="vtau" long_name="Wind Stress along j-axis" standard_name="surface_downward_y_stress" unit="N/m2" /> 422 434 <field id="voce" long_name="ocean current along j-axis" standard_name="sea_water_y_velocity" unit="m/s" grid_ref="grid_V_3D" /> … … 466 478 <field id="woce_eiv" long_name="EIV ocean vertical velocity" standard_name="bolus_upward_sea_water_velocity" unit="m/s" /> 467 479 468 <!-- woce_eiv: available with key_trabbl_adv --> 480 469 481 <field id="avt" long_name="vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" /> 482 <field id="logavt" long_name="logarithm of vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" /> 470 483 <field id="avm" long_name="vertical eddy viscosity" standard_name="ocean_vertical_momentum_diffusivity" unit="m2/s" /> 471 484 472 485 <!-- avs: available with key_zdfddm --> 473 486 <field id="avs" long_name="salt vertical eddy diffusivity" standard_name="ocean_vertical_salt_diffusivity" unit="m2/s" /> 487 <field id="logavs" long_name="logarithm of salt vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" /> 474 488 475 489 <!-- avt_evd and avm_evd: available with ln_zdfevd --> … … 479 493 <!-- avt_tide: available with key_zdftmx --> 480 494 <field id="av_tide" long_name="tidal vertical diffusivity" standard_name="ocean_vertical_tracer_diffusivity_due_to_tides" unit="m2/s" /> 481 482 <!-- fields available with key_zdftmx_new -->483 <field id="av_wave" long_name="wave-induced vertical diffusivity" standard_name="ocean_vertical_tracer_diffusivity_due_to_internal_waves" unit="m2/s" />484 <field id="bn2" long_name="squared Brunt-Vaisala frequency" standard_name="squared_brunt_vaisala_frequency" unit="s-1" />485 <field id="bflx_tmx" long_name="wave-induced buoyancy flux" standard_name="buoyancy_flux_due_to_internal_waves" unit="W/kg" />486 <field id="pcmap_tmx" long_name="power consumed by wave-driven mixing" standard_name="vertically_integrated_power_consumption_by_wave_driven_mixing" unit="W/m2" grid_ref="grid_W_2D" />487 <field id="emix_tmx" long_name="power density available for mixing" standard_name="power_available_for_mixing_from_breaking_internal_waves" unit="W/kg" />488 <field id="av_ratio" long_name="S over T diffusivity ratio" standard_name="salinity_over_temperature_diffusivity_ratio" unit="1" />489 495 490 496 <!-- variables available with key_diaar5 --> … … 565 571 <field id="ibgsfxbom" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 566 572 <field id="ibgsfxsum" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 573 <field id="ibgsfxsub" long_name="global mean salt flux (thermo)" unit="1e-3*m/day" /> 567 574 568 575 <field id="ibghfxdhc" long_name="Heat content variation in snow and ice" unit="W" /> -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref
r5429 r6851 21 21 cn_icerst_outdir = "." ! directory in which to write output ice restarts 22 22 ln_limdyn = .true. ! ice dynamics (T) or thermodynamics only (F) 23 rn_amax = 0.999 ! maximum tolerated ice concentration 23 rn_amax_n = 0.999 ! maximum tolerated ice concentration NH 24 rn_amax_s = 0.999 ! maximum tolerated ice concentration SH 24 25 ln_limdiahsb = .false. ! check the heat and salt budgets (T) or not (F) 25 26 ln_limdiaout = .true. ! output the heat and salt budgets (T) or not (F) … … 85 86 rn_hnewice = 0.1 ! thickness for new ice formation in open water (m) 86 87 ln_frazil = .false. ! use frazil ice collection thickness as a function of wind (T) or not (F) 87 rn_maxfrazb = 0.0 ! maximum fraction of frazil ice collecting at the ice base88 rn_maxfrazb = 1.0 ! maximum fraction of frazil ice collecting at the ice base 88 89 rn_vfrazb = 0.417 ! thresold drift speed for frazil ice collecting at the ice bottom (m/s) 89 90 rn_Cfrazb = 5.0 ! squeezing coefficient for frazil ice collecting at the ice bottom -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/SHARED/namelist_ref
r6347 r6851 3 3 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 4 4 !! NEMO/OPA : 1 - run manager (namrun) 5 !! namelists 2 - Domain (namcfg, namzgr, namzgr_sco, namdom, namtsd )5 !! namelists 2 - Domain (namcfg, namzgr, namzgr_sco, namdom, namtsd, namcrs, namc1d, namc1d_uvd) 6 6 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, namsbc_sas 7 7 !! namsbc_cpl, namtra_qsr, namsbc_rnf, … … 59 59 !!====================================================================== 60 60 !! namcfg parameters of the configuration 61 !! namzgr vertical coordinate 61 !! namzgr vertical coordinate (default: NO selection) 62 62 !! namzgr_sco s-coordinate or hybrid z-s-coordinate 63 63 !! namdom space and time domain (bathymetry, mesh, timestep) 64 !! namwad Wetting and drying (default F) 65 !! namtsd data: temperature & salinity 64 66 !! namcrs coarsened grid (for outputs and/or TOP) ("key_crs") 65 67 !! namc1d 1D configuration options ("key_c1d") 68 !! namc1d_dyndmp 1D newtonian damping applied on currents ("key_c1d") 66 69 !! namc1d_uvd 1D data (currents) ("key_c1d") 67 !! namc1d_dyndmp 1D newtonian damping applied on currents ("key_c1d")68 !! namtsd data: temperature & salinity69 70 !!====================================================================== 70 71 ! … … 101 102 / 102 103 !----------------------------------------------------------------------- 103 &namzgr_sco ! s-coordinate or hybrid z-s-coordinate 104 &namzgr_sco ! s-coordinate or hybrid z-s-coordinate (default F) 104 105 !----------------------------------------------------------------------- 105 106 ln_s_sh94 = .false. ! Song & Haidvogel 1994 hybrid S-sigma (T)| … … 165 166 / 166 167 !----------------------------------------------------------------------- 168 &namwad ! Wetting and drying (default F) 169 !----------------------------------------------------------------------- 170 ln_wd = .false. ! T/F activation of wetting and drying 171 rn_wdmin1 = 0.1 ! Minimum wet depth on dried cells 172 rn_wdmin2 = 0.01 ! Tolerance of min wet depth on dried cells 173 rn_wdld = 20.0 ! Land elevation below which wetting/drying is allowed 174 nn_wdit = 10 ! Max iterations for W/D limiter 175 / 176 !----------------------------------------------------------------------- 177 &namtsd ! data : Temperature & Salinity 178 !----------------------------------------------------------------------- 179 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 180 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 181 sn_tem = 'data_1m_potential_temperature_nomask', -1 ,'votemper', .true. , .true. , 'yearly' , '' , '' , '' 182 sn_sal = 'data_1m_salinity_nomask' , -1 ,'vosaline', .true. , .true. , 'yearly' , '' , '' , '' 183 ! 184 cn_dir = './' ! root directory for the location of the runoff files 185 ln_tsd_init = .true. ! Initialisation of ocean T & S with T & S input data (T) or not (F) 186 ln_tsd_tradmp = .true. ! damping of ocean T & S toward T & S input data (T) or not (F) 187 / 188 !----------------------------------------------------------------------- 167 189 &namcrs ! coarsened grid (for outputs and/or TOP) ("key_crs") 168 190 !----------------------------------------------------------------------- … … 202 224 ln_uvd_init = .false. ! Initialisation of ocean U & V with U & V input data (T) or not (F) 203 225 ln_uvd_dyndmp = .false. ! damping of ocean U & V toward U & V input data (T) or not (F) 204 /205 !-----------------------------------------------------------------------206 &namtsd ! data : Temperature & Salinity207 !-----------------------------------------------------------------------208 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !209 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !210 sn_tem = 'data_1m_potential_temperature_nomask', -1 ,'votemper' , .true. , .true. , 'yearly' , '' , '' , ''211 sn_sal = 'data_1m_salinity_nomask' , -1 ,'vosaline' , .true. , .true. , 'yearly' , '' , '' , ''212 !213 cn_dir = './' ! root directory for the location of the runoff files214 ln_tsd_init = .true. ! Initialisation of ocean T & S with T &S input data (T) or not (F)215 ln_tsd_tradmp = .true. ! damping of ocean T & S toward T &S input data (T) or not (F)216 226 / 217 227 … … 278 288 ln_apr_dyn = .false. ! Patm gradient added in ocean & ice Eqs. (T => fill namsbc_apr ) 279 289 ln_isf = .false. ! ice shelf (T => fill namsbc_isf) 280 ln_wave = .false.! coupling with surface wave (T => fill namsbc_wave)281 nn_lsm = 0! =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) ,290 ln_wave = .false. ! coupling with surface wave (T => fill namsbc_wave) 291 nn_lsm = 0 ! =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 282 292 ! =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 283 293 / … … 382 392 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 383 393 ! 384 nn_cplmodel = 1 385 ln_usecplmask = .false. 386 394 nn_cplmodel = 1 ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 395 ln_usecplmask = .false. ! use a coupling mask file to merge data received from several models 396 ! ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 387 397 / 388 398 !----------------------------------------------------------------------- 389 399 &namsbc_sas ! analytical surface boundary condition 390 400 !----------------------------------------------------------------------- 391 ! ! file name ! frequency (hours) ! variable ! time interp. 392 ! ! ! (if <0 months) ! name ! 393 sn_usp = 'sas_grid_U' , 120 , 'vozocrtx' , .true. , .true. , 'yearly' , '' , '' ,''394 sn_vsp = 'sas_grid_V' , 120 , 'vomecrty' , .true. , .true. , 'yearly' , '' , '' ,''395 sn_tem = 'sas_grid_T' , 120 , 'sosstsst' , .true. , .true. , 'yearly' , '' , '' ,''396 sn_sal = 'sas_grid_T' , 120 , 'sosaline' , .true. , .true. , 'yearly' , '' , '' ,''397 sn_ssh = 'sas_grid_T' , 120 , 'sossheig' , .true. , .true. , 'yearly' , '' , '' ,''398 sn_e3t = 'sas_grid_T' , 120 , 'e3t_m' , .true. , .true. , 'yearly' , '' , '' ,''399 sn_frq = 'sas_grid_T' , 120 , 'frq_m' , .true. , .true. , 'yearly' , '' , '' ,''401 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 402 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 403 sn_usp = 'sas_grid_U', 120 , 'vozocrtx', .true. , .true. , 'yearly' , '' , '' , '' 404 sn_vsp = 'sas_grid_V', 120 , 'vomecrty', .true. , .true. , 'yearly' , '' , '' , '' 405 sn_tem = 'sas_grid_T', 120 , 'sosstsst', .true. , .true. , 'yearly' , '' , '' , '' 406 sn_sal = 'sas_grid_T', 120 , 'sosaline', .true. , .true. , 'yearly' , '' , '' , '' 407 sn_ssh = 'sas_grid_T', 120 , 'sossheig', .true. , .true. , 'yearly' , '' , '' , '' 408 sn_e3t = 'sas_grid_T', 120 , 'e3t_m' , .true. , .true. , 'yearly' , '' , '' , '' 409 sn_frq = 'sas_grid_T', 120 , 'frq_m' , .true. , .true. , 'yearly' , '' , '' , '' 400 410 401 411 ln_3d_uve = .true. ! specify whether we are supplying a 3D u,v and e3 field 402 ln_read_frq = .false. 412 ln_read_frq = .false. ! specify whether we must read frq or not 403 413 cn_dir = './' ! root directory for the location of the bulk files are 404 414 / … … 414 424 ln_qsr_2bd = .false. ! 2 bands light penetration 415 425 ln_qsr_bio = .false. ! bio-model light penetration 416 nn_chldta = 1 ! RGB : 2D Chl data (=1), 3D Chl data (=2) or cst value (=0)426 nn_chldta = 1 ! RGB : Chl data (=1) or cst value (=0) 417 427 rn_abs = 0.58 ! RGB & 2 bands: fraction of light (rn_si1) 418 428 rn_si0 = 0.35 ! RGB & 2 bands: shortess depth of extinction … … 431 441 sn_dep_rnf = 'runoffs' , 0 , 'rodepth' , .false. , .true. , 'yearly' , '' , '' , '' 432 442 433 cn_dir 434 ln_rnf_mouth 435 rn_hrnf = 15.e0 ! depth over which enhanced vertical mixing is used436 rn_avt_rnf = 1.e-3 ! value of the additional vertical mixing coef. [m2/s]437 rn_rfact 438 ln_rnf_depth 439 ln_rnf_tem 440 ln_rnf_sal 441 ln_rnf_depth_ini = .false. 442 rn_rnf_max= 5.735e-4 ! max value of the runoff climatologie over global domain ( ln_rnf_depth_ini = .true )443 rn_dep_max= 150. ! depth over which runoffs is spread ( ln_rnf_depth_ini = .true )444 nn_rnf_depth_file = 0! create (=1) a runoff depth file or not (=0)443 cn_dir = './' ! root directory for the location of the runoff files 444 ln_rnf_mouth= .true. ! specific treatment at rivers mouths 445 rn_hrnf = 15.e0 ! depth over which enhanced vertical mixing is used (ln_rnf_mouth=T) 446 rn_avt_rnf = 1.e-3 ! value of the additional vertical mixing coef. [m2/s] (ln_rnf_mouth=T) 447 rn_rfact = 1.e0 ! multiplicative factor for runoff 448 ln_rnf_depth= .false. ! read in depth information for runoff 449 ln_rnf_tem = .false. ! read in temperature information for runoff 450 ln_rnf_sal = .false. ! read in salinity information for runoff 451 ln_rnf_depth_ini = .false. ! compute depth at initialisation from runoff file 452 rn_rnf_max = 5.735e-4 ! max value of the runoff climatologie over global domain ( ln_rnf_depth_ini = .true ) 453 rn_dep_max = 150. ! depth over which runoffs is spread ( ln_rnf_depth_ini = .true ) 454 nn_rnf_depth_file = 0 ! create (=1) a runoff depth file or not (=0) 445 455 / 446 456 !----------------------------------------------------------------------- 447 457 &namsbc_isf ! Top boundary layer (ISF) (nn_isf >0) 448 458 !----------------------------------------------------------------------- 449 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim! 'yearly'/ ! weights ! rotation ! land/sea mask !450 ! ! ! (if <0 months) ! name ! (logical) ! (T/F)! 'monthly' ! filename ! pairing ! filename !459 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 460 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 451 461 ! nn_isf == 4 452 sn_fwfisf = 'rnfisf' , -12 ,'sowflisf', .false. , .true. , 'yearly' , '' , '' ,''462 sn_fwfisf = 'rnfisf' , -12 ,'sowflisf', .false. , .true. , 'yearly' , '' , '' , '' 453 463 ! nn_isf == 3 454 sn_rnfisf = 'rnfisf' , -12 ,'sofwfisf', .false. , .true. , 'yearly' , '' , '' ,''464 sn_rnfisf = 'rnfisf' , -12 ,'sofwfisf', .false. , .true. , 'yearly' , '' , '' , '' 455 465 ! nn_isf == 2 and 3 456 sn_depmax_isf='rnfisf' , -12 ,'sozisfmax', .false. , .true. , 'yearly' , '' , '' ,''457 sn_depmin_isf='rnfisf' , -12 ,'sozisfmin', .false. , .true. , 'yearly' , '' , '' ,''466 sn_depmax_isf='rnfisf' , -12 ,'sozisfmax', .false. , .true. , 'yearly' , '' , '' , '' 467 sn_depmin_isf='rnfisf' , -12 ,'sozisfmin', .false. , .true. , 'yearly' , '' , '' , '' 458 468 ! nn_isf == 2 459 sn_Leff_isf = 'rnfisf' , -12 ,'Leff' , .false. , .true. , 'yearly' , '' , '' ,''469 sn_Leff_isf = 'rnfisf' , -12 ,'Leff' , .false. , .true. , 'yearly' , '' , '' , '' 460 470 ! 461 471 ! for all case … … 465 475 ! option 1 and 4 need ln_isfcav = .true. (domzgr) 466 476 ! only for nn_isf = 1 or 2 467 rn_gammat0 = 1.e-4 ! gammat coefficient used in blk formula468 rn_gammas0 = 1.e-4 ! gammas coefficient used in blk formula477 rn_gammat0 = 1.e-4 ! gammat coefficient used in blk formula 478 rn_gammas0 = 1.e-4 ! gammas coefficient used in blk formula 469 479 ! only for nn_isf = 1 or 4 470 480 rn_hisf_tbl = 30. ! thickness of the top boundary layer (Losh et al. 2008) 471 ! 0 => thickness of the tbl = thickness of the first wet cell481 ! ! 0 => thickness of the tbl = thickness of the first wet cell 472 482 ! only for nn_isf = 1 473 nn_isfblk = 1 ! 1 ISOMIP like: 2 equations formulation (Hunter et al., 2006)474 ! 2 ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015)475 nn_gammablk = 1 ! 0 = cst Gammat (= gammat/s)476 ! 1 = velocity dependend Gamma (u* * gammat/s) (Jenkins et al. 2010)477 ! 2 = velocity and stability dependent Gamma (Holland et al. 1999)483 nn_isfblk = 1 ! 1 ISOMIP like: 2 equations formulation (Hunter et al., 2006) 484 ! ! 2 ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2015) 485 nn_gammablk = 1 ! 0 = cst Gammat (= gammat/s) 486 ! ! 1 = velocity dependend Gamma (u* * gammat/s) (Jenkins et al. 2010) 487 ! ! 2 = velocity and stability dependent Gamma (Holland et al. 1999) 478 488 / 479 489 !----------------------------------------------------------------------- 480 490 &namsbc_iscpl ! land ice / ocean coupling option 481 491 !----------------------------------------------------------------------- 482 nn_drown = 10! number of iteration of the extrapolation loop (fill the new wet cells)483 ln_hsb = .false.! activate conservation module (conservation exact after a time of rn_fiscpl)484 nn_fiscpl = 43800! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency)492 nn_drown = 10 ! number of iteration of the extrapolation loop (fill the new wet cells) 493 ln_hsb = .false. ! activate conservation module (conservation exact after a time of rn_fiscpl) 494 nn_fiscpl = 43800 ! (number of time step) conservation period (maybe should be fix to the coupling frequencey of restart frequency) 485 495 / 486 496 !----------------------------------------------------------------------- 487 497 &namsbc_apr ! Atmospheric pressure used as ocean forcing or in bulk 488 498 !----------------------------------------------------------------------- 489 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !490 ! ! ! (if <0 months) ! name ! (logical)! (T/F) ! 'monthly' ! filename ! pairing ! filename !491 sn_apr = 'patm' , -1 ,'somslpre', .true. , .true. , 'yearly' , '' , '' ,''492 493 cn_dir = './' 494 rn_pref = 101000. 495 ln_ref_apr = .false. 496 ln_apr_obc = .false. 499 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 500 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 501 sn_apr = 'patm' , -1 ,'somslpre', .true. , .true. , 'yearly' , '' , '' , '' 502 503 cn_dir = './' ! root directory for the location of the bulk files 504 rn_pref = 101000. ! reference atmospheric pressure [N/m2]/ 505 ln_ref_apr = .false. ! ref. pressure: global mean Patm (T) or a constant (F) 506 ln_apr_obc = .false. ! inverse barometer added to OBC ssh data 497 507 / 498 508 !----------------------------------------------------------------------- 499 509 &namsbc_ssr ! surface boundary condition : sea surface restoring (ln_ssr=T) 500 510 !----------------------------------------------------------------------- 501 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !502 ! ! ! (if <0 months) ! name ! (logical)! (T/F) ! 'monthly' ! filename ! pairing ! filename !503 sn_sst = 'sst_data' , 24 , 'sst' , .false. , .false., 'yearly' , '' , '' ,''504 sn_sss = 'sss_data' , -1 , 'sss' , .true. , .true. , 'yearly' , '' , '' ,''511 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 512 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 513 sn_sst = 'sst_data', 24 , 'sst' , .false. , .false., 'yearly' , '' , '' , '' 514 sn_sss = 'sss_data', -1 , 'sss' , .true. , .true. , 'yearly' , '' , '' , '' 505 515 506 516 cn_dir = './' ! root directory for the location of the runoff files … … 510 520 rn_dqdt = -40. ! magnitude of the retroaction on temperature [W/m2/K] 511 521 rn_deds = -166.67 ! magnitude of the damping on salinity [mm/day] 512 ln_sssr_bnd = .true.! flag to bound erp term (associated with nn_sssr=2)522 ln_sssr_bnd = .true. ! flag to bound erp term (associated with nn_sssr=2) 513 523 rn_sssr_bnd = 4.e0 ! ABS(Max/Min) value of the damping erp term [mm/day] 514 524 / … … 516 526 &namsbc_alb ! albedo parameters 517 527 !----------------------------------------------------------------------- 518 nn_ice_alb = 0 ! parameterization of ice/snow albedo519 ! 0: Shine & Henderson-Sellers (JGR 1985)520 ! 1: "home made" based on Brandt et al. (J. Climate 2005)521 ! and Grenfell & Perovich (JGR 2004)522 rn_albice = 0.53 ! albedo of bare puddled ice (values from 0.49 to 0.58)523 ! 0.53 (default) => if nn_ice_alb=0524 ! 0.50 (default) => if nn_ice_alb=1528 nn_ice_alb = 0 ! parameterization of ice/snow albedo 529 ! 0: Shine & Henderson-Sellers (JGR 1985) 530 ! 1: "home made" based on Brandt et al. (J. Climate 2005) 531 ! and Grenfell & Perovich (JGR 2004) 532 rn_albice = 0.53 ! albedo of bare puddled ice (values from 0.49 to 0.58) 533 ! 0.53 (default) => if nn_ice_alb=0 534 ! 0.50 (default) => if nn_ice_alb=1 525 535 / 526 536 !----------------------------------------------------------------------- 527 537 &namsbc_wave ! External fields from wave model (ln_wave=T) 528 538 !----------------------------------------------------------------------- 529 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !530 ! ! ! (if <0 months) ! name ! (logical)! (T/F) ! 'monthly' ! filename ! pairing ! filename !531 sn_cdg = 'cdg_wave' , 1 , 'drag_coeff', .true. , .false., 'daily' ,'' , '' , ''532 sn_usd = 'sdw_wave' , 1 , 'u_sd2d' , .true. , .false., 'daily' ,'' , '' , ''533 sn_vsd = 'sdw_wave' , 1 , 'v_sd2d' , .true. , .false., 'daily' ,'' , '' , ''534 sn_wn = 'sdw_wave' , 1 , 'wave_num' , .true. , .false., 'daily' ,'' , '' , ''539 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 540 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 541 sn_cdg = 'cdg_wave', 1 , 'drag_coeff', .true. , .false., 'daily' , '' , '' , '' 542 sn_usd = 'sdw_wave', 1 , 'u_sd2d' , .true. , .false., 'daily' , '' , '' , '' 543 sn_vsd = 'sdw_wave', 1 , 'v_sd2d' , .true. , .false., 'daily' , '' , '' , '' 544 sn_wn = 'sdw_wave', 1 , 'wave_num' , .true. , .false., 'daily' , '' , '' , '' 535 545 ! 536 546 cn_dir_cdg = './' ! root directory for the location of drag coefficient files 537 ln_cdgw = .false.! Neutral drag coefficient read from wave model538 ln_sdw = .false.! Computation of 3D stokes drift547 ln_cdgw = .false. ! Neutral drag coefficient read from wave model 548 ln_sdw = .false. ! Computation of 3D stokes drift 539 549 / 540 550 !----------------------------------------------------------------------- … … 566 576 rn_speed_limit = 0. ! CFL speed limit for a berg 567 577 568 ! ! file name ! frequency (hours) ! variable ! time interp. 569 ! ! ! (if <0 months) ! name ! 570 sn_icb = 'calving', -1 , 'calvingmask', .true. , .true. , 'yearly' , '' , '' ,''578 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 579 ! ! ! (if <0 months) ! name ! (logical) ! (T/F ) ! 'monthly' ! filename ! pairing ! filename ! 580 sn_icb = 'calving', -1 , 'calvingmask', .true. , .true. , 'yearly' , '' , '' , '' 571 581 572 582 cn_dir = './' … … 578 588 !! namlbc lateral momentum boundary condition 579 589 !! namagrif agrif nested grid ( read by child model only ) ("key_agrif") 590 !! nam_tide Tidal forcing 580 591 !! nambdy Unstructured open boundaries ("key_bdy") 581 !! namtide Tidal forcing at open boundaries ("key_bdy_tides") 592 !! nambdy_dta Unstructured open boundaries - external data ("key_bdy") 593 !! nambdy_tide tidal forcing at open boundaries ("key_bdy_tides") 582 594 !!====================================================================== 583 595 ! … … 585 597 &namlbc ! lateral momentum boundary condition 586 598 !----------------------------------------------------------------------- 599 ! ! free slip ! partial slip ! no slip ! strong slip 587 600 rn_shlat = 2. ! shlat = 0 ! 0 < shlat < 2 ! shlat = 2 ! 2 < shlat 588 ! ! free slip ! partial slip ! no slip ! strong slip589 601 ln_vorlat = .false. ! consistency of vorticity boundary condition with analytical Eqs. 590 602 / … … 601 613 &nam_tide ! tide parameters ("key_tide") 602 614 !----------------------------------------------------------------------- 603 ln_tide_pot = .true.! use tidal potential forcing604 ln_tide_ramp = .false.!605 rdttideramp = 0.!606 clname(1) = 'DUMMY'! name of constituent - all tidal components must be set in namelist_cfg615 ln_tide_pot = .true. ! use tidal potential forcing 616 ln_tide_ramp= .false. ! 617 rdttideramp = 0. ! 618 clname(1) = 'DUMMY' ! name of constituent - all tidal components must be set in namelist_cfg 607 619 / 608 620 !----------------------------------------------------------------------- … … 643 655 &nambdy_dta ! open boundaries - external data ("key_bdy") 644 656 !----------------------------------------------------------------------- 645 ! ! file name ! frequency (hours) ! variable ! time interp. 646 ! ! ! (if <0 months) ! name ! (logical) 647 bn_ssh = 'amm12_bdyT_u2d' , 24 , 'sossheig', .true. , .false. , 'daily' , '' , '' ,''648 bn_u2d = 'amm12_bdyU_u2d' , 24 , 'vobtcrtx', .true. , .false. , 'daily' , '' , '' ,''649 bn_v2d = 'amm12_bdyV_u2d' , 24 , 'vobtcrty', .true. , .false. , 'daily' , '' , '' ,''650 bn_u3d = 'amm12_bdyU_u3d' , 24 , 'vozocrtx', .true. , .false. , 'daily' , '' , '' ,''651 bn_v3d = 'amm12_bdyV_u3d' , 24 , 'vomecrty', .true. , .false. , 'daily' , '' , '' ,''652 bn_tem = 'amm12_bdyT_tra' , 24 , 'votemper', .true. , .false. , 'daily' , '' , '' ,''653 bn_sal = 'amm12_bdyT_tra' , 24 , 'vosaline', .true. , .false. , 'daily' , '' , '' ,''657 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 658 ! ! ! (if <0 months) ! name ! (logical) ! (T/F ) ! 'monthly' ! filename ! pairing ! filename ! 659 bn_ssh = 'amm12_bdyT_u2d', 24 , 'sossheig', .true. , .false. , 'daily' , '' , '' , '' 660 bn_u2d = 'amm12_bdyU_u2d', 24 , 'vobtcrtx', .true. , .false. , 'daily' , '' , '' , '' 661 bn_v2d = 'amm12_bdyV_u2d', 24 , 'vobtcrty', .true. , .false. , 'daily' , '' , '' , '' 662 bn_u3d = 'amm12_bdyU_u3d', 24 , 'vozocrtx', .true. , .false. , 'daily' , '' , '' , '' 663 bn_v3d = 'amm12_bdyV_u3d', 24 , 'vomecrty', .true. , .false. , 'daily' , '' , '' , '' 664 bn_tem = 'amm12_bdyT_tra', 24 , 'votemper', .true. , .false. , 'daily' , '' , '' , '' 665 bn_sal = 'amm12_bdyT_tra', 24 , 'vosaline', .true. , .false. , 'daily' , '' , '' , '' 654 666 ! for lim2 655 ! bn_frld = 'amm12_bdyT_ice' , 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' ,''656 ! bn_hicif = 'amm12_bdyT_ice' , 24 , 'iicethic', .true. , .false. , 'daily' , '' , '' ,''657 ! bn_hsnif = 'amm12_bdyT_ice' , 24 , 'isnowthi', .true. , .false. , 'daily' , '' , '' ,''667 ! bn_frld = 'amm12_bdyT_ice', 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' , '' 668 ! bn_hicif = 'amm12_bdyT_ice', 24 , 'iicethic', .true. , .false. , 'daily' , '' , '' , '' 669 ! bn_hsnif = 'amm12_bdyT_ice', 24 , 'isnowthi', .true. , .false. , 'daily' , '' , '' , '' 658 670 ! for lim3 659 ! bn_a_i = 'amm12_bdyT_ice' , 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' ,''660 ! bn_ht_i = 'amm12_bdyT_ice' , 24 , 'iicethic', .true. , .false. , 'daily' , '' , '' ,''661 ! bn_ht_s = 'amm12_bdyT_ice' , 24 , 'isnowthi', .true. , .false. , 'daily' , '' , '' ,''662 663 cn_dir = 'bdydta/'! root directory for the location of the bulk files664 ln_full_vel = .false. 665 / 666 !----------------------------------------------------------------------- 667 &nambdy_tide !tidal forcing at open boundaries671 ! bn_a_i = 'amm12_bdyT_ice', 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' , '' 672 ! bn_ht_i = 'amm12_bdyT_ice', 24 , 'iicethic', .true. , .false. , 'daily' , '' , '' , '' 673 ! bn_ht_s = 'amm12_bdyT_ice', 24 , 'isnowthi', .true. , .false. , 'daily' , '' , '' , '' 674 675 cn_dir = 'bdydta/' ! root directory for the location of the bulk files 676 ln_full_vel = .false. ! 677 / 678 !----------------------------------------------------------------------- 679 &nambdy_tide ! tidal forcing at open boundaries 668 680 !----------------------------------------------------------------------- 669 681 filtide = 'bdydta/amm12_bdytide_' ! file name root of tidal forcing files … … 671 683 ln_bdytide_conj = .false. ! 672 684 / 685 673 686 !!====================================================================== 674 687 !! *** Bottom boundary condition *** … … 686 699 rn_bfri1 = 4.e-4 ! bottom drag coefficient (linear case) 687 700 rn_bfri2 = 1.e-3 ! bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T 688 rn_bfri2_max =1.e-1 ! max. bottom drag coefficient (non linear case and ln_loglayer=T)701 rn_bfri2_max= 1.e-1 ! max. bottom drag coefficient (non linear case and ln_loglayer=T) 689 702 rn_bfeb2 = 2.5e-3 ! bottom turbulent kinetic energy background (m2/s2) 690 703 rn_bfrz0 = 3.e-3 ! bottom roughness [m] if ln_loglayer=T … … 693 706 rn_tfri1 = 4.e-4 ! top drag coefficient (linear case) 694 707 rn_tfri2 = 2.5e-3 ! top drag coefficient (non linear case). Minimum coeft if ln_loglayer=T 695 rn_tfri2_max =1.e-1 ! max. top drag coefficient (non linear case and ln_loglayer=T)708 rn_tfri2_max= 1.e-1 ! max. top drag coefficient (non linear case and ln_loglayer=T) 696 709 rn_tfeb2 = 0.0 ! top turbulent kinetic energy background (m2/s2) 697 710 rn_tfrz0 = 3.e-3 ! top roughness [m] if ln_loglayer=T 698 711 ln_tfr2d = .false. ! horizontal variation of the top friction coef (read a 2D mask file ) 699 rn_tfrien = 50.! local multiplying factor of tfr (ln_tfr2d=T)712 rn_tfrien = 50. ! local multiplying factor of tfr (ln_tfr2d=T) 700 713 701 714 ln_bfrimp = .true. ! implicit bottom friction (requires ln_zdfexp = .false. if true) … … 719 732 &nambbl ! bottom boundary layer scheme ("key_trabbl") 720 733 !----------------------------------------------------------------------- 721 nn_bbl_ldf = 1 ! diffusive bbl (=1) or not (=0)722 nn_bbl_adv = 0 ! advective bbl (=1/2) or not (=0)723 rn_ahtbbl = 1000. ! lateral mixing coefficient in the bbl [m2/s]724 rn_gambbl = 10. ! advective bbl coefficient [s]734 nn_bbl_ldf = 1 ! diffusive bbl (=1) or not (=0) 735 nn_bbl_adv = 0 ! advective bbl (=1/2) or not (=0) 736 rn_ahtbbl = 1000. ! lateral mixing coefficient in the bbl [m2/s] 737 rn_gambbl = 10. ! advective bbl coefficient [s] 725 738 / 726 739 … … 739 752 &nameos ! ocean physical parameters 740 753 !----------------------------------------------------------------------- 741 nn_eos = -1 ! type of equation of state and Brunt-Vaisala frequency 742 ! =-1, TEOS-10 743 ! = 0, EOS-80 744 ! = 1, S-EOS (simplified eos) 745 ln_useCT = .true. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 746 ! 747 ! ! S-EOS coefficients : 748 ! rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 749 rn_a0 = 1.6550e-1 ! thermal expension coefficient (nn_eos= 1) 750 rn_b0 = 7.6554e-1 ! saline expension coefficient (nn_eos= 1) 751 rn_lambda1 = 5.9520e-2 ! cabbeling coeff in T^2 (=0 for linear eos) 752 rn_lambda2 = 7.4914e-4 ! cabbeling coeff in S^2 (=0 for linear eos) 753 rn_mu1 = 1.4970e-4 ! thermobaric coeff. in T (=0 for linear eos) 754 rn_mu2 = 1.1090e-5 ! thermobaric coeff. in S (=0 for linear eos) 755 rn_nu = 2.4341e-3 ! cabbeling coeff in T*S (=0 for linear eos) 754 ln_teos10 = .false. ! = Use TEOS-10 equation of state 755 ln_eos80 = .false. ! = Use EOS80 equation of state 756 ln_seos = .false. ! = Use simplified equation of state (S-EOS) 757 ! ! rhd(T,S,Z)*rau0 =-[a0+cb/2*(T-T0)+th*Z]*(T-T0) + b0*(S-35) 758 rn_a0 = 0.0e0 ! a0, thermal contraction coeff. (=0 except if rn_cb=0) 759 rn_b0 = 7.7e-1 ! b0, haline contraction coeff. 760 rn_cb = 1.1e-2 ! cb, cabbeling coeff. 761 rn_t0 = -4.5 ! T0, reference temperature (where alpha=0) 762 rn_th = 2.5e-5 ! th, thermobaric coeff. 763 ln_leos = .false. ! = Use linear equation of state (L-EOS) 764 ! ! rd(T,S,Z)*rau0 = -al*(T-10) + bl*(S-35) 765 rn_al = 1.6550e-1 ! al, thermal expension coefficient 766 rn_bl = 7.6554e-1 ! bl, saline expension coefficient 756 767 / 757 768 !----------------------------------------------------------------------- 758 769 &namtra_adv ! advection scheme for tracer (default: NO advection) 759 770 !----------------------------------------------------------------------- 760 ln_traadv_cen = .false.! 2nd order centered scheme761 nn_cen_h = 4 762 nn_cen_v = 4 763 ln_traadv_fct = .false.! FCT scheme764 nn_fct_h = 2 765 nn_fct_v = 2 766 nn_fct_zts = 0 767 ! 768 ln_traadv_mus = .false.! MUSCL scheme769 ln_mus_ups = .false.! use upstream scheme near river mouths770 ln_traadv_ubs = .false.! UBS scheme771 nn_ubs_v = 2 772 ln_traadv_qck = .false.! QUICKEST scheme771 ln_traadv_cen = .false. ! 2nd order centered scheme 772 nn_cen_h = 4 ! =2/4, horizontal 2nd order CEN / 4th order CEN 773 nn_cen_v = 4 ! =2/4, vertical 2nd order CEN / 4th order COMPACT 774 ln_traadv_fct = .false. ! FCT scheme 775 nn_fct_h = 2 ! =2/4, horizontal 2nd / 4th order 776 nn_fct_v = 2 ! =2/4, vertical 2nd / COMPACT 4th order 777 nn_fct_zts = 0 ! >=1, 2nd order FCT scheme with vertical sub-timestepping 778 ! ! (number of sub-timestep = nn_fct_zts) 779 ln_traadv_mus = .false. ! MUSCL scheme 780 ln_mus_ups = .false. ! use upstream scheme near river mouths 781 ln_traadv_ubs = .false. ! UBS scheme 782 nn_ubs_v = 2 ! =2 , vertical 2nd order FCT / COMPACT 4th order 783 ln_traadv_qck = .false. ! QUICKEST scheme 773 784 / 774 785 !----------------------------------------------------------------------- 775 786 &namtra_adv_mle ! mixed layer eddy parametrisation (Fox-Kemper param) (default: NO) 776 787 !----------------------------------------------------------------------- 777 ln_mle = .false.! (T) use the Mixed Layer Eddy (MLE) parameterisation778 rn_ce = 0.06! magnitude of the MLE (typical value: 0.06 to 0.08)779 nn_mle = 1! MLE type: =0 standard Fox-Kemper ; =1 new formulation780 rn_lf = 5.e+3! typical scale of mixed layer front (meters) (case rn_mle=0)781 rn_time = 172800.! time scale for mixing momentum across the mixed layer (seconds) (case rn_mle=0)782 rn_lat = 20.! reference latitude (degrees) of MLE coef. (case rn_mle=1)783 nn_mld_uv = 0! space interpolation of MLD at u- & v-pts (0=min,1=averaged,2=max)784 nn_conv = 0! =1 no MLE in case of convection ; =0 always MLE785 rn_rho_c_mle = 0.01! delta rho criterion used to calculate MLD for FK788 ln_mle = .false. ! (T) use the Mixed Layer Eddy (MLE) parameterisation 789 rn_ce = 0.06 ! magnitude of the MLE (typical value: 0.06 to 0.08) 790 nn_mle = 1 ! MLE type: =0 standard Fox-Kemper ; =1 new formulation 791 rn_lf = 5.e+3 ! typical scale of mixed layer front (meters) (case rn_mle=0) 792 rn_time = 172800. ! time scale for mixing momentum across the mixed layer (seconds) (case rn_mle=0) 793 rn_lat = 20. ! reference latitude (degrees) of MLE coef. (case rn_mle=1) 794 nn_mld_uv = 0 ! space interpolation of MLD at u- & v-pts (0=min,1=averaged,2=max) 795 nn_conv = 0 ! =1 no MLE in case of convection ; =0 always MLE 796 rn_rho_c_mle= 0.01 ! delta rho criterion used to calculate MLD for FK 786 797 / 787 798 !----------------------------------------------------------------------- … … 792 803 ln_traldf_lap = .false. ! laplacian operator 793 804 ln_traldf_blp = .false. ! bilaplacian operator 805 ! 794 806 ! ! Direction of action: 795 807 ln_traldf_lev = .false. ! iso-level … … 867 879 ln_vvl_layer = .false. ! full layer vertical coordinate 868 880 ln_vvl_ztilde_as_zstar = .false. ! ztilde vertical coordinate emulating zstar 869 ln_vvl_zstar_at_eqtor = .false.! ztilde near the equator881 ln_vvl_zstar_at_eqtor = .false. ! ztilde near the equator 870 882 rn_ahe3 = 0.0e0 ! thickness diffusion coefficient 871 883 rn_rst_e3t = 30.e0 ! ztilde to zstar restoration timescale [days] … … 875 887 / 876 888 !----------------------------------------------------------------------- 877 &namdyn_vor ! option of physics/algorithm(default: NO)889 &namdyn_vor ! Vorticity and/or Coriolis scheme (default: NO) 878 890 !----------------------------------------------------------------------- 879 891 ln_dynvor_ene = .false. ! enstrophy conserving scheme … … 955 967 nn_havtb = 0 ! horizontal shape for avtb (=1) or not (=0) 956 968 ln_zdfevd = .true. ! enhanced vertical diffusion (evd) (T) or not (F) 957 nn_evdm = 0 !evd apply on tracer (=0) or on tracer and momentum (=1)958 rn_avevd = 100.! evd mixing coefficient [m2/s]969 nn_evdm = 0 ! evd apply on tracer (=0) or on tracer and momentum (=1) 970 rn_avevd = 100. ! evd mixing coefficient [m2/s] 959 971 ln_zdfnpc = .false. ! Non-Penetrative Convective algorithm (T) or not (F) 960 nn_npc = 1 !frequency of application of npc961 nn_npcp = 365 !npc control print frequency972 nn_npc = 1 ! frequency of application of npc 973 nn_npcp = 365 ! npc control print frequency 962 974 ln_zdfexp = .false. ! time-stepping: split-explicit (T) or implicit (F) time stepping 963 nn_zdfexp = 3 !number of sub-timestep for ln_zdfexp=T975 nn_zdfexp = 3 ! number of sub-timestep for ln_zdfexp=T 964 976 / 965 977 !----------------------------------------------------------------------- 966 978 &namzdf_ric ! richardson number dependent vertical diffusion ("key_zdfric" ) 967 979 !----------------------------------------------------------------------- 968 rn_avmri = 100.e-4! maximum value of the vertical viscosity969 rn_alp = 5.! coefficient of the parameterization970 nn_ric = 2! coefficient of the parameterization971 rn_ekmfc = 0.7! Factor in the Ekman depth Equation972 rn_mldmin = 1.0! minimum allowable mixed-layer depth estimate (m)973 rn_mldmax = 1000.0! maximum allowable mixed-layer depth estimate (m)974 rn_wtmix = 10.0! vertical eddy viscosity coeff [m2/s] in the mixed-layer975 rn_wvmix = 10.0! vertical eddy diffusion coeff [m2/s] in the mixed-layer976 ln_mldw = .true.! Flag to use or not the mixed layer depth param.980 rn_avmri = 100.e-4 ! maximum value of the vertical viscosity 981 rn_alp = 5. ! coefficient of the parameterization 982 nn_ric = 2 ! coefficient of the parameterization 983 rn_ekmfc = 0.7 ! Factor in the Ekman depth Equation 984 rn_mldmin = 1.0 ! minimum allowable mixed-layer depth estimate (m) 985 rn_mldmax = 1000.0 ! maximum allowable mixed-layer depth estimate (m) 986 rn_wtmix = 10.0 ! vertical eddy viscosity coeff [m2/s] in the mixed-layer 987 rn_wvmix = 10.0 ! vertical eddy diffusion coeff [m2/s] in the mixed-layer 988 ln_mldw = .true. ! Flag to use or not the mixed layer depth param. 977 989 / 978 990 !----------------------------------------------------------------------- … … 994 1006 ln_lc = .true. ! Langmuir cell parameterisation (Axell 2002) 995 1007 rn_lc = 0.15 ! coef. associated to Langmuir cells 996 nn_etau = 1 ! penetration of tke below the mixed layer (ML) due to internal &intertial waves1008 nn_etau = 1 ! penetration of tke below the mixed layer (ML) due to near intertial waves 997 1009 ! = 0 no penetration 998 1010 ! = 1 add a tke source below the ML 999 1011 ! = 2 add a tke source just at the base of the ML 1000 ! = 3 as = 1 applied on HF part of the stress ("key_oasis3")1012 ! = 3 as = 1 applied on HF part of the stress (ln_cpl=T) 1001 1013 rn_efr = 0.05 ! fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 1002 1014 nn_htau = 1 ! type of exponential decrease of tke penetration below the ML … … 1005 1017 / 1006 1018 !----------------------------------------------------------------------- 1007 &namzdf_gls ! GLS vertical diffusion("key_zdfgls")1019 &namzdf_gls ! GLS vertical diffusion ("key_zdfgls") 1008 1020 !----------------------------------------------------------------------- 1009 1021 rn_emin = 1.e-7 ! minimum value of e [m2/s2] … … 1083 1095 / 1084 1096 !----------------------------------------------------------------------- 1085 &namsto ! Stochastic parametrization of EOS (default: NO) 1086 !----------------------------------------------------------------------- 1087 ln_sto_eos = .false. ! stochastic equation of state 1088 nn_sto_eos = 1 ! number of independent random walks 1089 rn_eos_stdxy = 1.4 ! random walk horz. standard deviation (in grid points) 1090 rn_eos_stdz = 0.7 ! random walk vert. standard deviation (in grid points) 1091 rn_eos_tcor = 1440. ! random walk time correlation (in timesteps) 1092 nn_eos_ord = 1 ! order of autoregressive processes 1093 nn_eos_flt = 0 ! passes of Laplacian filter 1094 rn_eos_lim = 2.0 ! limitation factor (default = 3.0) 1095 ! 1096 ln_rststo = .false. ! start from mean parameter (F) or from restart file (T) 1097 ln_rstseed = .true. ! read seed of RNG from restart file 1098 cn_storst_in = "restart_sto" ! suffix of stochastic parameter restart file (input) 1099 cn_storst_out= "restart_sto" ! suffix of stochastic parameter restart file (output) 1097 &namsto ! Stochastic parametrization of EOS (default: NO) 1098 !----------------------------------------------------------------------- 1099 ln_sto_eos = .false. ! stochastic equation of state 1100 nn_sto_eos = 1 ! number of independent random walks 1101 rn_eos_stdxy= 1.4 ! random walk horz. standard deviation (in grid points) 1102 rn_eos_stdz = 0.7 ! random walk vert. standard deviation (in grid points) 1103 rn_eos_tcor = 1440. ! random walk time correlation (in timesteps) 1104 nn_eos_ord = 1 ! order of autoregressive processes 1105 nn_eos_flt = 0 ! passes of Laplacian filter 1106 rn_eos_lim = 2.0 ! limitation factor (default = 3.0) 1107 ln_rststo = .false. ! start from mean parameter (F) or from restart file (T) 1108 ln_rstseed = .true. ! read seed of RNG from restart file 1109 cn_storst_in = "restart_sto" ! suffix of stochastic parameter restart file (input) 1110 cn_storst_out = "restart_sto" ! suffix of stochastic parameter restart file (output) 1100 1111 / 1101 1112 … … 1103 1114 !! *** Diagnostics namelists *** 1104 1115 !!====================================================================== 1105 !! namtrd dynamics and/or tracer trends 1106 !! namptr Poleward Transport Diagnostics 1107 !! namhsb Heat and salt budgets 1116 !! namtrd dynamics and/or tracer trends (default F) 1117 !! namptr Poleward Transport Diagnostics (default F) 1118 !! namhsb Heat and salt budgets (default F) 1119 !! namdiu Cool skin and warm layer models (default F) 1108 1120 !! namflo float parameters ("key_float") 1109 !! nam_diaharm Harmonic analysis of tidal constituents ('key_diaharm') 1110 !! namdct transports through some sections 1121 !! nam_diaharm Harmonic analysis of tidal constituents ("key_diaharm") 1122 !! namdct transports through some sections ("key_diadct") 1123 !! nam_diatmb Top Middle Bottom Output (default F) 1124 !! nam_dia25h 25h Mean Output (default F) 1111 1125 !! namnc4 netcdf4 chunking and compression settings ("key_netcdf4") 1112 1126 !!====================================================================== 1113 1127 ! 1114 1128 !----------------------------------------------------------------------- 1115 &namtrd ! diagnostics on dynamics and/or tracer trends (default F) 1116 ! ! and/or mixed-layer trends and/or barotropic vorticity 1129 &namtrd ! trend diagnostics (default F) 1117 1130 !----------------------------------------------------------------------- 1118 1131 ln_glo_trd = .false. ! (T) global domain averaged diag for T, T^2, KE, and PE … … 1134 1147 !!gm 1135 1148 !----------------------------------------------------------------------- 1136 &namptr ! Poleward Transport Diagnostic (default F) 1137 !----------------------------------------------------------------------- 1138 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 1139 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 1140 / 1141 !----------------------------------------------------------------------- 1142 &namhsb ! Heat and salt budgets (default F) 1143 !----------------------------------------------------------------------- 1144 ln_diahsb = .false. ! check the heat and salt budgets (T) or not (F) 1145 / 1146 !----------------------------------------------------------------------- 1147 &namflo ! float parameters ("key_float") 1148 !----------------------------------------------------------------------- 1149 jpnfl = 1 ! total number of floats during the run 1150 jpnnewflo = 0 ! number of floats for the restart 1151 ln_rstflo = .false. ! float restart (T) or not (F) 1152 nn_writefl = 75 ! frequency of writing in float output file 1153 nn_stockfl = 5475 ! frequency of creation of the float restart file 1154 ln_argo = .false. ! Argo type floats (stay at the surface each 10 days) 1155 ln_flork4 = .false. ! trajectories computed with a 4th order Runge-Kutta (T) 1156 ! or computed with Blanke' scheme (F) 1157 ln_ariane = .true. ! Input with Ariane tool convention(T) 1158 ln_flo_ascii = .true. ! Output with Ariane tool netcdf convention(F) or ascii file (T) 1159 / 1160 !----------------------------------------------------------------------- 1161 &nam_diaharm ! Harmonic analysis of tidal constituents ('key_diaharm') 1149 &namptr ! Poleward Transport Diagnostic (default F) 1150 !----------------------------------------------------------------------- 1151 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 1152 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 1153 / 1154 !----------------------------------------------------------------------- 1155 &namhsb ! Heat and salt budgets (default F) 1156 !----------------------------------------------------------------------- 1157 ln_diahsb = .false. ! check the heat and salt budgets (T) or not (F) 1158 / 1159 !----------------------------------------------------------------------- 1160 &namdiu ! Cool skin and warm layer models (default F) 1161 !----------------------------------------------------------------------- 1162 ln_diurnal = .false. ! 1163 ln_diurnal_only = .false. ! 1164 / 1165 !----------------------------------------------------------------------- 1166 &namflo ! float parameters ("key_float") 1167 !----------------------------------------------------------------------- 1168 jpnfl = 1 ! total number of floats during the run 1169 jpnnewflo = 0 ! number of floats for the restart 1170 ln_rstflo = .false. ! float restart (T) or not (F) 1171 nn_writefl = 75 ! frequency of writing in float output file 1172 nn_stockfl = 5475 ! frequency of creation of the float restart file 1173 ln_argo = .false. ! Argo type floats (stay at the surface each 10 days) 1174 ln_flork4 = .false. ! trajectories computed with a 4th order Runge-Kutta (T) 1175 ! ! or computed with Blanke' scheme (F) 1176 ln_ariane = .true. ! Input with Ariane tool convention(T) 1177 ln_flo_ascii= .true. ! Output with Ariane tool netcdf convention(F) or ascii file (T) 1178 / 1179 !----------------------------------------------------------------------- 1180 &nam_diaharm ! Harmonic analysis of tidal constituents ("key_diaharm") 1162 1181 !----------------------------------------------------------------------- 1163 1182 nit000_han = 1 ! First time step used for harmonic analysis … … 1168 1187 / 1169 1188 !----------------------------------------------------------------------- 1170 &namdct ! transports through some sections 1171 !----------------------------------------------------------------------- 1172 nn_dct = 15 ! time step frequency for transports computing 1173 nn_dctwri = 15 ! time step frequency for transports writing 1174 nn_secdebug = 112 ! 0 : no section to debug 1175 ! -1 : debug all section 1176 ! 0 < n : debug section number n 1177 / 1178 !----------------------------------------------------------------------- 1179 &namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4") 1189 &namdct ! transports through some sections ("key_diadct") 1190 !----------------------------------------------------------------------- 1191 nn_dct = 15 ! time step frequency for transports computing 1192 nn_dctwri = 15 ! time step frequency for transports writing 1193 nn_secdebug= 112 ! 0 : no section to debug 1194 ! ! -1 : debug all section 1195 ! ! 0 < n : debug section number n 1196 / 1197 !----------------------------------------------------------------------- 1198 &nam_diatmb ! Top Middle Bottom Output (default F) 1199 !----------------------------------------------------------------------- 1200 ln_diatmb = .false. ! Choose Top Middle and Bottom output or not 1201 / 1202 !----------------------------------------------------------------------- 1203 &nam_dia25h ! 25h Mean Output (default F) 1204 !----------------------------------------------------------------------- 1205 ln_dia25h = .false. ! Choose 25h mean output or not 1206 / 1207 !----------------------------------------------------------------------- 1208 &namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4") 1180 1209 !----------------------------------------------------------------------- 1181 1210 nn_nchunks_i= 4 ! number of chunks in i-dimension 1182 1211 nn_nchunks_j= 4 ! number of chunks in j-dimension 1183 1212 nn_nchunks_k= 31 ! number of chunks in k-dimension 1184 1185 1213 ! ! setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which 1214 ! ! is optimal for postprocessing which works exclusively with horizontal slabs 1186 1215 ln_nc4zip = .true. ! (T) use netcdf4 chunking and compression 1187 1216 ! ! (F) ignore chunking information and produce netcdf3-compatible files 1188 1217 / 1189 1218 … … 1196 1225 ! 1197 1226 !----------------------------------------------------------------------- 1198 &namobs ! observation usage switch1199 !----------------------------------------------------------------------- 1200 ln_diaobs = .false. ! Logical switch for the observation operator1201 ln_t3d = .false. ! Logical switch for T profile observations1202 ln_s3d = .false. ! Logical switch for S profile observations1203 ln_sla = .false. ! Logical switch for SLA observations1204 ln_sst = .false. ! Logical switch for SST observations1205 ln_sic = .false. ! Logical switch for Sea Ice observations1206 ln_vel3d = .false. ! Logical switch for velocity observations1207 ln_altbias = .false. ! Logical switch for altimeter bias correction1208 ln_nea = .false. ! Logical switch for rejection of observations near land1209 ln_grid_global = .true. ! Logical switch for global distribution of observations1210 ln_grid_search_lookup = .false. ! Logical switch for obs grid search w/lookup table1211 ln_ignmis = .true. ! Logical switch for ignoring missing files1212 ln_s_at_t = .false. ! Logical switch for computing model S at T obs if not there1213 ln_sstnight = .false. ! Logical switch for calculating night-time average for SST obs1227 &namobs ! observation usage switch 1228 !----------------------------------------------------------------------- 1229 ln_diaobs = .false. ! Logical switch for the observation operator 1230 ln_t3d = .false. ! Logical switch for T profile observations 1231 ln_s3d = .false. ! Logical switch for S profile observations 1232 ln_sla = .false. ! Logical switch for SLA observations 1233 ln_sst = .false. ! Logical switch for SST observations 1234 ln_sic = .false. ! Logical switch for Sea Ice observations 1235 ln_vel3d = .false. ! Logical switch for velocity observations 1236 ln_altbias = .false. ! Logical switch for altimeter bias correction 1237 ln_nea = .false. ! Logical switch for rejection of observations near land 1238 ln_grid_global = .true. ! Logical switch for global distribution of observations 1239 ln_grid_search_lookup = .false. ! Logical switch for obs grid search w/lookup table 1240 ln_ignmis = .true. ! Logical switch for ignoring missing files 1241 ln_s_at_t = .false. ! Logical switch for computing model S at T obs if not there 1242 ln_sstnight = .false. ! Logical switch for calculating night-time average for SST obs 1214 1243 ! All of the *files* variables below are arrays. Use namelist_cfg to add more files 1215 cn_profbfiles = 'profiles_01.nc' ! Profile feedback input observation file names 1216 cn_slafbfiles = 'sla_01.nc' ! SLA feedback input observation file names 1217 cn_sstfbfiles = 'sst_01.nc' ! SST feedback input observation file names 1218 cn_sicfbfiles = 'sic_01.nc' ! SIC feedback input observation file names 1219 cn_velfbfiles = 'vel_01.nc' ! Velocity feedback input observation file names 1220 cn_altbiasfile = 'altbias.nc' ! Altimeter bias input file name 1221 cn_gridsearchfile = 'gridsearch.nc' ! Grid search file name 1222 rn_gridsearchres = 0.5 ! Grid search resolution 1223 rn_dobsini = 00010101.000000 ! Initial date in window YYYYMMDD.HHMMSS 1224 rn_dobsend = 00010102.000000 ! Final date in window YYYYMMDD.HHMMSS 1225 nn_1dint = 0 ! Type of vertical interpolation method 1226 nn_2dint = 0 ! Type of horizontal interpolation method 1227 nn_msshc = 0 ! MSSH correction scheme 1228 rn_mdtcorr = 1.61 ! MDT correction 1229 rn_mdtcutoff = 65.0 ! MDT cutoff for computed correction 1230 nn_profdavtypes = -1 ! Profile daily average types - array 1231 ln_sstbias = .false. 1232 cn_sstbias_files = 'sstbias.nc' 1233 / 1234 !----------------------------------------------------------------------- 1235 &nam_asminc ! assimilation increments ('key_asminc') 1236 !----------------------------------------------------------------------- 1237 ln_bkgwri = .false. ! Logical switch for writing out background state 1238 ln_trainc = .false. ! Logical switch for applying tracer increments 1239 ln_dyninc = .false. ! Logical switch for applying velocity increments 1240 ln_sshinc = .false. ! Logical switch for applying SSH increments 1241 ln_asmdin = .false. ! Logical switch for Direct Initialization (DI) 1242 ln_asmiau = .false. ! Logical switch for Incremental Analysis Updating (IAU) 1243 nitbkg = 0 ! Timestep of background in [0,nitend-nit000-1] 1244 nitdin = 0 ! Timestep of background for DI in [0,nitend-nit000-1] 1245 nitiaustr = 1 ! Timestep of start of IAU interval in [0,nitend-nit000-1] 1246 nitiaufin = 15 ! Timestep of end of IAU interval in [0,nitend-nit000-1] 1247 niaufn = 0 ! Type of IAU weighting function 1248 ln_salfix = .false. ! Logical switch for ensuring that the sa > salfixmin 1249 salfixmin = -9999 ! Minimum salinity after applying the increments 1250 nn_divdmp = 0 ! Number of iterations of divergence damping operator 1251 / 1252 !----------------------------------------------------------------------- 1253 &namdiu ! Cool skin and warm layer models 1254 !----------------------------------------------------------------------- 1255 ln_diurnal = .false. ! 1256 ln_diurnal_only = .false. ! 1257 / 1258 !----------------------------------------------------------------------- 1259 &nam_diatmb ! Top Middle Bottom Output 1260 !----------------------------------------------------------------------- 1261 ln_diatmb = .false. ! Choose Top Middle and Bottom output or not 1262 / 1263 !----------------------------------------------------------------------- 1264 &namwad ! Wetting and drying 1265 !----------------------------------------------------------------------- 1266 ln_wd = .false. ! T/F activation of wetting and drying 1267 rn_wdmin1 = 0.1 ! Minimum wet depth on dried cells 1268 rn_wdmin2 = 0.01 ! Tolerance of min wet depth on dried cells 1269 rn_wdld = 20.0 ! Land elevation below which wetting/drying is allowed 1270 nn_wdit = 10 ! Max iterations for W/D limiter 1271 / 1272 !----------------------------------------------------------------------- 1273 &nam_dia25h ! 25h Mean Output 1274 !----------------------------------------------------------------------- 1275 ln_dia25h = .false. ! Choose 25h mean output or not 1276 / 1244 cn_profbfiles = 'profiles_01.nc' ! Profile feedback input observation file names 1245 cn_slafbfiles = 'sla_01.nc' ! SLA feedback input observation file names 1246 cn_sstfbfiles = 'sst_01.nc' ! SST feedback input observation file names 1247 cn_sicfbfiles = 'sic_01.nc' ! SIC feedback input observation file names 1248 cn_velfbfiles = 'vel_01.nc' ! Velocity feedback input observation file names 1249 cn_altbiasfile = 'altbias.nc' ! Altimeter bias input file name 1250 cn_gridsearchfile='gridsearch.nc' ! Grid search file name 1251 rn_gridsearchres = 0.5 ! Grid search resolution 1252 rn_dobsini = 00010101.000000 ! Initial date in window YYYYMMDD.HHMMSS 1253 rn_dobsend = 00010102.000000 ! Final date in window YYYYMMDD.HHMMSS 1254 nn_1dint = 0 ! Type of vertical interpolation method 1255 nn_2dint = 0 ! Type of horizontal interpolation method 1256 nn_msshc = 0 ! MSSH correction scheme 1257 rn_mdtcorr = 1.61 ! MDT correction 1258 rn_mdtcutoff = 65.0 ! MDT cutoff for computed correction 1259 nn_profdavtypes = -1 ! Profile daily average types - array 1260 ln_sstbias = .false. ! 1261 cn_sstbias_files = 'sstbias.nc' ! 1262 / 1263 !----------------------------------------------------------------------- 1264 &nam_asminc ! assimilation increments ('key_asminc') 1265 !----------------------------------------------------------------------- 1266 ln_bkgwri = .false. ! Logical switch for writing out background state 1267 ln_trainc = .false. ! Logical switch for applying tracer increments 1268 ln_dyninc = .false. ! Logical switch for applying velocity increments 1269 ln_sshinc = .false. ! Logical switch for applying SSH increments 1270 ln_asmdin = .false. ! Logical switch for Direct Initialization (DI) 1271 ln_asmiau = .false. ! Logical switch for Incremental Analysis Updating (IAU) 1272 nitbkg = 0 ! Timestep of background in [0,nitend-nit000-1] 1273 nitdin = 0 ! Timestep of background for DI in [0,nitend-nit000-1] 1274 nitiaustr = 1 ! Timestep of start of IAU interval in [0,nitend-nit000-1] 1275 nitiaufin = 15 ! Timestep of end of IAU interval in [0,nitend-nit000-1] 1276 niaufn = 0 ! Type of IAU weighting function 1277 ln_salfix = .false. ! Logical switch for ensuring that the sa > salfixmin 1278 salfixmin = -9999 ! Minimum salinity after applying the increments 1279 nn_divdmp = 0 ! Number of iterations of divergence damping operator 1280 / -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/CONFIG/SHARED/namelist_top_ref
r6140 r6851 68 68 rn_ahtrc_0 = 2000. ! lateral eddy diffusivity (lap. operator) [m2/s] 69 69 rn_bhtrc_0 = 1.e+12 ! lateral eddy diffusivity (bilap. operator) [m4/s] 70 ! 71 rn_fact_lap = 1. ! enhanced zonal eddy diffusivity 70 72 / 71 73 !----------------------------------------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r5341 r6851 234 234 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce, v_oce !: surface ocean velocity used in ice dynamics 235 235 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s] 236 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pahu , pahv !: ice hor. eddy diffusivity coef. at U- and V-points237 236 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ust2s, hicol !: friction velocity, ice collection thickness accreted in leads 238 237 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strp1, strp2 !: strength at previous time steps … … 253 252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhld !: heat flux from the lead used for bottom melting 254 253 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: snow-ocean mass exchange over 1 time step [kg/m2]256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: snow precipitation on ice over 1 time step [kg/m2]257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: snow sublimation over 1 time step [kg/m2]258 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: ice-ocean mass exchange over 1 time step [kg/m2]260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: snow ice growth component of wfx_ice [kg/m2]261 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: lateral ice growth component of wfx_ice [kg/m2]262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: bottom ice growth component of wfx_ice [kg/m2]263 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: dynamical ice growth component of wfx_ice [kg /m2]264 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: bottom melt component of wfx_ice [kg/m2]265 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: surface melt component of wfx_ice [kg/m2]266 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: residual component of wfx_ice [kg/m2]267 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_tot !: ice concentration tendency (total) [s-1]254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: snow-ocean mass exchange [kg.m-2.s-1] 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: snow precipitation on ice [kg.m-2.s-1] 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: snow/ice sublimation [kg.m-2.s-1] 257 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: ice-ocean mass exchange [kg.m-2.s-1] 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sni !: snow ice growth component of wfx_ice [kg.m-2.s-1] 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_opw !: lateral ice growth component of wfx_ice [kg.m-2.s-1] 261 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bog !: bottom ice growth component of wfx_ice [kg.m-2.s-1] 262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_dyn !: dynamical ice growth component of wfx_ice [kg.m-2.s-1] 263 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_bom !: bottom melt component of wfx_ice [kg.m-2.s-1] 264 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sum !: surface melt component of wfx_ice [kg.m-2.s-1] 265 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_res !: residual component of wfx_ice [kg.m-2.s-1] 266 267 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_tot !: ice concentration tendency (total) [s-1] 269 268 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_thd !: ice concentration tendency (thermodynamics) [s-1] 270 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_dyn !: ice concentration tendency (dynamics) [s-1]269 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_dyn !: ice concentration tendency (dynamics) [s-1] 271 270 272 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice growth/melt [PSU/m2/s] … … 279 278 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_res !: residual salt flux due to correction of ice thickness [PSU/m2/s] 280 279 281 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bog !: total heat flux causing bottom ice growth 282 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bom !: total heat flux causing bottom ice melt 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sum !: total heat flux causing surface ice melt 284 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_opw !: total heat flux causing open water ice formation 285 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dif !: total heat flux causing Temp change in the ice 286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_snw !: heat flux for snow melt 287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err !: heat flux error after heat diffusion 288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_dif !: heat flux remaining due to change in non-solar flux 289 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping 290 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_in !: heat flux available for thermo transformations 291 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_out !: heat flux remaining at the end of thermo transformations 292 280 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_sub !: salt flux due to ice sublimation 281 282 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bog !: total heat flux causing bottom ice growth [W.m-2] 283 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_bom !: total heat flux causing bottom ice melt [W.m-2] 284 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sum !: total heat flux causing surface ice melt [W.m-2] 285 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_opw !: total heat flux causing open water ice formation [W.m-2] 286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dif !: total heat flux causing Temp change in the ice [W.m-2] 287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_snw !: heat flux for snow melt [W.m-2] 288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err !: heat flux error after heat diffusion [W.m-2] 289 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 290 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping [W.m-2] 291 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_in !: heat flux available for thermo transformations [W.m-2] 292 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_out !: heat flux remaining at the end of thermo transformations [W.m-2] 293 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1] 294 293 295 ! heat flux associated with ice-atmosphere mass exchange 294 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sub !: heat flux for sublimation 295 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_spr !: heat flux of the snow precipitation 296 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_sub !: heat flux for sublimation [W.m-2] 297 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_spr !: heat flux of the snow precipitation [W.m-2] 296 298 297 299 ! heat flux associated with ice-ocean mass exchange 298 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_thd !: ice-ocean heat flux from thermo processes (limthd_dh) 299 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dyn !: ice-ocean heat flux from mecanical processes (limitd_me) 300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: residual heat flux due to correction of ice thickness 301 302 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_thd !: ice-ocean heat flux from thermo processes (limthd_dh) [W.m-2] 301 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dyn !: ice-ocean heat flux from mecanical processes (limitd_me) [W.m-2] 302 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: residual heat flux due to correction of ice thickness [W.m-2] 303 304 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 305 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: pahu3D , pahv3D 306 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rn_amax_2d !: maximum ice concentration 2d array 303 307 304 308 !!-------------------------------------------------------------------------- … … 369 373 !!-------------------------------------------------------------------------- 370 374 ! !!: ** Namelist namicerun read in sbc_lim_init ** 371 INTEGER , PUBLIC :: jpl !: number of ice categories372 INTEGER , PUBLIC :: nlay_i !: number of ice layers373 INTEGER , PUBLIC :: nlay_s !: number of snow layers374 CHARACTER(len=32) , PUBLIC :: cn_icerst_in !: suffix of ice restart name (input)375 INTEGER , PUBLIC :: jpl !: number of ice categories 376 INTEGER , PUBLIC :: nlay_i !: number of ice layers 377 INTEGER , PUBLIC :: nlay_s !: number of snow layers 378 CHARACTER(len=32) , PUBLIC :: cn_icerst_in !: suffix of ice restart name (input) 375 379 CHARACTER(len=256), PUBLIC :: cn_icerst_indir !: ice restart input directory 376 CHARACTER(len=32) , PUBLIC :: cn_icerst_out !: suffix of ice restart name (output)380 CHARACTER(len=32) , PUBLIC :: cn_icerst_out !: suffix of ice restart name (output) 377 381 CHARACTER(len=256), PUBLIC :: cn_icerst_outdir!: ice restart output directory 378 LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F) 379 LOGICAL , PUBLIC :: ln_icectl !: flag for sea-ice points output (T) or not (F) 380 REAL(wp) , PUBLIC :: rn_amax !: maximum ice concentration 381 INTEGER , PUBLIC :: iiceprt !: debug i-point 382 INTEGER , PUBLIC :: jiceprt !: debug j-point 382 LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F) 383 LOGICAL , PUBLIC :: ln_icectl !: flag for sea-ice points output (T) or not (F) 384 REAL(wp) , PUBLIC :: rn_amax_n !: maximum ice concentration Northern hemisphere 385 REAL(wp) , PUBLIC :: rn_amax_s !: maximum ice concentration Southern hemisphere 386 INTEGER , PUBLIC :: iiceprt !: debug i-point 387 INTEGER , PUBLIC :: jiceprt !: debug j-point 383 388 ! 384 389 !!-------------------------------------------------------------------------- … … 424 429 ALLOCATE( u_oce (jpi,jpj) , v_oce (jpi,jpj) , & 425 430 & ahiu (jpi,jpj) , ahiv (jpi,jpj) , & 426 & pahu (jpi,jpj) , pahv (jpi,jpj) , &427 431 & ust2s (jpi,jpj) , hicol (jpi,jpj) , & 428 432 & strp1 (jpi,jpj) , strp2 (jpi,jpj) , strength (jpi,jpj) , & … … 437 441 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , & 438 442 & afx_tot(jpi,jpj) , afx_thd(jpi,jpj), afx_dyn(jpi,jpj) , & 439 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead (jpi,jpj) , & 440 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , & 443 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl), pahu3D(jpi,jpj,jpl+1), pahv3D(jpi,jpj,jpl+1), & 444 & rn_amax_2d (jpi,jpj) , qlead (jpi,jpj) , & 445 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj), & 441 446 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 442 447 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , & 443 & hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , 448 & hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj) , & 444 449 & hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) , & 445 450 & hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , & … … 508 513 !!====================================================================== 509 514 END MODULE ice 515 -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r5836 r6851 24 24 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 25 25 USE sbc_oce , ONLY : sfx ! Surface boundary condition: ocean fields 26 26 USE sbc_ice , ONLY : qevap_ice 27 27 28 IMPLICIT NONE 28 29 PRIVATE … … 184 185 ! salt flux 185 186 zfs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 186 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) 187 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) & 187 188 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) 188 189 … … 209 210 ! salt flux 210 211 zfs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 211 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) 212 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) & 212 213 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 213 214 … … 256 257 ENDIF 257 258 IF ( zvmin < -epsi10 ) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',zvmin 258 IF ( zamax > rn_amax+epsi10 .AND. cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 259 IF ( zamax > MAX( rn_amax_n, rn_amax_s ) + epsi10 .AND. & 260 & cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 259 261 WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax 260 262 ENDIF … … 286 288 #if ! defined key_bdy 287 289 ! heat flux 288 zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e1e2t * tmask(:,:,1) * zconv ) 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 & * e1e2t * tmask(:,:,1) * zconv ) 289 292 ! salt flux 290 293 zsfx = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
r5836 r6851 56 56 real(wp) :: zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 57 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 58 & zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn, zbg_sfx_sub 59 59 real(wp) :: zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 60 60 real(wp) :: zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub … … 111 111 zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 112 112 zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 113 zbg_sfx_sub = ztmp * glob_sum( sfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 113 114 114 115 ! Heat budget 115 zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) ) * 1.e-20! ice heat content [1.e20 J]116 zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) ) * 1.e-20! snow heat content [1.e20 J]116 zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) * 1.e-20 ) ! ice heat content [1.e20 J] 117 zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J] 117 118 zbg_hfx_dhc = glob_sum( diag_heat(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 118 119 zbg_hfx_spr = glob_sum( hfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] … … 189 190 CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom ) ! salt flux bottom melt - 190 191 CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum ) ! salt flux surface melt - 192 CALL iom_put( 'ibgsfxsub' , zbg_sfx_sub ) ! salt flux sublimation - 191 193 192 194 CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc ) ! Heat content variation in snow and ice [W] -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r5836 r6851 7 7 !! - ! 2001-05 (G. Madec, R. Hordoir) opa norm 8 8 !! 1.0 ! 2002-08 (C. Ethe) F90, free form 9 !! 3.0 ! 2015-08 (O. Tintó and M. Castrillo) added lim_hdf (multiple) 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_lim3 … … 27 28 PRIVATE 28 29 29 PUBLIC lim_hdf 30 PUBLIC lim_hdf_init 30 PUBLIC lim_hdf ! called by lim_trp 31 PUBLIC lim_hdf_init ! called by sbc_lim_init 31 32 32 33 LOGICAL :: linit = .TRUE. ! initialization flag (set to flase after the 1st call) … … 43 44 CONTAINS 44 45 45 SUBROUTINE lim_hdf( ptab )46 SUBROUTINE lim_hdf( ptab , ihdf_vars , jpl , nlay_i ) 46 47 !!------------------------------------------------------------------- 47 48 !! *** ROUTINE lim_hdf *** … … 54 55 !! ** Action : update ptab with the diffusive contribution 55 56 !!------------------------------------------------------------------- 56 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: ptab ! Field on which the diffusion is applied 57 ! 58 INTEGER :: ji, jj ! dummy loop indices 57 INTEGER :: jpl, nlay_i, isize, ihdf_vars 58 REAL(wp), DIMENSION(:,:,:), INTENT( inout ),TARGET :: ptab ! Field on which the diffusion is applied 59 ! 60 INTEGER :: ji, jj, jk, jl, jm ! dummy loop indices 59 61 INTEGER :: iter, ierr ! local integers 60 REAL(wp) :: zrlxint, zconv ! local scalars 61 REAL(wp), POINTER, DIMENSION(:,:) :: zrlx, zflu, zflv, zdiv0, zdiv, ztab0 62 REAL(wp) :: zrlxint ! local scalars 63 REAL(wp), POINTER , DIMENSION ( : ) :: zconv ! local scalars 64 REAL(wp), POINTER , DIMENSION(:,:,:) :: zrlx,zdiv0, ztab0 65 REAL(wp), POINTER , DIMENSION(:,:) :: zflu, zflv, zdiv 62 66 CHARACTER(lc) :: charout ! local character 63 67 REAL(wp), PARAMETER :: zrelax = 0.5_wp ! relaxation constant for iterative procedure … … 65 69 INTEGER , PARAMETER :: its = 100 ! Maximum number of iteration 66 70 !!------------------------------------------------------------------- 71 TYPE(arrayptr) , ALLOCATABLE, DIMENSION(:) :: pt2d_array, zrlx_array 72 CHARACTER(len=1) , ALLOCATABLE, DIMENSION(:) :: type_array ! define the nature of ptab array grid-points 73 ! ! = T , U , V , F , W and I points 74 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: psgn_array ! =-1 the sign change across the north fold boundary 75 76 !!--------------------------------------------------------------------- 77 78 ! !== Initialisation ==! 79 ! +1 open water diffusion 80 isize = jpl*(ihdf_vars+nlay_i)+1 81 ALLOCATE( zconv (isize) ) 82 ALLOCATE( pt2d_array(isize) , zrlx_array(isize) ) 83 ALLOCATE( type_array(isize) ) 84 ALLOCATE( psgn_array(isize) ) 67 85 68 CALL wrk_alloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 ) 69 70 ! !== Initialisation ==! 86 CALL wrk_alloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 87 CALL wrk_alloc( jpi, jpj, zflu, zflv, zdiv ) 88 89 DO jk= 1 , isize 90 pt2d_array(jk)%pt2d=>ptab(:,:,jk) 91 zrlx_array(jk)%pt2d=>zrlx(:,:,jk) 92 type_array(jk)='T' 93 psgn_array(jk)=1. 94 END DO 95 71 96 ! 72 97 IF( linit ) THEN ! Metric coefficient (compute at the first call and saved in efact) … … 74 99 IF( lk_mpp ) CALL mpp_sum( ierr ) 75 100 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lim_hdf : unable to allocate arrays' ) 76 DO jj = 2, jpjm1 101 DO jj = 2, jpjm1 77 102 DO ji = fs_2 , fs_jpim1 ! vector opt. 78 103 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1e2t(ji,jj) … … 83 108 ! ! Time integration parameters 84 109 ! 85 ztab0(:, : ) = ptab(:,:) ! Arrays initialization 86 zdiv0(:, 1 ) = 0._wp 87 zdiv0(:,jpj) = 0._wp 88 zflu (jpi,:) = 0._wp 89 zflv (jpi,:) = 0._wp 90 zdiv0(1, :) = 0._wp 91 zdiv0(jpi,:) = 0._wp 110 zflu(jpi,:) = 0._wp 111 zflv(jpi,:) = 0._wp 112 113 DO jk = 1 , isize 114 ztab0( : , : , jk ) = ptab(:,:,jk) ! Arrays initialization 115 zdiv0( : , 1 , jk ) = 0._wp 116 zdiv0( : ,jpj, jk ) = 0._wp 117 zdiv0( 1 , : , jk ) = 0._wp 118 zdiv0(jpi, : , jk ) = 0._wp 119 END DO 92 120 93 121 zconv = 1._wp !== horizontal diffusion using a Crant-Nicholson scheme ==! 94 122 iter = 0 95 123 ! 96 DO WHILE( zconv> ( 2._wp * 1.e-04 ) .AND. iter <= its ) ! Sub-time step loop124 DO WHILE( MAXVAL(zconv(:)) > ( 2._wp * 1.e-04 ) .AND. iter <= its ) ! Sub-time step loop 97 125 ! 98 126 iter = iter + 1 ! incrementation of the sub-time step number 99 127 ! 128 DO jk = 1 , isize 129 jl = (jk-1) /( ihdf_vars+nlay_i)+1 130 IF (zconv(jk) > ( 2._wp * 1.e-04 )) THEN 131 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 132 DO ji = 1 , fs_jpim1 ! vector opt. 133 zflu(ji,jj) = pahu3D(ji,jj,jl) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj,jk) - ptab(ji,jj,jk) ) 134 zflv(ji,jj) = pahv3D(ji,jj,jl) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1,jk) - ptab(ji,jj,jk) ) 135 END DO 136 END DO 137 ! 138 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 139 DO ji = fs_2 , fs_jpim1 ! vector opt. 140 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj) 141 END DO 142 END DO 143 ! 144 IF( iter == 1 ) zdiv0(:,:,jk) = zdiv(:,:) ! save the 1st evaluation of the diffusive trend in zdiv0 145 ! 146 DO jj = 2, jpjm1 ! iterative evaluation 147 DO ji = fs_2 , fs_jpim1 ! vector opt. 148 zrlxint = ( ztab0(ji,jj,jk) & 149 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj,jk) ) & 150 & + ( 1.0 - zalfa ) * zdiv0(ji,jj,jk) ) & 151 & ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 152 zrlx(ji,jj,jk) = ptab(ji,jj,jk) + zrelax * ( zrlxint - ptab(ji,jj,jk) ) 153 END DO 154 END DO 155 END IF 156 157 END DO 158 159 CALL lbc_lnk_multi( zrlx_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 160 ! 161 IF ( MOD( iter-1 , nn_convfrq ) == 0 ) THEN !Convergence test every nn_convfrq iterations (perf. optimization ) 162 DO jk=1,isize 163 zconv(jk) = 0._wp ! convergence test 164 DO jj = 2, jpjm1 165 DO ji = fs_2, fs_jpim1 166 zconv(jk) = MAX( zconv(jk), ABS( zrlx(ji,jj,jk) - ptab(ji,jj,jk) ) ) 167 END DO 168 END DO 169 END DO 170 IF( lk_mpp ) CALL mpp_max_multiple( zconv , isize ) ! max over the global domain for all the variables 171 ENDIF 172 ! 173 DO jk=1,isize 174 ptab(:,:,jk) = zrlx(:,:,jk) 175 END DO 176 ! 177 END DO ! end of sub-time step loop 178 179 ! ----------------------- 180 !!! final step (clem) !!! 181 DO jk = 1, isize 182 jl = (jk-1) /( ihdf_vars+nlay_i)+1 100 183 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 101 184 DO ji = 1 , fs_jpim1 ! vector opt. 102 zflu(ji,jj) = pahu (ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )103 zflv(ji,jj) = pahv (ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )185 zflu(ji,jj) = pahu3D(ji,jj,jl) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj,jk) - ptab(ji,jj,jk) ) 186 zflv(ji,jj) = pahv3D(ji,jj,jl) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1,jk) - ptab(ji,jj,jk) ) 104 187 END DO 105 188 END DO … … 108 191 DO ji = fs_2 , fs_jpim1 ! vector opt. 109 192 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj) 110 END DO 111 END DO 112 ! 113 IF( iter == 1 ) zdiv0(:,:) = zdiv(:,:) ! save the 1st evaluation of the diffusive trend in zdiv0 114 ! 115 DO jj = 2, jpjm1 ! iterative evaluation 116 DO ji = fs_2 , fs_jpim1 ! vector opt. 117 zrlxint = ( ztab0(ji,jj) & 118 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) ) & 119 & + ( 1.0 - zalfa ) * zdiv0(ji,jj) ) & 120 & ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) ) 121 zrlx(ji,jj) = ptab(ji,jj) + zrelax * ( zrlxint - ptab(ji,jj) ) 122 END DO 123 END DO 124 CALL lbc_lnk( zrlx, 'T', 1. ) ! lateral boundary condition 125 ! 126 IF ( MOD( iter, nn_convfrq ) == 0 ) THEN ! convergence test every nn_convfrq iterations (perf. optimization) 127 zconv = 0._wp 128 DO jj = 2, jpjm1 129 DO ji = fs_2, fs_jpim1 130 zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) ) ) 131 END DO 132 END DO 133 IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain 134 ENDIF 135 ! 136 ptab(:,:) = zrlx(:,:) 137 ! 138 END DO ! end of sub-time step loop 139 140 ! ----------------------- 141 !!! final step (clem) !!! 142 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction 143 DO ji = 1 , fs_jpim1 ! vector opt. 144 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 145 zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 193 ptab(ji,jj,jk) = ztab0(ji,jj,jk) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj,jk) ) 194 END DO 146 195 END DO 147 196 END DO 148 ! 149 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 150 DO ji = fs_2 , fs_jpim1 ! vector opt. 151 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj) 152 ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) 153 END DO 154 END DO 155 CALL lbc_lnk( ptab, 'T', 1. ) ! lateral boundary condition 197 198 CALL lbc_lnk_multi( pt2d_array, type_array , psgn_array , isize ) ! Multiple interchange of all the variables 199 156 200 !!! final step (clem) !!! 157 201 ! ----------------------- 158 202 159 203 IF(ln_ctl) THEN 160 zrlx(:,:) = ptab(:,:) - ztab0(:,:) 161 WRITE(charout,FMT="(' lim_hdf : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 162 CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout ) 163 ENDIF 164 ! 165 CALL wrk_dealloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 ) 204 DO jk = 1 , isize 205 zrlx(:,:,jk) = ptab(:,:,jk) - ztab0(:,:,jk) 206 WRITE(charout,FMT="(' lim_hdf : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter 207 CALL prt_ctl( tab2d_1=zrlx(:,:,jk), clinfo1=charout ) 208 END DO 209 ENDIF 210 ! 211 CALL wrk_dealloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 212 CALL wrk_dealloc( jpi, jpj, zflu, zflv, zdiv ) 213 214 DEALLOCATE( zconv ) 215 DEALLOCATE( pt2d_array , zrlx_array ) 216 DEALLOCATE( type_array ) 217 DEALLOCATE( psgn_array ) 166 218 ! 167 219 END SUBROUTINE lim_hdf 220 168 221 169 222 … … 179 232 !!------------------------------------------------------------------- 180 233 INTEGER :: ios ! Local integer output status for namelist read 181 NAMELIST/namicehdf/ nn_convfrq 234 NAMELIST/namicehdf/ nn_convfrq 182 235 !!------------------------------------------------------------------- 183 236 ! … … 212 265 !!====================================================================== 213 266 END MODULE limhdf 267 -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r6347 r6851 24 24 USE par_oce ! ocean parameters 25 25 USE dom_ice ! sea-ice domain 26 USE limvar ! lim_var_salprof 26 27 USE in_out_manager ! I/O manager 27 28 USE lib_mpp ! MPP library … … 253 254 END DO 254 255 za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - zA ! ice conc in the last category 255 IF ( i_fill .LT.jpl ) za_i_ini(ji,jj,i_fill+1:jpl) = 0._wp256 IF ( i_fill < jpl ) za_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 256 257 257 258 !--- Ice thickness in the last category … … 261 262 END DO 262 263 zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / za_i_ini(ji,jj,i_fill) 263 IF ( i_fill .LT.jpl ) zh_i_ini(ji,jj,i_fill+1:jpl) = 0._wp264 IF ( i_fill < jpl ) zh_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 264 265 265 266 !--- volumes 266 267 zv_i_ini(ji,jj,:) = za_i_ini(ji,jj,:) * zh_i_ini(ji,jj,:) 267 IF ( i_fill .LT.jpl ) zv_i_ini(ji,jj,i_fill+1:jpl) = 0._wp268 IF ( i_fill < jpl ) zv_i_ini(ji,jj,i_fill+1:jpl) = 0._wp 268 269 269 270 ENDIF ! i_fill … … 273 274 !--------------------- 274 275 ! Test 1: area conservation 275 zA_cons = SUM( za_i_ini(ji,jj,:) ) 276 zconv = ABS( zat_i_ini(ji,jj) - zA_cons ) 277 IF ( zconv < 1.0e-6 ) THEN 276 zA_cons = SUM( za_i_ini(ji,jj,:) ) ; zconv = ABS( zat_i_ini(ji,jj) - zA_cons ) 277 IF ( zconv < 1.e-6 ) THEN 278 278 ztest_1 = 1 279 279 ELSE 280 ! this write is useful281 IF(lwp) WRITE(numout,*) ' * TEST1 AREA NOT CONSERVED *** zA_cons = ', zA_cons, &282 & ' zat_i_ini = ',zat_i_ini(ji,jj)283 280 ztest_1 = 0 284 281 ENDIF 285 282 286 283 ! Test 2: volume conservation 287 zV_cons = SUM( zv_i_ini(ji,jj,:))288 zconv = ABS( zvt_i_ini(ji,jj) - zV_cons)289 290 IF( zconv < 1. 0e-6 ) THEN284 zV_cons = SUM(zv_i_ini(ji,jj,:)) 285 zconv = ABS(zvt_i_ini(ji,jj) - zV_cons) 286 287 IF( zconv < 1.e-6 ) THEN 291 288 ztest_2 = 1 292 289 ELSE 293 ! this write is useful294 IF(lwp) WRITE(numout,*) ' * TEST2 VOLUME NOT CONSERVED *** zV_cons = ', zV_cons, &295 & ' zvt_i_ini = ', zvt_i_ini(ji,jj)296 290 ztest_2 = 0 297 291 ENDIF … … 301 295 ztest_3 = 1 302 296 ELSE 303 ! this write is useful304 IF(lwp) WRITE(numout,*) ' * TEST3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** ', &305 & ' zh_i_ini(ji,jj,i_fill) = ', zh_i_ini(ji,jj,i_fill), ' hi_max(jpl-1) = ', hi_max(i_fill-1)306 IF(lwp) WRITE(numout,*) ' ji,jj,i_fill ',ji,jj,i_fill307 IF(lwp) WRITE(numout,*) 'zht_i_ini ',zht_i_ini(ji,jj)308 297 ztest_3 = 0 309 298 ENDIF … … 312 301 ztest_4 = 1 313 302 DO jl = 1, jpl 314 IF ( za_i_ini(ji,jj,jl) .LT. 0._wp ) THEN 315 ! this write is useful 316 IF(lwp) WRITE(numout,*) ' * TEST 4 POSITIVITY NOT OK FOR CAT ', jl, ' WITH A = ', za_i_ini(ji,jj,jl) 303 IF ( za_i_ini(ji,jj,jl) < 0._wp ) THEN 317 304 ztest_4 = 0 318 305 ENDIF … … 381 368 END DO 382 369 370 ! for constant salinity in time 371 IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN 372 CALL lim_var_salprof 373 smv_i = sm_i * v_i 374 ENDIF 375 383 376 ! Snow temperature and heat content 384 377 DO jk = 1, nlay_s … … 531 524 !!----------------------------------------------------------------------------- 532 525 ! 533 REWIND( numnam_ice_ref ) ! Namelist namiceini in reference namelist : Ice initial state526 REWIND( numnam_ice_ref ) ! Namelist namiceini in reference namelist : Ice initial state 534 527 READ ( numnam_ice_ref, namiceini, IOSTAT = ios, ERR = 901) 535 528 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in reference namelist', lwp ) 536 529 537 REWIND( numnam_ice_cfg ) ! Namelist namiceini in configuration namelist : Ice initial state530 REWIND( numnam_ice_cfg ) ! Namelist namiceini in configuration namelist : Ice initial state 538 531 READ ( numnam_ice_cfg, namiceini, IOSTAT = ios, ERR = 902 ) 539 532 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in configuration namelist', lwp ) 540 533 IF(lwm) WRITE ( numoni, namiceini ) 541 534 542 slf_i(jp_hti) = sn_hti ; slf_i(jp_hts) = sn_hts 543 slf_i(jp_ati) = sn_ati ; slf_i(jp_tsu) = sn_tsu 544 slf_i(jp_tmi) = sn_tmi ; slf_i(jp_smi) = sn_smi 545 546 IF(lwp) THEN ! control print 535 slf_i(jp_hti) = sn_hti ; slf_i(jp_hts) = sn_hts 536 slf_i(jp_ati) = sn_ati ; slf_i(jp_tsu) = sn_tsu 537 slf_i(jp_tmi) = sn_tmi ; slf_i(jp_smi) = sn_smi 538 539 ! Define the initial parameters 540 ! ------------------------- 541 542 IF(lwp) THEN 547 543 WRITE(numout,*) 548 544 WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r5836 r6851 45 45 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: asum ! sum of total ice and open water area 46 46 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: aksum ! ratio of area removed to area ridged 47 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: athorn ! participation function; fraction of ridging/ 48 ! ! closing associated w/ category n 47 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: athorn ! participation function; fraction of ridging/closing associated w/ category n 49 48 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: hrmin ! minimum ridge thickness 50 49 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: hrmax ! maximum ridge thickness 51 50 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: hraft ! thickness of rafted ice 52 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: krdg ! mean ridge thickness/thickness of ridging ice51 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: krdg ! thickness of ridging ice / mean ridge thickness 53 52 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: aridge ! participating ice ridging 54 53 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: araft ! participating ice rafting 55 54 56 55 REAL(wp), PARAMETER :: krdgmin = 1.1_wp ! min ridge thickness multiplier 57 REAL(wp), PARAMETER :: kraft = 2.0_wp ! rafting multipliyer 58 REAL(wp), PARAMETER :: kamax = 1.0_wp ! max of ice area authorized (clem: scheme is not stable if kamax <= 0.99) 56 REAL(wp), PARAMETER :: kraft = 0.5_wp ! rafting multipliyer 59 57 60 58 REAL(wp) :: Cp ! 61 59 ! 62 !-----------------------------------------------------------------------63 ! Ridging diagnostic arrays for history files64 !-----------------------------------------------------------------------65 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dardg1dt ! rate of fractional area loss by ridging ice (1/s)66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dardg2dt ! rate of fractional area gain by new ridges (1/s)67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dvirdgdt ! rate of ice volume ridged (m/s)68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: opening ! rate of opening due to divergence/shear (1/s)69 60 ! 70 61 !!---------------------------------------------------------------------- … … 83 74 & asum (jpi,jpj) , athorn(jpi,jpj,0:jpl) , & 84 75 & aksum(jpi,jpj) , & 85 !86 76 & hrmin(jpi,jpj,jpl) , hraft(jpi,jpj,jpl) , aridge(jpi,jpj,jpl) , & 87 & hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) , & 88 ! 89 !* Ridging diagnostic arrays for history files 90 & dardg1dt(jpi,jpj) , dardg2dt(jpi,jpj) , & 91 & dvirdgdt(jpi,jpj) , opening(jpi,jpj) , STAT=lim_itd_me_alloc ) 77 & hrmax(jpi,jpj,jpl) , krdg (jpi,jpj,jpl) , araft (jpi,jpj,jpl) , STAT=lim_itd_me_alloc ) 92 78 ! 93 79 IF( lim_itd_me_alloc /= 0 ) CALL ctl_warn( 'lim_itd_me_alloc: failed to allocate arrays' ) … … 132 118 REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear 133 119 REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges 134 REAL(wp), POINTER, DIMENSION(:,:) :: msnow_mlt ! mass of snow added to ocean (kg m-2)135 REAL(wp), POINTER, DIMENSION(:,:) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2)136 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories137 120 ! 138 121 INTEGER, PARAMETER :: nitermax = 20 … … 142 125 IF( nn_timing == 1 ) CALL timing_start('limitd_me') 143 126 144 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross , msnow_mlt, esnow_mlt, vt_i_init, vt_i_final)127 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross ) 145 128 146 129 IF(ln_ctl) THEN … … 154 137 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 155 138 156 CALL lim_var_zapsmall157 CALL lim_var_glo2eqv ! equivalent variables, requested for rafting158 159 139 !-----------------------------------------------------------------------------! 160 140 ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons … … 164 144 CALL lim_itd_me_ridgeprep ! prepare ridging 165 145 ! 166 IF( con_i) CALL lim_column_sum( jpl, v_i, vt_i_init ) ! conservation check167 146 168 147 DO jj = 1, jpj ! Initialize arrays. 169 148 DO ji = 1, jpi 170 msnow_mlt(ji,jj) = 0._wp171 esnow_mlt(ji,jj) = 0._wp172 dardg1dt (ji,jj) = 0._wp173 dardg2dt (ji,jj) = 0._wp174 dvirdgdt (ji,jj) = 0._wp175 opening (ji,jj) = 0._wp176 149 177 150 !-----------------------------------------------------------------------------! … … 204 177 ! If divu_adv < 0, make sure the closing rate is large enough 205 178 ! to give asum = 1.0 after ridging. 206 207 divu_adv(ji,jj) = ( kamax- asum(ji,jj) ) * r1_rdtice ! asum found in ridgeprep179 180 divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice ! asum found in ridgeprep 208 181 209 182 IF( divu_adv(ji,jj) < 0._wp ) closing_net(ji,jj) = MAX( closing_net(ji,jj), -divu_adv(ji,jj) ) … … 224 197 DO WHILE ( iterate_ridging > 0 .AND. niter < nitermax ) 225 198 199 ! 3.2 closing_gross 200 !-----------------------------------------------------------------------------! 201 ! Based on the ITD of ridging and ridged ice, convert the net 202 ! closing rate to a gross closing rate. 203 ! NOTE: 0 < aksum <= 1 204 closing_gross(:,:) = closing_net(:,:) / aksum(:,:) 205 206 ! correction to closing rate and opening if closing rate is excessive 207 !--------------------------------------------------------------------- 208 ! Reduce the closing rate if more than 100% of the open water 209 ! would be removed. Reduce the opening rate proportionately. 226 210 DO jj = 1, jpj 227 211 DO ji = 1, jpi 228 229 ! 3.2 closing_gross 230 !-----------------------------------------------------------------------------! 231 ! Based on the ITD of ridging and ridged ice, convert the net 232 ! closing rate to a gross closing rate. 233 ! NOTE: 0 < aksum <= 1 234 closing_gross(ji,jj) = closing_net(ji,jj) / aksum(ji,jj) 235 236 ! correction to closing rate and opening if closing rate is excessive 237 !--------------------------------------------------------------------- 238 ! Reduce the closing rate if more than 100% of the open water 239 ! would be removed. Reduce the opening rate proportionately. 240 za = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 241 IF( za > epsi20 ) THEN 242 zfac = MIN( 1._wp, ato_i(ji,jj) / za ) 243 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 244 opning (ji,jj) = opning (ji,jj) * zfac 212 za = ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice 213 IF( za < 0._wp .AND. za > - ato_i(ji,jj) ) THEN ! would lead to negative ato_i 214 zfac = - ato_i(ji,jj) / za 215 opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) - ato_i(ji,jj) * r1_rdtice 216 ELSEIF( za > 0._wp .AND. za > ( asum(ji,jj) - ato_i(ji,jj) ) ) THEN ! would lead to ato_i > asum 217 zfac = ( asum(ji,jj) - ato_i(ji,jj) ) / za 218 opning(ji,jj) = athorn(ji,jj,0) * closing_gross(ji,jj) + ( asum(ji,jj) - ato_i(ji,jj) ) * r1_rdtice 245 219 ENDIF 246 247 220 END DO 248 221 END DO … … 256 229 DO ji = 1, jpi 257 230 za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 258 IF( za > epsi20) THEN259 zfac = MIN( 1._wp, a_i(ji,jj,jl) / za )231 IF( za > a_i(ji,jj,jl) ) THEN 232 zfac = a_i(ji,jj,jl) / za 260 233 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 261 opning (ji,jj) = opning (ji,jj) * zfac262 234 ENDIF 263 235 END DO … … 268 240 !-----------------------------------------------------------------------------! 269 241 270 CALL lim_itd_me_ridgeshift( opning, closing_gross, msnow_mlt, esnow_mlt ) 271 242 CALL lim_itd_me_ridgeshift( opning, closing_gross ) 243 244 272 245 ! 3.4 Compute total area of ice plus open water after ridging. 273 246 !-----------------------------------------------------------------------------! 274 247 ! This is in general not equal to one because of divergence during transport 275 asum(:,:) = ato_i(:,:) 276 DO jl = 1, jpl 277 asum(:,:) = asum(:,:) + a_i(:,:,jl) 278 END DO 248 asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 279 249 280 250 ! 3.5 Do we keep on iterating ??? … … 284 254 285 255 iterate_ridging = 0 286 287 256 DO jj = 1, jpj 288 257 DO ji = 1, jpi 289 IF (ABS(asum(ji,jj) - kamax ) < epsi10) THEN258 IF( ABS( asum(ji,jj) - 1._wp ) < epsi10 ) THEN 290 259 closing_net(ji,jj) = 0._wp 291 260 opning (ji,jj) = 0._wp 292 261 ELSE 293 262 iterate_ridging = 1 294 divu_adv (ji,jj) = ( kamax- asum(ji,jj) ) * r1_rdtice263 divu_adv (ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice 295 264 closing_net(ji,jj) = MAX( 0._wp, -divu_adv(ji,jj) ) 296 265 opning (ji,jj) = MAX( 0._wp, divu_adv(ji,jj) ) … … 309 278 310 279 IF( iterate_ridging == 1 ) THEN 280 CALL lim_itd_me_ridgeprep 311 281 IF( niter > nitermax ) THEN 312 282 WRITE(numout,*) ' ALERTE : non-converging ridging scheme ' 313 283 WRITE(numout,*) ' niter, iterate_ridging ', niter, iterate_ridging 314 284 ENDIF 315 CALL lim_itd_me_ridgeprep316 285 ENDIF 317 286 318 287 END DO !! on the do while over iter 319 320 !-----------------------------------------------------------------------------!321 ! 4) Ridging diagnostics322 !-----------------------------------------------------------------------------!323 ! Convert ridging rate diagnostics to correct units.324 ! Update fresh water and heat fluxes due to snow melt.325 DO jj = 1, jpj326 DO ji = 1, jpi327 328 dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice329 dardg2dt(ji,jj) = dardg2dt(ji,jj) * r1_rdtice330 dvirdgdt(ji,jj) = dvirdgdt(ji,jj) * r1_rdtice331 opening (ji,jj) = opening (ji,jj) * r1_rdtice332 333 !-----------------------------------------------------------------------------!334 ! 5) Heat, salt and freshwater fluxes335 !-----------------------------------------------------------------------------!336 wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice ! fresh water source for ocean337 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice ! heat sink for ocean (<0, W.m-2)338 339 END DO340 END DO341 342 ! Check if there is a ridging error343 IF( lwp ) THEN344 DO jj = 1, jpj345 DO ji = 1, jpi346 IF( ABS( asum(ji,jj) - kamax) > epsi10 ) THEN ! there is a bug347 WRITE(numout,*) ' '348 WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj)349 WRITE(numout,*) ' limitd_me '350 WRITE(numout,*) ' POINT : ', ji, jj351 WRITE(numout,*) ' jpl, a_i, athorn '352 WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0)353 DO jl = 1, jpl354 WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl)355 END DO356 ENDIF357 END DO358 END DO359 END IF360 361 ! Conservation check362 IF ( con_i ) THEN363 CALL lim_column_sum (jpl, v_i, vt_i_final)364 fieldid = ' v_i : limitd_me '365 CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid)366 ENDIF367 288 368 289 CALL lim_var_agg( 1 ) … … 377 298 CALL prt_ctl_info(' - Cell values : ') 378 299 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 379 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_itd_me : cell area :')300 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_itd_me : cell area :') 380 301 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me : at_i :') 381 302 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me : vt_i :') … … 410 331 ENDIF ! ln_limdyn=.true. 411 332 ! 412 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross , msnow_mlt, esnow_mlt, vt_i_init, vt_i_final)333 CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross ) 413 334 ! 414 335 IF( nn_timing == 1 ) CALL timing_stop('limitd_me') 415 336 END SUBROUTINE lim_itd_me 416 337 338 SUBROUTINE lim_itd_me_ridgeprep 339 !!---------------------------------------------------------------------! 340 !! *** ROUTINE lim_itd_me_ridgeprep *** 341 !! 342 !! ** Purpose : preparation for ridging and strength calculations 343 !! 344 !! ** Method : Compute the thickness distribution of the ice and open water 345 !! participating in ridging and of the resulting ridges. 346 !!---------------------------------------------------------------------! 347 INTEGER :: ji,jj, jl ! dummy loop indices 348 REAL(wp) :: Gstari, astari, hrmean, zdummy ! local scalar 349 REAL(wp), POINTER, DIMENSION(:,:,:) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n 350 !------------------------------------------------------------------------------! 351 352 CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 353 354 Gstari = 1.0/rn_gstar 355 astari = 1.0/rn_astar 356 aksum(:,:) = 0.0 357 athorn(:,:,:) = 0.0 358 aridge(:,:,:) = 0.0 359 araft (:,:,:) = 0.0 360 361 ! Zero out categories with very small areas 362 CALL lim_var_zapsmall 363 364 ! Ice thickness needed for rafting 365 DO jl = 1, jpl 366 DO jj = 1, jpj 367 DO ji = 1, jpi 368 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 369 ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 370 END DO 371 END DO 372 END DO 373 374 !------------------------------------------------------------------------------! 375 ! 1) Participation function 376 !------------------------------------------------------------------------------! 377 378 ! Compute total area of ice plus open water. 379 ! This is in general not equal to one because of divergence during transport 380 asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 381 382 ! Compute cumulative thickness distribution function 383 ! Compute the cumulative thickness distribution function Gsum, 384 ! where Gsum(n) is the fractional area in categories 0 to n. 385 ! initial value (in h = 0) equals open water area 386 Gsum(:,:,-1) = 0._wp 387 Gsum(:,:,0 ) = ato_i(:,:) 388 ! for each value of h, you have to add ice concentration then 389 DO jl = 1, jpl 390 Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 391 END DO 392 393 ! Normalize the cumulative distribution to 1 394 DO jl = 0, jpl 395 Gsum(:,:,jl) = Gsum(:,:,jl) / asum(:,:) 396 END DO 397 398 ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn) 399 !-------------------------------------------------------------------------------------------------- 400 ! Compute the participation function athorn; this is analogous to 401 ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975). 402 ! area lost from category n due to ridging/closing 403 ! athorn(n) = total area lost due to ridging/closing 404 ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar). 405 ! 406 ! The expressions for athorn are found by integrating b(h)g(h) between 407 ! the category boundaries. 408 ! athorn is always >= 0 and SUM(athorn(0:jpl))=1 409 !----------------------------------------------------------------- 410 411 IF( nn_partfun == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975) 412 DO jl = 0, jpl 413 DO jj = 1, jpj 414 DO ji = 1, jpi 415 IF ( Gsum(ji,jj,jl) < rn_gstar ) THEN 416 athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * & 417 & ( 2._wp - ( Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari ) 418 ELSEIF( Gsum(ji,jj,jl-1) < rn_gstar ) THEN 419 athorn(ji,jj,jl) = Gstari * ( rn_gstar - Gsum(ji,jj,jl-1) ) * & 420 & ( 2._wp - ( Gsum(ji,jj,jl-1) + rn_gstar ) * Gstari ) 421 ELSE 422 athorn(ji,jj,jl) = 0._wp 423 ENDIF 424 END DO 425 END DO 426 END DO 427 428 ELSE !--- Exponential, more stable formulation (Lipscomb et al, 2007) 429 ! 430 zdummy = 1._wp / ( 1._wp - EXP(-astari) ) ! precompute exponential terms using Gsum as a work array 431 DO jl = -1, jpl 432 Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 433 END DO 434 DO jl = 0, jpl 435 athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 436 END DO 437 ! 438 ENDIF 439 440 IF( ln_rafting ) THEN ! Ridging and rafting ice participation functions 441 ! 442 DO jl = 1, jpl 443 DO jj = 1, jpj 444 DO ji = 1, jpi 445 zdummy = TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) 446 aridge(ji,jj,jl) = ( 1._wp + zdummy ) * 0.5_wp * athorn(ji,jj,jl) 447 araft (ji,jj,jl) = ( 1._wp - zdummy ) * 0.5_wp * athorn(ji,jj,jl) 448 END DO 449 END DO 450 END DO 451 452 ELSE 453 ! 454 DO jl = 1, jpl 455 aridge(:,:,jl) = athorn(:,:,jl) 456 END DO 457 ! 458 ENDIF 459 460 !----------------------------------------------------------------- 461 ! 2) Transfer function 462 !----------------------------------------------------------------- 463 ! Compute max and min ridged ice thickness for each ridging category. 464 ! Assume ridged ice is uniformly distributed between hrmin and hrmax. 465 ! 466 ! This parameterization is a modified version of Hibler (1980). 467 ! The mean ridging thickness, hrmean, is proportional to hi^(0.5) 468 ! and for very thick ridging ice must be >= krdgmin*hi 469 ! 470 ! The minimum ridging thickness, hrmin, is equal to 2*hi 471 ! (i.e., rafting) and for very thick ridging ice is 472 ! constrained by hrmin <= (hrmean + hi)/2. 473 ! 474 ! The maximum ridging thickness, hrmax, is determined by 475 ! hrmean and hrmin. 476 ! 477 ! These modifications have the effect of reducing the ice strength 478 ! (relative to the Hibler formulation) when very thick ice is 479 ! ridging. 480 ! 481 ! aksum = net area removed/ total area removed 482 ! where total area removed = area of ice that ridges 483 ! net area removed = total area removed - area of new ridges 484 !----------------------------------------------------------------- 485 486 aksum(:,:) = athorn(:,:,0) 487 ! Transfer function 488 DO jl = 1, jpl !all categories have a specific transfer function 489 DO jj = 1, jpj 490 DO ji = 1, jpi 491 492 IF( athorn(ji,jj,jl) > 0._wp ) THEN 493 hrmean = MAX( SQRT( rn_hstar * ht_i(ji,jj,jl) ), ht_i(ji,jj,jl) * krdgmin ) 494 hrmin(ji,jj,jl) = MIN( 2._wp * ht_i(ji,jj,jl), 0.5_wp * ( hrmean + ht_i(ji,jj,jl) ) ) 495 hrmax(ji,jj,jl) = 2._wp * hrmean - hrmin(ji,jj,jl) 496 hraft(ji,jj,jl) = ht_i(ji,jj,jl) / kraft 497 krdg(ji,jj,jl) = ht_i(ji,jj,jl) / MAX( hrmean, epsi20 ) 498 499 ! Normalization factor : aksum, ensures mass conservation 500 aksum(ji,jj) = aksum(ji,jj) + aridge(ji,jj,jl) * ( 1._wp - krdg(ji,jj,jl) ) & 501 & + araft (ji,jj,jl) * ( 1._wp - kraft ) 502 503 ELSE 504 hrmin(ji,jj,jl) = 0._wp 505 hrmax(ji,jj,jl) = 0._wp 506 hraft(ji,jj,jl) = 0._wp 507 krdg (ji,jj,jl) = 1._wp 508 ENDIF 509 510 END DO 511 END DO 512 END DO 513 ! 514 CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 515 ! 516 END SUBROUTINE lim_itd_me_ridgeprep 517 518 519 SUBROUTINE lim_itd_me_ridgeshift( opning, closing_gross ) 520 !!---------------------------------------------------------------------- 521 !! *** ROUTINE lim_itd_me_icestrength *** 522 !! 523 !! ** Purpose : shift ridging ice among thickness categories of ice thickness 524 !! 525 !! ** Method : Remove area, volume, and energy from each ridging category 526 !! and add to thicker ice categories. 527 !!---------------------------------------------------------------------- 528 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: opning ! rate of opening due to divergence/shear 529 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: closing_gross ! rate at which area removed, excluding area of new ridges 530 ! 531 CHARACTER (len=80) :: fieldid ! field identifier 532 ! 533 INTEGER :: ji, jj, jl, jl1, jl2, jk ! dummy loop indices 534 INTEGER :: ij ! horizontal index, combines i and j loops 535 INTEGER :: icells ! number of cells with a_i > puny 536 REAL(wp) :: hL, hR, farea ! left and right limits of integration 537 538 INTEGER , POINTER, DIMENSION(:) :: indxi, indxj ! compressed indices 539 REAL(wp), POINTER, DIMENSION(:) :: zswitch, fvol ! new ridge volume going to n2 540 541 REAL(wp), POINTER, DIMENSION(:) :: afrac ! fraction of category area ridged 542 REAL(wp), POINTER, DIMENSION(:) :: ardg1 , ardg2 ! area of ice ridged & new ridges 543 REAL(wp), POINTER, DIMENSION(:) :: vsrdg , esrdg ! snow volume & energy of ridging ice 544 REAL(wp), POINTER, DIMENSION(:) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2 545 546 REAL(wp), POINTER, DIMENSION(:) :: vrdg1 ! volume of ice ridged 547 REAL(wp), POINTER, DIMENSION(:) :: vrdg2 ! volume of new ridges 548 REAL(wp), POINTER, DIMENSION(:) :: vsw ! volume of seawater trapped into ridges 549 REAL(wp), POINTER, DIMENSION(:) :: srdg1 ! sal*volume of ice ridged 550 REAL(wp), POINTER, DIMENSION(:) :: srdg2 ! sal*volume of new ridges 551 REAL(wp), POINTER, DIMENSION(:) :: smsw ! sal*volume of water trapped into ridges 552 REAL(wp), POINTER, DIMENSION(:) :: oirdg1, oirdg2 ! ice age of ice ridged 553 554 REAL(wp), POINTER, DIMENSION(:) :: afrft ! fraction of category area rafted 555 REAL(wp), POINTER, DIMENSION(:) :: arft1 , arft2 ! area of ice rafted and new rafted zone 556 REAL(wp), POINTER, DIMENSION(:) :: virft , vsrft ! ice & snow volume of rafting ice 557 REAL(wp), POINTER, DIMENSION(:) :: esrft , smrft ! snow energy & salinity of rafting ice 558 REAL(wp), POINTER, DIMENSION(:) :: oirft1, oirft2 ! ice age of ice rafted 559 560 REAL(wp), POINTER, DIMENSION(:,:) :: eirft ! ice energy of rafting ice 561 REAL(wp), POINTER, DIMENSION(:,:) :: erdg1 ! enth*volume of ice ridged 562 REAL(wp), POINTER, DIMENSION(:,:) :: erdg2 ! enth*volume of new ridges 563 REAL(wp), POINTER, DIMENSION(:,:) :: ersw ! enth of water trapped into ridges 564 !!---------------------------------------------------------------------- 565 566 CALL wrk_alloc( jpij, indxi, indxj ) 567 CALL wrk_alloc( jpij, zswitch, fvol ) 568 CALL wrk_alloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 569 CALL wrk_alloc( jpij, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 570 CALL wrk_alloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 571 CALL wrk_alloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw ) 572 573 !------------------------------------------------------------------------------- 574 ! 1) Compute change in open water area due to closing and opening. 575 !------------------------------------------------------------------------------- 576 DO jj = 1, jpj 577 DO ji = 1, jpi 578 ato_i(ji,jj) = MAX( 0._wp, ato_i(ji,jj) + & 579 & ( opning(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) ) * rdt_ice ) 580 END DO 581 END DO 582 583 !----------------------------------------------------------------- 584 ! 3) Pump everything from ice which is being ridged / rafted 585 !----------------------------------------------------------------- 586 ! Compute the area, volume, and energy of ice ridging in each 587 ! category, along with the area of the resulting ridge. 588 589 DO jl1 = 1, jpl !jl1 describes the ridging category 590 591 !------------------------------------------------ 592 ! 3.1) Identify grid cells with nonzero ridging 593 !------------------------------------------------ 594 icells = 0 595 DO jj = 1, jpj 596 DO ji = 1, jpi 597 IF( athorn(ji,jj,jl1) > 0._wp .AND. closing_gross(ji,jj) > 0._wp ) THEN 598 icells = icells + 1 599 indxi(icells) = ji 600 indxj(icells) = jj 601 ENDIF 602 END DO 603 END DO 604 605 DO ij = 1, icells 606 ji = indxi(ij) ; jj = indxj(ij) 607 608 !-------------------------------------------------------------------- 609 ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2) 610 !-------------------------------------------------------------------- 611 ardg1(ij) = aridge(ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice 612 arft1(ij) = araft (ji,jj,jl1) * closing_gross(ji,jj) * rdt_ice 613 614 !--------------------------------------------------------------- 615 ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1 616 !--------------------------------------------------------------- 617 afrac(ij) = ardg1(ij) / a_i(ji,jj,jl1) !ridging 618 afrft(ij) = arft1(ij) / a_i(ji,jj,jl1) !rafting 619 ardg2(ij) = ardg1(ij) * krdg(ji,jj,jl1) 620 arft2(ij) = arft1(ij) * kraft 621 622 !-------------------------------------------------------------------------- 623 ! 3.4) Subtract area, volume, and energy from ridging 624 ! / rafting category n1. 625 !-------------------------------------------------------------------------- 626 vrdg1(ij) = v_i(ji,jj,jl1) * afrac(ij) 627 vrdg2(ij) = vrdg1(ij) * ( 1. + rn_por_rdg ) 628 vsw (ij) = vrdg1(ij) * rn_por_rdg 629 630 vsrdg (ij) = v_s (ji,jj, jl1) * afrac(ij) 631 esrdg (ij) = e_s (ji,jj,1,jl1) * afrac(ij) 632 srdg1 (ij) = smv_i(ji,jj, jl1) * afrac(ij) 633 oirdg1(ij) = oa_i (ji,jj, jl1) * afrac(ij) 634 oirdg2(ij) = oa_i (ji,jj, jl1) * afrac(ij) * krdg(ji,jj,jl1) 635 636 ! rafting volumes, heat contents ... 637 virft (ij) = v_i (ji,jj, jl1) * afrft(ij) 638 vsrft (ij) = v_s (ji,jj, jl1) * afrft(ij) 639 esrft (ij) = e_s (ji,jj,1,jl1) * afrft(ij) 640 smrft (ij) = smv_i(ji,jj, jl1) * afrft(ij) 641 oirft1(ij) = oa_i (ji,jj, jl1) * afrft(ij) 642 oirft2(ij) = oa_i (ji,jj, jl1) * afrft(ij) * kraft 643 644 !----------------------------------------------------------------- 645 ! 3.5) Compute properties of new ridges 646 !----------------------------------------------------------------- 647 smsw(ij) = vsw(ij) * sss_m(ji,jj) ! salt content of seawater frozen in voids 648 srdg2(ij) = srdg1(ij) + smsw(ij) ! salt content of new ridge 649 650 sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ij) * rhoic * r1_rdtice 651 wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ij) * rhoic * r1_rdtice ! increase in ice volume due to seawater frozen in voids 652 653 ! virtual salt flux to keep salinity constant 654 IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN 655 srdg2(ij) = srdg2(ij) - vsw(ij) * ( sss_m(ji,jj) - sm_i(ji,jj,jl1) ) ! ridge salinity = sm_i 656 sfx_bri(ji,jj) = sfx_bri(ji,jj) + sss_m(ji,jj) * vsw(ij) * rhoic * r1_rdtice & ! put back sss_m into the ocean 657 & - sm_i(ji,jj,jl1) * vsw(ij) * rhoic * r1_rdtice ! and get sm_i from the ocean 658 ENDIF 659 660 !------------------------------------------ 661 ! 3.7 Put the snow somewhere in the ocean 662 !------------------------------------------ 663 ! Place part of the snow lost by ridging into the ocean. 664 ! Note that esrdg > 0; the ocean must cool to melt snow. 665 ! If the ocean temp = Tf already, new ice must grow. 666 ! During the next time step, thermo_rates will determine whether 667 ! the ocean cools or new ice grows. 668 wfx_snw(ji,jj) = wfx_snw(ji,jj) + ( rhosn * vsrdg(ij) * ( 1._wp - rn_fsnowrdg ) & 669 & + rhosn * vsrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice ! fresh water source for ocean 670 671 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ( - esrdg(ij) * ( 1._wp - rn_fsnowrdg ) & 672 & - esrft(ij) * ( 1._wp - rn_fsnowrft ) ) * r1_rdtice ! heat sink for ocean (<0, W.m-2) 673 674 !----------------------------------------------------------------- 675 ! 3.8 Compute quantities used to apportion ice among categories 676 ! in the n2 loop below 677 !----------------------------------------------------------------- 678 dhr (ij) = 1._wp / ( hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) ) 679 dhr2(ij) = 1._wp / ( hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) ) 680 681 682 ! update jl1 (removing ridged/rafted area) 683 a_i (ji,jj, jl1) = a_i (ji,jj, jl1) - ardg1 (ij) - arft1 (ij) 684 v_i (ji,jj, jl1) = v_i (ji,jj, jl1) - vrdg1 (ij) - virft (ij) 685 v_s (ji,jj, jl1) = v_s (ji,jj, jl1) - vsrdg (ij) - vsrft (ij) 686 e_s (ji,jj,1,jl1) = e_s (ji,jj,1,jl1) - esrdg (ij) - esrft (ij) 687 smv_i(ji,jj, jl1) = smv_i(ji,jj, jl1) - srdg1 (ij) - smrft (ij) 688 oa_i (ji,jj, jl1) = oa_i (ji,jj, jl1) - oirdg1(ij) - oirft1(ij) 689 690 END DO 691 692 !-------------------------------------------------------------------- 693 ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and 694 ! compute ridged ice enthalpy 695 !-------------------------------------------------------------------- 696 DO jk = 1, nlay_i 697 DO ij = 1, icells 698 ji = indxi(ij) ; jj = indxj(ij) 699 ! heat content of ridged ice 700 erdg1(ij,jk) = e_i(ji,jj,jk,jl1) * afrac(ij) 701 eirft(ij,jk) = e_i(ji,jj,jk,jl1) * afrft(ij) 702 703 ! enthalpy of the trapped seawater (J/m2, >0) 704 ! clem: if sst>0, then ersw <0 (is that possible?) 705 ersw(ij,jk) = - rhoic * vsw(ij) * rcp * sst_m(ji,jj) * r1_nlay_i 706 707 ! heat flux to the ocean 708 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ij,jk) * r1_rdtice ! > 0 [W.m-2] ocean->ice flux 709 710 ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean 711 erdg2(ij,jk) = erdg1(ij,jk) + ersw(ij,jk) 712 713 ! update jl1 714 e_i (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ij,jk) - eirft(ij,jk) 715 716 END DO 717 END DO 718 719 !------------------------------------------------------------------------------- 720 ! 4) Add area, volume, and energy of new ridge to each category jl2 721 !------------------------------------------------------------------------------- 722 DO jl2 = 1, jpl 723 ! over categories to which ridged/rafted ice is transferred 724 DO ij = 1, icells 725 ji = indxi(ij) ; jj = indxj(ij) 726 727 ! Compute the fraction of ridged ice area and volume going to thickness category jl2. 728 IF( hrmin(ji,jj,jl1) <= hi_max(jl2) .AND. hrmax(ji,jj,jl1) > hi_max(jl2-1) ) THEN 729 hL = MAX( hrmin(ji,jj,jl1), hi_max(jl2-1) ) 730 hR = MIN( hrmax(ji,jj,jl1), hi_max(jl2) ) 731 farea = ( hR - hL ) * dhr(ij) 732 fvol(ij) = ( hR * hR - hL * hL ) * dhr2(ij) 733 ELSE 734 farea = 0._wp 735 fvol(ij) = 0._wp 736 ENDIF 737 738 ! Compute the fraction of rafted ice area and volume going to thickness category jl2 739 IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) > hi_max(jl2-1) ) THEN 740 zswitch(ij) = 1._wp 741 ELSE 742 zswitch(ij) = 0._wp 743 ENDIF 744 745 a_i (ji,jj ,jl2) = a_i (ji,jj ,jl2) + ( ardg2 (ij) * farea + arft2 (ij) * zswitch(ij) ) 746 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + ( oirdg2(ij) * farea + oirft2(ij) * zswitch(ij) ) 747 v_i (ji,jj ,jl2) = v_i (ji,jj ,jl2) + ( vrdg2 (ij) * fvol(ij) + virft (ij) * zswitch(ij) ) 748 smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + ( srdg2 (ij) * fvol(ij) + smrft (ij) * zswitch(ij) ) 749 v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + ( vsrdg (ij) * rn_fsnowrdg * fvol(ij) + & 750 & vsrft (ij) * rn_fsnowrft * zswitch(ij) ) 751 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + ( esrdg (ij) * rn_fsnowrdg * fvol(ij) + & 752 & esrft (ij) * rn_fsnowrft * zswitch(ij) ) 753 754 END DO 755 756 ! Transfer ice energy to category jl2 by ridging 757 DO jk = 1, nlay_i 758 DO ij = 1, icells 759 ji = indxi(ij) ; jj = indxj(ij) 760 e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + erdg2(ij,jk) * fvol(ij) + eirft(ij,jk) * zswitch(ij) 761 END DO 762 END DO 763 ! 764 END DO ! jl2 765 766 END DO ! jl1 (deforming categories) 767 768 ! 769 CALL wrk_dealloc( jpij, indxi, indxj ) 770 CALL wrk_dealloc( jpij, zswitch, fvol ) 771 CALL wrk_dealloc( jpij, afrac, ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 772 CALL wrk_dealloc( jpij, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 773 CALL wrk_dealloc( jpij, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 774 CALL wrk_dealloc( jpij,nlay_i, eirft, erdg1, erdg2, ersw ) 775 ! 776 END SUBROUTINE lim_itd_me_ridgeshift 417 777 418 778 SUBROUTINE lim_itd_me_icestrength( kstrngth ) … … 434 794 INTEGER :: ksmooth ! smoothing the resistance to deformation 435 795 INTEGER :: numts_rm ! number of time steps for the P smoothing 436 REAL(wp) :: z hi, zp, z1_3! local scalars796 REAL(wp) :: zp, z1_3 ! local scalars 437 797 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here 438 798 !!---------------------------------------------------------------------- … … 459 819 DO ji = 1, jpi 460 820 ! 461 IF( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp ) THEN 462 zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 821 IF( athorn(ji,jj,jl) > 0._wp ) THEN 463 822 !---------------------------- 464 823 ! PE loss from deforming ice 465 824 !---------------------------- 466 strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * zhi * zhi825 strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i(ji,jj,jl) 467 826 468 827 !-------------------------- 469 828 ! PE gain from rafting ice 470 829 !-------------------------- 471 strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * zhi * zhi830 strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i(ji,jj,jl) 472 831 473 832 !---------------------------- 474 833 ! PE gain from ridging ice 475 834 !---------------------------- 476 strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) / krdg(ji,jj,jl) & 477 * z1_3 * ( hrmax(ji,jj,jl)**2 + hrmin(ji,jj,jl)**2 + hrmax(ji,jj,jl) * hrmin(ji,jj,jl) ) 835 strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl) * krdg(ji,jj,jl) * z1_3 * & 836 & ( hrmax(ji,jj,jl) * hrmax(ji,jj,jl) + & 837 & hrmin(ji,jj,jl) * hrmin(ji,jj,jl) + & 838 & hrmax(ji,jj,jl) * hrmin(ji,jj,jl) ) 478 839 !!(a**3-b**3)/(a-b) = a*a+ab+b*b 479 840 ENDIF … … 497 858 ! 498 859 ENDIF ! kstrngth 499 500 860 ! 501 861 !------------------------------------------------------------------------------! … … 503 863 !------------------------------------------------------------------------------! 504 864 ! CAN BE REMOVED 505 !506 865 IF( ln_icestr_bvf ) THEN 507 508 866 DO jj = 1, jpj 509 867 DO ji = 1, jpi … … 511 869 END DO 512 870 END DO 513 514 871 ENDIF 515 516 872 ! 517 873 !------------------------------------------------------------------------------! … … 558 914 IF ( ksmooth == 2 ) THEN 559 915 560 561 916 CALL lbc_lnk( strength, 'T', 1. ) 562 917 … … 565 920 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 566 921 numts_rm = 1 ! number of time steps for the running mean 567 IF ( strp1(ji,jj) > 0. 0) numts_rm = numts_rm + 1568 IF ( strp2(ji,jj) > 0. 0) numts_rm = numts_rm + 1922 IF ( strp1(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 923 IF ( strp2(ji,jj) > 0._wp ) numts_rm = numts_rm + 1 569 924 zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm 570 925 strp2(ji,jj) = strp1(ji,jj) … … 583 938 ! 584 939 END SUBROUTINE lim_itd_me_icestrength 585 586 587 SUBROUTINE lim_itd_me_ridgeprep588 !!---------------------------------------------------------------------!589 !! *** ROUTINE lim_itd_me_ridgeprep ***590 !!591 !! ** Purpose : preparation for ridging and strength calculations592 !!593 !! ** Method : Compute the thickness distribution of the ice and open water594 !! participating in ridging and of the resulting ridges.595 !!---------------------------------------------------------------------!596 INTEGER :: ji,jj, jl ! dummy loop indices597 REAL(wp) :: Gstari, astari, zhi, hrmean, zdummy ! local scalar598 REAL(wp), POINTER, DIMENSION(:,:) :: zworka ! temporary array used here599 REAL(wp), POINTER, DIMENSION(:,:,:) :: Gsum ! Gsum(n) = sum of areas in categories 0 to n600 !------------------------------------------------------------------------------!601 602 CALL wrk_alloc( jpi,jpj, zworka )603 CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )604 605 Gstari = 1.0/rn_gstar606 astari = 1.0/rn_astar607 aksum(:,:) = 0.0608 athorn(:,:,:) = 0.0609 aridge(:,:,:) = 0.0610 araft (:,:,:) = 0.0611 hrmin(:,:,:) = 0.0612 hrmax(:,:,:) = 0.0613 hraft(:,:,:) = 0.0614 krdg (:,:,:) = 1.0615 616 ! ! Zero out categories with very small areas617 CALL lim_var_zapsmall618 619 !------------------------------------------------------------------------------!620 ! 1) Participation function621 !------------------------------------------------------------------------------!622 623 ! Compute total area of ice plus open water.624 ! This is in general not equal to one because of divergence during transport625 asum(:,:) = ato_i(:,:)626 DO jl = 1, jpl627 asum(:,:) = asum(:,:) + a_i(:,:,jl)628 END DO629 630 ! Compute cumulative thickness distribution function631 ! Compute the cumulative thickness distribution function Gsum,632 ! where Gsum(n) is the fractional area in categories 0 to n.633 ! initial value (in h = 0) equals open water area634 635 Gsum(:,:,-1) = 0._wp636 Gsum(:,:,0 ) = ato_i(:,:)637 638 ! for each value of h, you have to add ice concentration then639 DO jl = 1, jpl640 Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl)641 END DO642 643 ! Normalize the cumulative distribution to 1644 zworka(:,:) = 1._wp / Gsum(:,:,jpl)645 DO jl = 0, jpl646 Gsum(:,:,jl) = Gsum(:,:,jl) * zworka(:,:)647 END DO648 649 ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn)650 !--------------------------------------------------------------------------------------------------651 ! Compute the participation function athorn; this is analogous to652 ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975).653 ! area lost from category n due to ridging/closing654 ! athorn(n) = total area lost due to ridging/closing655 ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar).656 !657 ! The expressions for athorn are found by integrating b(h)g(h) between658 ! the category boundaries.659 !-----------------------------------------------------------------660 661 IF( nn_partfun == 0 ) THEN !--- Linear formulation (Thorndike et al., 1975)662 DO jl = 0, jpl663 DO jj = 1, jpj664 DO ji = 1, jpi665 IF( Gsum(ji,jj,jl) < rn_gstar) THEN666 athorn(ji,jj,jl) = Gstari * ( Gsum(ji,jj,jl) - Gsum(ji,jj,jl-1) ) * &667 & ( 2.0 - (Gsum(ji,jj,jl-1) + Gsum(ji,jj,jl) ) * Gstari )668 ELSEIF (Gsum(ji,jj,jl-1) < rn_gstar) THEN669 athorn(ji,jj,jl) = Gstari * ( rn_gstar - Gsum(ji,jj,jl-1) ) * &670 & ( 2.0 - ( Gsum(ji,jj,jl-1) + rn_gstar ) * Gstari )671 ELSE672 athorn(ji,jj,jl) = 0.0673 ENDIF674 END DO675 END DO676 END DO677 678 ELSE !--- Exponential, more stable formulation (Lipscomb et al, 2007)679 !680 zdummy = 1._wp / ( 1._wp - EXP(-astari) ) ! precompute exponential terms using Gsum as a work array681 DO jl = -1, jpl682 Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy683 END DO684 DO jl = 0, jpl685 athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl)686 END DO687 !688 ENDIF689 690 IF( ln_rafting ) THEN ! Ridging and rafting ice participation functions691 !692 DO jl = 1, jpl693 DO jj = 1, jpj694 DO ji = 1, jpi695 IF ( athorn(ji,jj,jl) > 0._wp ) THEN696 !!gm TANH( -X ) = - TANH( X ) so can be computed only 1 time....697 aridge(ji,jj,jl) = ( TANH ( rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)698 araft (ji,jj,jl) = ( TANH ( -rn_craft * ( ht_i(ji,jj,jl) - rn_hraft ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)699 IF ( araft(ji,jj,jl) < epsi06 ) araft(ji,jj,jl) = 0._wp700 aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0 )701 ENDIF702 END DO703 END DO704 END DO705 706 ELSE707 !708 DO jl = 1, jpl709 aridge(:,:,jl) = athorn(:,:,jl)710 END DO711 !712 ENDIF713 714 IF( ln_rafting ) THEN715 716 IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) > epsi10 .AND. lwp ) THEN717 DO jl = 1, jpl718 DO jj = 1, jpj719 DO ji = 1, jpi720 IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) > epsi10 ) THEN721 WRITE(numout,*) ' ALERTE 96 : wrong participation function ... '722 WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl723 WRITE(numout,*) ' lat, lon : ', gphit(ji,jj), glamt(ji,jj)724 WRITE(numout,*) ' aridge : ', aridge(ji,jj,1:jpl)725 WRITE(numout,*) ' araft : ', araft(ji,jj,1:jpl)726 WRITE(numout,*) ' athorn : ', athorn(ji,jj,1:jpl)727 ENDIF728 END DO729 END DO730 END DO731 ENDIF732 733 ENDIF734 735 !-----------------------------------------------------------------736 ! 2) Transfer function737 !-----------------------------------------------------------------738 ! Compute max and min ridged ice thickness for each ridging category.739 ! Assume ridged ice is uniformly distributed between hrmin and hrmax.740 !741 ! This parameterization is a modified version of Hibler (1980).742 ! The mean ridging thickness, hrmean, is proportional to hi^(0.5)743 ! and for very thick ridging ice must be >= krdgmin*hi744 !745 ! The minimum ridging thickness, hrmin, is equal to 2*hi746 ! (i.e., rafting) and for very thick ridging ice is747 ! constrained by hrmin <= (hrmean + hi)/2.748 !749 ! The maximum ridging thickness, hrmax, is determined by750 ! hrmean and hrmin.751 !752 ! These modifications have the effect of reducing the ice strength753 ! (relative to the Hibler formulation) when very thick ice is754 ! ridging.755 !756 ! aksum = net area removed/ total area removed757 ! where total area removed = area of ice that ridges758 ! net area removed = total area removed - area of new ridges759 !-----------------------------------------------------------------760 761 ! Transfer function762 DO jl = 1, jpl !all categories have a specific transfer function763 DO jj = 1, jpj764 DO ji = 1, jpi765 766 IF (a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0.0 ) THEN767 zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl)768 hrmean = MAX(SQRT(rn_hstar*zhi), zhi*krdgmin)769 hrmin(ji,jj,jl) = MIN(2.0*zhi, 0.5*(hrmean + zhi))770 hrmax(ji,jj,jl) = 2.0*hrmean - hrmin(ji,jj,jl)771 hraft(ji,jj,jl) = kraft*zhi772 krdg(ji,jj,jl) = hrmean / zhi773 ELSE774 hraft(ji,jj,jl) = 0.0775 hrmin(ji,jj,jl) = 0.0776 hrmax(ji,jj,jl) = 0.0777 krdg (ji,jj,jl) = 1.0778 ENDIF779 780 END DO781 END DO782 END DO783 784 ! Normalization factor : aksum, ensures mass conservation785 aksum(:,:) = athorn(:,:,0)786 DO jl = 1, jpl787 aksum(:,:) = aksum(:,:) + aridge(:,:,jl) * ( 1._wp - 1._wp / krdg(:,:,jl) ) &788 & + araft (:,:,jl) * ( 1._wp - 1._wp / kraft )789 END DO790 !791 CALL wrk_dealloc( jpi,jpj, zworka )792 CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )793 !794 END SUBROUTINE lim_itd_me_ridgeprep795 796 797 SUBROUTINE lim_itd_me_ridgeshift( opning, closing_gross, msnow_mlt, esnow_mlt )798 !!----------------------------------------------------------------------799 !! *** ROUTINE lim_itd_me_icestrength ***800 !!801 !! ** Purpose : shift ridging ice among thickness categories of ice thickness802 !!803 !! ** Method : Remove area, volume, and energy from each ridging category804 !! and add to thicker ice categories.805 !!----------------------------------------------------------------------806 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: opning ! rate of opening due to divergence/shear807 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: closing_gross ! rate at which area removed, excluding area of new ridges808 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: msnow_mlt ! mass of snow added to ocean (kg m-2)809 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2)810 !811 CHARACTER (len=80) :: fieldid ! field identifier812 LOGICAL, PARAMETER :: l_conservation_check = .true. ! if true, check conservation (useful for debugging)813 !814 INTEGER :: ji, jj, jl, jl1, jl2, jk ! dummy loop indices815 INTEGER :: ij ! horizontal index, combines i and j loops816 INTEGER :: icells ! number of cells with aicen > puny817 REAL(wp) :: hL, hR, farea, ztmelts ! left and right limits of integration818 819 INTEGER , POINTER, DIMENSION(:) :: indxi, indxj ! compressed indices820 821 REAL(wp), POINTER, DIMENSION(:,:) :: vice_init, vice_final ! ice volume summed over categories822 REAL(wp), POINTER, DIMENSION(:,:) :: eice_init, eice_final ! ice energy summed over layers823 824 REAL(wp), POINTER, DIMENSION(:,:,:) :: aicen_init, vicen_init ! ice area & volume before ridging825 REAL(wp), POINTER, DIMENSION(:,:,:) :: vsnwn_init, esnwn_init ! snow volume & energy before ridging826 REAL(wp), POINTER, DIMENSION(:,:,:) :: smv_i_init, oa_i_init ! ice salinity & age before ridging827 828 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: eicen_init ! ice energy before ridging829 830 REAL(wp), POINTER, DIMENSION(:,:) :: afrac , fvol ! fraction of category area ridged & new ridge volume going to n2831 REAL(wp), POINTER, DIMENSION(:,:) :: ardg1 , ardg2 ! area of ice ridged & new ridges832 REAL(wp), POINTER, DIMENSION(:,:) :: vsrdg , esrdg ! snow volume & energy of ridging ice833 REAL(wp), POINTER, DIMENSION(:,:) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2834 835 REAL(wp), POINTER, DIMENSION(:,:) :: vrdg1 ! volume of ice ridged836 REAL(wp), POINTER, DIMENSION(:,:) :: vrdg2 ! volume of new ridges837 REAL(wp), POINTER, DIMENSION(:,:) :: vsw ! volume of seawater trapped into ridges838 REAL(wp), POINTER, DIMENSION(:,:) :: srdg1 ! sal*volume of ice ridged839 REAL(wp), POINTER, DIMENSION(:,:) :: srdg2 ! sal*volume of new ridges840 REAL(wp), POINTER, DIMENSION(:,:) :: smsw ! sal*volume of water trapped into ridges841 REAL(wp), POINTER, DIMENSION(:,:) :: oirdg1, oirdg2 ! ice age of ice ridged842 843 REAL(wp), POINTER, DIMENSION(:,:) :: afrft ! fraction of category area rafted844 REAL(wp), POINTER, DIMENSION(:,:) :: arft1 , arft2 ! area of ice rafted and new rafted zone845 REAL(wp), POINTER, DIMENSION(:,:) :: virft , vsrft ! ice & snow volume of rafting ice846 REAL(wp), POINTER, DIMENSION(:,:) :: esrft , smrft ! snow energy & salinity of rafting ice847 REAL(wp), POINTER, DIMENSION(:,:) :: oirft1, oirft2 ! ice age of ice rafted848 849 REAL(wp), POINTER, DIMENSION(:,:,:) :: eirft ! ice energy of rafting ice850 REAL(wp), POINTER, DIMENSION(:,:,:) :: erdg1 ! enth*volume of ice ridged851 REAL(wp), POINTER, DIMENSION(:,:,:) :: erdg2 ! enth*volume of new ridges852 REAL(wp), POINTER, DIMENSION(:,:,:) :: ersw ! enth of water trapped into ridges853 !!----------------------------------------------------------------------854 855 CALL wrk_alloc( (jpi+1)*(jpj+1), indxi, indxj )856 CALL wrk_alloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final )857 CALL wrk_alloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )858 CALL wrk_alloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 )859 CALL wrk_alloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )860 CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )861 CALL wrk_alloc( jpi, jpj, nlay_i, eirft, erdg1, erdg2, ersw )862 CALL wrk_alloc( jpi, jpj, nlay_i, jpl, eicen_init )863 864 ! Conservation check865 eice_init(:,:) = 0._wp866 867 IF( con_i ) THEN868 CALL lim_column_sum (jpl, v_i, vice_init )869 CALL lim_column_sum_energy (jpl, nlay_i, e_i, eice_init )870 DO ji = mi0(iiceprt), mi1(iiceprt)871 DO jj = mj0(jiceprt), mj1(jiceprt)872 WRITE(numout,*) ' vice_init : ', vice_init(ji,jj)873 WRITE(numout,*) ' eice_init : ', eice_init(ji,jj)874 END DO875 END DO876 ENDIF877 878 !-------------------------------------------------------------------------------879 ! 1) Compute change in open water area due to closing and opening.880 !-------------------------------------------------------------------------------881 DO jj = 1, jpj882 DO ji = 1, jpi883 ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice &884 & + opning(ji,jj) * rdt_ice885 IF ( ato_i(ji,jj) < -epsi10 ) THEN ! there is a bug886 IF(lwp) WRITE(numout,*) 'Ridging error: ato_i < 0 -- ato_i : ',ato_i(ji,jj)887 ELSEIF( ato_i(ji,jj) < 0._wp ) THEN ! roundoff error888 ato_i(ji,jj) = 0._wp889 ENDIF890 END DO891 END DO892 893 !-----------------------------------------------------------------894 ! 2) Save initial state variables895 !-----------------------------------------------------------------896 aicen_init(:,:,:) = a_i (:,:,:)897 vicen_init(:,:,:) = v_i (:,:,:)898 vsnwn_init(:,:,:) = v_s (:,:,:)899 smv_i_init(:,:,:) = smv_i(:,:,:)900 esnwn_init(:,:,:) = e_s (:,:,1,:)901 eicen_init(:,:,:,:) = e_i (:,:,:,:)902 oa_i_init (:,:,:) = oa_i (:,:,:)903 904 !905 !-----------------------------------------------------------------906 ! 3) Pump everything from ice which is being ridged / rafted907 !-----------------------------------------------------------------908 ! Compute the area, volume, and energy of ice ridging in each909 ! category, along with the area of the resulting ridge.910 911 DO jl1 = 1, jpl !jl1 describes the ridging category912 913 !------------------------------------------------914 ! 3.1) Identify grid cells with nonzero ridging915 !------------------------------------------------916 917 icells = 0918 DO jj = 1, jpj919 DO ji = 1, jpi920 IF( aicen_init(ji,jj,jl1) > epsi10 .AND. athorn(ji,jj,jl1) > 0._wp &921 & .AND. closing_gross(ji,jj) > 0._wp ) THEN922 icells = icells + 1923 indxi(icells) = ji924 indxj(icells) = jj925 ENDIF926 END DO927 END DO928 929 DO ij = 1, icells930 ji = indxi(ij)931 jj = indxj(ij)932 933 !--------------------------------------------------------------------934 ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2)935 !--------------------------------------------------------------------936 937 ardg1(ji,jj) = aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice938 arft1(ji,jj) = araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice939 ardg2(ji,jj) = ardg1(ji,jj) / krdg(ji,jj,jl1)940 arft2(ji,jj) = arft1(ji,jj) / kraft941 942 !---------------------------------------------------------------943 ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1944 !---------------------------------------------------------------945 946 afrac(ji,jj) = ardg1(ji,jj) / aicen_init(ji,jj,jl1) !ridging947 afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting948 949 IF( afrac(ji,jj) > kamax + epsi10 ) THEN ! there is a bug950 IF(lwp) WRITE(numout,*) ' ardg > a_i -- ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1)951 ELSEIF( afrac(ji,jj) > kamax ) THEN ! roundoff error952 afrac(ji,jj) = kamax953 ENDIF954 955 IF( afrft(ji,jj) > kamax + epsi10 ) THEN ! there is a bug956 IF(lwp) WRITE(numout,*) ' arft > a_i -- arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)957 ELSEIF( afrft(ji,jj) > kamax) THEN ! roundoff error958 afrft(ji,jj) = kamax959 ENDIF960 961 !--------------------------------------------------------------------------962 ! 3.4) Subtract area, volume, and energy from ridging963 ! / rafting category n1.964 !--------------------------------------------------------------------------965 vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj)966 vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + rn_por_rdg )967 vsw (ji,jj) = vrdg1(ji,jj) * rn_por_rdg968 969 vsrdg (ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj)970 esrdg (ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj)971 srdg1 (ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj)972 oirdg1(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj)973 oirdg2(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) / krdg(ji,jj,jl1)974 975 ! rafting volumes, heat contents ...976 virft (ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj)977 vsrft (ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj)978 esrft (ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj)979 smrft (ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)980 oirft1(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj)981 oirft2(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) / kraft982 983 ! substract everything984 a_i(ji,jj,jl1) = a_i(ji,jj,jl1) - ardg1 (ji,jj) - arft1 (ji,jj)985 v_i(ji,jj,jl1) = v_i(ji,jj,jl1) - vrdg1 (ji,jj) - virft (ji,jj)986 v_s(ji,jj,jl1) = v_s(ji,jj,jl1) - vsrdg (ji,jj) - vsrft (ji,jj)987 e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg (ji,jj) - esrft (ji,jj)988 smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1 (ji,jj) - smrft (ji,jj)989 oa_i(ji,jj,jl1) = oa_i(ji,jj,jl1) - oirdg1(ji,jj) - oirft1(ji,jj)990 991 !-----------------------------------------------------------------992 ! 3.5) Compute properties of new ridges993 !-----------------------------------------------------------------994 !---------995 ! Salinity996 !---------997 smsw(ji,jj) = vsw(ji,jj) * sss_m(ji,jj) ! salt content of seawater frozen in voids !! MV HC2014998 srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge999 1000 !srdg2(ji,jj) = MIN( rn_simax * vrdg2(ji,jj) , zsrdg2 ) ! impose a maximum salinity1001 1002 sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice1003 wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice ! increase in ice volume du to seawater frozen in voids1004 1005 !------------------------------------1006 ! 3.6 Increment ridging diagnostics1007 !------------------------------------1008 1009 ! jl1 looping 1-jpl1010 ! ij looping 1-icells1011 1012 dardg1dt (ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj)1013 dardg2dt (ji,jj) = dardg2dt(ji,jj) + ardg2(ji,jj) + arft2(ji,jj)1014 opening (ji,jj) = opening (ji,jj) + opning(ji,jj) * rdt_ice1015 1016 IF( con_i ) vice_init(ji,jj) = vice_init(ji,jj) + vrdg2(ji,jj) - vrdg1(ji,jj)1017 1018 !------------------------------------------1019 ! 3.7 Put the snow somewhere in the ocean1020 !------------------------------------------1021 ! Place part of the snow lost by ridging into the ocean.1022 ! Note that esnow_mlt < 0; the ocean must cool to melt snow.1023 ! If the ocean temp = Tf already, new ice must grow.1024 ! During the next time step, thermo_rates will determine whether1025 ! the ocean cools or new ice grows.1026 ! jl1 looping 1-jpl1027 ! ij looping 1-icells1028 1029 msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-rn_fsnowrdg) & ! rafting included1030 & + rhosn*vsrft(ji,jj)*(1.0-rn_fsnowrft)1031 1032 ! in J/m2 (same as e_s)1033 esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-rn_fsnowrdg) & !rafting included1034 & - esrft(ji,jj)*(1.0-rn_fsnowrft)1035 1036 !-----------------------------------------------------------------1037 ! 3.8 Compute quantities used to apportion ice among categories1038 ! in the n2 loop below1039 !-----------------------------------------------------------------1040 1041 ! jl1 looping 1-jpl1042 ! ij looping 1-icells1043 1044 dhr (ji,jj) = hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1)1045 dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1)1046 1047 END DO1048 1049 !--------------------------------------------------------------------1050 ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and1051 ! compute ridged ice enthalpy1052 !--------------------------------------------------------------------1053 DO jk = 1, nlay_i1054 DO ij = 1, icells1055 ji = indxi(ij)1056 jj = indxj(ij)1057 ! heat content of ridged ice1058 erdg1(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj)1059 eirft(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj)1060 e_i (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk)1061 1062 1063 ! enthalpy of the trapped seawater (J/m2, >0)1064 ! clem: if sst>0, then ersw <0 (is that possible?)1065 ersw(ji,jj,jk) = - rhoic * vsw(ji,jj) * rcp * sst_m(ji,jj) * r1_nlay_i1066 1067 ! heat flux to the ocean1068 hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice ! > 0 [W.m-2] ocean->ice flux1069 1070 ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean1071 erdg2(ji,jj,jk) = erdg1(ji,jj,jk) + ersw(ji,jj,jk)1072 1073 END DO1074 END DO1075 1076 1077 IF( con_i ) THEN1078 DO jk = 1, nlay_i1079 DO ij = 1, icells1080 ji = indxi(ij)1081 jj = indxj(ij)1082 eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - erdg1(ji,jj,jk)1083 END DO1084 END DO1085 ENDIF1086 1087 !-------------------------------------------------------------------------------1088 ! 4) Add area, volume, and energy of new ridge to each category jl21089 !-------------------------------------------------------------------------------1090 ! jl1 looping 1-jpl1091 DO jl2 = 1, jpl1092 ! over categories to which ridged ice is transferred1093 DO ij = 1, icells1094 ji = indxi(ij)1095 jj = indxj(ij)1096 1097 ! Compute the fraction of ridged ice area and volume going to1098 ! thickness category jl2.1099 ! Transfer area, volume, and energy accordingly.1100 1101 IF( hrmin(ji,jj,jl1) >= hi_max(jl2) .OR. hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN1102 hL = 0._wp1103 hR = 0._wp1104 ELSE1105 hL = MAX( hrmin(ji,jj,jl1), hi_max(jl2-1) )1106 hR = MIN( hrmax(ji,jj,jl1), hi_max(jl2) )1107 ENDIF1108 1109 ! fraction of ridged ice area and volume going to n21110 farea = ( hR - hL ) / dhr(ji,jj)1111 fvol(ji,jj) = ( hR*hR - hL*hL ) / dhr2(ji,jj)1112 1113 a_i (ji,jj ,jl2) = a_i (ji,jj ,jl2) + ardg2 (ji,jj) * farea1114 v_i (ji,jj ,jl2) = v_i (ji,jj ,jl2) + vrdg2 (ji,jj) * fvol(ji,jj)1115 v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg1116 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * rn_fsnowrdg1117 smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + srdg2 (ji,jj) * fvol(ji,jj)1118 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirdg2(ji,jj) * farea1119 1120 END DO1121 1122 ! Transfer ice energy to category jl2 by ridging1123 DO jk = 1, nlay_i1124 DO ij = 1, icells1125 ji = indxi(ij)1126 jj = indxj(ij)1127 e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj) * erdg2(ji,jj,jk)1128 END DO1129 END DO1130 !1131 END DO ! jl2 (new ridges)1132 1133 DO jl2 = 1, jpl1134 1135 DO ij = 1, icells1136 ji = indxi(ij)1137 jj = indxj(ij)1138 ! Compute the fraction of rafted ice area and volume going to1139 ! thickness category jl2, transfer area, volume, and energy accordingly.1140 !1141 IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) > hi_max(jl2-1) ) THEN1142 a_i (ji,jj ,jl2) = a_i (ji,jj ,jl2) + arft2 (ji,jj)1143 v_i (ji,jj ,jl2) = v_i (ji,jj ,jl2) + virft (ji,jj)1144 v_s (ji,jj ,jl2) = v_s (ji,jj ,jl2) + vsrft (ji,jj) * rn_fsnowrft1145 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft1146 smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + smrft (ji,jj)1147 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirft2(ji,jj)1148 ENDIF1149 !1150 END DO1151 1152 ! Transfer rafted ice energy to category jl21153 DO jk = 1, nlay_i1154 DO ij = 1, icells1155 ji = indxi(ij)1156 jj = indxj(ij)1157 IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND. hraft(ji,jj,jl1) > hi_max(jl2-1) ) THEN1158 e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk)1159 ENDIF1160 END DO1161 END DO1162 1163 END DO1164 1165 END DO ! jl1 (deforming categories)1166 1167 ! Conservation check1168 IF ( con_i ) THEN1169 CALL lim_column_sum (jpl, v_i, vice_final)1170 fieldid = ' v_i : limitd_me '1171 CALL lim_cons_check (vice_init, vice_final, 1.0e-6, fieldid)1172 1173 CALL lim_column_sum_energy (jpl, nlay_i, e_i, eice_final )1174 fieldid = ' e_i : limitd_me '1175 CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid)1176 1177 DO ji = mi0(iiceprt), mi1(iiceprt)1178 DO jj = mj0(jiceprt), mj1(jiceprt)1179 WRITE(numout,*) ' vice_init : ', vice_init (ji,jj)1180 WRITE(numout,*) ' vice_final : ', vice_final(ji,jj)1181 WRITE(numout,*) ' eice_init : ', eice_init (ji,jj)1182 WRITE(numout,*) ' eice_final : ', eice_final(ji,jj)1183 END DO1184 END DO1185 ENDIF1186 !1187 CALL wrk_dealloc( (jpi+1)*(jpj+1), indxi, indxj )1188 CALL wrk_dealloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final )1189 CALL wrk_dealloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 )1190 CALL wrk_dealloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 )1191 CALL wrk_dealloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )1192 CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )1193 CALL wrk_dealloc( jpi, jpj, nlay_i, eirft, erdg1, erdg2, ersw )1194 CALL wrk_dealloc( jpi, jpj, nlay_i, jpl, eicen_init )1195 !1196 END SUBROUTINE lim_itd_me_ridgeshift1197 940 1198 941 SUBROUTINE lim_itd_me_init -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r5836 r6851 159 159 CALL wrk_alloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask ) 160 160 CALL wrk_alloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds ) 161 CALL wrk_alloc( jpi,jpj, z dt , zds , zs1 , zs2 , zs12 , zresr , zpice )161 CALL wrk_alloc( jpi,jpj, zs1 , zs2 , zs12 , zresr , zpice ) 162 162 163 163 #if defined key_lim2 && ! defined key_lim2_vp … … 690 690 CALL wrk_dealloc( jpi,jpj, u_oce2, u_ice2, v_oce1 , v_ice1 , zmask ) 691 691 CALL wrk_dealloc( jpi,jpj, zf1 , zu_ice, zf2 , zv_ice , zdt , zds ) 692 CALL wrk_dealloc( jpi,jpj, z dt , zds , zs1 , zs2 , zs12 , zresr , zpice )692 CALL wrk_dealloc( jpi,jpj, zs1 , zs2 , zs12 , zresr , zpice ) 693 693 694 694 END SUBROUTINE lim_rhg -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r6140 r6851 107 107 REAL(wp) :: zqsr ! New solar flux received by the ocean 108 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 3D workspace 109 REAL(wp), POINTER, DIMENSION(:,:) :: zalb ! 2D workspace 109 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) 112 114 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 113 115 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface … … 118 120 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) & 119 121 & * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 120 IF( iom_use('qemp_oce' ) ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 121 IF( iom_use('qemp_ice' ) ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 122 123 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 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 128 CALL wrk_alloc( jpi,jpj, zalb ) 129 130 zalb(:,:) = 0._wp 131 WHERE ( SUM( a_i_b, dim=3 ) <= epsi06 ) ; zalb(:,:) = 0.066_wp 132 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 ) 133 END WHERE 134 IF( iom_use('alb_ice' ) ) CALL iom_put( "alb_ice" , zalb(:,:) ) ! ice albedo output 135 136 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - SUM( a_i_b, dim=3 ) ) 137 IF( iom_use('albedo' ) ) CALL iom_put( "albedo" , zalb(:,:) ) ! ice albedo output 138 139 CALL wrk_dealloc( jpi,jpj, zalb ) 140 124 141 DO jj = 1, jpj 125 142 DO ji = 1, jpi … … 140 157 hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr 141 158 142 ! Add the residual from heat diffusion equation (W.m-2) 143 !------------------------------------------------------- 144 hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) 159 ! Add the residual from heat diffusion equation and sublimation (W.m-2) 160 !---------------------------------------------------------------------- 161 hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) + & 162 & ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) ) 145 163 146 164 ! New qsr and qns used to compute the oceanic heat flux at the next time step 147 !--------------------------------------------------- 165 !---------------------------------------------------------------------------- 148 166 qsr(ji,jj) = zqsr 149 167 qns(ji,jj) = hfx_out(ji,jj) - zqsr … … 165 183 166 184 ! mass flux at the ocean/ice interface 167 fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice ! F/M mass flux save at least for biogeochemical model 168 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 169 185 fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) ) ! F/M mass flux save at least for biogeochemical model 186 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 170 187 END DO 171 188 END DO … … 175 192 !------------------------------------------! 176 193 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) & 177 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 194 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) 178 195 179 196 !-------------------------------------------------------------! -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r6140 r6851 440 440 ! 441 441 DO ji = kideb, kiut 442 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) )442 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) + dh_i_sub(ji) ) 443 443 IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp ) THEN 444 444 zvi = a_i_1d(ji) * ht_i_1d(ji) … … 495 495 ! 496 496 CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 497 CALL tab_2d_1d( nbpb, qevap_ice_1d(1:nbpb), qevap_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 497 498 CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 498 499 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) ) … … 524 525 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 525 526 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 527 CALL tab_2d_1d( nbpb, sfx_sub_1d (1:nbpb), sfx_sub , jpi, jpj,npb(1:nbpb) ) 526 528 ! 527 529 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) … … 574 576 CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj ) 575 577 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 578 CALL tab_1d_2d( nbpb, sfx_sub , npb, sfx_sub_1d(1:nbpb) , jpi, jpj ) 576 579 ! 577 580 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r5487 r6851 74 74 75 75 REAL(wp) :: ztmelts ! local scalar 76 REAL(wp) :: z fdum76 REAL(wp) :: zdum 77 77 REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment 78 78 REAL(wp) :: zs_snic ! snow-ice salinity … … 95 95 REAL(wp), POINTER, DIMENSION(:) :: zq_rema ! remaining heat at the end of the routine (J.m-2) 96 96 REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) 97 REAL(wp), POINTER, DIMENSION(:) :: zevap_rema ! remaining mass flux from sublimation (kg.m-2) 97 98 98 99 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel ! snow melt … … 105 106 106 107 REAL(wp), POINTER, DIMENSION(:) :: zqh_i ! total ice heat content (J.m-2) 107 REAL(wp), POINTER, DIMENSION(:) :: zqh_s ! total snow heat content (J.m-2)108 REAL(wp), POINTER, DIMENSION(:) :: zq_s ! total snow enthalpy (J.m-3)109 108 REAL(wp), POINTER, DIMENSION(:) :: zsnw ! distribution of snow after wind blowing 110 109 … … 118 117 ! Discriminate between varying salinity (nn_icesal=2) and prescribed cases (other values) 119 118 SELECT CASE( nn_icesal ) ! varying salinity or not 120 CASE( 1, 3 , 4) ; zswitch_sal = 0 ! prescribed salinity profile121 CASE( 2 ) 119 CASE( 1, 3 ) ; zswitch_sal = 0 ! prescribed salinity profile 120 CASE( 2 ) ; zswitch_sal = 1 ! varying salinity profile 122 121 END SELECT 123 122 124 CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw )125 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i , zqh_s, zq_s)123 CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema ) 124 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i ) 126 125 CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i ) 127 126 CALL wrk_alloc( jpij, nlay_i, icount ) 128 127 129 dh_i_surf (:) = 0._wp ; dh_i_bott (:) = 0._wp ; dh_snowice(:) = 0._wp 128 dh_i_surf (:) = 0._wp ; dh_i_bott (:) = 0._wp ; dh_snowice(:) = 0._wp ; dh_i_sub(:) = 0._wp 130 129 dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp 131 130 132 131 zqprec (:) = 0._wp ; zq_su (:) = 0._wp ; zq_bo (:) = 0._wp ; zf_tt(:) = 0._wp 133 zq_rema (:) = 0._wp ; zsnw (:) = 0._wp 132 zq_rema (:) = 0._wp ; zsnw (:) = 0._wp ; zevap_rema(:) = 0._wp ; 134 133 zdh_s_mel(:) = 0._wp ; zdh_s_pre(:) = 0._wp ; zdh_s_sub(:) = 0._wp ; zqh_i(:) = 0._wp 135 zqh_s (:) = 0._wp ; zq_s (:) = 0._wp136 134 137 135 zdeltah(:,:) = 0._wp ; zh_i(:,:) = 0._wp … … 159 157 ! 160 158 DO ji = kideb, kiut 161 z fdum= qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)159 zdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 162 160 zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 163 161 164 zq_su (ji) = MAX( 0._wp, z fdum* rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) )162 zq_su (ji) = MAX( 0._wp, zdum * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 165 163 zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 166 164 END DO … … 187 185 ! 2) Computing layer thicknesses and enthalpies. ! 188 186 !------------------------------------------------------------! 189 !190 DO jk = 1, nlay_s191 DO ji = kideb, kiut192 zqh_s(ji) = zqh_s(ji) + q_s_1d(ji,jk) * ht_s_1d(ji) * r1_nlay_s193 END DO194 END DO195 187 ! 196 188 DO jk = 1, nlay_i … … 275 267 END DO 276 268 277 !---------------------- 278 ! 3.2 S now sublimation279 !---------------------- 269 !------------------------------ 270 ! 3.2 Sublimation (part1: snow) 271 !------------------------------ 280 272 ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 281 273 ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean) 282 ! clem comment: ice should also sublimate283 274 zdeltah(:,:) = 0._wp 284 ! coupled mode: sublimation is set to 0 (evap_ice = 0) until further notice 285 ! forced mode: snow thickness change due to sublimation 286 DO ji = kideb, kiut 287 zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) 288 ! Heat flux by sublimation [W.m-2], < 0 289 ! sublimate first snow that had fallen, then pre-existing snow 275 DO ji = kideb, kiut 276 zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) 277 ! remaining evap in kg.m-2 (used for ice melting later on) 278 zevap_rema(ji) = evap_ice_1d(ji) * rdt_ice + zdh_s_sub(ji) * rhosn 279 ! Heat flux by sublimation [W.m-2], < 0 (sublimate first snow that had fallen, then pre-existing snow) 290 280 zdeltah(ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 291 281 hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1) & … … 309 299 !------------------------------------------- 310 300 ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 311 zq_s(:) = 0._wp312 301 DO jk = 1, nlay_s 313 302 DO ji = kideb,kiut 314 rswitch = MAX( 0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 ) ) 315 q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) * & 316 & ( ( zdh_s_pre(ji) ) * zqprec(ji) + & 317 & ( ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) ) 318 zq_s(ji) = zq_s(ji) + q_s_1d(ji,jk) 303 rswitch = MAX( 0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 ) ) 304 q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) * & 305 & ( ( zdh_s_pre(ji) ) * zqprec(ji) + & 306 & ( ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) ) 319 307 END DO 320 308 END DO … … 370 358 zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0] 371 359 372 ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)360 ! Contribution to salt flux >0 (clem: using sm_i_1d and not s_i_1d(jk) is ok) 373 361 sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 374 362 … … 383 371 384 372 END IF 373 ! ---------------------- 374 ! Sublimation part2: ice 375 ! ---------------------- 376 zdum = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoic ) 377 zdeltah(ji,jk) = zdeltah(ji,jk) + zdum 378 dh_i_sub(ji) = dh_i_sub(ji) + zdum 379 ! Salt flux > 0 (clem2016: flux is sent to the ocean for simplicity but salt should remain in the ice except if all ice is melted. 380 ! It must be corrected at some point) 381 sfx_sub_1d(ji) = sfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * sm_i_1d(ji) * r1_rdtice 382 ! Heat flux [W.m-2], < 0 383 hfx_sub_1d(ji) = hfx_sub_1d(ji) + zdum * q_i_1d(ji,jk) * a_i_1d(ji) * r1_rdtice 384 ! Mass flux > 0 385 wfx_sub_1d(ji) = wfx_sub_1d(ji) - rhoic * a_i_1d(ji) * zdum * r1_rdtice 386 ! update remaining mass flux 387 zevap_rema(ji) = zevap_rema(ji) + zdum * rhoic 388 385 389 ! record which layers have disappeared (for bottom melting) 386 390 ! => icount=0 : no layer has vanished … … 389 393 icount(ji,jk) = NINT( rswitch ) 390 394 zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 391 395 392 396 ! update heat content (J.m-2) and layer thickness 393 397 qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk) … … 397 401 ! update ice thickness 398 402 DO ji = kideb, kiut 399 ht_i_1d(ji) = MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) ) 403 ht_i_1d(ji) = MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) + dh_i_sub(ji) ) 404 END DO 405 406 ! remaining "potential" evap is sent to ocean 407 DO ji = kideb, kiut 408 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 409 wfx_err_sub(ii,ij) = wfx_err_sub(ii,ij) - zevap_rema(ji) * a_i_1d(ji) * r1_rdtice ! <=0 (net evap for the ocean in kg.m-2.s-1) 400 410 END DO 401 411 … … 653 663 sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice 654 664 665 ! virtual salt flux to keep salinity constant 666 IF( nn_icesal == 1 .OR. nn_icesal == 3 ) THEN 667 sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice & ! put back sss_m into the ocean 668 & - sm_i_1d(ji) * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice ! and get sm_i from the ocean 669 ENDIF 670 655 671 ! Contribution to mass flux 656 672 ! All snow is thrown in the ocean, and seawater is taken to replace the volume … … 686 702 WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp 687 703 688 CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw )689 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i , zqh_s, zq_s)704 CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema, zsnw, zevap_rema ) 705 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i ) 690 706 CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i ) 691 707 CALL wrk_dealloc( jpij, nlay_i, icount ) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r5202 r6851 75 75 INTEGER :: ii, ij, iter ! - - 76 76 REAL(wp) :: ztmelts, zdv, zfrazb, zweight, zde ! local scalars 77 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new! - -77 REAL(wp) :: zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf ! - - 78 78 REAL(wp) :: ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit ! - - 79 LOGICAL :: iterate_frazil ! iterate frazil ice collection thickness80 79 CHARACTER (len = 15) :: fieldid 81 80 … … 108 107 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_1d ! 1-D version of smv_i 109 108 110 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_1d 111 112 REAL(wp), POINTER, DIMENSION(:,:) :: zvrel 113 114 REAL(wp) :: zcai = 1.4e-3_wp 109 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze_i_1d !: 1-D version of e_i 110 111 REAL(wp), POINTER, DIMENSION(:,:) :: zvrel ! relative ice / frazil velocity 112 113 REAL(wp) :: zcai = 1.4e-3_wp ! ice-air drag (clem: should be dependent on coupling/forcing used) 115 114 !!-----------------------------------------------------------------------! 116 115 … … 143 142 !------------------------------------------------------------------------------! 144 143 ! hicol is the thickness of new ice formed in open water 145 ! hicol can be either prescribed (frazswi = 0) 146 ! or computed (frazswi = 1) 144 ! hicol can be either prescribed (frazswi = 0) or computed (frazswi = 1) 147 145 ! Frazil ice forms in open water, is transported by wind 148 146 ! accumulates at the edge of the consolidated ice edge … … 155 153 zvrel(:,:) = 0._wp 156 154 157 ! Default new ice thickness 158 hicol(:,:) = rn_hnewice 155 ! Default new ice thickness 156 WHERE( qlead(:,:) < 0._wp ) ; hicol = rn_hnewice 157 ELSEWHERE ; hicol = 0._wp 158 END WHERE 159 159 160 160 IF( ln_frazil ) THEN … … 182 182 & + vtau_ice(ji ,jj ) * vmask(ji ,jj ,1) ) * 0.5_wp 183 183 ! Square root of wind stress 184 ztenagm = SQRT( SQRT( ztaux **2 + ztauy**2) )184 ztenagm = SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 185 185 186 186 !--------------------- … … 205 205 zvrel2 = MAX( ( zvfrx - zvgx ) * ( zvfrx - zvgx ) & 206 206 & + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) 207 zvrel(ji,jj) 207 zvrel(ji,jj) = SQRT( zvrel2 ) 208 208 209 209 !--------------------- 210 210 ! Iterative procedure 211 211 !--------------------- 212 hicol(ji,jj) = zhicrit + 0.1 213 hicol(ji,jj) = zhicrit + hicol(ji,jj) & 214 & / ( hicol(ji,jj) * hicol(ji,jj) - zhicrit * zhicrit ) * ztwogp * zvrel2 215 216 !!gm better coding: above: hicol(ji,jj) * hicol(ji,jj) = (zhicrit + 0.1)*(zhicrit + 0.1) 217 !!gm = zhicrit**2 + 0.2*zhicrit +0.01 218 !!gm therefore the 2 lines with hicol can be replaced by 1 line: 219 !!gm hicol(ji,jj) = zhicrit + (zhicrit + 0.1) / ( 0.2 * zhicrit + 0.01 ) * ztwogp * zvrel2 220 !!gm further more (zhicrit + 0.1)/(0.2 * zhicrit + 0.01 )*ztwogp can be computed one for all outside the DO loop 212 hicol(ji,jj) = zhicrit + ( zhicrit + 0.1 ) & 213 & / ( ( zhicrit + 0.1 ) * ( zhicrit + 0.1 ) - zhicrit * zhicrit ) * ztwogp * zvrel2 221 214 222 215 iter = 1 223 iterate_frazil = .true. 224 225 DO WHILE ( iter < 100 .AND. iterate_frazil ) 226 zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) & 227 - hicol(ji,jj) * zhicrit * ztwogp * zvrel2 228 zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0*hicol(ji,jj) + zhicrit ) & 229 - zhicrit * ztwogp * zvrel2 230 zhicol_new = hicol(ji,jj) - zf/zfp 231 hicol(ji,jj) = zhicol_new 232 216 DO WHILE ( iter < 20 ) 217 zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj) * hicol(ji,jj) - zhicrit * zhicrit ) - & 218 & hicol(ji,jj) * zhicrit * ztwogp * zvrel2 219 zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0 * hicol(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2 220 221 hicol(ji,jj) = hicol(ji,jj) - zf/zfp 233 222 iter = iter + 1 234 235 END DO ! do while 223 END DO 236 224 237 225 ENDIF ! end of selection of pixels where ice forms 238 226 239 END DO ! loop on ji ends240 END DO ! loop on jj ends241 !242 CALL lbc_lnk( zvrel(:,:), 'T', 1. )243 CALL lbc_lnk( hicol(:,:), 'T', 1. )227 END DO 228 END DO 229 ! 230 CALL lbc_lnk( zvrel(:,:), 'T', 1. ) 231 CALL lbc_lnk( hicol(:,:), 'T', 1. ) 244 232 245 233 ENDIF ! End of computation of frazil ice collection thickness … … 282 270 ! Move from 2-D to 1-D vectors 283 271 !------------------------------ 284 ! If ocean gains heat do nothing 285 ! 0therwise compute new ice formation 272 ! If ocean gains heat do nothing. Otherwise compute new ice formation 286 273 287 274 IF ( nbpac > 0 ) THEN … … 297 284 END DO 298 285 299 CALL tab_2d_1d( nbpac, qlead_1d (1:nbpac) , qlead , jpi, jpj, npac(1:nbpac) ) 300 CALL tab_2d_1d( nbpac, t_bo_1d (1:nbpac) , t_bo , jpi, jpj, npac(1:nbpac) ) 301 CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac) , sfx_opw, jpi, jpj, npac(1:nbpac) ) 302 CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac) , wfx_opw, jpi, jpj, npac(1:nbpac) ) 303 CALL tab_2d_1d( nbpac, hicol_1d (1:nbpac) , hicol , jpi, jpj, npac(1:nbpac) ) 304 CALL tab_2d_1d( nbpac, zvrel_1d (1:nbpac) , zvrel , jpi, jpj, npac(1:nbpac) ) 305 306 CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac) , hfx_thd, jpi, jpj, npac(1:nbpac) ) 307 CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac) , hfx_opw, jpi, jpj, npac(1:nbpac) ) 286 CALL tab_2d_1d( nbpac, qlead_1d (1:nbpac) , qlead , jpi, jpj, npac(1:nbpac) ) 287 CALL tab_2d_1d( nbpac, t_bo_1d (1:nbpac) , t_bo , jpi, jpj, npac(1:nbpac) ) 288 CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac) , sfx_opw , jpi, jpj, npac(1:nbpac) ) 289 CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac) , wfx_opw , jpi, jpj, npac(1:nbpac) ) 290 CALL tab_2d_1d( nbpac, hicol_1d (1:nbpac) , hicol , jpi, jpj, npac(1:nbpac) ) 291 CALL tab_2d_1d( nbpac, zvrel_1d (1:nbpac) , zvrel , jpi, jpj, npac(1:nbpac) ) 292 293 CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac) , hfx_thd , jpi, jpj, npac(1:nbpac) ) 294 CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac) , hfx_opw , jpi, jpj, npac(1:nbpac) ) 295 CALL tab_2d_1d( nbpac, rn_amax_1d(1:nbpac) , rn_amax_2d, jpi, jpj, npac(1:nbpac) ) 308 296 309 297 !------------------------------------------------------------------------------! … … 316 304 zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:) 317 305 za_b(1:nbpac,:) = za_i_1d(1:nbpac,:) 306 318 307 !---------------------- 319 308 ! Thickness of new ice 320 309 !---------------------- 321 DO ji = 1, nbpac 322 zh_newice(ji) = rn_hnewice 323 END DO 324 IF( ln_frazil ) zh_newice(1:nbpac) = hicol_1d(1:nbpac) 310 zh_newice(1:nbpac) = hicol_1d(1:nbpac) 325 311 326 312 !---------------------- … … 346 332 DO ji = 1, nbpac 347 333 ztmelts = - tmut * zs_newice(ji) + rt0 ! Melting point (K) 348 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_1d(ji) ) &334 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_1d(ji) ) & 349 335 & + lfus * ( 1.0 - ( ztmelts - rt0 ) / MIN( t_bo_1d(ji) - rt0, -epsi10 ) ) & 350 336 & - rcp * ( ztmelts - rt0 ) ) … … 384 370 ! salt flux 385 371 sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice 386 372 END DO 373 374 zv_frazb(:) = 0._wp 375 IF( ln_frazil ) THEN 387 376 ! A fraction zfrazb of frazil ice is accreted at the ice bottom 388 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 389 zfrazb = rswitch * ( TANH ( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb 390 zv_frazb(ji) = zfrazb * zv_newice(ji) 391 zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 392 END DO 393 377 DO ji = 1, nbpac 378 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 379 zfrazb = rswitch * ( TANH( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb 380 zv_frazb(ji) = zfrazb * zv_newice(ji) 381 zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 382 END DO 383 END IF 384 394 385 !----------------- 395 386 ! Area of new ice … … 409 400 ! we keep the excessive volume in memory and attribute it later to bottom accretion 410 401 DO ji = 1, nbpac 411 IF ( za_newice(ji) > ( rn_amax - zat_i_1d(ji) ) ) THEN412 zda_res(ji) = za_newice(ji) - ( rn_amax - zat_i_1d(ji) )402 IF ( za_newice(ji) > ( rn_amax_1d(ji) - zat_i_1d(ji) ) ) THEN 403 zda_res(ji) = za_newice(ji) - ( rn_amax_1d(ji) - zat_i_1d(ji) ) 413 404 zdv_res(ji) = zda_res (ji) * zh_newice(ji) 414 405 za_newice(ji) = za_newice(ji) - zda_res (ji) … … 443 434 jl = jcat(ji) 444 435 rswitch = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) ) 445 ze_i_1d(ji,jk,jl) = zswinew(ji) * ze_newice(ji) + 436 ze_i_1d(ji,jk,jl) = zswinew(ji) * ze_newice(ji) + & 446 437 & ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_b(ji,jl) ) & 447 438 & * rswitch / MAX( zv_i_1d(ji,jl), epsi20 ) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r5123 r6851 62 62 END DO 63 63 64 !------------------------------------------------------------------------------| 65 ! 1) Constant salinity, constant in time | 66 !------------------------------------------------------------------------------| 67 !!gm comment: if nn_icesal = 1 s_i_new, s_i_1d and sm_i_1d can be set to rn_icesal one for all in the initialisation phase !! 68 !!gm ===>>> simplification of almost all test on nn_icesal value 69 IF( nn_icesal == 1 ) THEN 70 s_i_1d (kideb:kiut,1:nlay_i) = rn_icesal 71 sm_i_1d(kideb:kiut) = rn_icesal 72 s_i_new(kideb:kiut) = rn_icesal 73 ENDIF 64 !--------------------------------------------------------------------| 65 ! 1) salinity constant in time | 66 !--------------------------------------------------------------------| 67 ! do nothing 74 68 75 !---------------------------------------------------------------------- --------|76 ! Module 2 : Constant salinity varying in time|77 !---------------------------------------------------------------------- --------|69 !----------------------------------------------------------------------| 70 ! 2) salinity varying in time | 71 !----------------------------------------------------------------------| 78 72 IF( nn_icesal == 2 ) THEN 79 73 … … 113 107 114 108 !------------------------------------------------------------------------------| 115 ! Module 3 : Profile of salinity, constant in time|109 ! 3) vertical profile of salinity, constant in time | 116 110 !------------------------------------------------------------------------------| 117 111 IF( nn_icesal == 3 ) CALL lim_var_salprof1d( kideb, kiut ) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r5836 r6851 63 63 INTEGER, INTENT(in) :: kt ! number of iteration 64 64 ! 65 INTEGER :: ji, jj, jk, j l, jt ! dummy loop indices65 INTEGER :: ji, jj, jk, jm , jl, jt ! dummy loop indices 66 66 INTEGER :: initad ! number of sub-timestep for the advection 67 67 REAL(wp) :: zcfl , zusnit ! - - … … 75 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhimax ! old ice thickness 76 76 REAL(wp), POINTER, DIMENSION(:,:) :: zatold, zeiold, zesold ! old concentration, enthalpies 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhdfptab 77 78 REAL(wp) :: zdv, zvi, zvs, zsmv, zes, zei 78 79 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 80 !!--------------------------------------------------------------------- 81 INTEGER :: ihdf_vars = 6 !!Number of variables in which we apply horizontal diffusion 82 !! inside limtrp for each ice category , not counting the 83 !! variables corresponding to ice_layers 79 84 !!--------------------------------------------------------------------- 80 85 IF( nn_timing == 1 ) CALL timing_start('limtrp') … … 85 90 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 86 91 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold, zsmvold ) 92 CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1,zhdfptab) 87 93 88 94 IF( numit == nstart .AND. lwp ) THEN … … 170 176 z0oi (:,:,jl) = oa_i (:,:, jl) * e1e2t(:,:) ! Age content 171 177 z0es (:,:,jl) = e_s (:,:,1,jl) * e1e2t(:,:) ! Snow heat content 172 178 DO jk = 1, nlay_i 173 179 z0ei (:,:,jk,jl) = e_i (:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 174 180 END DO … … 284 290 ! Diffusion of Ice fields 285 291 !------------------------------------------------------------------------------! 286 292 !------------------------------------ 293 ! Diffusion of other ice variables 294 !------------------------------------ 295 jm=1 296 DO jl = 1, jpl 297 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 298 ! DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 299 ! DO ji = 1 , fs_jpim1 ! vector opt. 300 ! pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj,jl) ) ) ) & 301 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 302 ! pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj ,jl) ) ) ) & 303 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 304 ! END DO 305 ! END DO 306 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 307 DO ji = 1 , fs_jpim1 ! vector opt. 308 pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj, jl ) ) ) ) & 309 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj, jl ) ) ) ) * ahiu(ji,jj) 310 pahv3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji, jj, jl ) ) ) ) & 311 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji, jj+1,jl ) ) ) ) * ahiv(ji,jj) 312 END DO 313 END DO 314 315 zhdfptab(:,:,jm)= a_i (:,:, jl); jm = jm + 1 316 zhdfptab(:,:,jm)= v_i (:,:, jl); jm = jm + 1 317 zhdfptab(:,:,jm)= v_s (:,:, jl); jm = jm + 1 318 zhdfptab(:,:,jm)= smv_i(:,:, jl); jm = jm + 1 319 zhdfptab(:,:,jm)= oa_i (:,:, jl); jm = jm + 1 320 zhdfptab(:,:,jm)= e_s (:,:,1,jl); jm = jm + 1 321 ! Sample of adding more variables to apply lim_hdf using lim_hdf optimization--- 322 ! zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1 323 ! zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1 324 ! 325 ! and in this example the parameter ihdf_vars musb be changed to 8 (necessary for allocation) 326 !---------------------------------------------------------------------------------------- 327 DO jk = 1, nlay_i 328 zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 329 END DO 330 END DO 287 331 ! 288 332 !-------------------------------- … … 290 334 !-------------------------------- 291 335 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 336 !DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 337 ! DO ji = 1 , fs_jpim1 ! vector opt. 338 ! pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) & 339 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 340 ! pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) & 341 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 342 ! END DO 343 !END DO 344 292 345 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 293 346 DO ji = 1 , fs_jpim1 ! vector opt. 294 pahu (ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) &295 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj)296 pahv (ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) &297 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj)347 pahu3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) & 348 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 349 pahv3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) & 350 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 298 351 END DO 299 352 END DO 300 353 ! 301 CALL lim_hdf( ato_i (:,:) ) 302 303 !------------------------------------ 304 ! Diffusion of other ice variables 305 !------------------------------------ 306 DO jl = 1, jpl 307 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 308 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 309 DO ji = 1 , fs_jpim1 ! vector opt. 310 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj,jl) ) ) ) & 311 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 312 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj ,jl) ) ) ) & 313 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 314 END DO 315 END DO 316 317 CALL lim_hdf( v_i (:,:, jl) ) 318 CALL lim_hdf( v_s (:,:, jl) ) 319 CALL lim_hdf( smv_i(:,:, jl) ) 320 CALL lim_hdf( oa_i (:,:, jl) ) 321 CALL lim_hdf( a_i (:,:, jl) ) 322 CALL lim_hdf( e_s (:,:,1,jl) ) 354 zhdfptab(:,:,jm)= ato_i (:,:); 355 CALL lim_hdf( zhdfptab, ihdf_vars, jpl, nlay_i) 356 357 jm=1 358 DO jl = 1, jpl 359 a_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 360 v_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 361 v_s (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 362 smv_i(:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 363 oa_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 364 e_s (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 365 ! Sample of adding more variables to apply lim_hdf--------- 366 ! variable_1 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 367 ! variable_2 (:,:,1,jl) = zhdfptab(:,:, jm ) ; jm + 1 368 !----------------------------------------------------------- 323 369 DO jk = 1, nlay_i 324 CALL lim_hdf( e_i(:,:,jk,jl) ) 325 END DO 326 END DO 370 e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 371 END DO 372 END DO 373 374 ato_i (:,:) = zhdfptab(:,:,jm) 327 375 328 376 !------------------------------------------------------------------------------! … … 422 470 DO jj = 1, jpj 423 471 DO ji = 1, jpi 424 a_i(ji,jj,1) = MIN( a_i(ji,jj,1), rn_amax )472 a_i(ji,jj,1) = MIN( a_i(ji,jj,1), rn_amax_2d(ji,jj) ) 425 473 END DO 426 474 END DO … … 464 512 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 465 513 CALL wrk_dealloc( jpi,jpj,jpl, zviold, zvsold, zhimax, zsmvold ) 514 CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars+nlay_i)+1,zhdfptab) 466 515 ! 467 516 IF( nn_timing == 1 ) CALL timing_stop('limtrp') … … 479 528 !!====================================================================== 480 529 END MODULE limtrp 530 -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r5836 r6851 80 80 DO jj = 1, jpj 81 81 DO ji = 1, jpi 82 IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN83 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )84 oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )82 IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN 83 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) ) 84 oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) ) 85 85 ENDIF 86 86 END DO -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r5836 r6851 94 94 DO jj = 1, jpj 95 95 DO ji = 1, jpi 96 IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN97 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )98 oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) )96 IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN 97 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) ) 98 oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) ) 99 99 ENDIF 100 100 END DO -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r5202 r6851 163 163 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) !0 if no ice and 1 if yes 164 164 ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 165 END DO 166 END DO 167 END DO 168 ! Force the upper limit of ht_i to always be < hi_max (99 m). 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 rswitch = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) ) 172 ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) ) 173 a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch 174 END DO 175 END DO 176 177 DO jl = 1, jpl 178 DO jj = 1, jpj 179 DO ji = 1, jpi 180 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) !0 if no ice and 1 if yes 165 181 ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 166 182 o_i(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch … … 168 184 END DO 169 185 END DO 170 186 171 187 IF( nn_icesal == 2 )THEN 172 188 DO jl = 1, jpl … … 298 314 ! Vertically constant, constant in time 299 315 !--------------------------------------- 300 IF( nn_icesal == 1 ) s_i(:,:,:,:) = rn_icesal 316 IF( nn_icesal == 1 ) THEN 317 s_i (:,:,:,:) = rn_icesal 318 sm_i(:,:,:) = rn_icesal 319 ENDIF 301 320 302 321 !----------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r6140 r6851 154 154 ENDIF 155 155 156 IF ( iom_use( "icecolf" ) ) THEN 157 DO jj = 1, jpj 158 DO ji = 1, jpi 159 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) ) 160 z2d(ji,jj) = hicol(ji,jj) * rswitch 161 END DO 162 END DO 163 CALL iom_put( "icecolf" , z2d ) ! frazil ice collection thickness 164 ENDIF 165 156 IF ( iom_use( "icecolf" ) ) CALL iom_put( "icecolf", hicol ) ! frazil ice collection thickness 157 166 158 CALL iom_put( "isst" , sst_m ) ! sea surface temperature 167 159 CALL iom_put( "isss" , sss_m ) ! sea surface salinity … … 187 179 CALL iom_put( "destrp" , diag_trp_es ) ! advected snw enthalpy (W/m2) 188 180 189 CALL iom_put( "sfxbog" , sfx_bog * rday ) ! salt flux from b rines190 CALL iom_put( "sfxbom" , sfx_bom * rday ) ! salt flux from b rines191 CALL iom_put( "sfxsum" , sfx_sum * rday ) ! salt flux from brines192 CALL iom_put( "sfxsni" , sfx_sni * rday ) ! salt flux from brines193 CALL iom_put( "sfxopw" , sfx_opw * rday ) ! salt flux from brines181 CALL iom_put( "sfxbog" , sfx_bog * rday ) ! salt flux from bottom growth 182 CALL iom_put( "sfxbom" , sfx_bom * rday ) ! salt flux from bottom melt 183 CALL iom_put( "sfxsum" , sfx_sum * rday ) ! salt flux from surface melt 184 CALL iom_put( "sfxsni" , sfx_sni * rday ) ! salt flux from snow ice formation 185 CALL iom_put( "sfxopw" , sfx_opw * rday ) ! salt flux from open water formation 194 186 CALL iom_put( "sfxdyn" , sfx_dyn * rday ) ! salt flux from ridging rafting 195 CALL iom_put( "sfxres" , sfx_res * rday ) ! salt flux from limupdate (resultant)187 CALL iom_put( "sfxres" , sfx_res * rday ) ! salt flux from residual 196 188 CALL iom_put( "sfxbri" , sfx_bri * rday ) ! salt flux from brines 189 CALL iom_put( "sfxsub" , sfx_sub * rday ) ! salt flux from sublimation 197 190 CALL iom_put( "sfx" , sfx * rday ) ! total salt flux 198 191 … … 233 226 CALL iom_put ('hfxspr' , hfx_spr(:,:) ) ! Heat content of snow precip 234 227 228 IF ( iom_use( "vfxthin" ) ) THEN ! ice production for open water + thin ice (<20cm) => comparable to observations 229 DO jj = 1, jpj 230 DO ji = 1, jpi 231 z2d(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj) ! mean ice thickness 232 END DO 233 END DO 234 WHERE( z2d(:,:) < 0.2 .AND. z2d(:,:) > 0. ) ; z2da = wfx_bog 235 ELSEWHERE ; z2da = 0._wp 236 END WHERE 237 CALL iom_put( "vfxthin", ( wfx_opw + z2da ) * ztmp ) 238 ENDIF 239 235 240 !-------------------------------- 236 241 ! Output values for each category -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r5407 r6851 45 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qns_ice_1d 46 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_bo_1d 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rn_amax_1d 47 48 48 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_sum_1d … … 83 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_res_1d 84 85 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_sub_1d 87 85 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sprecip_1d !: <==> the 2D sprecip 86 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: frld_1d !: <==> the 2D frld … … 91 94 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: evap_ice_1d !: <==> the 2D evap_ice 92 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qprec_ice_1d !: <==> the 2D qprec_ice 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qevap_ice_1d !: <==> the 3D qevap_ice 93 97 ! ! to reintegrate longwave flux inside the ice thermodynamics 94 98 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice … … 107 111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_tot !: Snow accretion/ablation [m] 108 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_surf !: Ice surface accretion/ablation [m] 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_sub !: Ice surface sublimation [m] 109 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_bott !: Ice bottom accretion/ablation [m] 110 115 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_snowice !: Snow ice formation [m of ice] … … 144 149 & hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) , & 145 150 & hfx_dif_1d(jpij) , hfx_opw_1d(jpij) , & 151 & rn_amax_1d(jpij) , & 146 152 & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 147 153 & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & … … 153 159 & wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) , & 154 160 & dqns_ice_1d(jpij) , evap_ice_1d (jpij), & 155 & qprec_ice_1d(jpij), i0 (jpij) ,&161 & qprec_ice_1d(jpij), qevap_ice_1d(jpij), i0 (jpij) , & 156 162 & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij), & 157 & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , 163 & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij), & 158 164 & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , & 159 165 & dsm_i_si_1d(jpij) , hicol_1d (jpij) , STAT=ierr(2) ) … … 161 167 ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , & 162 168 & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 163 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_ bott(jpij) , &164 & dh_ snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , &165 & t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) , &166 & q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) , &169 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_sub (jpij) , & 170 & dh_i_bott (jpij) ,dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , & 171 & t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) , & 172 & q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) , & 167 173 & qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 168 174 ! -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
r5656 r6851 390 390 !! ** Method : time coefficient and call to atomic routines 391 391 !!----------------------------------------------------------------------- 392 INTEGER :: ji,jj,jn393 REAL(wp) :: zalpha394 REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr392 INTEGER :: ji, jj, jn 393 REAL(wp) :: zalpha 394 REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr 395 395 !!----------------------------------------------------------------------- 396 396 ! … … 399 399 zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) 400 400 ! 401 tabice_agr(:,:,:) = 0. e0402 DO jn = 1,7403 DO jj = 1,2401 tabice_agr(:,:,:) = 0._wp 402 DO jn = 1, 7 403 DO jj = 1, 2 404 404 DO ji = 1, jpi 405 405 tabice_agr(ji,jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj ,jn,1) + zalpha*adv_ice_sn(ji,jj ,jn,2) … … 409 409 END DO 410 410 411 DO jn = 1,7411 DO jn = 1, 7 412 412 DO jj = 1, jpj 413 DO ji =1,2413 DO ji = 1, 2 414 414 tabice_agr(ji ,jj,jn) = (1-zalpha)*adv_ice_oe(ji ,jj,jn,1) + zalpha*adv_ice_oe(ji ,jj,jn,2) 415 415 tabice_agr(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) … … 529 529 END DO 530 530 END DO 531 ELSE 532 DO jj=MAX(j1,2),j2 533 DO ji=MAX(i1,2),i2 534 uice_agr(ji,jj) = tabres(ji,jj) 535 END DO 536 END DO 531 537 ENDIF 532 538 #else … … 541 547 END DO 542 548 END DO 549 ELSE 550 DO jj= j1, j2 551 DO ji= i1, i2 552 uice_agr(ji,jj) = tabres(ji,jj) 553 END DO 554 END DO 543 555 ENDIF 544 556 #endif … … 566 578 tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 567 579 ENDIF 580 END DO 581 END DO 582 ELSE 583 DO jj=MAX(j1,2),j2 584 DO ji=MAX(i1,2),i2 585 vice_agr(ji,jj) = tabres(ji,jj) 568 586 END DO 569 587 END DO … … 580 598 END DO 581 599 END DO 600 ELSE 601 DO jj= j1 ,j2 602 DO ji = i1, i2 603 vice_agr(ji,jj) = tabres(ji,jj) 604 END DO 605 END DO 582 606 ENDIF 583 607 #endif … … 585 609 586 610 587 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before )611 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, k1, k2, before ) 588 612 !!----------------------------------------------------------------------- 589 613 !! *** ROUTINE interp_adv_ice *** … … 593 617 !! put -9999 where no ice for correct extrapolation 594 618 !!----------------------------------------------------------------------- 595 INTEGER , INTENT(in) :: i1, i2, j1, j2596 REAL(wp), DIMENSION(i1:i2,j1:j2, 7), INTENT(inout) ::tabres597 LOGICAL , INTENT(in) ::before598 ! !619 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 620 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 621 LOGICAL , INTENT(in ) :: before 622 ! 599 623 INTEGER :: ji, jj, jk 600 624 !!----------------------------------------------------------------------- 601 625 ! 602 626 IF( before ) THEN 603 DO jj=j1,j2604 DO ji =i1,i2605 IF( tms(ji,jj) == 0. ) THEN606 tabres(ji,jj,:) = -9999 .627 DO jj = j1, j2 628 DO ji = i1, i2 629 IF( tms(ji,jj) == 0._wp ) THEN 630 tabres(ji,jj,:) = -9999 607 631 ELSE 608 632 tabres(ji,jj, 1) = frld (ji,jj) … … 613 637 tabres(ji,jj, 6) = tbif (ji,jj,3) 614 638 tabres(ji,jj, 7) = qstoif(ji,jj) 615 639 ENDIF 616 640 END DO 641 END DO 642 ELSE 643 DO jj = j1, j2 644 DO ji = i1, i2 645 DO jk = k1, k2 646 tabice_agr(ji,jj,jk) = tabres(ji,jj,jk) 647 END DO 648 END DO 617 649 END DO 618 650 ENDIF … … 629 661 END SUBROUTINE agrif_lim2_interp_empty 630 662 #endif 663 !!====================================================================== 631 664 END MODULE agrif_lim2_interp -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r6347 r6851 25 25 LOGICAL, PUBLIC :: ln_dia25h !: 25h mean output 26 26 27 !! * variables for calculating 25-hourly means28 REAL(wp) :: r1_25 = 1._wp / 25.0_wp ! factor for the mean calulation27 !! * variables for calculating 25-hourly means 28 REAL(wp) :: r1_25 = 1._wp / 25.0_wp ! factor for the mean calulation 29 29 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tn_25h , sn_25h 30 30 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:) :: sshn_25h … … 55 55 !! 56 56 !!--------------------------------------------------------------------------- 57 INTEGER :: ios ! Local integer output status for namelist read 58 INTEGER :: ierror ! Local integer for memory allocation 57 INTEGER :: ios, ierror ! Local integer 59 58 ! 60 59 NAMELIST/nam_dia25h/ ln_dia25h … … 159 158 !! 160 159 !!---------------------------------------------------------------------- 161 INTEGER, INTENT( in ) :: kt ! ocean time-step index 162 ! 163 INTEGER :: ji, jj, jk 164 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout 165 REAL(wp) :: zsto, zout, zmax, zjulian, zmdi ! temporary reals 166 INTEGER :: i_steps ! no of timesteps per hour 160 INTEGER, INTENT( in ) :: kt ! ocean time-step index 161 ! 162 INTEGER :: ji, jj, jk ! dummy loop indices 163 INTEGER :: i_steps ! no of timesteps per hour 164 INTEGER :: iyear0, nimonth0,iday0 ! start year,imonth,day 165 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout 166 REAL(wp) :: zsto, zout, zmax, zjulian, zmdi ! temporary reals 167 167 REAL(wp), DIMENSION(jpi,jpj ) :: zw2d, un_dm, vn_dm ! temporary workspace 168 168 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! temporary workspace 169 REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb ! temporary workspace 170 INTEGER :: iyear0, nimonth0,iday0 ! start year,imonth,day 169 REAL(wp), DIMENSION(jpi,jpj, 3 ) :: zwtmb ! temporary workspace 171 170 !!---------------------------------------------------------------------- 172 171 -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r6140 r6851 212 212 REAL(wp) :: zztmp 213 213 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 214 ! reading initial file215 LOGICAL :: ln_tsd_init !: T & S data flag216 LOGICAL :: ln_tsd_tradmp !: internal damping toward input data flag217 CHARACTER(len=100) :: cn_dir218 TYPE(FLD_N) :: sn_tem,sn_sal219 INTEGER :: ios=0220 221 NAMELIST/namtsd/ ln_tsd_init,ln_tsd_tradmp,cn_dir,sn_tem,sn_sal222 !223 224 REWIND( numnam_ref ) ! Namelist namtsd in reference namelist :225 READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)226 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in reference namelist for dia_ar5', lwp )227 REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run228 READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )229 902 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in configuration namelist for dia_ar5', lwp )230 IF(lwm) WRITE ( numond, namtsd )231 214 ! 232 215 !!---------------------------------------------------------------------- … … 250 233 IF( lk_mpp ) CALL mpp_sum( vol0 ) 251 234 252 CALL iom_open ( TRIM( cn_dir )//TRIM(sn_sal%clname), inum ) 253 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,1), 1 ) 254 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 ) 235 236 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 237 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 238 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 255 239 CALL iom_close( inum ) 240 256 241 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 257 242 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90
r6347 r6851 151 151 WRITE(numout,*) 'dia_cfl : Maximum Courant number information for the run:' 152 152 WRITE(numout,*) '~~~~~~~~~~~~' 153 WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cu', cu_max, & 154 & 'at (i,j,k) = (', cu_loc(1), cu_loc(2), cu_loc(3), ')' 153 WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cu', cu_max, 'at (i, j, k) = (', cu_loc(1), cu_loc(2), cu_loc(3), ')' 155 154 WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cu_max) 156 WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cv', cv_max, & 157 & 'at (i,j,k) = (', cv_loc(1), cv_loc(2), cv_loc(3), ')' 155 WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cv', cv_max, 'at (i, j, k) = (', cv_loc(1), cv_loc(2), cv_loc(3), ')' 158 156 WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cv_max) 159 WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cw', cw_max, & 160 & 'at (i,j,k) = (', cw_loc(1), cw_loc(2), cw_loc(3), ')' 157 WRITE(numout,FMT='(12x,a12,7x,f6.4,5x,a16,i4,1x,i4,1x,i4,a1)') 'Run Max Cw', cw_max, 'at (i, j, k) = (', cw_loc(1), cw_loc(2), cw_loc(3), ')' 161 158 WRITE(numout,FMT='(12x,a8,11x,f7.1)') ' => dt/C', dt*(1.0/cw_max) 162 159 -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r6140 r6851 118 118 !! ** Method : use iom_put 119 119 !!---------------------------------------------------------------------- 120 !! 121 INTEGER, INTENT( in ) :: kt ! ocean time-step index 122 !! 123 INTEGER :: ji, jj, jk ! dummy loop indices 124 INTEGER :: jkbot ! 125 REAL(wp) :: zztmp, zztmpx, zztmpy ! 126 !! 127 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace 128 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d ! 3D workspace 120 INTEGER, INTENT( in ) :: kt ! ocean time-step index 121 ! 122 INTEGER :: ji, jj, jk ! dummy loop indices 123 INTEGER :: jkbot ! local integer 124 REAL(wp) :: zztmp, zztmpx, zztmpy ! local scalars 125 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace 126 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d ! 3D - 129 127 !!---------------------------------------------------------------------- 130 128 ! 131 129 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 132 130 ! 133 CALL wrk_alloc( jpi , jpj ,z2d )134 CALL wrk_alloc( jpi , jpj, jpk ,z3d )131 CALL wrk_alloc( jpi,jpj, z2d ) 132 CALL wrk_alloc( jpi,jpj,jpk, z3d ) 135 133 ! 136 134 ! Output the initial state and forcings … … 140 138 ENDIF 141 139 142 IF( ln_linssh ) THEN 143 CALL iom_put( "e3t" , e3t_n(:,:,:) ) 144 CALL iom_put( "e3u" , e3u_n(:,:,:) ) 145 CALL iom_put( "e3v" , e3v_n(:,:,:) ) 146 CALL iom_put( "e3w" , e3w_n(:,:,:) ) 147 ENDIF 140 ! Output of initial vertical scale factor 141 CALL iom_put("e3t_0", e3t_0(:,:,:) ) 142 CALL iom_put("e3u_0", e3t_0(:,:,:) ) 143 CALL iom_put("e3v_0", e3t_0(:,:,:) ) 144 ! 145 CALL iom_put( "e3t" , e3t_n(:,:,:) ) 146 CALL iom_put( "e3u" , e3u_n(:,:,:) ) 147 CALL iom_put( "e3v" , e3v_n(:,:,:) ) 148 CALL iom_put( "e3w" , e3w_n(:,:,:) ) 149 IF( iom_use("e3tdef") ) & 150 CALL iom_put( "e3tdef" , ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 148 151 149 152 CALL iom_put( "ssh" , sshn ) ! sea surface height 150 if( iom_use('ssh2') ) CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) ) ! square of sea surface height151 153 152 154 CALL iom_put( "toce", tsn(:,:,:,jp_tem) ) ! 3D temperature … … 184 186 z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1) 185 187 ! 186 END DO187 END DO188 END DO 189 END DO 188 190 CALL lbc_lnk( z2d, 'T', 1. ) 189 191 CALL iom_put( "taubot", z2d ) … … 228 230 CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef. 229 231 CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef. (useful only with key_zdfddm) 232 233 IF( iom_use('logavt') ) CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt (:,:,:) ) ) ) 234 IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, fsavs(:,:,:) ) ) ) 230 235 231 236 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN … … 275 280 DO jj = 2, jpjm1 276 281 DO ji = fs_2, fs_jpim1 ! vector opt. 277 zztmp = 1._wp / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 278 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 279 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e2u(ji ,jj) * e3u_n(ji ,jj,jk) ) & 280 & * zztmp 281 ! 282 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 283 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * e3v_n(ji,jj ,jk) ) & 284 & * zztmp 285 ! 286 rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 287 ! 288 ENDDO 289 ENDDO 290 ENDDO 282 zztmpx = un(ji-1,jj,jk) * un(ji-1,jj,jk) * e1e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 283 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e1e2u(ji ,jj) * e3u_n(ji ,jj,jk) 284 zztmpy = vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1e2v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 285 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1e2v(ji,jj ) * e3v_n(ji,jj ,jk) ! 286 rke(ji,jj,jk) = 0.25_wp * ( zztmpx + zztmpy ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 287 END DO 288 END DO 289 END DO 291 290 CALL lbc_lnk( rke, 'T', 1. ) 292 291 CALL iom_put( "eken", rke ) 293 292 ENDIF 294 293 ! 294 CALL iom_put( "hdiv", hdivn ) ! Horizontal divergence 295 ! 295 296 IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 296 z3d(:,:,jpk) = 0. e0297 z3d(:,:,jpk) = 0._wp 297 298 DO jk = 1, jpkm1 298 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk)299 z3d(:,:,jk) = rau0 * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 299 300 END DO 300 301 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction … … 302 303 303 304 IF( iom_use("u_heattr") ) THEN 304 z2d(:,:) = 0. e0305 z2d(:,:) = 0._wp 305 306 DO jk = 1, jpkm1 306 307 DO jj = 2, jpjm1 … … 315 316 316 317 IF( iom_use("u_salttr") ) THEN 317 z2d(:,:) = 0. e0318 z2d(:,:) = 0._wp 318 319 DO jk = 1, jpkm1 319 320 DO jj = 2, jpjm1 … … 331 332 z3d(:,:,jpk) = 0.e0 332 333 DO jk = 1, jpkm1 333 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk)334 z3d(:,:,jk) = rau0 * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 334 335 END DO 335 336 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction … … 362 363 ENDIF 363 364 ! 364 CALL wrk_dealloc( jpi , jpj , z2d ) 365 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 366 ! 367 ! If we want tmb values 368 369 IF (ln_diatmb) THEN 370 CALL dia_tmb 371 ENDIF 372 IF (ln_dia25h) THEN 373 CALL dia_25h( kt ) 374 ENDIF 375 365 CALL wrk_dealloc( jpi,jpj , z2d ) 366 CALL wrk_dealloc( jpi,jpj,jpk, z3d ) 367 ! 368 IF( ln_diatmb ) CALL dia_tmb ! Top, Middle, Bottom diagnostics 369 IF( ln_dia25h ) CALL dia_25h( kt ) ! 25h time-mean diagnostics 370 ! 376 371 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') 377 372 ! -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/DIU/cool_skin.F90
r6075 r6851 17 17 USE in_out_manager 18 18 USE sbc_oce 19 USE lib_mpp 19 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 21 … … 55 56 !! 56 57 !!---------------------------------------------------------------------- 57 58 IMPLICIT NONE59 60 58 ALLOCATE( x_csdsst(jpi,jpj), x_csthick(jpi,jpj) ) 61 x_csdsst = 0.62 x_csthick = 0. 63 59 x_csdsst = 0._wp 60 x_csthick = 0._wp 61 ! 64 62 END SUBROUTINE diurnal_sst_coolskin_init 65 63 64 66 65 SUBROUTINE diurnal_sst_coolskin_step(psqflux, pstauflux, psrho, rdt) 67 66 !!---------------------------------------------------------------------- … … 74 73 !! ** Reference : 75 74 !!---------------------------------------------------------------------- 76 77 IMPLICIT NONE 78 79 ! Dummy variables 80 REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psqflux ! Heat (non-solar)(Watts) 81 REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux ! Wind stress (kg/ m s^2) 82 REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho ! Water density (kg/m^3) 83 REAL(wp), INTENT(IN) :: rdt ! Time-step 84 85 ! Local variables 86 REAL(wp), DIMENSION(jpi,jpj) :: z_fv ! Friction velocity 87 REAL(wp), DIMENSION(jpi,jpj) :: z_gamma ! Dimensionless function of wind speed 88 REAL(wp), DIMENSION(jpi,jpj) :: z_lamda ! Sauders (dimensionless) proportionality constant 89 REAL(wp), DIMENSION(jpi,jpj) :: z_wspd ! Wind speed (m/s) 90 REAL(wp) :: z_ztx ! Temporary u wind stress 91 REAL(wp) :: z_zty ! Temporary v wind stress 92 REAL(wp) :: z_zmod ! Temporary total wind stress 93 94 INTEGER :: ji,jj 75 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psqflux ! Heat (non-solar)(Watts) 76 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pstauflux ! Wind stress (kg/ m s^2) 77 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psrho ! Water density (kg/m^3) 78 REAL(wp) , INTENT(in) :: rdt ! Time-step 79 ! 80 INTEGER :: ji, jj ! dummy loop indices 81 REAL(wp) :: z_ztx, z_zty, z_zmod ! local scalar 82 REAL(wp), DIMENSION(jpi,jpj) :: z_fv ! Friction velocity 83 REAL(wp), DIMENSION(jpi,jpj) :: z_gamma ! Dimensionless function of wind speed 84 REAL(wp), DIMENSION(jpi,jpj) :: z_lamda ! Sauders (dimensionless) proportionality constant 85 REAL(wp), DIMENSION(jpi,jpj) :: z_wspd ! Wind speed (m/s) 86 !!---------------------------------------------------------------------- 95 87 96 88 IF ( .NOT. ln_blk_core ) THEN … … 107 99 z_wspd(ji,jj) = SQRT( pstauflux(ji,jj) / ( pp_cda * pp_rhoa ) ) 108 100 ELSE 109 z_fv (ji,jj) = 0.110 z_wspd(ji,jj) = 0. 101 z_fv (ji,jj) = 0._wp 102 z_wspd(ji,jj) = 0._wp 111 103 ENDIF 112 113 104 114 105 ! Calculate gamma function which is dependent upon wind speed … … 119 110 ENDIF 120 111 121 122 112 ! Calculate lamda function 123 113 IF( tmask(ji,jj,1) == 1. .AND. z_fv(ji,jj) /= 0 ) THEN … … 126 116 z_lamda(ji,jj) = 0. 127 117 ENDIF 128 129 130 118 131 119 ! Calculate the cool skin thickness - only when heat flux is out of the ocean … … 136 124 ENDIF 137 125 138 139 140 126 ! Calculate the cool skin correction - only when the heat flux is out of the ocean 141 127 IF( tmask(ji,jj,1) == 1. .AND. x_csthick(ji,jj) /= 0. .AND. psqflux(ji,jj) < 0. ) THEN … … 144 130 x_csdsst(ji,jj) = 0. 145 131 ENDIF 146 147 END DO148 END DO149 132 ! 133 END DO 134 END DO 135 ! 150 136 END SUBROUTINE diurnal_sst_coolskin_step 151 137 152 138 !!===================================================================== 153 139 END MODULE cool_skin -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r6152 r6851 653 653 ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 654 654 END DO 655 656 ! Write outputs657 ! =============658 CALL iom_put( "e3t", e3t_n(:,:,:) )659 CALL iom_put( "e3u", e3u_n(:,:,:) )660 CALL iom_put( "e3v", e3v_n(:,:,:) )661 CALL iom_put( "e3w", e3w_n(:,:,:) )662 CALL iom_put( "tpt_dep", gde3w_n(:,:,:) )663 IF( iom_use("e3tdef") ) &664 CALL iom_put( "e3tdef", ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100. * tmask(:,:,:) ) ** 2 )665 655 666 656 ! write restart file -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r5836 r6851 71 71 ! 72 72 ! ! horizontal mesh (inum3) 73 CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r 4) ! ! latitude74 CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r 4)75 CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r 4)76 CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r 4)77 78 CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r 4) ! ! longitude79 CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r 4)80 CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r 4)81 CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r 4)73 CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r8 ) ! ! latitude 74 CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r8 ) 75 CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r8 ) 76 CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r8 ) 77 78 CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r8 ) ! ! longitude 79 CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r8 ) 80 CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r8 ) 81 CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r8 ) 82 82 83 83 CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 ) ! ! e1 scale factors … … 129 129 !! masks, depth and vertical scale factors 130 130 !!---------------------------------------------------------------------- 131 !!132 131 INTEGER :: inum0 ! temprary units for 'mesh_mask.nc' file 133 132 INTEGER :: inum1 ! temprary units for 'mesh.nc' file … … 229 228 230 229 ! ! horizontal mesh (inum3) 231 CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r 4) ! ! latitude232 CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r 4)233 CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r 4)234 CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r 4)235 236 CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r 4) ! ! longitude237 CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r 4)238 CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r 4)239 CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r 4)230 CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r8 ) ! ! latitude 231 CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r8 ) 232 CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r8 ) 233 CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r8 ) 234 235 CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r8 ) ! ! longitude 236 CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r8 ) 237 CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r8 ) 238 CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r8 ) 240 239 241 240 CALL iom_rstput( 0, 0, inum3, 'e1t', e1t, ktype = jp_r8 ) ! ! e1 scale factors … … 257 256 CALL iom_rstput( 0, 0, inum4, 'misf', zprt, ktype = jp_i2 ) ! ! nb of ocean T-points 258 257 zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp ) 259 CALL iom_rstput( 0, 0, inum4, 'isfdraft', zprt, ktype = jp_r 4) ! ! nb of ocean T-points258 CALL iom_rstput( 0, 0, inum4, 'isfdraft', zprt, ktype = jp_r8 ) ! ! nb of ocean T-points 260 259 261 260 IF( ln_sco ) THEN ! s-coordinate … … 279 278 CALL iom_rstput( 0, 0, inum4, 'gdept_1d' , gdept_1d ) ! ! stretched system 280 279 CALL iom_rstput( 0, 0, inum4, 'gdepw_1d' , gdepw_1d ) 281 CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r 4)282 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r 4)280 CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r8 ) 281 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r8 ) 283 282 ENDIF 284 283 … … 302 301 ! 303 302 IF( nmsh <= 3 ) THEN ! ! 3D depth 304 CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r 4)303 CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r8 ) 305 304 DO jk = 1,jpk 306 305 DO jj = 1, jpjm1 … … 312 311 END DO 313 312 CALL lbc_lnk( zdepu, 'U', 1. ) ; CALL lbc_lnk( zdepv, 'V', 1. ) 314 CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r 4)315 CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r 4)316 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r 4)313 CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r8 ) 314 CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r8 ) 315 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r8 ) 317 316 ELSE ! ! 2D bottom depth 318 317 DO jj = 1,jpj … … 322 321 END DO 323 322 END DO 324 CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r 4)325 CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r 4)323 CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r8 ) 324 CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r8 ) 326 325 ENDIF 327 326 ! -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r6152 r6851 137 137 IF( ln_sco ) ioptio = ioptio + 1 138 138 IF( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' ) 139 ! 140 ioptio = 0 141 IF ( ln_zco .AND. ln_isfcav ) ioptio = ioptio + 1 142 IF ( ln_sco .AND. ln_isfcav ) ioptio = ioptio + 1 143 IF( ioptio > 0 ) CALL ctl_stop( ' Cavity not tested/compatible with full step (zco) and sigma (ln_sco) ' ) 139 144 ! 140 145 ! Build the vertical coordinate system … … 503 508 CALL iom_close( inum ) 504 509 mbathy(:,:) = INT( bathy(:,:) ) 510 ! initialisation isf variables 511 risfdep(:,:) = 0._wp ; misfdep(:,:) = 1 505 512 ! ! ===================== 506 513 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration … … 539 546 CALL iom_close( inum ) 540 547 ! 541 risfdep(:,:)=0._wp 542 misfdep(:,:)=1 548 ! initialisation isf variables 549 risfdep(:,:) = 0._wp ; misfdep(:,:) = 1 550 ! 543 551 IF ( ln_isfcav ) THEN 544 552 CALL iom_open ( 'isf_draft_meter.nc', inum ) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r6140 r6851 118 118 ENDIF 119 119 DO jk = 2, jpkm1 ! interior advective fluxes 120 DO jj = 2, jpj m1! 1/4 * Vertical transport121 DO ji = fs_2, fs_jpim1120 DO jj = 2, jpj ! 1/4 * Vertical transport 121 DO ji = fs_2, jpi 122 122 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 123 123 END DO -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r6140 r6851 211 211 ENDIF 212 212 DO jk = 2, jpkm1 ! interior fluxes 213 DO jj = 2, jpj m1214 DO ji = fs_2, fs_jpim1213 DO jj = 2, jpj 214 DO ji = fs_2, jpi 215 215 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 216 216 END DO -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r6140 r6851 294 294 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 295 295 va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 296 & / ( ze3va * rau0 ) 296 & / ( ze3va * rau0 ) * vmask(ji,jj,1) 297 297 END DO 298 298 END DO -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
r5215 r6851 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/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r6347 r6851 114 114 CASE (30) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "D360") 115 115 END SELECT 116 WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday116 WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':',i2.2,':00')") nyear,nmonth,nday,nhour,nminute 117 117 CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 118 118 … … 792 792 ENDIF 793 793 IF( PRESENT(pv_r3d) ) THEN 794 IF( idom == jpdom_data ) THEN ; icnt (3) = jpkdta794 IF( idom == jpdom_data ) THEN ; icnt (3) = jpkdta 795 795 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3) ; icnt(3) = kcount(3) 796 ELSE ; icnt (3) = jpk796 ELSE ; icnt (3) = jpk 797 797 ENDIF 798 798 ENDIF -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r6140 r6851 9 9 !! 3.5 ! 2012 (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk 10 10 !! 3.4 ! 2012-12 (R. Bourdalle-Badie, G. Reffray) add a C1D case 11 !! 3.6 ! 2015-06 (O. Tintó and M. Castrillo) add lbc_lnk_multi 11 12 !!---------------------------------------------------------------------- 12 13 #if defined key_mpp_mpi … … 22 23 23 24 INTERFACE lbc_lnk_multi 24 MODULE PROCEDURE mpp_lnk_2d_9 25 MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple 25 26 END INTERFACE 26 27 ! … … 29 30 END INTERFACE 30 31 ! 31 !JMM interface not defined if not key_mpp_mpi : likely do not compile without this CPP key !!!!32 32 INTERFACE lbc_sum 33 33 MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 34 34 END INTERFACE 35 35 ! 36 36 INTERFACE lbc_bdy_lnk 37 37 MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d … … 83 83 ! 84 84 INTERFACE lbc_sum 85 MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d85 MODULE PROCEDURE lbc_lnk_sum_3d, lbc_lnk_sum_2d 86 86 END INTERFACE 87 87 … … 90 90 END INTERFACE 91 91 ! 92 INTERFACE lbc_lnk_multi 93 MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple 94 END INTERFACE 95 92 96 INTERFACE lbc_bdy_lnk 93 97 MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d … … 97 101 MODULE PROCEDURE lbc_lnk_2d_e 98 102 END INTERFACE 103 104 TYPE arrayptr 105 REAL , DIMENSION (:,:), POINTER :: pt2d 106 END TYPE arrayptr 107 PUBLIC arrayptr 99 108 100 109 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 110 PUBLIC lbc_sum ! ocean/ice lateral boundary conditions (sum of the overlap region) 101 111 PUBLIC lbc_lnk_e ! 112 PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions 102 113 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 103 114 PUBLIC lbc_lnk_icb ! … … 181 192 ! 182 193 END SUBROUTINE lbc_lnk_2d 194 195 196 SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 197 !! 198 INTEGER :: num_fields 199 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 200 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points 201 ! ! = T , U , V , F , W and I points 202 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary 203 ! ! = 1. , the sign is kept 204 ! 205 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES 206 ! 207 DO ii = 1, num_fields 208 CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 209 END DO 210 ! 211 END SUBROUTINE lbc_lnk_2d_multiple 212 213 SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC & 214 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF & 215 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 216 !!--------------------------------------------------------------------- 217 ! Second 2D array on which the boundary condition is applied 218 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA 219 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE 220 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI 221 ! define the nature of ptab array grid-points 222 CHARACTER(len=1) , INTENT(in ) :: cd_typeA 223 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE 224 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI 225 ! =-1 the sign change across the north fold boundary 226 REAL(wp) , INTENT(in ) :: psgnA 227 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE 228 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI 229 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only 230 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries) 231 !! 232 !!--------------------------------------------------------------------- 233 234 !!The first array 235 CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 236 237 !! Look if more arrays to process 238 IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 239 IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 240 IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 241 IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 242 IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 243 IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 244 IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 245 IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 246 247 END SUBROUTINE lbc_lnk_2d_9 248 249 250 251 183 252 184 253 #else … … 379 448 ! 380 449 END SUBROUTINE lbc_lnk_2d 450 451 452 SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 453 !! 454 INTEGER :: num_fields 455 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 456 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points 457 ! ! = T , U , V , F , W and I points 458 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary 459 ! ! = 1. , the sign is kept 460 ! 461 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES 462 ! 463 DO ii = 1, num_fields 464 CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 465 END DO 466 ! 467 END SUBROUTINE lbc_lnk_2d_multiple 468 469 SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC & 470 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF & 471 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 472 !!--------------------------------------------------------------------- 473 ! Second 2D array on which the boundary condition is applied 474 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA 475 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE 476 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI 477 ! define the nature of ptab array grid-points 478 CHARACTER(len=1) , INTENT(in ) :: cd_typeA 479 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE 480 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI 481 ! =-1 the sign change across the north fold boundary 482 REAL(wp) , INTENT(in ) :: psgnA 483 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE 484 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI 485 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only 486 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries) 487 !! 488 !!--------------------------------------------------------------------- 489 490 !!The first array 491 CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 492 493 !! Look if more arrays to process 494 IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 495 IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 496 IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 497 IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 498 IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 499 IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 500 IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 501 IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 502 503 END SUBROUTINE lbc_lnk_2d_9 504 505 SUBROUTINE lbc_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 506 !!--------------------------------------------------------------------- 507 !! *** ROUTINE lbc_lnk_sum_2d *** 508 !! 509 !! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case) 510 !! 511 !! ** Comments: compute the sum of the common cell (overlap region) for the ice sheet/ocean 512 !! coupling if conservation option activated. As no ice shelf are present along 513 !! this line, nothing is done along the north fold. 514 !!---------------------------------------------------------------------- 515 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 516 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 517 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 518 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 519 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries) 520 !! 521 REAL(wp) :: zland 522 !!---------------------------------------------------------------------- 523 524 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default) 525 ELSE ; zland = 0._wp 526 ENDIF 527 528 IF (PRESENT(cd_mpp)) THEN 529 ! only fill the overlap area and extra allows 530 ! this is in mpp case. In this module, just do nothing 531 ELSE 532 ! ! East-West boundaries 533 ! ! ==================== 534 SELECT CASE ( nperio ) 535 ! 536 CASE ( 1 , 4 , 6 ) !** cyclic east-west 537 pt2d(jpim1,:) = pt2d(jpim1,:) + pt2d( 1 ,:) 538 pt2d( 2 ,:) = pt2d( 2 ,:) + pt2d(jpi,:) 539 pt2d( 1 ,:) = 0.0_wp ! all points 540 pt2d(jpi,:) = 0.0_wp 541 ! 542 CASE DEFAULT !** East closed -- West closed 543 SELECT CASE ( cd_type ) 544 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 545 pt2d( 1 ,:) = zland 546 pt2d(jpi,:) = zland 547 CASE ( 'F' ) ! F-point 548 pt2d(jpi,:) = zland 549 END SELECT 550 ! 551 END SELECT 552 ! ! North-South boundaries 553 ! ! ====================== 554 ! Nothing to do for the north fold, there is no ice shelf along this line. 555 ! 556 END IF 557 558 END SUBROUTINE 559 560 SUBROUTINE lbc_lnk_sum_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 561 !!--------------------------------------------------------------------- 562 !! *** ROUTINE lbc_lnk_sum_3d *** 563 !! 564 !! ** Purpose : set lateral boundary conditions on a 3D array (non mpp case) 565 !! 566 !! ** Comments: compute the sum of the common cell (overlap region) for the ice sheet/ocean 567 !! coupling if conservation option activated. As no ice shelf are present along 568 !! this line, nothing is done along the north fold. 569 !!---------------------------------------------------------------------- 570 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 571 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 572 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 573 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 574 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries) 575 !! 576 REAL(wp) :: zland 577 !!---------------------------------------------------------------------- 578 579 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default) 580 ELSE ; zland = 0._wp 581 ENDIF 582 583 584 IF( PRESENT( cd_mpp ) ) THEN 585 ! only fill the overlap area and extra allows 586 ! this is in mpp case. In this module, just do nothing 587 ELSE 588 ! ! East-West boundaries 589 ! ! ====================== 590 SELECT CASE ( nperio ) 591 ! 592 CASE ( 1 , 4 , 6 ) !** cyclic east-west 593 pt3d(jpim1,:,:) = pt3d(jpim1,:,:) + pt3d( 1 ,:,:) 594 pt3d( 2 ,:,:) = pt3d( 2 ,:,:) + pt3d(jpi,:,:) 595 pt3d( 1 ,:,:) = 0.0_wp ! all points 596 pt3d(jpi,:,:) = 0.0_wp 597 ! 598 CASE DEFAULT !** East closed -- West closed 599 SELECT CASE ( cd_type ) 600 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 601 pt3d( 1 ,:,:) = zland 602 pt3d(jpi,:,:) = zland 603 CASE ( 'F' ) ! F-point 604 pt3d(jpi,:,:) = zland 605 END SELECT 606 ! 607 END SELECT 608 ! ! North-South boundaries 609 ! ! ====================== 610 ! Nothing to do for the north fold, there is no ice shelf along this line. 611 ! 612 END IF 613 END SUBROUTINE 614 381 615 382 616 #endif … … 448 682 !!====================================================================== 449 683 END MODULE lbclnk 684 -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r6140 r6851 24 24 !! 3.5 ! 2013 ( C. Ethe, G. Madec ) message passing arrays as local variables 25 25 !! 3.5 ! 2013 (S.Mocavero, I.Epicoco - CMCC) north fold optimizations 26 !! 3.6 ! 2015 (O. Tintó and M. Castrillo - BSC) Added 'mpp_lnk_2d_multiple', 'mpp_lbc_north_2d_multiple', 'mpp_max_multiple' 26 27 !!---------------------------------------------------------------------- 27 28 … … 62 63 USE lbcnfd ! north fold treatment 63 64 USE in_out_manager ! I/O manager 65 USE wrk_nemo ! work arrays 64 66 65 67 IMPLICIT NONE … … 70 72 PUBLIC mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e 71 73 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 74 PUBLIC mpp_max_multiple 72 75 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 73 PUBLIC mpp_lnk_2d_9 76 PUBLIC mpp_lnk_2d_9 , mpp_lnk_2d_multiple 74 77 PUBLIC mpp_lnk_sum_3d, mpp_lnk_sum_2d 75 78 PUBLIC mppscatter, mppgather … … 79 82 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 80 83 PUBLIC mpp_lbc_north_icb, mpp_lnk_2d_icb 84 PUBLIC mpprank 81 85 82 86 TYPE arrayptr 83 87 REAL , DIMENSION (:,:), POINTER :: pt2d 84 88 END TYPE arrayptr 89 PUBLIC arrayptr 85 90 86 91 !! * Interfaces … … 106 111 INTERFACE mpp_maxloc 107 112 MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 113 END INTERFACE 114 115 INTERFACE mpp_max_multiple 116 MODULE PROCEDURE mppmax_real_multiple 108 117 END INTERFACE 109 118 … … 726 735 ! ----------------------- 727 736 ! 728 DO ii = 1 , num_fields729 737 !First Array 730 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 731 ! 732 SELECT CASE ( jpni ) 733 CASE ( 1 ) ; CALL lbc_nfd ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) ) ! only 1 northern proc, no mpp 734 CASE DEFAULT ; CALL mpp_lbc_north( pt2d_array(ii)%pt2d( : , : ), type_array(ii), psgn_array(ii) ) ! for all northern procs. 735 END SELECT 736 ! 737 ENDIF 738 ! 739 END DO 738 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 739 ! 740 SELECT CASE ( jpni ) 741 CASE ( 1 ) ; 742 DO ii = 1 , num_fields 743 CALL lbc_nfd ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) ) ! only 1 northern proc, no mpp 744 END DO 745 CASE DEFAULT ; CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, num_fields ) ! for all northern procs. 746 END SELECT 747 ! 748 ENDIF 749 ! 740 750 ! 741 751 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) … … 2020 2030 2021 2031 2032 SUBROUTINE mppmax_real_multiple( ptab, NUM , kcom ) 2033 !!---------------------------------------------------------------------- 2034 !! *** routine mppmax_real *** 2035 !! 2036 !! ** Purpose : Maximum 2037 !! 2038 !!---------------------------------------------------------------------- 2039 REAL(wp), DIMENSION(:) , INTENT(inout) :: ptab ! ??? 2040 INTEGER , INTENT(in ) :: NUM 2041 INTEGER , INTENT(in ), OPTIONAL :: kcom ! ??? 2042 !! 2043 INTEGER :: ierror, localcomm 2044 REAL(wp) , POINTER , DIMENSION(:) :: zwork 2045 !!---------------------------------------------------------------------- 2046 ! 2047 CALL wrk_alloc(NUM , zwork) 2048 localcomm = mpi_comm_opa 2049 IF( PRESENT(kcom) ) localcomm = kcom 2050 ! 2051 CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror ) 2052 ptab = zwork 2053 CALL wrk_dealloc(NUM , zwork) 2054 ! 2055 END SUBROUTINE mppmax_real_multiple 2056 2057 2022 2058 SUBROUTINE mppmin_a_real( ptab, kdim, kcom ) 2023 2059 !!---------------------------------------------------------------------- … … 2913 2949 2914 2950 2951 SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, num_fields) 2952 !!--------------------------------------------------------------------- 2953 !! *** routine mpp_lbc_north_2d *** 2954 !! 2955 !! ** Purpose : Ensure proper north fold horizontal bondary condition 2956 !! in mpp configuration in case of jpn1 > 1 2957 !! (for multiple 2d arrays ) 2958 !! 2959 !! ** Method : North fold condition and mpp with more than one proc 2960 !! in i-direction require a specific treatment. We gather 2961 !! the 4 northern lines of the global domain on 1 processor 2962 !! and apply lbc north-fold on this sub array. Then we 2963 !! scatter the north fold array back to the processors. 2964 !! 2965 !!---------------------------------------------------------------------- 2966 INTEGER , INTENT (in ) :: num_fields ! number of variables contained in pt2d 2967 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 2968 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_type ! nature of pt2d grid-points 2969 ! ! = T , U , V , F or W gridpoints 2970 REAL(wp), DIMENSION(:), INTENT(in ) :: psgn ! = -1. the sign change across the north fold 2971 !! ! = 1. , the sign is kept 2972 INTEGER :: ji, jj, jr, jk 2973 INTEGER :: ierr, itaille, ildi, ilei, iilb 2974 INTEGER :: ijpj, ijpjm1, ij, iproc 2975 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf !for mpi_isend when avoiding mpi_allgather 2976 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather 2977 INTEGER, DIMENSION(MPI_STATUS_SIZE):: ml_stat ! for mpi_isend when avoiding mpi_allgather 2978 ! ! Workspace for message transfers avoiding mpi_allgather 2979 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztab 2980 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: znorthloc, zfoldwk 2981 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: znorthgloio 2982 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztabl, ztabr 2983 INTEGER :: istatus(mpi_status_size) 2984 INTEGER :: iflag 2985 !!---------------------------------------------------------------------- 2986 ! 2987 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 2988 ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) ) 2989 ! 2990 ijpj = 4 2991 ijpjm1 = 3 2992 ! 2993 2994 DO jk = 1, num_fields 2995 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc the last 4 jlines of pt2d (for every variable) 2996 ij = jj - nlcj + ijpj 2997 znorthloc(:,ij,jk) = pt2d_array(jk)%pt2d(:,jj) 2998 END DO 2999 END DO 3000 ! ! Build in procs of ncomm_north the znorthgloio 3001 itaille = jpi * ijpj 3002 3003 IF ( l_north_nogather ) THEN 3004 ! 3005 ! Avoid the use of mpi_allgather by exchanging only with the processes already identified 3006 ! (in nemo_northcomms) as being involved in this process' northern boundary exchange 3007 ! 3008 ztabr(:,:,:) = 0 3009 ztabl(:,:,:) = 0 3010 3011 DO jk = 1, num_fields 3012 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 3013 ij = jj - nlcj + ijpj 3014 DO ji = nfsloop, nfeloop 3015 ztabl(ji,ij,jk) = pt2d_array(jk)%pt2d(ji,jj) 3016 END DO 3017 END DO 3018 END DO 3019 3020 DO jr = 1,nsndto 3021 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 3022 CALL mppsend(5, znorthloc, itaille*num_fields, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "num_fields" times 3023 ENDIF 3024 END DO 3025 DO jr = 1,nsndto 3026 iproc = nfipproc(isendto(jr),jpnj) 3027 IF(iproc .ne. -1) THEN 3028 ilei = nleit (iproc+1) 3029 ildi = nldit (iproc+1) 3030 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 3031 ENDIF 3032 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 3033 CALL mpprecv(5, zfoldwk, itaille*num_fields, iproc) ! Buffer expanded "num_fields" times 3034 DO jk = 1 , num_fields 3035 DO jj = 1, ijpj 3036 DO ji = ildi, ilei 3037 ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) ! Modified to 3D 3038 END DO 3039 END DO 3040 END DO 3041 ELSE IF (iproc .eq. (narea-1)) THEN 3042 DO jk = 1, num_fields 3043 DO jj = 1, ijpj 3044 DO ji = ildi, ilei 3045 ztabr(iilb+ji,jj,jk) = pt2d_array(jk)%pt2d(ji,nlcj-ijpj+jj) ! Modified to 3D 3046 END DO 3047 END DO 3048 END DO 3049 ENDIF 3050 END DO 3051 IF (l_isend) THEN 3052 DO jr = 1,nsndto 3053 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 3054 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 3055 ENDIF 3056 END DO 3057 ENDIF 3058 ! 3059 DO ji = 1, num_fields ! Loop to manage 3D variables 3060 CALL mpp_lbc_nfd( ztabl(:,:,ji), ztabr(:,:,ji), cd_type(ji), psgn(ji) ) ! North fold boundary condition 3061 END DO 3062 ! 3063 DO jk = 1, num_fields 3064 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt2d 3065 ij = jj - nlcj + ijpj 3066 DO ji = 1, nlci 3067 pt2d_array(jk)%pt2d(ji,jj) = ztabl(ji,ij,jk) ! Modified to 3D 3068 END DO 3069 END DO 3070 END DO 3071 3072 ! 3073 ELSE 3074 ! 3075 CALL MPI_ALLGATHER( znorthloc , itaille*num_fields, MPI_DOUBLE_PRECISION, & 3076 & znorthgloio, itaille*num_fields, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 3077 ! 3078 ztab(:,:,:) = 0.e0 3079 DO jk = 1, num_fields 3080 DO jr = 1, ndim_rank_north ! recover the global north array 3081 iproc = nrank_north(jr) + 1 3082 ildi = nldit (iproc) 3083 ilei = nleit (iproc) 3084 iilb = nimppt(iproc) 3085 DO jj = 1, ijpj 3086 DO ji = ildi, ilei 3087 ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr) 3088 END DO 3089 END DO 3090 END DO 3091 END DO 3092 3093 DO ji = 1, num_fields 3094 CALL lbc_nfd( ztab(:,:,ji), cd_type(ji), psgn(ji) ) ! North fold boundary condition 3095 END DO 3096 ! 3097 DO jk = 1, num_fields 3098 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt2d 3099 ij = jj - nlcj + ijpj 3100 DO ji = 1, nlci 3101 pt2d_array(jk)%pt2d(ji,jj) = ztab(ji+nimpp-1,ij,jk) 3102 END DO 3103 END DO 3104 END DO 3105 ! 3106 ! 3107 ENDIF 3108 DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 3109 DEALLOCATE( ztabl, ztabr ) 3110 ! 3111 END SUBROUTINE mpp_lbc_north_2d_multiple 3112 3113 2915 3114 SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn) 2916 3115 !!--------------------------------------------------------------------- … … 2929 3128 !!---------------------------------------------------------------------- 2930 3129 REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) :: pt2d ! 2D array with extra halo 2931 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 2932 ! ! = T , U , V , F or W -points 2933 REAL(wp) , INTENT(in ) :: psgn ! = -1. the sign change across the 2934 !! ! north fold, = 1. otherwise 3130 CHARACTER(len=1) , INTENT(in ) :: cd_type ! type of input grid-points 3131 REAL(wp) , INTENT(in ) :: psgn ! sign change across the north fold 3132 !! 2935 3133 INTEGER :: ji, jj, jr 2936 3134 INTEGER :: ierr, itaille, ildi, ilei, iilb 2937 3135 INTEGER :: ijpj, ij, iproc 2938 !2939 3136 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab_e, znorthloc_e 2940 3137 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio_e 2941 2942 3138 !!---------------------------------------------------------------------- 2943 3139 ! 2944 3140 ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) ) 2945 2946 ! 2947 ijpj=4 2948 ztab_e(:,:) = 0.e0 2949 2950 ij=0 3141 ! 3142 ijpj = 4 3143 ztab_e(:,:) = 0._wp 3144 ! 3145 ij = 0 2951 3146 ! put in znorthloc_e the last 4 jlines of pt2d 2952 3147 DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj … … 3014 3209 !!---------------------------------------------------------------------- 3015 3210 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied 3016 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 3017 ! ! = T , U , V , F , W points 3018 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 3019 ! ! = 1. , the sign is kept 3211 CHARACTER(len=1) , INTENT(in ) :: cd_type ! type of ptab grid-points 3212 REAL(wp) , INTENT(in ) :: psgn ! sign change across the north fold 3020 3213 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set 3021 3214 ! -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r6140 r6851 198 198 199 199 #endif 200 IF(lwp) THEN201 WRITE(numout,*)202 WRITE(numout,*) ' defines mpp subdomains'203 WRITE(numout,*) ' ----------------------'204 WRITE(numout,*) ' iresti=',iresti,' irestj=',irestj205 WRITE(numout,*) ' jpni =',jpni ,' jpnj =',jpnj206 ifreq = 4207 il1 = 1208 DO jn = 1, (jpni-1)/ifreq+1209 il2 = MIN( jpni, il1+ifreq-1 )210 WRITE(numout,*)211 WRITE(numout,9200) ('***',ji = il1,il2-1)212 DO jj = jpnj, 1, -1213 WRITE(numout,9203) (' ',ji = il1,il2-1)214 WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )215 WRITE(numout,9203) (' ',ji = il1,il2-1)216 WRITE(numout,9200) ('***',ji = il1,il2-1)217 END DO218 WRITE(numout,9201) (ji,ji = il1,il2)219 il1 = il1+ifreq220 END DO221 9200 FORMAT(' ***',20('*************',a3))222 9203 FORMAT(' * ',20(' * ',a3))223 9201 FORMAT(' ',20(' ',i3,' '))224 9202 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * '))225 ENDIF226 227 zidom = nreci228 DO ji = 1, jpni229 zidom = zidom + ilcit(ji,1) - nreci230 END DO231 IF(lwp) WRITE(numout,*)232 IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo233 234 zjdom = nrecj235 DO jj = 1, jpnj236 zjdom = zjdom + ilcjt(1,jj) - nrecj237 END DO238 IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo239 IF(lwp) WRITE(numout,*)240 241 200 242 201 ! 2. Index arrays for subdomains … … 301 260 nlejt(jn) = nlej 302 261 END DO 303 304 305 ! 4. From global to local 262 263 ! 4. Subdomain print 264 ! ------------------ 265 266 IF(lwp) WRITE(numout,*) 267 IF(lwp) WRITE(numout,*) ' mpp_init: defines mpp subdomains' 268 IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------' 269 IF(lwp) WRITE(numout,*) 270 IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj 271 IF(lwp) WRITE(numout,*) 272 IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj 273 zidom = nreci 274 DO ji = 1, jpni 275 zidom = zidom + ilcit(ji,1) - nreci 276 END DO 277 IF(lwp) WRITE(numout,*) 278 IF(lwp) WRITE(numout,*)' sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo 279 280 zjdom = nrecj 281 DO jj = 1, jpnj 282 zjdom = zjdom + ilcjt(1,jj) - nrecj 283 END DO 284 IF(lwp) WRITE(numout,*)' sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo 285 IF(lwp) WRITE(numout,*) 286 287 IF(lwp) THEN 288 ifreq = 4 289 il1 = 1 290 DO jn = 1, (jpni-1)/ifreq+1 291 il2 = MIN( jpni, il1+ifreq-1 ) 292 WRITE(numout,*) 293 WRITE(numout,9200) ('***',ji = il1,il2-1) 294 DO jj = jpnj, 1, -1 295 WRITE(numout,9203) (' ',ji = il1,il2-1) 296 WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 ) 297 WRITE(numout,9204) (nfipproc(ji,jj),ji=il1,il2) 298 WRITE(numout,9203) (' ',ji = il1,il2-1) 299 WRITE(numout,9200) ('***',ji = il1,il2-1) 300 END DO 301 WRITE(numout,9201) (ji,ji = il1,il2) 302 il1 = il1+ifreq 303 END DO 304 9200 FORMAT(' ***',20('*************',a3)) 305 9203 FORMAT(' * ',20(' * ',a3)) 306 9201 FORMAT(' ',20(' ',i3,' ')) 307 9202 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * ')) 308 9204 FORMAT(' * ',20(' ',i3,' * ')) 309 ENDIF 310 311 ! 5. From global to local 306 312 ! ----------------------- 307 313 … … 310 316 311 317 312 ! 5. Subdomain neighbours318 ! 6. Subdomain neighbours 313 319 ! ---------------------- 314 320 … … 433 439 WRITE(numout,*) ' nimpp = ', nimpp 434 440 WRITE(numout,*) ' njmpp = ', njmpp 435 WRITE(numout,*) ' nbse = ', nbse , ' npse = ', npse 436 WRITE(numout,*) ' nbsw = ', nbsw , ' npsw = ', npsw 437 WRITE(numout,*) ' nbne = ', nbne , ' npne = ', npne 438 WRITE(numout,*) ' nbnw = ', nbnw , ' npnw = ', npnw 441 WRITE(numout,*) ' nreci = ', nreci , ' npse = ', npse 442 WRITE(numout,*) ' nrecj = ', nrecj , ' npsw = ', npsw 443 WRITE(numout,*) ' jpreci = ', jpreci , ' npne = ', npne 444 WRITE(numout,*) ' jprecj = ', jprecj , ' npnw = ', npnw 445 WRITE(numout,*) 439 446 ENDIF 440 447 … … 443 450 ! Prepare mpp north fold 444 451 445 IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN452 IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 446 453 CALL mpp_ini_north 447 END IF 454 IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1' 455 ENDIF 448 456 449 457 ! Prepare NetCDF output file (if necessary) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
r6140 r6851 72 72 73 73 ! read namelist for ln_zco 74 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 74 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh 75 75 76 76 !!---------------------------------------------------------------------- … … 318 318 ENDIF 319 319 320 ! Check wet points over the entire domain to preserve the MPI communication stencil 320 321 isurf = 0 321 DO jj = 1 +jprecj, ilj-jprecj322 DO ji = 1 +jpreci, ili-jpreci322 DO jj = 1, ilj 323 DO ji = 1, ili 323 324 IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1 324 325 END DO 325 326 END DO 327 326 328 IF(isurf /= 0) THEN 327 329 icont = icont + 1 … … 333 335 334 336 nfipproc(:,:) = ipproc(:,:) 335 336 337 337 338 ! Control … … 441 442 ii = iin(narea) 442 443 ij = ijn(narea) 444 445 ! set default neighbours 446 noso = ioso(ii,ij) 447 nowe = iowe(ii,ij) 448 noea = ioea(ii,ij) 449 nono = iono(ii,ij) 450 npse = iose(ii,ij) 451 npsw = iosw(ii,ij) 452 npne = ione(ii,ij) 453 npnw = ionw(ii,ij) 454 455 ! check neighbours location 443 456 IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 444 457 iiso = 1 + MOD(ioso(ii,ij),jpni) … … 511 524 IF (lwp) THEN 512 525 CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 526 WRITE(inum,'(a)') ' jpnij jpi jpj jpk jpiglo jpjglo' 513 527 WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 514 528 WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' … … 523 537 END IF 524 538 525 IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )526 527 ! Prepare mpp north fold528 529 IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN530 CALL mpp_ini_north531 IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'532 ENDIF533 534 539 ! Defined npolj, either 0, 3 , 4 , 5 , 6 535 540 ! In this case the important thing is that npolj /= 0 … … 548 553 ENDIF 549 554 555 ! Periodicity : no corner if nbondi = 2 and nperio != 1 556 557 IF(lwp) THEN 558 WRITE(numout,*) ' nproc = ', nproc 559 WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea 560 WRITE(numout,*) ' nono = ', nono , ' noso = ', noso 561 WRITE(numout,*) ' nbondi = ', nbondi 562 WRITE(numout,*) ' nbondj = ', nbondj 563 WRITE(numout,*) ' npolj = ', npolj 564 WRITE(numout,*) ' nperio = ', nperio 565 WRITE(numout,*) ' nlci = ', nlci 566 WRITE(numout,*) ' nlcj = ', nlcj 567 WRITE(numout,*) ' nimpp = ', nimpp 568 WRITE(numout,*) ' njmpp = ', njmpp 569 WRITE(numout,*) ' nreci = ', nreci , ' npse = ', npse 570 WRITE(numout,*) ' nrecj = ', nrecj , ' npsw = ', npsw 571 WRITE(numout,*) ' jpreci = ', jpreci , ' npne = ', npne 572 WRITE(numout,*) ' jprecj = ', jprecj , ' npnw = ', npnw 573 WRITE(numout,*) 574 ENDIF 575 576 IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' ) 577 578 ! Prepare mpp north fold 579 580 IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 581 CALL mpp_ini_north 582 IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1' 583 ENDIF 584 550 585 ! Prepare NetCDF output file (if necessary) 551 586 CALL mpp_init_ioipsl 552 587 553 ! Periodicity : no corner if nbondi = 2 and nperio != 1554 555 IF(lwp) THEN556 WRITE(numout,*) ' nproc= ',nproc557 WRITE(numout,*) ' nowe= ',nowe558 WRITE(numout,*) ' noea= ',noea559 WRITE(numout,*) ' nono= ',nono560 WRITE(numout,*) ' noso= ',noso561 WRITE(numout,*) ' nbondi= ',nbondi562 WRITE(numout,*) ' nbondj= ',nbondj563 WRITE(numout,*) ' npolj= ',npolj564 WRITE(numout,*) ' nperio= ',nperio565 WRITE(numout,*) ' nlci= ',nlci566 WRITE(numout,*) ' nlcj= ',nlcj567 WRITE(numout,*) ' nimpp= ',nimpp568 WRITE(numout,*) ' njmpp= ',njmpp569 WRITE(numout,*) ' nbse= ',nbse,' npse= ',npse570 WRITE(numout,*) ' nbsw= ',nbsw,' npsw= ',npsw571 WRITE(numout,*) ' nbne= ',nbne,' npne= ',npne572 WRITE(numout,*) ' nbnw= ',nbnw,' npnw= ',npnw573 ENDIF574 588 575 589 END SUBROUTINE mpp_init2 -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r6140 r6851 184 184 DO jj = 2, jpjm1 185 185 DO ji = fs_2, fs_jpim1 ! vector opt. 186 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt (ji,jj), hmlpt(ji+1,jj ), 5._wp)&187 & - 0.5_wp * ( risfdep(ji,jj) + risfdep(ji+1,jj ) ) )188 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / ( MAX(hmlpt (ji,jj), hmlpt(ji ,jj+1), 5._wp)&189 & - 0.5_wp * ( risfdep(ji,jj) + risfdep(ji ,jj+1)) )186 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX(hmlpt (ji,jj), hmlpt (ji+1,jj ), 5._wp) & 187 & - MAX(risfdep(ji,jj), risfdep(ji+1,jj ) ) ) 188 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / ( MAX(hmlpt (ji,jj), hmlpt (ji ,jj+1), 5._wp) & 189 & - MAX(risfdep(ji,jj), risfdep(ji ,jj+1) ) ) 190 190 END DO 191 191 END DO … … 215 215 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 216 216 ! thickness of water column between surface and level k at u/v point 217 zdepu = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji+1,jj 218 - ( risfdep(ji,jj) + risfdep(ji+1,jj) ) - e3u_n(ji,jj,miku(ji,jj)))219 zdepv = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji,jj+1,jk) ) 220 - ( risfdep(ji,jj) + risfdep(ji,jj+1) ) - e3v_n(ji,jj,mikv(ji,jj)))217 zdepu = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji+1,jj,jk) ) & 218 & - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj) ) - e3u_n(ji,jj,miku(ji,jj)) ) 219 zdepv = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n (ji,jj+1,jk) ) & 220 & - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) - e3v_n(ji,jj,mikv(ji,jj)) ) 221 221 ! 222 222 zwz(ji,jj,jk) = ( ( 1._wp - zfi) * zau / ( zbu - zeps ) & -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r5407 r6851 80 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qemp_oce !: heat flux of precip and evap over ocean [W/m2] 81 81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qemp_ice !: heat flux of precip and evap over ice [W/m2] 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qprec_ice !: heat flux of precip over ice [J/m3] 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qevap_ice !: heat flux of evap over ice [W/m2] 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qprec_ice !: enthalpy of precip over ice [J/m3] 83 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_oce !: evap - precip over ocean [kg/m2/s] 84 85 #endif … … 144 145 #endif 145 146 #if defined key_lim3 146 & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) , &147 & qemp_ice(jpi,jpj) , qe mp_oce(jpi,jpj) ,&148 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) ,&147 & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) , & 148 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , & 149 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , & 149 150 #endif 150 151 & emp_ice(jpi,jpj) , STAT= ierr(1) ) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r5836 r6851 668 668 qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 669 669 670 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 671 DO jl = 1, jpl 672 qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) - lfus ) 673 ! but then qemp_ice should also include sublimation 674 END DO 675 670 676 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 671 677 #endif -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r6140 r6851 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) … … 612 614 ! --- evaporation --- ! 613 615 z1_lsub = 1._wp / Lsub 614 evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub! sublimation615 devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub616 zevap (:,:) = emp(:,:) + tprecip(:,:)! evaporation over ocean616 evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_lsub ! sublimation 617 devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_lsub ! d(sublimation)/dT 618 zevap (:,:) = rn_efac * ( emp(:,:) + tprecip(:,:) ) ! evaporation over ocean 617 619 618 620 ! --- evaporation minus precipitation --- ! … … 637 639 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 638 640 qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 641 642 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 643 DO jl = 1, jpl 644 qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) ) 645 ! But we do not have Tice => consider it at 0°C => evap=0 646 END DO 639 647 640 648 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6165 r6851 1006 1006 IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1007 1007 sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 1008 IF( srcv(jpr_soce)%laction .AND. l n_useCT ) THEN ! make sure that sst_m is the potential temperature1008 IF( srcv(jpr_soce)%laction .AND. l_useCT ) THEN ! make sure that sst_m is the potential temperature 1009 1009 sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 1010 1010 ENDIF … … 1327 1327 !! *** ROUTINE sbc_cpl_ice_flx *** 1328 1328 !! 1329 !! ** Purpose : provide the heat and freshwater fluxes of the 1330 !! ocean-ice system. 1329 !! ** Purpose : provide the heat and freshwater fluxes of the ocean-ice system 1331 1330 !! 1332 1331 !! ** Method : transform the fields received from the atmosphere into … … 1339 1338 !! emp_ice = sublimation - solid precipitation as liquid 1340 1339 !! precipitation are re-routed directly to the ocean and 1341 !! runoffs and calving directly enter the ocean. 1340 !! calving directly enter the ocean (runoffs are read but 1341 !! included in trasbc.F90) 1342 1342 !! * solid precipitation (sprecip), used to add to qns_tot 1343 1343 !! the heat lost associated to melting solid precipitation 1344 1344 !! over the ocean fraction. 1345 !! ===>> CAUTION here this changes the net heat flux received from 1346 !! the atmosphere 1347 !! 1348 !! - the fluxes have been separated from the stress as 1349 !! (a) they are updated at each ice time step compare to 1350 !! an update at each coupled time step for the stress, and 1351 !! (b) the conservative computation of the fluxes over the 1352 !! sea-ice area requires the knowledge of the ice fraction 1353 !! after the ice advection and before the ice thermodynamics, 1354 !! so that the stress is updated before the ice dynamics 1355 !! while the fluxes are updated after it. 1345 !! * heat content of rain, snow and evap can also be provided, 1346 !! otherwise heat flux associated with these mass flux are 1347 !! guessed (qemp_oce, qemp_ice) 1348 !! 1349 !! - the fluxes have been separated from the stress as 1350 !! (a) they are updated at each ice time step compare to 1351 !! an update at each coupled time step for the stress, and 1352 !! (b) the conservative computation of the fluxes over the 1353 !! sea-ice area requires the knowledge of the ice fraction 1354 !! after the ice advection and before the ice thermodynamics, 1355 !! so that the stress is updated before the ice dynamics 1356 !! while the fluxes are updated after it. 1357 !! 1358 !! ** Details 1359 !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice => provided 1360 !! + qemp_oce + qemp_ice => recalculated and added up to qns 1361 !! 1362 !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice => provided 1363 !! 1364 !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce) 1365 !! river runoff (rnf) is provided but not included here 1356 1366 !! 1357 1367 !! ** Action : update at each nf_ice time step: 1358 1368 !! qns_tot, qsr_tot non-solar and solar total heat fluxes 1359 1369 !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice 1360 !! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)1361 !! emp_ice 1362 !! dqns_ice 1363 !! sprecip 1370 !! emp_tot total evaporation - precipitation(liquid and solid) (-calving) 1371 !! emp_ice ice sublimation - solid precipitation over the ice 1372 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1373 !! sprecip solid precipitation over the ocean 1364 1374 !!---------------------------------------------------------------------- 1365 1375 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] … … 1370 1380 ! 1371 1381 INTEGER :: jl ! dummy loop index 1372 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1373 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, z sprecip, ztprecip, zqns_tot, zqsr_tot1374 REAL(wp), POINTER, DIMENSION(:,: ,:) :: zqns_ice, zqsr_ice, zdqns_ice1375 REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqsr_oce, zqprec_ice, zqemp_oce ! for LIM31382 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk, zsnw 1383 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1384 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1385 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1376 1386 !!---------------------------------------------------------------------- 1377 1387 ! 1378 1388 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1379 1389 ! 1380 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1381 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1390 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1391 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1392 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1393 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1382 1394 1383 1395 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1386 1398 ! 1387 1399 ! ! ========================= ! 1388 ! ! freshwater budget ! (emp)1400 ! ! freshwater budget ! 1389 1401 ! ! ========================= ! 1390 1402 ! 1391 ! ! total Precipitation - total Evaporation (emp_tot)1392 ! ! solid precipitation - sublimation (emp_ice)1393 ! ! solid Precipitation (sprecip)1394 ! ! liquid + solid Precipitation (tprecip)1403 ! ! solid Precipitation (sprecip) 1404 ! ! liquid + solid Precipitation (tprecip) 1405 ! ! total Evaporation - total Precipitation (emp_tot) 1406 ! ! sublimation - solid precipitation (cell average) (emp_ice) 1395 1407 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1396 CASE( 'conservative' 1397 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here1398 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here1399 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)1400 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1401 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) )! liquid precipitation1408 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1409 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1410 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1411 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1412 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 1413 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1402 1414 IF( iom_use('hflx_rain_cea') ) & 1403 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1404 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1405 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1415 & CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1406 1416 IF( iom_use('evap_ao_cea' ) ) & 1407 CALL iom_put( 'evap_ao_cea' , ztmp )! ice-free oce evap (cell average)1417 & CALL iom_put( 'evap_ao_cea' , frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! ice-free oce evap (cell average) 1408 1418 IF( iom_use('hflx_evap_cea') ) & 1409 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )! heat flux from from evap (cell average)1410 CASE( 'oce and ice' 1419 & 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) 1420 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1411 1421 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1412 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1422 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) 1413 1423 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1414 1424 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1415 1425 END SELECT 1416 1426 1417 IF( iom_use('subl_ai_cea') ) & 1418 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1419 ! 1420 ! ! runoffs and calving (put in emp_tot) 1427 #if defined key_lim3 1428 ! zsnw = snow fraction over ice after wind blowing 1429 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw ) 1430 1431 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1432 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1433 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1434 1435 ! --- evaporation over ocean (used later for qemp) --- ! 1436 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1437 1438 ! --- evaporation over ice (kg/m2/s) --- ! 1439 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1440 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 1441 ! therefore, sublimation is not redistributed over the ice categories in case no subgrid scale fluxes are provided by atm. 1442 zdevap_ice(:,:) = 0._wp 1443 1444 ! --- runoffs (included in emp later on) --- ! 1445 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1446 1447 ! --- calving (put in emp_tot and emp_oce) --- ! 1448 IF( srcv(jpr_cal)%laction ) THEN 1449 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1450 zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1) 1451 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1452 ENDIF 1453 1454 IF( ln_mixcpl ) THEN 1455 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1456 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1457 emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:) 1458 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1459 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1460 DO jl=1,jpl 1461 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:) 1462 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 1463 ENDDO 1464 ELSE 1465 emp_tot(:,:) = zemp_tot(:,:) 1466 emp_ice(:,:) = zemp_ice(:,:) 1467 emp_oce(:,:) = zemp_oce(:,:) 1468 sprecip(:,:) = zsprecip(:,:) 1469 tprecip(:,:) = ztprecip(:,:) 1470 DO jl=1,jpl 1471 evap_ice (:,:,jl) = zevap_ice (:,:) 1472 devap_ice(:,:,jl) = zdevap_ice(:,:) 1473 ENDDO 1474 ENDIF 1475 1476 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1477 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1478 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1479 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1480 #else 1481 ! runoffs and calving (put in emp_tot) 1421 1482 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1422 1483 IF( srcv(jpr_cal)%laction ) THEN … … 1437 1498 ENDIF 1438 1499 1439 CALL iom_put( 'snowpre' , sprecip ) ! Snow1440 IF( iom_use('snow_ao_cea') ) &1441 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snowover ice-free ocean (cell average)1442 IF( iom_use('snow_ai_cea') ) &1443 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1500 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1501 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1502 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1503 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1504 #endif 1444 1505 1445 1506 ! ! ========================= ! 1446 1507 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1447 1508 ! ! ========================= ! 1448 CASE( 'oce only' ) 1449 zqns_tot(:,: 1450 CASE( 'conservative' ) 1451 zqns_tot(:,: 1509 CASE( 'oce only' ) ! the required field is directly provided 1510 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1511 CASE( 'conservative' ) ! the required fields are directly provided 1512 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1452 1513 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1453 1514 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1454 1515 ELSE 1455 ! Set all category values equal for the moment1456 1516 DO jl=1,jpl 1457 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1517 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal 1458 1518 ENDDO 1459 1519 ENDIF 1460 CASE( 'oce and ice' ) 1461 zqns_tot(:,: 1520 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1521 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1462 1522 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1463 1523 DO jl=1,jpl … … 1466 1526 ENDDO 1467 1527 ELSE 1468 qns_tot(:,: 1528 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1469 1529 DO jl=1,jpl 1470 1530 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) … … 1472 1532 ENDDO 1473 1533 ENDIF 1474 CASE( 'mixed oce-ice' ) 1534 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1475 1535 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1476 1536 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1477 1537 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1478 1538 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1479 & + pist(:,:,1)* zicefr(:,:) ) )1539 & + pist(:,:,1) * zicefr(:,:) ) ) 1480 1540 END SELECT 1481 1541 !!gm … … 1487 1547 !! similar job should be done for snow and precipitation temperature 1488 1548 ! 1489 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1490 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1491 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1492 IF( iom_use('hflx_cal_cea') ) & 1493 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1494 ENDIF 1495 1496 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1497 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1498 1499 #if defined key_lim3 1500 CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1501 1502 ! --- evaporation --- ! 1503 ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 1504 ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 1505 ! but it is incoherent WITH the ice model 1506 DO jl=1,jpl 1507 evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1) 1508 ENDDO 1509 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 1510 1511 ! --- evaporation minus precipitation --- ! 1512 emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 1513 1549 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1550 zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1551 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 1552 IF( iom_use('hflx_cal_cea') ) CALL iom_put( 'hflx_cal_cea', - frcv(jpr_cal)%z3(:,:,1) * lfus ) ! heat flux from calving 1553 ENDIF 1554 1555 #if defined key_lim3 1514 1556 ! --- non solar flux over ocean --- ! 1515 1557 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1517 1559 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1518 1560 1519 ! --- heat flux associated with emp --- !1520 z snw(:,:) = 0._wp1521 CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing1522 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap1523 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip1524 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 1525 qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap1526 & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice1527 1528 ! --- heat content ofprecip over ice in J/m3 (to be used in 1D-thermo) --- !1561 ! --- heat flux associated with emp (W/m2) --- ! 1562 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn(:,:) & ! evap 1563 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1564 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean + snow melting 1565 ! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1566 ! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1567 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 1568 ! qevap_ice=0 since we consider Tice=0degC 1569 1570 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1529 1571 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1530 1572 1531 ! --- total non solar flux --- ! 1532 zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 1573 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1574 DO jl = 1, jpl 1575 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0degC 1576 END DO 1577 1578 ! --- total non solar flux (including evap/precip) --- ! 1579 zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) 1533 1580 1534 1581 ! --- in case both coupled/forced are active, we must mix values --- ! … … 1537 1584 qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 1538 1585 DO jl=1,jpl 1539 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1586 qns_ice (:,:,jl) = qns_ice (:,:,jl) * xcplmask(:,:,0) + zqns_ice (:,:,jl)* zmsk(:,:) 1587 qevap_ice(:,:,jl) = qevap_ice(:,:,jl) * xcplmask(:,:,0) + zqevap_ice(:,:,jl)* zmsk(:,:) 1540 1588 ENDDO 1541 1589 qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 1542 1590 qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:) 1543 !!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0)1591 qemp_ice (:,:) = qemp_ice(:,:) * xcplmask(:,:,0) + zqemp_ice(:,:)* zmsk(:,:) 1544 1592 ELSE 1545 1593 qns_tot (:,: ) = zqns_tot (:,: ) 1546 1594 qns_oce (:,: ) = zqns_oce (:,: ) 1547 1595 qns_ice (:,:,:) = zqns_ice (:,:,:) 1548 qprec_ice(:,:) = zqprec_ice(:,:) 1549 qemp_oce (:,:) = zqemp_oce (:,:) 1550 ENDIF 1551 1552 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1596 qevap_ice(:,:,:) = zqevap_ice(:,:,:) 1597 qprec_ice(:,: ) = zqprec_ice(:,: ) 1598 qemp_oce (:,: ) = zqemp_oce (:,: ) 1599 qemp_ice (:,: ) = zqemp_ice (:,: ) 1600 ENDIF 1601 1602 !! clem: we should output qemp_oce and qemp_ice (at least) 1603 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1604 !! these diags are not outputed yet 1605 !! IF( iom_use('hflx_rain_cea') ) CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) ) ! heat flux from rain (cell average) 1606 !! 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) 1607 !! IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put( 'hflx_snow_ai_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) ) ! heat flux from snow (cell average) 1608 1553 1609 #else 1554 ! 1555 ! clem: this formulation is certainly wrong... but better than it was before... 1610 ! clem: this formulation is certainly wrong... but better than it was... 1556 1611 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1557 1612 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1558 1613 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1559 & - zemp_ice(:,:) * zicefr(:,:)) * zcptn(:,:)1614 & - zemp_ice(:,:) ) * zcptn(:,:) 1560 1615 1561 1616 IF( ln_mixcpl ) THEN … … 1569 1624 qns_ice(:,:,:) = zqns_ice(:,:,:) 1570 1625 ENDIF 1571 !1572 1626 #endif 1627 1573 1628 ! ! ========================= ! 1574 1629 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) … … 1619 1674 1620 1675 #if defined key_lim3 1621 CALL wrk_alloc( jpi,jpj, zqsr_oce )1622 1676 ! --- solar flux over ocean --- ! 1623 1677 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1627 1681 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 1628 1682 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 1629 1630 CALL wrk_dealloc( jpi,jpj, zqsr_oce )1631 1683 #endif 1632 1684 … … 1679 1731 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1680 1732 1681 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1682 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1733 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1734 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1735 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1736 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1683 1737 ! 1684 1738 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 1719 1773 1720 1774 IF ( nn_components == jp_iam_opa ) THEN 1721 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l n_useCT on the received part1775 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 1722 1776 ELSE 1723 1777 ! we must send the surface potential temperature 1724 IF( l n_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )1778 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 1725 1779 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 1726 1780 ENDIF -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r6140 r6851 104 104 INTEGER, INTENT(in) :: kblk ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED) 105 105 !! 106 INTEGER :: jl ! dummy loop index 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean ice albedo (for coupled) 109 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice 110 !!---------------------------------------------------------------------- 111 112 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 106 INTEGER :: jl ! dummy loop index 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os , zalb_cs ! ice albedo under overcast/clear sky 108 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice 109 !!---------------------------------------------------------------------- 110 111 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 113 112 114 113 !-----------------------! … … 193 192 ! fr1_i0 , fr2_i0 : 1sr & 2nd fraction of qsr penetration in ice [%] 194 193 !---------------------------------------------------------------------------------------- 195 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs , zalb_ice)194 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 196 195 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 197 196 … … 199 198 CASE( jp_clio ) ! CLIO bulk formulation 200 199 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 201 ! ( zalb_ice) is computed within the bulk routine202 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice )203 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi= zalb_ice, psst=sst_m, pist=t_su )204 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )200 ! (alb_ice) is computed within the bulk routine 201 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice ) 202 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 203 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 205 204 CASE( jp_core ) ! CORE bulk formulation 206 205 ! albedo depends on cloud fraction because of non-linear spectral effects 207 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)208 CALL blk_ice_core_flx( t_su, zalb_ice )209 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi= zalb_ice, psst=sst_m, pist=t_su )210 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )206 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 207 CALL blk_ice_core_flx( t_su, alb_ice ) 208 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 209 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 211 210 CASE ( jp_purecpl ) 212 211 ! albedo depends on cloud fraction because of non-linear spectral effects 213 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 214 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 215 ! clem: evap_ice is forced to 0 in coupled mode for now 216 ! but it needs to be changed (along with modif in limthd_dh) once heat flux from evap will be avail. from atm. models 217 evap_ice (:,:,:) = 0._wp ; devap_ice (:,:,:) = 0._wp 218 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 212 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 213 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 214 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 219 215 END SELECT 220 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs , zalb_ice)216 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 221 217 222 218 !----------------------------! … … 260 256 !! ** purpose : Allocate all the dynamic arrays of the LIM-3 modules 261 257 !!---------------------------------------------------------------------- 262 INTEGER :: ierr258 INTEGER :: ji, jj, ierr 263 259 !!---------------------------------------------------------------------- 264 260 IF(lwp) WRITE(numout,*) … … 317 313 tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu 318 314 ! 315 DO jj = 1, jpj 316 DO ji = 1, jpi 317 IF( gphit(ji,jj) > 0._wp ) THEN ; rn_amax_2d(ji,jj) = rn_amax_n ! NH 318 ELSE ; rn_amax_2d(ji,jj) = rn_amax_s ! SH 319 ENDIF 320 ENDDO 321 ENDDO 322 ! 319 323 nstart = numit + nn_fsbc 320 324 nitrun = nitend - nit000 + 1 … … 339 343 INTEGER :: ios ! Local integer output status for namelist read 340 344 NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, & 341 & ln_limdyn, rn_amax , ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt345 & ln_limdyn, rn_amax_n, rn_amax_s, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt 342 346 !!------------------------------------------------------------------- 343 347 ! … … 359 363 WRITE(numout,*) ' number of snow layers = ', nlay_s 360 364 WRITE(numout,*) ' switch for ice dynamics (1) or not (0) ln_limdyn = ', ln_limdyn 361 WRITE(numout,*) ' maximum ice concentration = ', rn_amax 365 WRITE(numout,*) ' maximum ice concentration for NH = ', rn_amax_n 366 WRITE(numout,*) ' maximum ice concentration for SH = ', rn_amax_s 362 367 WRITE(numout,*) ' Diagnose heat/salt budget or not ln_limdiahsb = ', ln_limdiahsb 363 368 WRITE(numout,*) ' Output heat/salt budget or not ln_limdiaout = ', ln_limdiaout … … 568 573 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp 569 574 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 570 sfx_res(:,:) = 0._wp 575 sfx_res(:,:) = 0._wp ; sfx_sub(:,:) = 0._wp 571 576 ! 572 577 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp … … 584 589 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 585 590 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 586 hfx_err_dif(:,:) = 0._wp ; 591 hfx_err_dif(:,:) = 0._wp 592 wfx_err_sub(:,:) = 0._wp 587 593 ! 588 594 afx_tot(:,:) = 0._wp ; -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r6140 r6851 323 323 emp_b (:,:) = emp (:,:) 324 324 sfx_b (:,:) = sfx (:,:) 325 IF ( ln_rnf ) THEN 326 rnf_b (:,: ) = rnf (:,: ) 327 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 328 ENDIF 325 329 ENDIF 326 330 ! ! ---------------------------------------- ! … … 430 434 ! ! ---------------------------------------- ! 431 435 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 432 CALL iom_put( "empmr" , emp - rnf ) ! upward water flux 436 CALL iom_put( "empmr" , emp - rnf ) ! upward water flux 437 CALL iom_put( "empbmr" , emp_b - rnf ) ! before upward water flux ( needed to recalculate the time evolution of ssh in offline ) 433 438 CALL iom_put( "saltflx", sfx ) ! downward salt flux 434 439 ! (includes virtual salt flux beneath ice -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r6140 r6851 109 109 ! 110 110 CALL wrk_alloc( jpi,jpj, ztfrz) 111 112 ! ! ---------------------------------------- ! 113 IF( kt /= nit000 ) THEN ! Swap of forcing fields ! 114 ! ! ---------------------------------------- ! 115 rnf_b (:,: ) = rnf (:,: ) ! Swap the ocean forcing fields except at nit000 116 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) ! where before fields are set at the end of the routine 117 ! 118 ENDIF 119 111 ! 120 112 ! !-------------------! 121 113 ! ! Update runoff ! -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r6140 r6851 70 70 ssu_m(:,:) = ub(:,:,1) 71 71 ssv_m(:,:) = vb(:,:,1) 72 IF( l n_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )73 ELSE 72 IF( l_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 73 ELSE ; sst_m(:,:) = zts(:,:,jp_tem) 74 74 ENDIF 75 75 sss_m(:,:) = zts(:,:,jp_sal) … … 92 92 ssu_m(:,:) = zcoef * ub(:,:,1) 93 93 ssv_m(:,:) = zcoef * vb(:,:,1) 94 IF( l n_useCT ) THEN ; sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )95 ELSE 94 IF( l_useCT ) THEN ; sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 95 ELSE ; sst_m(:,:) = zcoef * zts(:,:,jp_tem) 96 96 ENDIF 97 97 sss_m(:,:) = zcoef * zts(:,:,jp_sal) … … 120 120 ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 121 121 ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 122 IF( l n_useCT ) THEN ; sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) )123 ELSE 122 IF( l_useCT ) THEN ; sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 123 ELSE ; sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 124 124 ENDIF 125 125 sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) … … 241 241 ssu_m(:,:) = ub(:,:,1) 242 242 ssv_m(:,:) = vb(:,:,1) 243 IF( l n_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) )244 ELSE 243 IF( l_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 244 ELSE ; sst_m(:,:) = tsn(:,:,1,jp_tem) 245 245 ENDIF 246 246 sss_m(:,:) = tsn (:,:,1,jp_sal) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r6140 r6851 22 22 !! - ! 2014-09 (F. Roquet) add TEOS-10, S-EOS, and modify EOS-80 23 23 !! - ! 2015-06 (P.A. Bouttier) eos_fzp functions changed to subroutines for AGRIF 24 !! - ! 2016-04 (F. Roquet) modify S-EOS as in Roquet et al. (JPO, 2015) + L-EOS 25 !! - ! 2016-04 (T. Graham, G. Madec) logicals instead of an integer as control of the EOS used 26 !! - ! 2016-07 (G. Madec, F. Roquet) generic freezing point for all EOS 24 27 !!---------------------------------------------------------------------- 25 28 26 29 !!---------------------------------------------------------------------- 27 30 !! eos : generic interface of the equation of state 28 !! eos_insitu : Compute the in situ density 29 !! eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass 30 !! eos_insitu_2d : Compute the in situ density for 2d fields 31 !! bn2 : Compute the Brunt-Vaisala frequency 31 !! eos_insitu : compute the in situ density 32 !! eos_insitu_pot: compute the insitu and surface referenced potential volumic mass 33 !! eos_insitu_2d : compute the in situ density for 2d fields 32 34 !! eos_rab : generic interface of in situ thermal/haline expansion ratio 33 35 !! eos_rab_3d : compute in situ thermal/haline expansion ratio 34 36 !! eos_rab_2d : compute in situ thermal/haline expansion ratio for 2d fields 37 !! bn2 : compute the Brunt-Vaisala frequency 38 !! eos_pt_from_ct: compute potential temperature from conservative temperature 35 39 !! eos_fzp_2d : freezing temperature for 2d fields 36 40 !! eos_fzp_0d : freezing temperature for scalar 41 !! eos_pen : Potential Energy diagnostics 37 42 !! eos_init : set eos parameters (namelist) 38 43 !!---------------------------------------------------------------------- … … 75 80 76 81 ! !!** Namelist nameos ** 77 INTEGER , PUBLIC :: nn_eos ! = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 78 LOGICAL , PUBLIC :: ln_useCT ! determine if eos_pt_from_ct is used to compute sst_m 79 80 ! !!! simplified eos coefficients (default value: Vallis 2006) 81 REAL(wp) :: rn_a0 = 1.6550e-1_wp ! thermal expansion coeff. 82 REAL(wp) :: rn_b0 = 7.6554e-1_wp ! saline expansion coeff. 83 REAL(wp) :: rn_lambda1 = 5.9520e-2_wp ! cabbeling coeff. in T^2 84 REAL(wp) :: rn_lambda2 = 5.4914e-4_wp ! cabbeling coeff. in S^2 85 REAL(wp) :: rn_mu1 = 1.4970e-4_wp ! thermobaric coeff. in T 86 REAL(wp) :: rn_mu2 = 1.1090e-5_wp ! thermobaric coeff. in S 87 REAL(wp) :: rn_nu = 2.4341e-3_wp ! cabbeling coeff. in theta*salt 82 ! ! Choice of Equation Of Seawater (EOS) 83 LOGICAL , PUBLIC :: ln_TEOS10 ! use the polyTEOS-10 EOS 84 LOGICAL , PUBLIC :: ln_EOS80 ! use the polyEOS-80 EOS 85 LOGICAL , PUBLIC :: ln_SEOS ! use the Simplified EOS (Roquet et al. JPO 2015) 86 LOGICAL , PUBLIC :: ln_LEOS ! use a Linear EOS 87 ! ! S-EOS coefficients (default value see Roquet et al. JPO 2015, Eq.17) 88 REAL(wp) :: rn_a0, rn_b0, rn_cb, rn_t0, rn_th 89 REAL(wp) :: rn_al, rn_bl ! L-EOS coefficients 90 91 LOGICAL , PUBLIC :: l_useCT ! =T in ln_TEOS10, ln_SEOS or ln_LEOS=T (i.e. use eos_pt_from_ct to compute sst_m), =F otherwise 92 INTEGER , PUBLIC :: neos ! Identifier for equation of state used 93 INTEGER , PARAMETER :: np_teos10 = -1 ! parameter for using TEOS-10 94 INTEGER , PARAMETER :: np_eos80 = 0 ! parameter for using EOS-80 95 INTEGER , PARAMETER :: np_seos = 1 ! parameter for using Simplified EOS 96 INTEGER , PARAMETER :: np_leos = 2 ! parameter for using Linear EOS 97 98 ! All EOS 99 REAL(wp) :: rSA2SP ! conversion factor from SA to SP (set to 1 for EOS-80) 88 100 89 101 ! TEOS10/EOS80 parameters … … 169 181 REAL(wp) :: BPE002 170 182 183 ! S-EOS (L-EOS) parameters 184 REAL(wp) :: SA0, SB0 , SCB , STH , ST0 185 171 186 !! * Substitutions 172 187 # include "vectopt_loop_substitute.h90" … … 184 199 !! ** Purpose : Compute the in situ density (ratio rho/rau0) from 185 200 !! potential temperature and salinity using an equation of state 186 !! defined through the namelist parameter nn_eos.201 !! selected in the nameos namelist 187 202 !! 188 203 !! ** Method : prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0 … … 194 209 !! rau0 reference density kg/m^3 195 210 !! 196 !! nn_eos = -1 : polynomial TEOS-10 equation of stateis used for rho(t,s,z).211 !! ln_TEOS10 : polynomial TEOS-10 Equation of Seawater is used for rho(t,s,z). 197 212 !! Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celcius, sa=35.5 g/kg 198 213 !! 199 !! nn_eos = 0 : polynomial EOS-80 equation of stateis used for rho(t,s,z).214 !! ln_EOS80 : polynomial EOS-80 Equation of Seawater is used for rho(t,s,z). 200 215 !! Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celcius, sp=35.5 psu 201 216 !! 202 !! nn_eos = 1 : simplified equation of state 203 !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0 204 !! linear case function of T only: rn_alpha<>0, other coefficients = 0 205 !! linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0 206 !! Vallis like equation: use default values of coefficients 217 !! ln_SEOS : simplified Equation of Seawater (Eq. (17) of Roquet et al. JPO 2015) 218 !! rd(T,S,Z) = [-(a0+.5*cb*(T-T0)+th*Z)*(T-T0) + b0*(S-35) ] / rau0 219 !! 220 !! ln_LEOS : linear Equation of Seawater 221 !! rd(T,S,Z) = [ -al*(T-10) + bl*(S-35) ] / rau0 222 !! 223 !! Note that both TEOS-10 and EOS-80 share a same polynomial expression 224 !! Note that both S-EOS and L-EOS share a same polynomial expression 207 225 !! 208 226 !! ** Action : compute prd , the in situ density (no units) 209 227 !! 210 !! References : Roquet et al , Ocean Modelling, in preparation (2014)211 !! Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006228 !! References : Roquet et al. 2015, Ocean Modelling. 229 !! Roquet et al. 2015, J. Phys. Oceanogr. 212 230 !! TEOS-10 Manual, 2010 213 231 !!---------------------------------------------------------------------- … … 224 242 IF( nn_timing == 1 ) CALL timing_start('eos-insitu') 225 243 ! 226 SELECT CASE( n n_eos )227 ! 228 CASE( -1, 0 ) !== polynomial TEOS-10 /EOS-80 ==!244 SELECT CASE( neos ) 245 ! 246 CASE( np_teos10 , np_eos80 ) !== polynomial TEOS-10 or EOS-80 ==! 229 247 ! 230 248 DO jk = 1, jpkm1 … … 266 284 END DO 267 285 ! 268 CASE( 1 ) !== simplifiedEOS ==!286 CASE( np_seos , np_leos ) !== simplified or linear EOS ==! 269 287 ! 270 288 DO jk = 1, jpkm1 271 289 DO jj = 1, jpj 272 290 DO ji = 1, jpi 273 zt = pts (ji,jj,jk,jp_tem) - 10._wp291 zt = pts (ji,jj,jk,jp_tem) - ST0 274 292 zs = pts (ji,jj,jk,jp_sal) - 35._wp 275 293 zh = pdep (ji,jj,jk) 276 294 ztm = tmask(ji,jj,jk) 277 295 ! 278 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 279 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 280 & - rn_nu * zt * zs 281 ! 296 zn = - ( SA0 + 0.5_wp*SCB * zt + STH * zh ) * zt + SB0 * zs 297 ! 282 298 prd(ji,jj,jk) = zn * r1_rau0 * ztm ! density anomaly (masked) 283 299 END DO … … 299 315 !! 300 316 !! ** Purpose : Compute the in situ density (ratio rho/rau0) and the 301 !! potential volumic mass (Kg/m3) from potential temperature and 302 !! salinity fields using an equation of state defined through the 303 !! namelist parameter nn_eos. 317 !! potential density (kg/m3) from temperature and salinity 318 !! fields using the equation of state selected in the namelist. 304 319 !! 305 320 !! ** Action : - prd , the in situ density (no units) 306 !! - prhop, the potential volumic mass (Kg/m3) 307 !! 321 !! - prhop, the potential density (kg/m3) 308 322 !!---------------------------------------------------------------------- 309 323 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] … … 322 336 IF( nn_timing == 1 ) CALL timing_start('eos-pot') 323 337 ! 324 SELECT CASE ( n n_eos )325 ! 326 CASE( -1, 0 ) !== polynomial TEOS-10 /EOS-80 ==!338 SELECT CASE ( neos ) 339 ! 340 CASE( np_teos10 , np_eos80 ) !== polynomial TEOS-10 or EOS-80 ==! 327 341 ! 328 342 ! Stochastic equation of state 329 343 IF ( ln_sto_eos ) THEN 330 ALLOCATE( zn0_sto(1:2*nn_sto_eos))331 ALLOCATE( zn_sto(1:2*nn_sto_eos))332 ALLOCATE( zsign(1:2*nn_sto_eos))344 ALLOCATE( zn0_sto(1:2*nn_sto_eos) ) 345 ALLOCATE( zn_sto (1:2*nn_sto_eos) ) 346 ALLOCATE( zsign (1:2*nn_sto_eos) ) 333 347 DO jsmp = 1, 2*nn_sto_eos, 2 334 348 zsign(jsmp) = 1._wp … … 387 401 END DO 388 402 END DO 389 DEALLOCATE( zn0_sto,zn_sto,zsign)390 ! Non-stochastic equation of state391 ELSE 403 DEALLOCATE( zn0_sto, zn_sto, zsign ) 404 ! 405 ELSE ! Non-stochastic equation of state 392 406 DO jk = 1, jpkm1 393 407 DO jj = 1, jpj … … 430 444 ENDIF 431 445 432 CASE( 1 ) !== simplifiedEOS ==!446 CASE( np_seos , np_leos ) !== simplified or linear EOS ==! 433 447 ! 434 448 DO jk = 1, jpkm1 435 449 DO jj = 1, jpj 436 450 DO ji = 1, jpi 437 zt = pts (ji,jj,jk,jp_tem) - 10._wp451 zt = pts (ji,jj,jk,jp_tem) - ST0 438 452 zs = pts (ji,jj,jk,jp_sal) - 35._wp 439 453 zh = pdep (ji,jj,jk) 440 454 ztm = tmask(ji,jj,jk) 441 455 ! ! potential density referenced at the surface 442 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 443 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 444 & - rn_nu * zt * zs 456 zn = - ( SA0 + 0.5_wp*SCB * zt ) * zt + SB0 * zs 445 457 prhop(ji,jj,jk) = ( rau0 + zn ) * ztm 446 458 ! ! density anomaly (masked) 447 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh459 zn = zn - STH * zh * zt 448 460 prd(ji,jj,jk) = zn * r1_rau0 * ztm 449 461 ! … … 466 478 !! 467 479 !! ** Purpose : Compute the in situ density (ratio rho/rau0) from 468 !! potentialtemperature and salinity using an equation of state469 !! defined through the namelist parameter nn_eos. * 2D field case480 !! temperature and salinity using an equation of state 481 !! selected in the nameos namelist. * 2D field case 470 482 !! 471 483 !! ** Action : - prd , the in situ density (no units) (unmasked) 472 !!473 484 !!---------------------------------------------------------------------- 474 485 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] … … 486 497 prd(:,:) = 0._wp 487 498 ! 488 SELECT CASE( n n_eos )489 ! 490 CASE( -1, 0 ) !== polynomial TEOS-10 /EOS-80 ==!499 SELECT CASE( neos ) 500 ! 501 CASE( np_teos10 , np_eos80 ) !== polynomial TEOS-10 or EOS-80 ==! 491 502 ! 492 503 DO jj = 1, jpjm1 … … 527 538 CALL lbc_lnk( prd, 'T', 1. ) ! Lateral boundary conditions 528 539 ! 529 CASE( 1 ) !== simplifiedEOS ==!540 CASE( np_seos , np_leos ) !== simplified or linear EOS ==! 530 541 ! 531 542 DO jj = 1, jpjm1 532 543 DO ji = 1, fs_jpim1 ! vector opt. 533 544 ! 534 zt = pts (ji,jj,jp_tem) - 10._wp545 zt = pts (ji,jj,jp_tem) - ST0 535 546 zs = pts (ji,jj,jp_sal) - 35._wp 536 547 zh = pdep (ji,jj) ! depth at the partial step level 537 548 ! 538 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 539 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 540 & - rn_nu * zt * zs 541 ! 549 zn = - ( SA0 + 0.5_wp*SCB * zt + STH * zh ) * zt + SB0 * zs 550 ! 542 551 prd(ji,jj) = zn * r1_rau0 ! unmasked in situ density anomaly 543 552 ! … … 576 585 IF( nn_timing == 1 ) CALL timing_start('rab_3d') 577 586 ! 578 SELECT CASE ( n n_eos )579 ! 580 CASE( -1, 0 ) !== polynomial TEOS-10 /EOS-80 ==!587 SELECT CASE ( neos ) 588 ! 589 CASE( np_teos10 , np_eos80 ) !== polynomial TEOS-10 or EOS-80 ==! 581 590 ! 582 591 DO jk = 1, jpkm1 … … 635 644 END DO 636 645 ! 637 CASE( 1 ) !== simplifiedEOS ==!646 CASE( np_seos , np_leos ) !== simplified or linear EOS ==! 638 647 ! 639 648 DO jk = 1, jpkm1 640 649 DO jj = 1, jpj 641 650 DO ji = 1, jpi 642 zt = pts (ji,jj,jk,jp_tem) - 10._wp! pot. temperature anomaly (t-T0)651 zt = pts (ji,jj,jk,jp_tem) - ST0 ! pot. temperature anomaly (t-T0) 643 652 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 644 653 zh = gdept_n(ji,jj,jk) ! depth in meters at t-point 645 654 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 646 655 ! 647 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 648 pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm ! alpha 649 ! 650 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 651 pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm ! beta 656 pab(ji,jj,jk,jp_tem) = ( SA0 + SCB * zt + STH * zh ) * r1_rau0 * ztm ! alpha 657 ! 658 pab(ji,jj,jk,jp_sal) = SB0 * r1_rau0 * ztm ! beta 652 659 ! 653 660 END DO … … 657 664 CASE DEFAULT 658 665 IF(lwp) WRITE(numout,cform_err) 659 IF(lwp) WRITE(numout,*) ' bad flag value for n n_eos = ', nn_eos666 IF(lwp) WRITE(numout,*) ' bad flag value for neos = ', neos 660 667 nstop = nstop + 1 661 668 ! … … 668 675 ! 669 676 END SUBROUTINE rab_3d 677 670 678 671 679 SUBROUTINE rab_2d( pts, pdep, pab ) … … 690 698 pab(:,:,:) = 0._wp 691 699 ! 692 SELECT CASE ( n n_eos )693 ! 694 CASE( -1, 0 ) !== polynomial TEOS-10 /EOS-80 ==!700 SELECT CASE ( neos ) 701 ! 702 CASE( np_teos10 , np_eos80 ) !== polynomial TEOS-10 or EOS-80 ==! 695 703 ! 696 704 DO jj = 1, jpjm1 … … 750 758 CALL lbc_lnk( pab(:,:,jp_sal), 'T', 1. ) 751 759 ! 752 CASE( 1 ) !== simplifiedEOS ==!760 CASE( np_seos , np_leos ) !== simplified or linear EOS ==! 753 761 ! 754 762 DO jj = 1, jpjm1 755 763 DO ji = 1, fs_jpim1 ! vector opt. 756 764 ! 757 zt = pts (ji,jj,jp_tem) - 10._wp! pot. temperature anomaly (t-T0)765 zt = pts (ji,jj,jp_tem) - ST0 ! pot. temperature anomaly (t-T0) 758 766 zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 759 767 zh = pdep (ji,jj) ! depth at the partial step level 760 768 ! 761 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 762 pab(ji,jj,jp_tem) = zn * r1_rau0 ! alpha 763 ! 764 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 765 pab(ji,jj,jp_sal) = zn * r1_rau0 ! beta 769 pab(ji,jj,jp_tem) = ( SA0 + SCB * zt + STH * zh ) * r1_rau0 ! alpha 770 ! 771 pab(ji,jj,jp_sal) = SB0 * r1_rau0 ! beta 766 772 ! 767 773 END DO … … 773 779 CASE DEFAULT 774 780 IF(lwp) WRITE(numout,cform_err) 775 IF(lwp) WRITE(numout,*) ' bad flag value for n n_eos = ', nn_eos781 IF(lwp) WRITE(numout,*) ' bad flag value for neos = ', neos 776 782 nstop = nstop + 1 777 783 ! … … 806 812 pab(:) = 0._wp 807 813 ! 808 SELECT CASE ( n n_eos )809 ! 810 CASE( -1, 0 ) !== polynomial TEOS-10 /EOS-80 ==!814 SELECT CASE ( neos ) 815 ! 816 CASE( np_teos10 , np_eos80 ) !== polynomial TEOS-10 or EOS-80 ==! 811 817 ! 812 818 ! … … 858 864 ! 859 865 ! 860 ! 861 CASE( 1 ) !== simplified EOS ==! 862 ! 863 zt = pts(jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 866 CASE( np_seos , np_leos ) !== simplified or linear EOS ==! 867 ! 868 zt = pts(jp_tem) - ST0 ! pot. temperature anomaly (t-T0) 864 869 zs = pts(jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 865 zh = pdep ! depth at the partial step level 866 ! 867 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 868 pab(jp_tem) = zn * r1_rau0 ! alpha 869 ! 870 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 871 pab(jp_sal) = zn * r1_rau0 ! beta 870 zh = pdep ! depth at the partial step level 871 ! 872 pab(jp_tem) = ( SA0 + SCB * zt + STH * zh ) * r1_rau0 ! alpha 873 ! 874 pab(jp_sal) = SB0 * r1_rau0 ! beta 872 875 ! 873 876 CASE DEFAULT 874 877 IF(lwp) WRITE(numout,cform_err) 875 IF(lwp) WRITE(numout,*) ' bad flag value for n n_eos = ', nn_eos878 IF(lwp) WRITE(numout,*) ' bad flag value for neos = ', neos 876 879 nstop = nstop + 1 877 880 ! … … 885 888 SUBROUTINE bn2( pts, pab, pn2 ) 886 889 !!---------------------------------------------------------------------- 887 !! *** ROUTINE bn2 ***890 !! *** ROUTINE bn2 *** 888 891 !! 889 892 !! ** Purpose : Compute the local Brunt-Vaisala frequency at the 890 893 !! time-step of the input arguments 891 894 !! 892 !! ** Method : pn2 = grav * (a lpha dk[T] + betadk[S] ) / e3w895 !! ** Method : pn2 = grav * (a*dk[T] + b*dk[S] ) / e3w 893 896 !! where alpha and beta are given in pab, and computed on T-points. 894 897 !! N.B. N^2 is set one for all to zero at jk=1 in istate module. 895 898 !! 896 899 !! ** Action : pn2 : square of the brunt-vaisala frequency at w-point 897 !!898 900 !!---------------------------------------------------------------------- 899 901 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celcius,psu] … … 999 1001 !! checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m 1000 1002 !! 1003 !! Note1: ptf is the IN SITU freezing temperature. It is equal to the potential 1004 !! one when pdep=0 (or pdep is not present). 1005 !! Potential freezing point is what is needed by sea-ice model 1006 !! Note2: This formulation needs a salinity given in Practical Salinity Units (PSU) 1007 !! With other EOS than EOS-80, the salinity is multiplied by a factor 1008 !! of 35/35.16504 to convert salinity from Absolute to Practical. 1009 !! This approximation leads to a ~0.003.degrees rms difference with the 1010 !! exact value of the freezing point. 1011 !! 1001 1012 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978 1002 1013 !!---------------------------------------------------------------------- … … 1009 1020 !!---------------------------------------------------------------------- 1010 1021 ! 1011 SELECT CASE ( nn_eos ) 1012 ! 1013 CASE ( -1, 1 ) !== CT,SA (TEOS-10 formulation) ==! 1014 ! 1015 DO jj = 1, jpj 1016 DO ji = 1, jpi 1017 zs= SQRT( ABS( psal(ji,jj) ) * r1_S0 ) ! square root salinity 1018 ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1019 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 1020 END DO 1021 END DO 1022 ptf(:,:) = ptf(:,:) * psal(:,:) 1023 ! 1024 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1025 ! 1026 CASE ( 0 ) !== PT,SP (UNESCO formulation) ==! 1027 ! 1028 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) & 1029 & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:) 1030 ! 1031 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1032 ! 1033 CASE DEFAULT 1034 IF(lwp) WRITE(numout,cform_err) 1035 IF(lwp) WRITE(numout,*) ' bad flag value for nn_eos = ', nn_eos 1036 nstop = nstop + 1 1037 ! 1038 END SELECT 1022 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) * rSA2SP ) & 1023 & - 2.154996e-4_wp * psal(:,:) * rSA2SP ) * psal(:,:) * rSA2SP 1024 ! 1025 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1039 1026 ! 1040 1027 END SUBROUTINE eos_fzp_2d 1028 1041 1029 1042 1030 SUBROUTINE eos_fzp_0d( psal, ptf, pdep ) … … 1059 1047 !!---------------------------------------------------------------------- 1060 1048 ! 1061 SELECT CASE ( nn_eos ) 1062 ! 1063 CASE ( -1, 1 ) !== CT,SA (TEOS-10 formulation) ==! 1064 ! 1065 zs = SQRT( ABS( psal ) * r1_S0 ) ! square root salinity 1066 ptf = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1067 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 1068 ptf = ptf * psal 1069 ! 1070 IF( PRESENT( pdep ) ) ptf = ptf - 7.53e-4 * pdep 1071 ! 1072 CASE ( 0 ) !== PT,SP (UNESCO formulation) ==! 1073 ! 1074 ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal ) & 1075 & - 2.154996e-4_wp * psal ) * psal 1076 ! 1077 IF( PRESENT( pdep ) ) ptf = ptf - 7.53e-4 * pdep 1078 ! 1079 CASE DEFAULT 1080 IF(lwp) WRITE(numout,cform_err) 1081 IF(lwp) WRITE(numout,*) ' bad flag value for nn_eos = ', nn_eos 1082 nstop = nstop + 1 1083 ! 1084 END SELECT 1049 ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal * rSA2SP ) & 1050 & - 2.154996e-4_wp * psal * rSA2SP ) * psal * rSA2SP 1051 ! 1052 IF( PRESENT( pdep ) ) ptf = ptf - 7.53e-4 * pdep 1085 1053 ! 1086 1054 END SUBROUTINE eos_fzp_0d … … 1109 1077 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 1110 1078 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab_pe ! alpha_pe and beta_pe 1111 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: ppen 1079 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: ppen ! potential energy anomaly 1112 1080 ! 1113 1081 INTEGER :: ji, jj, jk ! dummy loop indices … … 1118 1086 IF( nn_timing == 1 ) CALL timing_start('eos_pen') 1119 1087 ! 1120 SELECT CASE ( n n_eos )1121 ! 1122 CASE( -1, 0 ) !== polynomial TEOS-10 /EOS-80 ==!1088 SELECT CASE ( neos ) 1089 ! 1090 CASE( np_teos10 , np_eos80 ) !== polynomial TEOS-10 or EOS-80 ==! 1123 1091 ! 1124 1092 DO jk = 1, jpkm1 … … 1183 1151 END DO 1184 1152 ! 1185 CASE( 1 ) !== Vallis (2006) simplifiedEOS ==!1153 CASE( np_seos , np_leos ) !== simplified or linear EOS ==! 1186 1154 ! 1187 1155 DO jk = 1, jpkm1 1188 1156 DO jj = 1, jpj 1189 1157 DO ji = 1, jpi 1190 zt = pts(ji,jj,jk,jp_tem) - 10._wp! temperature anomaly (t-T0)1191 zs = pts(ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0)1158 zt = pts(ji,jj,jk,jp_tem) - ST0 ! temperature anomaly (t-T0) 1159 zs = pts(ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 1192 1160 zh = gdept_n(ji,jj,jk) ! depth in meters at t-point 1193 1161 ztm = tmask(ji,jj,jk) ! tmask 1194 1162 zn = 0.5_wp * zh * r1_rau0 * ztm 1195 1163 ! ! Potential Energy 1196 ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs )* zn1164 ppen(ji,jj,jk) = STH * zt * zn 1197 1165 ! ! alphaPE 1198 pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1* zn1199 pab_pe(ji,jj,jk,jp_sal) = rn_b0 * rn_mu2 * zn1166 pab_pe(ji,jj,jk,jp_tem) = - STH * zn 1167 pab_pe(ji,jj,jk,jp_sal) = 0._wp 1200 1168 ! 1201 1169 END DO … … 1205 1173 CASE DEFAULT 1206 1174 IF(lwp) WRITE(numout,cform_err) 1207 IF(lwp) WRITE(numout,*) ' bad flag value for n n_eos = ', nn_eos1175 IF(lwp) WRITE(numout,*) ' bad flag value for neos = ', neos 1208 1176 nstop = nstop + 1 1209 1177 ! … … 1223 1191 !! ** Method : Read the namelist nameos and control the parameters 1224 1192 !!---------------------------------------------------------------------- 1225 INTEGER :: ios ! local integer 1226 !! 1227 NAMELIST/nameos/ nn_eos, ln_useCT, rn_a0, rn_b0, rn_lambda1, rn_mu1, & 1228 & rn_lambda2, rn_mu2, rn_nu 1193 INTEGER :: ios, ioptio ! local integer 1194 !! 1195 NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, ln_LEOS, & ! EOS choice 1196 & rn_a0, rn_b0, rn_cb, rn_t0, rn_th, & ! S-EOS parameters 1197 & rn_al, rn_bl ! L-EOS - - 1229 1198 !!---------------------------------------------------------------------- 1230 1199 ! … … 1238 1207 IF(lwm) WRITE( numond, nameos ) 1239 1208 ! 1240 rau0 = 1026._wp !: volumic mass of reference[kg/m3]1241 rcp = 3991.86795711963_wp !: heat capacity[J/K]1209 rau0 = 1026._wp !: density of reference [kg/m3] 1210 rcp = 3991.86795711963_wp !: heat capacity [J/K] 1242 1211 ! 1243 1212 IF(lwp) THEN ! Control print … … 1245 1214 WRITE(numout,*) 'eos_init : equation of state' 1246 1215 WRITE(numout,*) '~~~~~~~~' 1247 WRITE(numout,*) ' Namelist nameos : set eos parameters' 1248 WRITE(numout,*) ' flag for eq. of state and N^2 nn_eos = ', nn_eos 1249 IF( ln_useCT ) THEN 1250 WRITE(numout,*) ' model uses Conservative Temperature' 1251 WRITE(numout,*) ' Important: model must be initialized with CT and SA fields' 1252 ELSE 1253 WRITE(numout,*) ' model does not use Conservative Temperature' 1254 ENDIF 1216 WRITE(numout,*) ' Namelist nameos : Chosen the Equation Of Seawater (EOS)' 1217 WRITE(numout,*) ' TEOS-10 : rho(Conservative Temperature, Absolute Salinity, depth) ln_TEOS10 = ', ln_TEOS10 1218 WRITE(numout,*) ' EOS-80 : rho(Potential Temperature, Practical Salinity, depth) ln_EOS80 = ', ln_EOS80 1219 WRITE(numout,*) ' S-EOS : rho(Conservative Temperature, Absolute Salinity, depth) ln_SEOS = ', ln_SEOS 1220 WRITE(numout,*) ' L-EOS : rho(Conservative Temperature, Absolute Salinity ) ln_LEOS = ', ln_LEOS 1255 1221 ENDIF 1256 ! 1257 SELECT CASE( nn_eos ) ! check option 1258 ! 1259 CASE( -1 ) !== polynomial TEOS-10 ==! 1222 1223 ! Check options for equation of state & set neos based on logical flags 1224 ioptio = 0 1225 IF( ln_TEOS10 ) THEN ; ioptio = ioptio+1 ; neos = np_teos10 ; ENDIF 1226 IF( ln_EOS80 ) THEN ; ioptio = ioptio+1 ; neos = np_eos80 ; ENDIF 1227 IF( ln_SEOS ) THEN ; ioptio = ioptio+1 ; neos = np_seos ; ENDIF 1228 IF( ln_LEOS ) THEN ; ioptio = ioptio+1 ; neos = np_leos ; ENDIF 1229 IF( ioptio /= 1 ) CALL ctl_stop("Exactly one equation of state option must be selected") 1230 ! 1231 SELECT CASE( neos ) ! check option 1232 ! 1233 CASE( np_teos10 ) !== polynomial TEOS-10 ==! 1260 1234 IF(lwp) WRITE(numout,*) 1261 1235 IF(lwp) WRITE(numout,*) ' use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 1236 ! 1237 l_useCT = .TRUE. ! model temperature is Conservative temperature 1238 rSA2SP = 35._wp / 35.16504_wp ! model salinity is Absolute Salinity (= conversion from SA to SP) 1262 1239 ! 1263 1240 rdeltaS = 32._wp … … 1446 1423 BPE002 = 1.7269476440e-04_wp 1447 1424 ! 1448 CASE( 0 ) !== polynomial EOS-80 formulation ==!1425 CASE( np_eos80 ) !== polynomial EOS-80 formulation ==! 1449 1426 ! 1450 1427 IF(lwp) WRITE(numout,*) 1451 1428 IF(lwp) WRITE(numout,*) ' use of EOS-80 equation of state (pot. temp. and pract. salinity)' 1429 ! 1430 l_useCT = .FALSE. ! model temperature is Potential temperature 1431 rSA2SP = 1._wp ! model salinity is SP (Practical Salinity) ==>> rSA2SP=1 1452 1432 ! 1453 1433 rdeltaS = 20._wp … … 1636 1616 BPE002 = 5.3661089288e-04_wp 1637 1617 ! 1638 CASE( 1 ) !== Simplified EOS==!1618 CASE( np_seos ) !== Simplified EOS ==! 1639 1619 IF(lwp) THEN 1640 1620 WRITE(numout,*) 1641 WRITE(numout,*) ' use of simplified eos: rhd(dT=T-10,dS=S-35,Z) = ' 1642 WRITE(numout,*) ' [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0' 1621 WRITE(numout,*) ' use of simplified eos (S-EOS): ' 1622 WRITE(numout,*) ' rhd(dT=CT-T0,dS=SA-35,Z) = [ - (a0 + cb/2*dT + th*Z )*dT + b0*dS ] / rau0' 1623 WRITE(numout,*) ' with' 1624 WRITE(numout,*) ' linear thermal expansion coef. a0 = rn_a0 = ', rn_a0 1625 WRITE(numout,*) ' haline contraction coef. b0 = rn_b0 = ', rn_b0 1626 WRITE(numout,*) ' cabbeling coef. cb = rn_cb = ', rn_cb 1627 WRITE(numout,*) ' reference temperature coef. T0 = rn_t0 = ', rn_t0 1628 WRITE(numout,*) ' thermobaric coef. th = rn_th = ', rn_th 1643 1629 WRITE(numout,*) 1644 WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a01645 WRITE(numout,*) ' saline cont. coef. rn_b0 = ', rn_b01646 WRITE(numout,*) ' cabbeling coef. rn_lambda1 = ', rn_lambda11647 WRITE(numout,*) ' cabbeling coef. rn_lambda2 = ', rn_lambda21648 WRITE(numout,*) ' thermobar. coef. rn_mu1 = ', rn_mu11649 WRITE(numout,*) ' thermobar. coef. rn_mu2 = ', rn_mu21650 WRITE(numout,*) ' 2nd cabbel. coef. rn_nu = ', rn_nu1651 WRITE(numout,*) ' Caution: rn_beta0=0 incompatible with ddm parameterization '1652 1630 ENDIF 1653 ! 1654 CASE DEFAULT !== ERROR in nn_eos ==! 1655 WRITE(ctmp1,*) ' bad flag value for nn_eos = ', nn_eos 1631 IF( rn_b0 == 0._wp ) CALL ctl_warn('eos_init: rn_b0=0 incompatible with ddm parameterization ') 1632 IF( rn_a0 == 0._wp .AND. rn_cb == 0._wp ) CALL ctl_stop('eos_init: S-EOS need non zero a0 or cb') 1633 ! 1634 l_useCT = .TRUE. ! Use Conservative Temperature 1635 rSA2SP = 35._wp / 35.16504_wp ! model salinity is Absolute Salinity (= conversion from SA to SP) 1636 ! 1637 SA0 = rn_a0 1638 SB0 = rn_b0 1639 SCB = rn_cb 1640 ST0 = rn_t0 1641 STH = rn_th 1642 ! 1643 CASE( np_leos ) !== Linear EOS ==! 1644 IF(lwp) THEN 1645 WRITE(numout,*) 1646 WRITE(numout,*) ' use of linear eos (L-EOS): ' 1647 WRITE(numout,*) ' rhd(dT=CT-10,dS=SA-35) = [ - al*dT + bl*dS ] / rau0' 1648 WRITE(numout,*) ' with' 1649 WRITE(numout,*) ' thermal expansion coef. al = rn_al = ', rn_al 1650 WRITE(numout,*) ' haline contraction coef. bl = rn_bl = ', rn_bl 1651 WRITE(numout,*) 1652 ENDIF 1653 IF( rn_bl == 0._wp ) CALL ctl_warn('eos_init: rn_bl=0 incompatible with ddm parameterization ') 1654 ! 1655 l_useCT = .TRUE. ! Use Conservative Temperature 1656 rSA2SP = 35._wp / 35.16504_wp ! model salinity is Absolute Salinity (= conversion from SA to SP) 1657 ! 1658 SA0 = rn_al 1659 SB0 = rn_bl 1660 SCB = 0._wp 1661 ST0 = 10._wp 1662 STH = 0._wp 1663 ! 1664 CASE DEFAULT !== ERROR in neos ==! 1665 WRITE(ctmp1,*) ' bad flag value for neos = ', neos, '. You should never see this error' 1656 1666 CALL ctl_stop( ctmp1 ) 1657 1667 ! … … 1663 1673 r1_rau0_rcp = 1._wp / rau0_rcp 1664 1674 ! 1675 IF(lwp) THEN 1676 IF( l_useCT ) THEN 1677 WRITE(numout,*) ' The ocean model uses Conservative Temperature and Absolute Salinity' 1678 WRITE(numout,*) ' Important: model initialization must be with CT and SA fields' 1679 ELSE 1680 WRITE(numout,*) ' model use Potential Temperature and Practical salinity' 1681 ENDIF 1682 ENDIF 1683 ! 1665 1684 IF(lwp) WRITE(numout,*) 1666 IF(lwp) WRITE(numout,*) ' volumic mass of reference rau0= ', rau0 , ' kg/m^3'1667 IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0= ', r1_rau0, ' m^3/kg'1668 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp 1669 IF(lwp) WRITE(numout,*) ' rau0 * rcp 1670 IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) 1685 IF(lwp) WRITE(numout,*) ' density of reference rau0 = ', rau0 , ' kg/m^3' 1686 IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0 = ', r1_rau0, ' m^3/kg' 1687 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin' 1688 IF(lwp) WRITE(numout,*) ' rau0 * rcp rau0_rcp = ', rau0_rcp 1689 IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp 1671 1690 ! 1672 1691 END SUBROUTINE eos_init -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r6140 r6851 122 122 ! 123 123 CALL tra_bbl_dif( tsb, tsa, jpts ) 124 IF( ln_ctl ) & 125 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & 126 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 124 IF( ln_ctl ) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & 125 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 127 126 ! lateral boundary conditions ; just need for outputs 128 127 CALL lbc_lnk( ahu_bbl, 'U', 1. ) ; CALL lbc_lnk( ahv_bbl, 'V', 1. ) … … 255 254 DO jj = 1, jpjm1 256 255 DO ji = 1, jpim1 ! CAUTION start from i=1 to update i=2 when cyclic east-west 257 IF( utr_bbl(ji,jj) /= 0. e0) THEN ! non-zero i-direction bbl advection256 IF( utr_bbl(ji,jj) /= 0._wp ) THEN ! non-zero i-direction bbl advection 258 257 ! down-slope i/k-indices (deep) & up-slope i/k indices (shelf) 259 258 iid = ji + MAX( 0, mgrhu(ji,jj) ) ; iis = ji + 1 - MAX( 0, mgrhu(ji,jj) ) … … 277 276 ENDIF 278 277 ! 279 IF( vtr_bbl(ji,jj) /= 0. e0) THEN ! non-zero j-direction bbl advection278 IF( vtr_bbl(ji,jj) /= 0._wp ) THEN ! non-zero j-direction bbl advection 280 279 ! down-slope j/k-indices (deep) & up-slope j/k indices (shelf) 281 280 ijd = jj + MAX( 0, mgrhv(ji,jj) ) ; ijs = jj + 1 - MAX( 0, mgrhv(ji,jj) ) … … 452 451 zgdrho = 0.5 * ( za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) ) & 453 452 & - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) ) ) * umask(ji,jj,1) 454 zgdrho = MAX( 0. e0, zgdrho ) ! only if shelf is denser than deep453 zgdrho = MAX( 0._wp, zgdrho ) ! only if shelf is denser than deep 455 454 ! 456 455 ! ! bbl transport (down-slope direction) … … 470 469 zgdrho = 0.5 * ( za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) ) & 471 470 & - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) ) ) * vmask(ji,jj,1) 472 zgdrho = MAX( 0. e0, zgdrho ) ! only if shelf is denser than deep471 zgdrho = MAX( 0._wp, zgdrho ) ! only if shelf is denser than deep 473 472 ! 474 473 ! ! bbl transport (down-slope direction) … … 549 548 DO jj = 1, jpjm1 550 549 DO ji = 1, jpim1 551 mgrhu(ji,jj) = INT( SIGN( 1. e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) )552 mgrhv(ji,jj) = INT( SIGN( 1. e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) )550 mgrhu(ji,jj) = INT( SIGN( 1._wp, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 551 mgrhv(ji,jj) = INT( SIGN( 1._wp, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 553 552 END DO 554 553 END DO … … 573 572 ij0 = 102 ; ij1 = 102 ! Gibraltar enhancement of BBL 574 573 ii0 = 139 ; ii1 = 140 575 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4. e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))576 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4. e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))574 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4._wp*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 575 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4._wp*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 577 576 ! 578 577 ij0 = 88 ; ij1 = 88 ! Red Sea enhancement of BBL 579 578 ii0 = 161 ; ii1 = 162 580 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10. e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))581 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10. e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))579 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10._wp*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 580 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10._wp*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 582 581 ! 583 582 CASE ( 4 ) ! ORCA_R4 584 583 ij0 = 52 ; ij1 = 52 ! Gibraltar enhancement of BBL 585 584 ii0 = 70 ; ii1 = 71 586 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4. e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))587 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4. e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))585 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4._wp*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 586 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4._wp*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 588 587 END SELECT 589 588 ! -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r6140 r6851 178 178 IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) ) & 179 179 & CALL ctl_stop( 'eddy induced velocity on tracers requires iso-neutral laplacian diffusion' ) 180 IF( ln_isfcav .AND. ln_traldf_triad ) & 181 & CALL ctl_stop( ' ice shelf cavity and traldf_triad not tested' ) 180 182 ! 181 183 IF( nldf == np_lap_i .OR. nldf == np_lap_it .OR. & -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r6347 r6851 11 11 !! 3.2 ! 2009-04 (G. Madec & NEMO team) 12 12 !! 3.6 ! 2012-05 (C. Rousset) store attenuation coef for use in ice model 13 !! -! 2015-12 (O. Aumont, J. Jouanno, C. Ethe) use vertical profile of chlorophyll14 !! 3.7 ! 201 6-01 (G. Madec, A. Coward) remove optimisation for fix volume13 !! 3.6 ! 2015-12 (O. Aumont, J. Jouanno, C. Ethe) use vertical profile of chlorophyll 14 !! 3.7 ! 2015-11 (G. Madec, A. Coward) remove optimisation for fix volume 15 15 !!---------------------------------------------------------------------- 16 16 … … 56 56 INTEGER , PUBLIC :: nksr !: levels below which the light cannot penetrate (depth larger than 391 m) 57 57 58 INTEGER, PARAMETER :: np_RGB = 1 ! R-G-B light penetration with constant Chlorophyll 59 INTEGER, PARAMETER :: np_2BD = 2 ! 2 bands light penetration 60 INTEGER, PARAMETER :: np_BIO = 3 ! bio-model light penetration 58 INTEGER, PARAMETER :: np_RGB = 1 ! R-G-B light penetration with constant Chlorophyll 59 INTEGER, PARAMETER :: np_RGBc = 2 ! R-G-B light penetration with Chlorophyll data 60 INTEGER, PARAMETER :: np_2BD = 3 ! 2 bands light penetration 61 INTEGER, PARAMETER :: np_BIO = 4 ! bio-model light penetration 61 62 ! 62 63 INTEGER :: nqsr ! user choice of the type of light penetration 63 64 REAL(wp) :: xsi0r ! inverse of rn_si0 64 65 REAL(wp) :: xsi1r ! inverse of rn_si1 65 66 REAL(wp) :: rChl_0 = 0.05_wp ! value of Chlorophyll used in case of constant Chlorophyll67 66 ! 68 67 REAL(wp) , DIMENSION(3,61) :: rkrgb ! tabulated attenuation coefficients for RGB absorption 69 TYPE(FLD), DIMENSION(:), ALLOCATABLE:: sf_chl ! structure of input Chl (file informations, fields read)68 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read) 70 69 71 70 !! * Substitutions … … 110 109 REAL(wp) :: zchl, zcoef, z1_2 ! local scalars 111 110 REAL(wp) :: zc0 , zc1 , zc2 , zc3 ! - - 111 REAL(wp) :: zzc0, zzc1, zzc2, zzc3 ! - - 112 112 REAL(wp) :: zz0 , zz1 ! - - 113 REAL(wp) :: zCb, zCmax, zze, z 1_ze, zpsi, zpsimax, zdelpsi, zCtot, zCze113 REAL(wp) :: zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 114 114 REAL(wp) :: zlogc, zlogc2, zlogc3 115 115 REAL(wp), POINTER, DIMENSION(:,:) :: zekb, zekg, zekr 116 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, z chl3d, ztrdt117 REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot 116 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 117 REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot, zchl3d 118 118 !!---------------------------------------------------------------------- 119 119 ! … … 153 153 ! !--------------------------------! 154 154 ! 155 CASE( np_BIO ) !== bio-model fluxes ==!155 CASE( np_BIO ) !== bio-model fluxes ==! 156 156 ! 157 157 DO jk = 1, nksr … … 159 159 END DO 160 160 ! 161 CASE( np_RGB )!== R-G-B fluxes ==!161 CASE( np_RGB , np_RGBc ) !== R-G-B fluxes ==! 162 162 ! 163 163 CALL wrk_alloc( jpi,jpj, zekb, zekg, zekr ) 164 164 CALL wrk_alloc( jpi,jpj,jpk, ze0, ze1, ze2, ze3, zea, zchl3d ) 165 165 ! 166 SELECT CASE( nn_chldta ) ! set 3D chlorophyll field 167 ! 168 CASE( 0 ) ! constant 166 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll 167 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 169 168 DO jk = 1, nksr + 1 170 zchl3d(:,:,jk) = rChl_0 171 END DO 172 ! 173 CASE( 1 ) ! surface chlorophyl data spread uniformly on the vertical 174 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 175 DO jk = 1, nksr + 1 ! uniform vertical profile 176 zchl3d(:,:,jk) = sf_chl(1)%fnow(:,:,1) 177 END DO 178 ! 179 CASE( 2 ) ! surface chlorophyl data + Morel and Berthon (1989) profile 180 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 181 DO jj = 2, jpjm1 ! Chl profile = F( surface Chl value) 182 DO ji = fs_2, fs_jpim1 183 zchl = sf_chl(1)%fnow(ji,jj,1) 184 zCtot = 40.6_wp * zchl**0.459 185 zze = 568.2_wp * zCtot**(-0.746) 186 IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293) 187 zlogc = LOG( zchl ) 188 !!gm : instead of this : 189 zlogc2 = zlogc * zlogc 190 zlogc3 = zlogc * zlogc * zlogc 191 zCb = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3 192 zCmax = 0.299 - 0.289 * zlogc + 0.579 * zlogc2 193 zpsimax = 0.6 - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3 194 zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2 195 !!gm faster & more precise: 196 ! zCb = 0.768 + zlogc * ( ( 0.087 + zlogc * (- 0.179 - zlogc * 0.025 ) ) 197 ! zCmax = 0.299 + zlogc * ( - 0.289 + zlogc * 0.579 ) 198 ! zpsimax = 0.6 + zlogc * ( (- 0.640 + zlogc * ( 0.021 + zlogc * 0.115 ) ) 199 ! zdelpsi = 0.710 + zlogc * ( 0.159 + zlogc * 0.021 ) 200 !!gm end 201 zCze = 1.12_wp * (zchl)**0.803 202 z1_ze = 1._wp / zze 203 DO jk = 1, nksr + 1 204 zpsi = gdept_n(ji,jj,jk) * z1_ze 169 DO jj = 2, jpjm1 ! Separation in R-G-B depending of the surface Chl 170 DO ji = fs_2, fs_jpim1 171 zchl = sf_chl(1)%fnow(ji,jj,1) 172 zCtot = 40.6 * zchl**0.459 173 zze = 568.2 * zCtot**(-0.746) 174 IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293) 175 zpsi = gdepw_n(ji,jj,jk) / zze 176 ! 177 zlogc = LOG( zchl ) 178 zlogc2 = zlogc * zlogc 179 zlogc3 = zlogc * zlogc * zlogc 180 zCb = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3 181 zCmax = 0.299 - 0.289 * zlogc + 0.579 * zlogc2 182 zpsimax = 0.6 - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3 183 zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2 184 zCze = 1.12 * (zchl)**0.803 185 ! 205 186 zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) ) 206 187 END DO 188 ! 207 189 END DO 208 190 END DO 209 ! 210 END SELECT 191 ELSE !* constant chrlorophyll 192 DO jk = 1, nksr + 1 193 zchl3d(:,:,jk) = 0.05 194 ENDDO 195 ENDIF 211 196 ! 212 197 zcoef = ( 1. - rn_abs ) / 3._wp !* surface equi-partition in R-G-B … … 221 206 END DO 222 207 ! 223 DO jk = 2, nksr+1 !* interior partition in R-G-B function of 3DChl208 DO jk = 2, nksr+1 !* interior equi-partition in R-G-B depending of vertical profile of Chl 224 209 DO jj = 2, jpjm1 225 210 DO ji = fs_2, fs_jpim1 226 zchl = MIN( 10. _wp , MAX( 0.03_wp, zchl3d(ji,jj,jk) ) )227 irgb = NINT( 41 ._wp + 20._wp *LOG10(zchl) + 1.e-15 )211 zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) ) 212 irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 228 213 zekb(ji,jj) = rkrgb(1,irgb) 229 214 zekg(ji,jj) = rkrgb(2,irgb) … … 231 216 END DO 232 217 END DO 218 233 219 DO jj = 2, jpjm1 234 220 DO ji = fs_2, fs_jpim1 … … 254 240 END DO 255 241 ! 256 CALL wrk_dealloc( jpi,jpj, zekb, zekg, zekr)242 CALL wrk_dealloc( jpi,jpj, zekb, zekg, zekr ) 257 243 CALL wrk_dealloc( jpi,jpj,jpk, ze0, ze1, ze2, ze3, zea, zchl3d ) 258 244 ! … … 344 330 INTEGER :: ji, jj, jk ! dummy loop indices 345 331 INTEGER :: ios, irgb, ierror, ioptio ! local integer 346 ! REAL(wp) :: zz0, zc0 , zc1, zcoef ! local scalars347 ! REAL(wp) :: zz1, zc2 , zc3, zchl ! - -348 332 ! 349 333 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files … … 374 358 WRITE(numout,*) ' bio-model light penetration ln_qsr_bio = ', ln_qsr_bio 375 359 WRITE(numout,*) ' light penetration for ice-model (LIM3) ln_qsr_ice = ', ln_qsr_ice 376 WRITE(numout,*) ' RGB : Chl data (=1 ,2) or cst value (=0)nn_chldta = ', nn_chldta360 WRITE(numout,*) ' RGB : Chl data (=1) or cst value (=0) nn_chldta = ', nn_chldta 377 361 WRITE(numout,*) ' RGB & 2 bands: fraction of light (rn_si1) rn_abs = ', rn_abs 378 362 WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0 … … 390 374 ! 391 375 IF( ln_qsr_rgb .AND. nn_chldta == 0 ) nqsr = np_RGB 376 IF( ln_qsr_rgb .AND. nn_chldta == 1 ) nqsr = np_RGBc 392 377 IF( ln_qsr_2bd ) nqsr = np_2BD 393 378 IF( ln_qsr_bio ) nqsr = np_BIO … … 399 384 SELECT CASE( nqsr ) 400 385 ! 401 CASE( np_RGB )!== Red-Green-Blue light penetration ==!386 CASE( np_RGB , np_RGBc ) !== Red-Green-Blue light penetration ==! 402 387 ! 403 388 IF(lwp) WRITE(numout,*) ' R-G-B light penetration ' … … 409 394 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m' 410 395 ! 411 SELECT CASE( nn_chldta ) ! set 3D chlorophyll field 412 CASE( 0 ) ! constant 413 IF(lwp) WRITE(numout,*) ' constant Chlorophyll set to rChl_0 =', rChl_0 414 ! 415 CASE( 1 , 2 ) ! 3D chlorophyl field : read 2D surface data 416 ! 417 IF(lwp) WRITE(numout,*) ' surface 2D Chlorophyll field read in a file' 396 IF( nqsr == np_RGBc ) THEN ! Chl data : set sf_chl structure 397 IF(lwp) WRITE(numout,*) ' Chlorophyll read in a file' 418 398 ALLOCATE( sf_chl(1), STAT=ierror ) 419 399 IF( ierror > 0 ) THEN … … 425 405 CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init', & 426 406 & 'Solar penetration function of read chlorophyll', 'namtra_qsr' ) 427 ! 428 IF( lwp .AND. nn_chldta == 1 ) WRITE(numout,*) ' profile of chlorophyll : Chl(z) = Chl(z=0)' 429 IF( lwp .AND. nn_chldta == 2 ) WRITE(numout,*) ' profile of chlorophyll : Chl(z) = Func[Chl(z=0)]' 430 ! 431 END SELECT 432 ! 433 CASE( np_2BD ) !== 2 bands light penetration ==! 407 ENDIF 408 IF( nqsr == np_RGB ) THEN ! constant Chl 409 IF(lwp) WRITE(numout,*) ' Constant Chlorophyll concentration = 0.05' 410 ENDIF 411 ! 412 CASE( np_2BD ) !== 2 bands light penetration ==! 434 413 ! 435 414 IF(lwp) WRITE(numout,*) ' 2 bands light penetration' … … 438 417 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m' 439 418 ! 440 CASE( np_BIO ) 419 CASE( np_BIO ) !== BIO light penetration ==! 441 420 ! 442 421 IF(lwp) WRITE(numout,*) ' bio-model light penetration' -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r6140 r6851 207 207 END DO 208 208 ENDIF 209 210 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*tsn(:,:,1,jp_tem) ) ! runoff term on sst 211 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*tsn(:,:,1,jp_sal) ) ! runoff term on sss 212 209 213 ! 210 214 !---------------------------------------- -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r6140 r6851 106 106 DO jj = 2, jpj 107 107 DO ji = 2, jpi 108 zke(ji,jj,jk) = 0. 5_wp * rau0 *(un(ji ,jj,jk) * putrd(ji ,jj,jk) * bu(ji ,jj,jk) &109 & + un(ji-1,jj,jk) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk) &110 & + vn(ji,jj ,jk) * pvtrd(ji,jj ,jk) * bv(ji,jj ,jk) &111 & + vn(ji,jj-1,jk) * pvtrd(ji,jj-1,jk) * bv(ji,jj-1,jk) ) * r1_bt(ji,jj,jk)108 zke(ji,jj,jk) = 0.25_wp * rau0 * ( un(ji ,jj,jk) * putrd(ji ,jj,jk) * bu(ji ,jj,jk) & 109 & + un(ji-1,jj,jk) * putrd(ji-1,jj,jk) * bu(ji-1,jj,jk) & 110 & + vn(ji,jj ,jk) * pvtrd(ji,jj ,jk) * bv(ji,jj ,jk) & 111 & + vn(ji,jj-1,jk) * pvtrd(ji,jj-1,jk) * bv(ji,jj-1,jk) ) * r1_bt(ji,jj,jk) 112 112 END DO 113 113 END DO -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r6347 r6851 31 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld !: mixing layer depth (turbocline) [m] 32 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmlp !: mixed layer depth (rho=rho0+zdcrit) [m] 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmlpt !: depth of the last T-point inside the mixed layer 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmlpt !: depth of the last T-point inside the mixed layer [m] 34 34 35 35 REAL(wp), PUBLIC :: rho_c = 0.01_wp !: density criterion for mixed layer depth … … 77 77 INTEGER, INTENT(in) :: kt ! ocean time-step index 78 78 ! 79 INTEGER :: ji, jj, jk ! dummy loop indices80 INTEGER :: iikn, iiki, ikt 81 REAL(wp) :: zN2_c ! local scalar79 INTEGER :: ji, jj, jk ! dummy loop indices 80 INTEGER :: iikn, iiki, ikt ! local integer 81 REAL(wp) :: zN2_c ! local scalar 82 82 INTEGER, POINTER, DIMENSION(:,:) :: imld ! 2D workspace 83 83 !!---------------------------------------------------------------------- … … 130 130 IF( .NOT.lk_offline ) THEN ! no need to output in offline mode 131 131 IF ( iom_use("mldr10_1") ) THEN 132 IF( .NOT. ln_isfcav ) CALL iom_put( "mldr10_1", hmlp ) ! mixed layer depth 133 IF( ln_isfcav ) CALL iom_put( "mldr10_1", hmlp - risfdep) ! mixed layer thickness 132 IF( ln_isfcav ) THEN ; CALL iom_put( "mldr10_1", hmlp - risfdep) ! mixed layer thickness 133 ELSE ; CALL iom_put( "mldr10_1", hmlp ) ! mixed layer depth 134 END IF 134 135 END IF 135 136 IF ( iom_use("mldkz5") ) THEN 136 IF( .NOT. ln_isfcav ) CALL iom_put( "mldkz5" , hmld ) ! turbocline depth 137 IF( ln_isfcav ) CALL iom_put( "mldkz5" , hmld - risfdep ) ! turbocline thickness 137 IF( ln_isfcav ) THEN ; CALL iom_put( "mldkz5" , hmld - risfdep ) ! turbocline thickness 138 ELSE ; CALL iom_put( "mldkz5" , hmld ) ! turbocline depth 139 END IF 138 140 END IF 139 141 ENDIF -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r6140 r6851 31 31 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 32 32 33 USE eosbn2, ONLY : n n_eos33 USE eosbn2, ONLY : neos 34 34 35 35 IMPLICIT NONE … … 175 175 ! Compute Ekman depth from wind stress forcing. 176 176 ! ------------------------------------------------------- 177 zflageos = ( 0.5 + SIGN( 0.5, nn_eos - 1. ) ) * rau0 177 !!gm small bug : boussinesq equation of the ocean model 178 !!gm therefore rau0 should be used not the potential surface density... 179 !!gm ===>>>> zrhos = rau0 in the epression below, and the rsmall is useless in zustar calculation 180 zflageos = ( 0.5 + SIGN( 0.5, neos - 1. ) ) * rau0 178 181 DO jj = 2, jpjm1 179 182 DO ji = fs_2, fs_jpim1 -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r6347 r6851 376 376 DO ji = fs_2, fs_jpim1 ! vector opt. 377 377 zcof = zfact1 * tmask(ji,jj,jk) 378 # if defined key_zdftmx_new 379 ! key_zdftmx_new: New internal wave-driven param: set a minimum value for Kz on TKE (ensure numerical stability) 380 zzd_up = zcof * MAX( avm(ji,jj,jk+1) + avm(ji,jj,jk), 2.e-5_wp ) & ! upper diagonal 381 & / ( e3t_n(ji,jj,jk ) * e3w_n(ji,jj,jk ) ) 382 zzd_lw = zcof * MAX( avm(ji,jj,jk) + avm(ji,jj,jk-1), 2.e-5_wp ) & ! lower diagonal 383 & / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk ) ) 384 # else 378 385 zzd_up = zcof * ( avm (ji,jj,jk+1) + avm (ji,jj,jk ) ) & ! upper diagonal 379 386 & / ( e3t_n(ji,jj,jk ) * e3w_n(ji,jj,jk ) ) 380 387 zzd_lw = zcof * ( avm (ji,jj,jk ) + avm (ji,jj,jk-1) ) & ! lower diagonal 381 388 & / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk ) ) 389 # endif 382 390 ! ! shear prod. at w-point weightened by mask 383 391 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r6347 r6851 698 698 699 699 DO jk = 2, jpkm1 ! complete with the level-dependent part 700 emix_tmx(:,:,jk) = zfact(:,:) * ( EXP( ( fsde3w(:,:,jk ) - zhdep(:,:) ) / hcri_tmx(:,:) ) &701 & - EXP( ( fsde3w(:,:,jk-1) - zhdep(:,:) ) / hcri_tmx(:,:) ) ) * wmask(:,:,jk) &702 & / ( fsde3w(:,:,jk) - fsde3w(:,:,jk-1) )700 emix_tmx(:,:,jk) = zfact(:,:) * ( EXP( ( gde3w_n(:,:,jk ) - zhdep(:,:) ) / hcri_tmx(:,:) ) & 701 & - EXP( ( gde3w_n(:,:,jk-1) - zhdep(:,:) ) / hcri_tmx(:,:) ) ) * wmask(:,:,jk) & 702 & / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 703 703 END DO 704 704 … … 712 712 zfact(:,:) = 0._wp 713 713 DO jk = 2, jpkm1 ! part independent of the level 714 zfact(:,:) = zfact(:,:) + fse3w(:,:,jk) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk)714 zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 715 715 END DO 716 716 … … 729 729 zfact(:,:) = 0._wp 730 730 DO jk = 2, jpkm1 ! part independent of the level 731 zfact(:,:) = zfact(:,:) + fse3w(:,:,jk) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk)731 zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 732 732 END DO 733 733 … … 750 750 zfact(:,:) = 0._wp 751 751 DO jk = 2, jpkm1 752 zfact(:,:) = zfact(:,:) + fse3w(:,:,jk) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk)752 zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 753 753 zwkb(:,:,jk) = zfact(:,:) 754 754 END DO … … 783 783 DO jk = 2, jpkm1 ! complete with the level-dependent part 784 784 emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk) & 785 & / ( fsde3w(:,:,jk) - fsde3w(:,:,jk-1) )785 & / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 786 786 END DO 787 787 … … 827 827 DO jj = 1, jpj 828 828 DO ji = 1, jpi 829 ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) &829 ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) & 830 830 & * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 831 831 END DO … … 891 891 pcmap_tmx(:,:) = 0._wp 892 892 DO jk = 2, jpkm1 893 pcmap_tmx(:,:) = pcmap_tmx(:,:) + fse3w(:,:,jk) * bflx_tmx(:,:,jk) * wmask(:,:,jk)893 pcmap_tmx(:,:) = pcmap_tmx(:,:) + e3w_n(:,:,jk) * bflx_tmx(:,:,jk) * wmask(:,:,jk) 894 894 END DO 895 895 pcmap_tmx(:,:) = rau0 * pcmap_tmx(:,:) -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/OPA_SRC/step.F90
r6140 r6851 112 112 ! Update stochastic parameters and random T/S fluctuations 113 113 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 114 CALL sto_par( kstp ) ! Stochastic parameters 114 IF( ln_sto_eos ) THEN ! Stochastic parameterisation 115 CALL sto_par( kstp ) ! Stochastic parameters 116 CALL sto_pts( tsn ) ! Random T/S fluctuations 117 ENDIF 115 118 116 119 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 154 157 ! 155 158 IF( l_ldfslp ) THEN ! slope of lateral mixing 156 !!gm : why this here ????157 IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations158 !!gm159 159 CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density 160 160 … … 172 172 ENDIF 173 173 ENDIF 174 ! ! eddy diffusivity coeff. and/or eiv coeff. 175 IF( l_ldftra_time .OR. l_ldfeiv_time ) CALL ldf_tra( kstp ) 174 ! ! eddy diffusivity coeff. 175 IF( l_ldftra_time .OR. l_ldfeiv_time ) CALL ldf_tra( kstp ) ! and/or eiv coeff. 176 IF( l_ldfdyn_time ) CALL ldf_dyn( kstp ) ! eddy viscosity coeff. 176 177 177 178 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 182 183 IF(.NOT.ln_linssh ) CALL dom_vvl_sf_nxt( kstp ) ! after vertical scale factors 183 184 CALL wzv ( kstp ) ! now cross-level velocity 184 !!gm : why also here ????185 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations186 !!gm187 185 CALL eos ( tsn, rhd, rhop, gdept_n(:,:,:) ) ! now in situ density for hpg computation 188 186 … … 203 201 204 202 IF( lk_asminc .AND. ln_asmiau .AND. ln_dyninc ) & 205 203 & CALL dyn_asm_inc ( kstp ) ! apply dynamics assimilation increment 206 204 IF( lk_bdy ) CALL bdy_dyn3d_dmp ( kstp ) ! bdy damping trends 207 205 #if defined key_agrif … … 305 303 !!jc: That would be better, but see comment above 306 304 !! 307 IF( lrst_oce ) CALL rst_write ( kstp ) ! write output ocean restart file 305 IF( lrst_oce ) CALL rst_write ( kstp ) ! write output ocean restart file 306 IF( ln_sto_eos ) CALL sto_rst_write( kstp ) ! write restart file for stochastic parameters 308 307 309 308 #if defined key_agrif -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r6140 r6851 131 131 ! 132 132 CALL p4z_bio( kt, jnt ) ! Biology 133 CALL p4z_sed( kt, jnt ) ! Sedimentation134 133 CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation 134 CALL p4z_sed( kt, jnt ) ! Surface and Bottom boundary conditions 135 135 CALL p4z_flx( kt, jnt ) ! Compute surface fluxes 136 136 ! -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r6140 r6851 40 40 REAL(wp), PUBLIC :: rn_ahtrc_0 !: laplacian diffusivity coefficient for passive tracer [m2/s] 41 41 REAL(wp), PUBLIC :: rn_bhtrc_0 !: bilaplacian - -- - - [m4/s] 42 REAL(wp), PUBLIC :: rn_fact_lap !: Enhanced zonal diffusivity coefficent in the equatorial domain 42 43 ! 43 44 ! !!: ** lateral mixing namelist (nam_trcldf) ** … … 64 65 INTEGER, INTENT( in ) :: kt ! ocean time-step index 65 66 ! 66 INTEGER :: jn 67 INTEGER :: ji, jj, jk, jn 68 REAL(wp) :: zdep 67 69 CHARACTER (len=22) :: charout 68 70 REAL(wp), POINTER, DIMENSION(:,:,:) :: zahu, zahv … … 76 78 ztrtrd(:,:,:,:) = tra(:,:,:,:) 77 79 ENDIF 78 ! 79 ! !* set the lateral diffusivity coef. for passive tracer 80 ! !* set the lateral diffusivity coef. for passive tracer 80 81 CALL wrk_alloc( jpi,jpj,jpk, zahu, zahv ) 81 zahu(:,:,:) = rldf * ahtu(:,:,:) 82 zahu(:,:,:) = rldf * ahtu(:,:,:) 82 83 zahv(:,:,:) = rldf * ahtv(:,:,:) 83 84 ! !* Enhanced zonal diffusivity coefficent in the equatorial domain 85 DO jk= 1, jpk 86 DO jj = 1, jpj 87 DO ji = 1, jpi 88 IF( gdept_n(ji,jj,jk) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 89 zdep = MAX( gdept_n(ji,jj,jk) - 1000., 0. ) / 1000. 90 zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) ) 91 ENDIF 92 END DO 93 END DO 94 END DO 95 ! 84 96 SELECT CASE ( nldf ) !* compute lateral mixing trend and add it to the general trend 85 97 ! … … 136 148 NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp, & 137 149 & ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad, & 138 & rn_ahtrc_0 , rn_bhtrc_0 150 & rn_ahtrc_0 , rn_bhtrc_0, rn_fact_lap 139 151 !!---------------------------------------------------------------------- 140 152 ! … … 164 176 WRITE(numout,*) ' laplacian rn_ahtrc_0 = ', rn_ahtrc_0 165 177 WRITE(numout,*) ' bilaplacian rn_bhtrc_0 = ', rn_bhtrc_0 178 WRITE(numout,*) ' enhanced zonal diffusivity rn_fact_lap = ', rn_fact_lap 179 166 180 ENDIF 167 181 ! -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_athena_xios
r6140 r6851 27 27 # export MPIRUN="mpirun -n $OCEANCORES" 28 28 29 module load INTEL/intel_xe_2013 NETCDF/netcdf-4.3_parallel _shared NETCDF/parallel-netcdf-1.3.1 HDF5/hdf5-1.8.11_parallel_shared29 module load INTEL/intel_xe_2013 NETCDF/netcdf-4.3_parallel NETCDF/parallel-netcdf-1.3.1 HDF5/hdf5-1.8.11_parallel 30 30 export MPIRUN="mpirun.lsf" 31 31 -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/SETTE/sette.sh
r6140 r6851 123 123 # Directory to run the tests 124 124 SETTE_DIR=$(cd $(dirname "$0"); pwd) 125 MAIN_DIR=$ {SETTE_DIR%/SETTE}125 MAIN_DIR=$(dirname $SETTE_DIR) 126 126 CONFIG_DIR=${MAIN_DIR}/CONFIG 127 127 TOOLS_DIR=${MAIN_DIR}/TOOLS -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/TOOLS/REBUILD_NEMO/icb_combrest.py
r6140 r6851 1 import os 1 2 from netCDF4 import Dataset 2 3 from argparse import ArgumentParser … … 63 64 if procnum < 1: 64 65 print('Need some files to collate! procnum = ',procnum) 65 sys.exit( )66 sys.exit(11) 66 67 67 68 icu = [] … … 79 80 except: 80 81 print 'Error: unable to open input file: ' + pathstart+nn+'.nc' 81 sys.exit( )82 sys.exit(12) 82 83 for d in fw.dimensions : 83 84 if d == 'n' : … … 151 152 print 'Error accessing output file: ' + pathout 152 153 print 'Check it is a writable location.' 153 sys.exit( )154 sys.exit(13) 154 155 else : 156 # Copy 2D variables across to output file from input file. This step avoids problems if rebuild_nemo 157 # has created an "n" dimension in the prototype rebuilt file (ie. if there are icebergs on the zeroth 158 # processor). 155 159 try: 156 fo = Dataset(pathout, 'r+', format='NETCDF4') 160 os.rename(pathout,pathout.replace('.nc','_WORK.nc')) 161 except OSError: 162 print 'Error: unable to move icebergs restart file: '+pathout 163 sys.exit(14) 164 # 165 try: 166 fi = Dataset(pathout.replace('.nc','_WORK.nc'), 'r') 157 167 except: 158 print 'Error accessing output file: ' + pathout 159 print 'Check it exists and is writable.' 160 print 'Or run adding the -O option to create an output file which will' 161 print 'contain the iceberg state data only.' 162 sys.exit() 168 print 'Error: unable to open icebergs restart file: '+pathout.replace('.nc','_WORK.nc') 169 sys.exit(15) 170 fo = Dataset(pathout, 'w') 171 for dim in ['x','y','c']: 172 indim = fi.dimensions[dim] 173 fo.createDimension(dim, len(indim)) 174 for var in ['calving','calving_hflx','stored_ice','stored_heat']: 175 invar = fi.variables[var] 176 fo.createVariable(var, invar.datatype, invar.dimensions) 177 fo.variables[var][:] = invar[:] 178 fo.variables[var].long_name = invar.long_name 179 fo.variables[var].units = invar.units 180 os.remove(pathout.replace('.nc','_WORK.nc')) 163 181 # 164 182 add_k = 1 … … 166 184 if d == 'n' : 167 185 print 'Error: dimension n already exists in output file' 168 sys.exit( )186 sys.exit(16) 169 187 if d == 'k' : 170 188 add_k = 0 -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90
r3025 r6851 200 200 WRITE(numerr,*) 'Attribute DOMAIN_number_total is : ', ndomain_file 201 201 WRITE(numerr,*) 'Number of files specified in namelist is: ', ndomain 202 STOP 202 STOP 9 203 203 ENDIF 204 204 … … 268 268 WRITE(numerr,*) 'Attribute DOMAIN_local_sizes is : ', local_sizes 269 269 WRITE(numerr,*) 'Dimensions to be rebuilt are of size : ', outdimlens(rebuild_dims(1)), outdimlens(rebuild_dims(2)) 270 STOP 270 STOP 9 271 271 ENDIF 272 272 … … 384 384 SELECT CASE( xtype ) 385 385 CASE( NF90_BYTE ) 386 globaldata_0d_i1 = 0 386 387 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i1 ) ) 387 388 CASE( NF90_SHORT ) 389 globaldata_0d_i2 = 0 388 390 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i2 ) ) 389 391 CASE( NF90_INT ) 392 globaldata_0d_i4 = 0 390 393 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i4 ) ) 391 394 CASE( NF90_FLOAT ) 395 globaldata_0d_sp = 0. 392 396 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_sp ) ) 393 397 CASE( NF90_DOUBLE ) 398 globaldata_0d_dp = 0. 394 399 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_dp ) ) 395 400 CASE DEFAULT 396 401 WRITE(numerr,*) 'Unknown nf90 type: ', xtype 397 STOP 402 STOP 9 398 403 END SELECT 399 404 … … 403 408 CASE( NF90_BYTE ) 404 409 ALLOCATE(globaldata_1d_i1(indimlens(dimids(1)))) 410 globaldata_1d_i1(:) = 0 405 411 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i1 ) ) 406 412 CASE( NF90_SHORT ) 407 413 ALLOCATE(globaldata_1d_i2(indimlens(dimids(1)))) 414 globaldata_1d_i2(:) = 0 408 415 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i2 ) ) 409 416 CASE( NF90_INT ) 410 417 ALLOCATE(globaldata_1d_i4(indimlens(dimids(1)))) 418 globaldata_1d_i4(:) = 0 411 419 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i4 ) ) 412 420 CASE( NF90_FLOAT ) 413 421 ALLOCATE(globaldata_1d_sp(indimlens(dimids(1)))) 422 globaldata_1d_sp(:) = 0. 414 423 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_sp ) ) 415 424 CASE( NF90_DOUBLE ) 416 425 ALLOCATE(globaldata_1d_dp(indimlens(dimids(1)))) 426 globaldata_1d_dp(:) = 0. 417 427 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_dp ) ) 418 428 CASE DEFAULT 419 429 WRITE(numerr,*) 'Unknown nf90 type: ', xtype 420 STOP 430 STOP 9 421 431 END SELECT 422 432 … … 426 436 CASE( NF90_BYTE ) 427 437 ALLOCATE(globaldata_2d_i1(indimlens(dimids(1)),indimlens(dimids(2)))) 438 globaldata_2d_i1(:,:) = 0 428 439 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i1 ) ) 429 440 CASE( NF90_SHORT ) 430 441 ALLOCATE(globaldata_2d_i2(indimlens(dimids(1)),indimlens(dimids(2)))) 442 globaldata_2d_i2(:,:) = 0 431 443 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i2 ) ) 432 444 CASE( NF90_INT ) 433 445 ALLOCATE(globaldata_2d_i4(indimlens(dimids(1)),indimlens(dimids(2)))) 446 globaldata_2d_i4(:,:) = 0 434 447 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i4 ) ) 435 448 CASE( NF90_FLOAT ) 436 449 ALLOCATE(globaldata_2d_sp(indimlens(dimids(1)),indimlens(dimids(2)))) 450 globaldata_2d_sp(:,:) = 0. 437 451 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_sp ) ) 438 452 CASE( NF90_DOUBLE ) 439 453 ALLOCATE(globaldata_2d_dp(indimlens(dimids(1)),indimlens(dimids(2)))) 454 globaldata_2d_dp(:,:) = 0. 440 455 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_dp ) ) 441 456 CASE DEFAULT 442 457 WRITE(numerr,*) 'Unknown nf90 type: ', xtype 443 STOP 458 STOP 9 444 459 END SELECT 445 460 … … 450 465 ALLOCATE(globaldata_3d_i1(indimlens(dimids(1)),indimlens(dimids(2)), & 451 466 & indimlens(dimids(3)))) 467 globaldata_3d_i1(:,:,:) = 0 452 468 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i1 ) ) 453 469 CASE( NF90_SHORT ) 454 470 ALLOCATE(globaldata_3d_i2(indimlens(dimids(1)),indimlens(dimids(2)), & 455 471 & indimlens(dimids(3)))) 472 globaldata_3d_i2(:,:,:) = 0 456 473 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i2 ) ) 457 474 CASE( NF90_INT ) 458 475 ALLOCATE(globaldata_3d_i4(indimlens(dimids(1)),indimlens(dimids(2)), & 459 476 & indimlens(dimids(3)))) 477 globaldata_3d_i4(:,:,:) = 0 460 478 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i4 ) ) 461 479 CASE( NF90_FLOAT ) 462 480 ALLOCATE(globaldata_3d_sp(indimlens(dimids(1)),indimlens(dimids(2)), & 463 481 & indimlens(dimids(3)))) 482 globaldata_3d_sp(:,:,:) = 0. 464 483 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_sp ) ) 465 484 CASE( NF90_DOUBLE ) 466 485 ALLOCATE(globaldata_3d_dp(indimlens(dimids(1)),indimlens(dimids(2)), & 467 486 & indimlens(dimids(3)))) 487 globaldata_3d_dp(:,:,:) = 0. 468 488 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_dp ) ) 469 489 CASE DEFAULT 470 490 WRITE(numerr,*) 'Unknown nf90 type: ', xtype 471 STOP 491 STOP 9 472 492 END SELECT 473 493 … … 478 498 ALLOCATE(globaldata_4d_i1(indimlens(dimids(1)),indimlens(dimids(2)), & 479 499 & indimlens(dimids(3)),ntchunk)) 500 globaldata_4d_i1(:,:,:,:) = 0 480 501 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i1, start=(/1,1,1,nt/) ) ) 481 502 CASE( NF90_SHORT ) 482 503 ALLOCATE(globaldata_4d_i2(indimlens(dimids(1)),indimlens(dimids(2)), & 483 504 & indimlens(dimids(3)),ntchunk)) 505 globaldata_4d_i2(:,:,:,:) = 0 484 506 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i2, start=(/1,1,1,nt/) ) ) 485 507 CASE( NF90_INT ) 486 508 ALLOCATE(globaldata_4d_i4(indimlens(dimids(1)),indimlens(dimids(2)), & 487 509 & indimlens(dimids(3)),ntchunk)) 510 globaldata_4d_i4(:,:,:,:) = 0 488 511 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i4, start=(/1,1,1,nt/) ) ) 489 512 CASE( NF90_FLOAT ) 490 513 ALLOCATE(globaldata_4d_sp(indimlens(dimids(1)),indimlens(dimids(2)), & 491 514 & indimlens(dimids(3)),ntchunk)) 515 globaldata_4d_sp(:,:,:,:) = 0. 492 516 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_sp, start=(/1,1,1,nt/) ) ) 493 517 CASE( NF90_DOUBLE ) 494 518 ALLOCATE(globaldata_4d_dp(indimlens(dimids(1)),indimlens(dimids(2)), & 495 519 & indimlens(dimids(3)),ntchunk)) 520 globaldata_4d_dp(:,:,:,:) = 0. 496 521 CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_dp, start=(/1,1,1,nt/) ) ) 497 522 CASE DEFAULT 498 523 WRITE(numerr,*) 'Unknown nf90 type: ', xtype 499 STOP 524 STOP 9 500 525 END SELECT 501 526 … … 517 542 CASE( NF90_BYTE ) 518 543 ALLOCATE(globaldata_1d_i1(outdimlens(dimids(1)))) 544 globaldata_1d_i1(:) = 0 519 545 CASE( NF90_SHORT ) 520 546 ALLOCATE(globaldata_1d_i2(outdimlens(dimids(1)))) 547 globaldata_1d_i2(:) = 0 521 548 CASE( NF90_INT ) 522 549 ALLOCATE(globaldata_1d_i4(outdimlens(dimids(1)))) 550 globaldata_1d_i4(:) = 0 523 551 CASE( NF90_FLOAT ) 524 552 ALLOCATE(globaldata_1d_sp(outdimlens(dimids(1)))) 553 globaldata_1d_sp(:) = 0. 525 554 CASE( NF90_DOUBLE ) 526 555 ALLOCATE(globaldata_1d_dp(outdimlens(dimids(1)))) 556 globaldata_1d_dp(:) = 0. 527 557 CASE DEFAULT 528 558 WRITE(numerr,*) 'Unknown nf90 type: ', xtype 529 STOP 559 STOP 9 530 560 END SELECT 531 561 … … 535 565 CASE( NF90_BYTE ) 536 566 ALLOCATE(globaldata_2d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)))) 567 globaldata_2d_i1(:,:) = 0 537 568 CASE( NF90_SHORT ) 538 569 ALLOCATE(globaldata_2d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)))) 570 globaldata_2d_i2(:,:) = 0 539 571 CASE( NF90_INT ) 540 572 ALLOCATE(globaldata_2d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)))) 573 globaldata_2d_i4(:,:) = 0 541 574 CASE( NF90_FLOAT ) 542 575 ALLOCATE(globaldata_2d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)))) 576 globaldata_2d_sp(:,:) = 0. 543 577 CASE( NF90_DOUBLE ) 544 578 ALLOCATE(globaldata_2d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)))) 579 globaldata_2d_dp(:,:) = 0. 545 580 CASE DEFAULT 546 581 WRITE(numerr,*) 'Unknown nf90 type: ', xtype 547 STOP 582 STOP 9 548 583 END SELECT 549 584 … … 554 589 ALLOCATE(globaldata_3d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)), & 555 590 & outdimlens(dimids(3)))) 591 globaldata_3d_i1(:,:,:) = 0 556 592 CASE( NF90_SHORT ) 557 593 ALLOCATE(globaldata_3d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)), & -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg
r6140 r6851 1 1 # name | units | axis | pt| interpolation | long name | standard name 2 X | 1| X | | | | projection_x_coordinate3 Y | 1| Y | | | | projection_y_coordinate4 Z | 1| Z | | | | projection_z_coordinate5 T | 1| T | | | | projection_t_coordinate2 X | unitless | X | | | | projection_x_coordinate 3 Y | unitless | Y | | | | projection_y_coordinate 4 Z | unitless | Z | | | | projection_z_coordinate 5 T | unitless | T | | | | projection_t_coordinate 6 6 nav_lon | degrees_east | XY | T | cubic | Longitude | longitude 7 7 nav_lat | degrees_north | XY | T | cubic | Latitude | latitude … … 43 43 kt | | | | | | 44 44 rdt | | | | | | 45 rdttra1 | | | | | | 45 46 utau_b | | XY | U | | |surface_downward_eastward_stress 46 47 vtau_b | | XY | V | | |surface_downward_northward_stress -
branches/2016/dev_r6325_SIMPLIF_1/NEMOGCM/TOOLS/SIREN/src/attribute.f90
r5617 r6851 83 83 !> @date November, 2014 84 84 !> - Fix memory leaks bug 85 !> @date September, 2015 86 !> - manage useless (dummy) attributes 85 87 ! 86 88 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 98 100 PUBLIC :: TATT !< attribute structure 99 101 102 PRIVATE :: cm_dumatt !< dummy attribute array 103 100 104 ! function and subroutine 101 105 PUBLIC :: att_init !< initialize attribute structure … … 105 109 PUBLIC :: att_get_index !< get attribute index, in an array of attribute structure 106 110 PUBLIC :: att_get_id !< get attribute id, read from file 111 PUBLIC :: att_get_dummy !< fill dummy attribute array 112 PUBLIC :: att_is_dummy !< check if attribute is defined as dummy attribute 107 113 108 114 PRIVATE :: att__clean_unit ! clean attribute strcuture … … 135 141 END TYPE TATT 136 142 143 CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumatt !< dummy attribute 144 137 145 INTERFACE att_init 138 146 MODULE PROCEDURE att__init_c … … 1251 1259 1252 1260 END SUBROUTINE att__clean_arr 1261 !------------------------------------------------------------------- 1262 !> @brief This subroutine fill dummy attribute array 1263 ! 1264 !> @author J.Paul 1265 !> @date September, 2015 - Initial Version 1266 !> @date Marsh, 2016 1267 !> - close file (bugfix) 1268 ! 1269 !> @param[in] cd_dummy dummy configuration file 1270 !------------------------------------------------------------------- 1271 SUBROUTINE att_get_dummy( cd_dummy ) 1272 IMPLICIT NONE 1273 ! Argument 1274 CHARACTER(LEN=*), INTENT(IN) :: cd_dummy 1275 1276 ! local variable 1277 INTEGER(i4) :: il_fileid 1278 INTEGER(i4) :: il_status 1279 1280 LOGICAL :: ll_exist 1281 1282 ! loop indices 1283 ! namelist 1284 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar 1285 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim 1286 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt 1287 1288 !---------------------------------------------------------------- 1289 NAMELIST /namdum/ & !< dummy namelist 1290 & cn_dumvar, & !< variable name 1291 & cn_dumdim, & !< dimension name 1292 & cn_dumatt !< attribute name 1293 !---------------------------------------------------------------- 1294 1295 ! init 1296 cm_dumatt(:)='' 1297 1298 ! read namelist 1299 INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 1300 IF( ll_exist )THEN 1301 1302 il_fileid=fct_getunit() 1303 1304 OPEN( il_fileid, FILE=TRIM(cd_dummy), & 1305 & FORM='FORMATTED', & 1306 & ACCESS='SEQUENTIAL', & 1307 & STATUS='OLD', & 1308 & ACTION='READ', & 1309 & IOSTAT=il_status) 1310 CALL fct_err(il_status) 1311 IF( il_status /= 0 )THEN 1312 CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 1313 ENDIF 1314 1315 READ( il_fileid, NML = namdum ) 1316 cm_dumatt(:)=cn_dumatt(:) 1317 1318 CLOSE( il_fileid ) 1319 1320 ENDIF 1321 1322 END SUBROUTINE att_get_dummy 1323 !------------------------------------------------------------------- 1324 !> @brief This function check if attribute is defined as dummy attribute 1325 !> in configuraton file 1326 !> 1327 !> @author J.Paul 1328 !> @date September, 2015 - Initial Version 1329 ! 1330 !> @param[in] td_att attribute structure 1331 !> @return true if attribute is dummy attribute 1332 !------------------------------------------------------------------- 1333 FUNCTION att_is_dummy(td_att) 1334 IMPLICIT NONE 1335 1336 ! Argument 1337 TYPE(TATT), INTENT(IN) :: td_att 1338 1339 ! function 1340 LOGICAL :: att_is_dummy 1341 1342 ! loop indices 1343 INTEGER(i4) :: ji 1344 !---------------------------------------------------------------- 1345 1346 att_is_dummy=.FALSE. 1347 DO ji=1,ip_maxdum 1348 IF( fct_lower(td_att%c_name) == fct_lower(cm_dumatt(ji)) )THEN 1349 att_is_dummy=.TRUE. 1350 EXIT 1351 ENDIF 1352 ENDDO 1353 1354 END FUNCTION att_is_dummy 1253 1355 END MODULE att 1254 1356
Note: See TracChangeset
for help on using the changeset viewer.