Changeset 4896
- Timestamp:
- 2014-11-27T15:58:54+01:00 (10 years ago)
- Location:
- branches/2014/dev_CNRS_2014/NEMOGCM
- Files:
-
- 12 deleted
- 103 edited
- 14 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
r4370 r4896 11 11 nn_stock = 4320 ! frequency of creation of a restart file (modulo referenced to 1) 12 12 nn_write = 60 ! frequency of write in the output file (modulo referenced to nn_it000) 13 14 ln_clobber = .true. ! clobber (overwrite) an existing file 15 13 16 / 14 17 !----------------------------------------------------------------------- … … 82 85 !----------------------------------------------------------------------- 83 86 nn_fsbc = 1 ! frequency of surface boundary condition computation 84 87 ! ! (also = the frequency of sea-ice model call) 85 88 ln_ana = .true. ! analytical formulation (T => fill namsbc_ana ) 86 89 ln_blk_core = .false. ! CORE bulk formulation (T => fill namsbc_core) … … 198 201 &nameos ! ocean physical parameters 199 202 !----------------------------------------------------------------------- 200 nn_eos = 2 ! type of equation of state and Brunt-Vaisala frequency 203 nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency 204 ! =-1, TEOS-10 205 ! = 0, EOS-80 206 ! = 1, S-EOS (simplified eos) 207 ln_useCT = .false. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 208 ! ! 209 ! ! S-EOS coefficients : 210 ! ! rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 211 rn_a0 = 1.6550e-1 ! thermal expension coefficient (nn_eos= 1) 212 rn_b0 = 7.6554e-1 ! saline expension coefficient (nn_eos= 1) 213 rn_lambda1 = 5.9520e-2 ! cabbeling coeff in T^2 (=0 for linear eos) 214 rn_lambda2 = 7.4914e-4 ! cabbeling coeff in S^2 (=0 for linear eos) 215 rn_mu1 = 1.4970e-4 ! thermobaric coeff. in T (=0 for linear eos) 216 rn_mu2 = 1.1090e-5 ! thermobaric coeff. in S (=0 for linear eos) 217 rn_nu = 2.4341e-3 ! cabbeling coeff in T*S (=0 for linear eos) 218 !!org GYRE rn_alpha = 2.0e-4 ! thermal expension coefficient (nn_eos= 1 or 2) 219 !!org GYRE rn_beta = 7.7e-4 ! saline expension coefficient (nn_eos= 2) 220 !!org caution now a0 = alpha / rau0 with rau0 = 1026 201 221 / 202 222 !----------------------------------------------------------------------- 203 223 &namtra_adv ! advection scheme for tracer 204 224 !----------------------------------------------------------------------- 205 ln_traadv_msc_ups= .false. ! use upstream scheme within muscl 225 ln_traadv_cen2 = .false. ! 2nd order centered scheme 226 ln_traadv_tvd = .true. ! TVD scheme 227 ln_traadv_muscl = .false. ! MUSCL scheme 228 ln_traadv_muscl2 = .false. ! MUSCL2 scheme + cen2 at boundaries 229 ln_traadv_ubs = .false. ! UBS scheme 230 ln_traadv_qck = .false. ! QUICKEST scheme 231 ln_traadv_msc_ups= .false. ! use upstream scheme within muscl 206 232 / 207 233 !----------------------------------------------------------------------- … … 242 268 !namdyn_spg ! surface pressure gradient (CPP key only) 243 269 !----------------------------------------------------------------------- 270 244 271 !----------------------------------------------------------------------- 245 272 &namdyn_ldf ! lateral diffusion on momentum … … 301 328 ! ! or mixed-layer trends or barotropic vorticity ("key_trdmld" or "key_trdvor") 302 329 !----------------------------------------------------------------------- 303 / 330 ln_glo_trd = .false. ! (T) global domain averaged diag for T, T^2, KE, and PE 331 ln_dyn_trd = .false. ! (T) 3D momentum trend output 332 ln_dyn_mxl = .FALSE. ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 333 ln_vor_trd = .FALSE. ! (T) 2D barotropic vorticity trends (not coded yet) 334 ln_KE_trd = .false. ! (T) 3D Kinetic Energy trends 335 ln_PE_trd = .false. ! (T) 3D Potential Energy trends 336 ln_tra_trd = .false. ! (T) 3D tracer trend output 337 ln_tra_mxl = .false. ! (T) 2D tracer trends averaged over the mixed layer (not coded yet) 338 nn_trd = 365 ! print frequency (ln_glo_trd=T) (unit=time step) 339 / 340 !!gm nn_ctls = 0 ! control surface type in mixed-layer trends (0,1 or n<jpk) 341 !!gm rn_ucf = 1. ! unit conversion factor (=1 -> /seconds ; =86400. -> /day) 342 !!gm cn_trdrst_in = "restart_mld" ! suffix of ocean restart name (input) 343 !!gm cn_trdrst_out = "restart_mld" ! suffix of ocean restart name (output) 344 !!gm ln_trdmld_restart = .false. ! restart for ML diagnostics 345 !!gm ln_trdmld_instant = .false. ! flag to diagnose trends of instantantaneous or mean ML T/S 346 !!gm 304 347 !----------------------------------------------------------------------- 305 348 &namflo ! float parameters ("key_float") -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm
r4230 r4896 1 bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi 1 bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_nosignedzero -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
r4370 r4896 206 206 &nameos ! ocean physical parameters 207 207 !----------------------------------------------------------------------- 208 nn_eos = 2 ! type of equation of state and Brunt-Vaisala frequency 208 nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency 209 ! =-1, TEOS-10 210 ! = 0, EOS-80 211 ! = 1, S-EOS (simplified eos) 212 ln_useCT = .false. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 213 ! ! 214 ! ! S-EOS coefficients : 215 ! ! rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 216 rn_a0 = 1.6550e-1 ! thermal expension coefficient (nn_eos= 1) 217 rn_b0 = 7.6554e-1 ! saline expension coefficient (nn_eos= 1) 218 rn_lambda1 = 5.9520e-2 ! cabbeling coeff in T^2 (=0 for linear eos) 219 rn_lambda2 = 7.4914e-4 ! cabbeling coeff in S^2 (=0 for linear eos) 220 rn_mu1 = 1.4970e-4 ! thermobaric coeff. in T (=0 for linear eos) 221 rn_mu2 = 1.1090e-5 ! thermobaric coeff. in S (=0 for linear eos) 222 rn_nu = 2.4341e-3 ! cabbeling coeff in T*S (=0 for linear eos) 223 !!org GYRE rn_alpha = 2.0e-4 ! thermal expension coefficient (nn_eos= 1 or 2) 224 !!org GYRE rn_beta = 7.7e-4 ! saline expension coefficient (nn_eos= 2) 225 !!org caution now a0 = alpha / rau0 with rau0 = 1026 209 226 / 210 227 !----------------------------------------------------------------------- -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg
r4370 r4896 121 121 &nameos ! ocean physical parameters 122 122 !----------------------------------------------------------------------- 123 nn_eos = 2 ! type of equation of state and Brunt-Vaisala frequency 123 nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency 124 ! =-1, TEOS-10 125 ! = 0, EOS-80 126 ! = 1, S-EOS (simplified eos) 127 ln_useCT = .false. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 128 ! ! 129 ! ! S-EOS coefficients : 130 ! ! rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 131 rn_a0 = 1.6550e-1 ! thermal expension coefficient (nn_eos= 1) 132 rn_b0 = 7.6554e-1 ! saline expension coefficient (nn_eos= 1) 133 rn_lambda1 = 5.9520e-2 ! cabbeling coeff in T^2 (=0 for linear eos) 134 rn_lambda2 = 7.4914e-4 ! cabbeling coeff in S^2 (=0 for linear eos) 135 rn_mu1 = 1.4970e-4 ! thermobaric coeff. in T (=0 for linear eos) 136 rn_mu2 = 1.1090e-5 ! thermobaric coeff. in S (=0 for linear eos) 137 rn_nu = 2.4341e-3 ! cabbeling coeff in T*S (=0 for linear eos) 138 !!org GYRE rn_alpha = 2.0e-4 ! thermal expension coefficient (nn_eos= 1 or 2) 139 !!org GYRE rn_beta = 7.7e-4 ! saline expension coefficient (nn_eos= 2) 140 !!org caution now a0 = alpha / rau0 with rau0 = 1026 124 141 / 125 142 !----------------------------------------------------------------------- -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm
r4230 r4896 1 bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi 1 bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/SHARED/field_def.xml
r4565 r4896 28 28 <field id="mldkz5" long_name="mixing layer depth (Turbocline)" unit="m" /> 29 29 <field id="mldr10_1" long_name="Mixed Layer Depth 0.01 ref.10m" unit="m" /> 30 <field id="rhop" long_name="potential density (sigma0)" unit="kg/m3" grid_ref="grid_T_3D"/> 31 <field id="eken" long_name="kinetic energy" unit="m2/s2" grid_ref="grid_T_3D"/> 32 <field id="hdiv" long_name="horizontal divergence" unit="s-1" grid_ref="grid_T_3D"/> 30 <!-- EOS --!> 31 <field id="alpha" long_name="thermal expansion" unit="1/degC" grid_ref="grid_T_3D"/> 32 <field id="beta" long_name="haline contraction" unit="1/psu" grid_ref="grid_T_3D"/> 33 <field id="bn2" long_name="squared Brunt-Vaisala frequency" unit="1/s" grid_ref="grid_T_3D"/> 34 <field id="rhop" long_name="potential density (sigma0)" unit="kg/m3" grid_ref="grid_T_3D"/> 35 <!-- Energy - horizontal divergence --!> 36 <field id="eken" long_name="kinetic energy" unit="m2/s2" grid_ref="grid_T_3D"/> 37 <field id="hdiv" long_name="horizontal divergence" unit="s-1" grid_ref="grid_T_3D"/> 33 38 <!-- variables available with MLE --> 34 39 <field id="Lf_NHpf" long_name="MLE: Lf = N H / f" unit="m" /> … … 629 634 </field_group> 630 635 636 <!-- 637 ============================================================================================================ 638 Trend diagnostics : temperature, KE, PE, momentum 639 ============================================================================================================ 640 --> 641 642 <field_group id="trendT" grid_ref="grid_T_3D"> 643 <!-- variables available with ln_tra_trd --> 644 <field id="ttrd_xad" long_name="temperature-trend: i-advection" unit="degC/s" /> 645 <field id="strd_xad" long_name="salinity -trend: i-advection" unit="psu/s" /> 646 <field id="ttrd_yad" long_name="temperature-trend: j-advection" unit="degC/s" /> 647 <field id="strd_yad" long_name="salinity -trend: j-advection" unit="psu/s" /> 648 <field id="ttrd_zad" long_name="temperature-trend: k-advection" unit="degC/s" /> 649 <field id="strd_zad" long_name="salinity -trend: k-advection" unit="psu/s" /> 650 <field id="ttrd_sad" long_name="temperature-trend: surface adv. (no-vvl)" unit="degC/s" grid_ref="grid_T_2D" /> 651 <field id="strd_sad" long_name="salinity -trend: surface adv. (no-vvl)" unit="psu/s" grid_ref="grid_T_2D" /> 652 <field id="ttrd_ldf" long_name="temperature-trend: lateral diffusion" unit="degC/s" /> 653 <field id="strd_ldf" long_name="salinity -trend: lateral diffusion" unit="psu/s" /> 654 <field id="ttrd_zdf" long_name="temperature-trend: vertical diffusion" unit="degC/s" /> 655 <field id="strd_zdf" long_name="salinity -trend: vertical diffusion" unit="psu/s" /> 656 <!-- ln_traldf_iso=T only (iso-neutral diffusion) --> 657 <field id="ttrd_zdfp" long_name="temperature-trend: pure vert. diffusion" unit="degC/s" /> 658 <field id="strd_zdfp" long_name="salinity -trend: pure vert. diffusion" unit="psu/s" /> 659 <!-- --> 660 <field id="ttrd_dmp" long_name="temperature-trend: interior restoring" unit="degC/s" /> 661 <field id="strd_dmp" long_name="salinity -trend: interior restoring" unit="psu/s" /> 662 <field id="ttrd_bbl" long_name="temperature-trend: bottom boundary layer" unit="degC/s" /> 663 <field id="strd_bbl" long_name="salinity -trend: bottom boundary layer" unit="psu/s" /> 664 <field id="ttrd_npc" long_name="temperature-trend: non-penetrative conv." unit="degC/s" /> 665 <field id="strd_npc" long_name="salinity -trend: non-penetrative conv." unit="psu/s" /> 666 <field id="ttrd_qns" long_name="temperature-trend: non-solar flux + runoff" unit="degC/s" /> 667 <field id="strd_cdt" long_name="salinity -trend: C/D term + runoff" unit="degC/s" /> 668 <field id="ttrd_qsr" long_name="temperature-trend: solar penetr. heating" unit="degC/s" /> 669 <field id="ttrd_bbc" long_name="temperature-trend: geothermal heating" unit="degC/s" /> 670 <field id="ttrd_atf" long_name="temperature-trend: asselin time filter" unit="degC/s" /> 671 <field id="strd_atf" long_name="salinity -trend: asselin time filter" unit="psu/s" /> 672 <!-- variables available with ln_KE_trd --> 673 <field id="ketrd_hpg" long_name="ke-trend: hydrostatic pressure gradient" unit="W/s^3" /> 674 <field id="ketrd_spg" long_name="ke-trend: surface pressure gradient" unit="W/s^3" /> 675 <field id="ketrd_spgexp" long_name="ke-trend: surface pressure gradient (explicit)" unit="W/s^3" /> 676 <field id="ketrd_spgflt" long_name="ke-trend: surface pressure gradient (filter)" unit="W/s^3" /> 677 <field id="ssh_flt" long_name="filtered contribution to ssh (dynspg_flt)" unit="m" grid_ref="grid_T_2D" /> 678 <field id="w0" long_name="surface vertical velocity" unit="m/s" grid_ref="grid_T_2D" /> 679 <field id="pw0_exp" long_name="surface pressure flux due to ssh" unit="W/s^2" grid_ref="grid_T_2D" /> 680 <field id="pw0_flt" long_name="surface pressure flux due to filtered ssh" unit="W/s^2" grid_ref="grid_T_2D" /> 681 <field id="ketrd_keg" long_name="ke-trend: KE gradient or hor. adv." unit="W/s^3" /> 682 <field id="ketrd_rvo" long_name="ke-trend: relative vorticity or metric term" unit="W/s^3" /> 683 <field id="ketrd_pvo" long_name="ke-trend: planetary vorticity" unit="W/s^3" /> 684 <field id="ketrd_zad" long_name="ke-trend: vertical advection" unit="W/s^3" /> 685 <field id="ketrd_udx" long_name="ke-trend: U.dx[U]" unit="W/s^3" /> 686 <field id="ketrd_ldf" long_name="ke-trend: lateral diffusion" unit="W/s^3" /> 687 <field id="ketrd_zdf" long_name="ke-trend: vertical diffusion" unit="W/s^3" /> 688 <field id="ketrd_tau" long_name="ke-trend: wind stress " unit="W/s^3" grid_ref="grid_T_2D" /> 689 <field id="ketrd_bfr" long_name="ke-trend: bottom friction (explicit)" unit="W/s^3" /> 690 <field id="ketrd_bfri" long_name="ke-trend: bottom friction (implicit)" unit="W/s^3" /> 691 <field id="ketrd_atf" long_name="ke-trend: asselin time filter trend" unit="W/s^3" /> 692 <field id="ketrd_convP2K" long_name="ke-trend: conversion (potential to kinetic)" unit="W/s^3" /> 693 <field id="KE" long_name="kinetic energy: u(n)*u(n+1)/2" unit="W/s^2" /> 694 <!-- variables available with ln_PE_trd --> 695 <field id="petrd_xad" long_name="pe-trend: i-advection" unit="W/m^3" /> 696 <field id="petrd_yad" long_name="pe-trend: j-advection" unit="W/m^3" /> 697 <field id="petrd_zad" long_name="pe-trend: k-advection" unit="W/m^3" /> 698 <field id="petrd_sad" long_name="pe-trend: surface adv. (no-vvl)" unit="W/m^3" grid_ref="grid_T_2D" /> 699 <field id="petrd_ldf" long_name="pe-trend: lateral diffusion" unit="W/m^3" /> 700 <field id="petrd_zdf" long_name="pe-trend: vertical diffusion" unit="W/m^3" /> 701 <field id="petrd_zdfp" long_name="pe-trend: pure vert. diffusion" unit="W/m^3" /> 702 <field id="petrd_dmp" long_name="pe-trend: interior restoring" unit="W/m^3" /> 703 <field id="petrd_bbl" long_name="pe-trend: bottom boundary layer" unit="W/m^3" /> 704 <field id="petrd_npc" long_name="pe-trend: non-penetrative conv." unit="W/m^3" /> 705 <field id="petrd_nsr" long_name="pe-trend: surface forcing + runoff" unit="W/m^3" /> 706 <field id="petrd_qsr" long_name="pe-trend: solar penetr. heating" unit="W/m^3" /> 707 <field id="petrd_bbc" long_name="pe-trend: geothermal heating" unit="W/m^3" /> 708 <field id="petrd_atf" long_name="pe-trend: asselin time filter" unit="W/m^3" /> 709 <field id="PEanom" long_name="potential energy anomaly" unit="SI" /> 710 <field id="alphaPE" long_name="- partial deriv. of PEanom wrt T" unit="/degC" /> 711 <field id="betaPE" long_name="partial deriv. of PEanom wrt S" unit="/psu" /> 712 </field_group> 713 714 <field_group id="trendU" grid_ref="grid_U_3D"> 715 <!-- variables available with ln_dyn_trd --> 716 <field id="utrd_hpg" long_name="i-trend: hydrostatic pressure gradient" unit="m/s^2" /> 717 <field id="utrd_spg" long_name="i-trend: surface pressure gradient" unit="m/s^2" /> 718 <field id="utrd_spgexp" long_name="i-trend: surface pressure gradient (explicit)" unit="m/s^2" /> 719 <field id="utrd_spgflt" long_name="i-trend: surface pressure gradient (filtered)" unit="m/s^2" /> 720 <field id="utrd_keg" long_name="i-trend: KE gradient or hor. adv." unit="m/s^2" /> 721 <field id="utrd_rvo" long_name="i-trend: relative vorticity or metric term" unit="m/s^2" /> 722 <field id="utrd_pvo" long_name="i-trend: planetary vorticity" unit="m/s^2" /> 723 <field id="utrd_zad" long_name="i-trend: vertical advection" unit="m/s^2" /> 724 <field id="utrd_udx" long_name="i-trend: U.dx[U]" unit="m/s^2" /> 725 <field id="utrd_ldf" long_name="i-trend: lateral diffusion" unit="m/s^2" /> 726 <field id="utrd_zdf" long_name="i-trend: vertical diffusion" unit="m/s^2" /> 727 <field id="utrd_tau" long_name="i-trend: wind stress " unit="m/s^2" grid_ref="grid_U_2D" /> 728 <field id="utrd_bfr" long_name="i-trend: bottom friction (explicit)" unit="m/s^2" /> 729 <field id="utrd_bfri" long_name="i-trend: bottom friction (implicit)" unit="m/s^2" /> 730 <field id="utrd_tot" long_name="i-trend: total momentum trend before atf" unit="m/s^2" /> 731 <field id="utrd_atf" long_name="i-trend: asselin time filter trend" unit="m/s^2" /> 732 </field_group> 733 734 <field_group id="trendV" grid_ref="grid_V_3D"> 735 <!-- variables available with ln_dyn_trd --> 736 <field id="vtrd_hpg" long_name="j-trend: hydrostatic pressure gradient" unit="m/s^2" /> 737 <field id="vtrd_spg" long_name="j-trend: surface pressure gradient" unit="m/s^2" /> 738 <field id="vtrd_spgexp" long_name="j-trend: surface pressure gradient (explicit)" unit="m/s^2" /> 739 <field id="vtrd_spgflt" long_name="j-trend: surface pressure gradient (filtered)" unit="m/s^2" /> 740 <field id="vtrd_keg" long_name="j-trend: KE gradient or hor. adv." unit="m/s^2" /> 741 <field id="vtrd_rvo" long_name="j-trend: relative vorticity or metric term" unit="m/s^2" /> 742 <field id="vtrd_pvo" long_name="j-trend: planetary vorticity" unit="m/s^2" /> 743 <field id="vtrd_zad" long_name="j-trend: vertical advection" unit="m/s^2" /> 744 <field id="vtrd_vdy" long_name="i-trend: V.dx[V]" unit="m/s^2" /> 745 <field id="vtrd_ldf" long_name="j-trend: lateral diffusion" unit="m/s^2" /> 746 <field id="vtrd_zdf" long_name="j-trend: vertical diffusion" unit="m/s^2" /> 747 <field id="vtrd_tau" long_name="j-trend: wind stress " unit="m/s^2" grid_ref="grid_V_2D" /> 748 <field id="vtrd_bfr" long_name="j-trend: bottom friction (explicit)" unit="m/s^2" /> 749 <field id="vtrd_bfri" long_name="j-trend: bottom friction (implicit)" unit="m/s^2" /> 750 <field id="vtrd_tot" long_name="j-trend: total momentum trend before atf" unit="m/s^2" /> 751 <field id="vtrd_atf" long_name="j-trend: asselin time filter trend" unit="m/s^2" /> 752 </field_group> 753 631 754 </field_definition> -
branches/2014/dev_CNRS_2014/NEMOGCM/CONFIG/SHARED/namelist_ref
r4384 r4896 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! NEMO/OPA : 1 - run manager (namrun , namcfg)3 !! namelists 2 - Domain (nam zgr, namzgr_sco, namdom, namtsd)2 !! NEMO/OPA : 1 - run manager (namrun) 3 !! namelists 2 - Domain (namcfg, namzgr, namzgr_sco, namdom, namtsd) 4 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, namsbc_sas 5 5 !! namsbc_cpl, namtra_qsr, namsbc_rnf, … … 18 18 !! *** Run management namelists *** 19 19 !!====================================================================== 20 !! namrun 20 !! namrun parameters of the run 21 21 !!====================================================================== 22 22 ! … … 31 31 nn_leapy = 0 ! Leap year calendar (1) or not (0) 32 32 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 33 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart= .true.34 nn_rstctl = 0 ! restart control = > activated only if ln_rstart =T33 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T 34 nn_rstctl = 0 ! restart control ==> activated only if ln_rstart=T 35 35 ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist 36 36 ! = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart … … 47 47 / 48 48 ! 49 !----------------------------------------------------------------------- 50 &namcfg ! default parameters of the configuration 49 !!====================================================================== 50 !! *** Domain namelists *** 51 !!====================================================================== 52 !! namcfg parameters of the configuration 53 !! namzgr vertical coordinate 54 !! namzgr_sco s-coordinate or hybrid z-s-coordinate 55 !! namdom space and time domain (bathymetry, mesh, timestep) 56 !! namtsd data: temperature & salinity 57 !!====================================================================== 58 ! 59 !----------------------------------------------------------------------- 60 &namcfg ! parameters of the configuration 51 61 !----------------------------------------------------------------------- 52 62 cp_cfg = "default" ! name of the configuration 53 cp_cfz = ''! name of the zoom of configuration63 cp_cfz = "no zoom" ! name of the zoom of configuration 54 64 jp_cfg = 0 ! resolution of the configuration 55 65 jpidta = 10 ! 1st lateral dimension ( >= jpi ) … … 57 67 jpkdta = 31 ! number of levels ( >= jpk ) 58 68 jpiglo = 10 ! 1st dimension of global domain --> i =jpidta 59 jpjglo = 12 ! 2nd - - --> j 69 jpjglo = 12 ! 2nd - - --> j =jpjdta 60 70 jpizoom = 1 ! left bottom (i,j) indices of the zoom 61 71 jpjzoom = 1 ! in data domain indices … … 67 77 ! = 6 cyclic East-West AND North fold F-point pivot 68 78 / 69 !!======================================================================70 !! *** Domain namelists ***71 !!======================================================================72 !! namzgr vertical coordinate73 !! namzgr_sco s-coordinate or hybrid z-s-coordinate74 !! namdom space and time domain (bathymetry, mesh, timestep)75 !! namtsd data: temperature & salinity76 !!======================================================================77 !78 79 !----------------------------------------------------------------------- 79 80 &namzgr ! vertical coordinate … … 635 636 !! nameos equation of state 636 637 !! namtra_adv advection scheme 638 !! namtra_adv_mle mixed layer eddy param. (Fox-Kemper param.) 637 639 !! namtra_ldf lateral diffusion scheme 638 640 !! namtra_dmp T & S newtonian damping … … 642 644 &nameos ! ocean physical parameters 643 645 !----------------------------------------------------------------------- 644 nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency 645 ! = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) ) 646 ! = 1, linear: rho(T) = rau0 * ( 1.028 - ralpha * T ) 647 ! = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T ) 648 rn_alpha = 2.0e-4 ! thermal expension coefficient (nn_eos= 1 or 2) 649 rn_beta = 7.7e-4 ! saline expension coefficient (nn_eos= 2) 646 nn_eos = -1 ! type of equation of state and Brunt-Vaisala frequency 647 ! =-1, TEOS-10 648 ! = 0, EOS-80 649 ! = 1, S-EOS (simplified eos) 650 ln_useCT = .true. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm 651 ! ! 652 ! ! S-EOS coefficients : 653 ! ! rd(T,S,Z)*rau0 = -a0*(1+.5*lambda*dT+mu*Z+nu*dS)*dT+b0*dS 654 rn_a0 = 1.6550e-1 ! thermal expension coefficient (nn_eos= 1) 655 rn_b0 = 7.6554e-1 ! saline expension coefficient (nn_eos= 1) 656 rn_lambda1 = 5.9520e-2 ! cabbeling coeff in T^2 (=0 for linear eos) 657 rn_lambda2 = 7.4914e-4 ! cabbeling coeff in S^2 (=0 for linear eos) 658 rn_mu1 = 1.4970e-4 ! thermobaric coeff. in T (=0 for linear eos) 659 rn_mu2 = 1.1090e-5 ! thermobaric coeff. in S (=0 for linear eos) 660 rn_nu = 2.4341e-3 ! cabbeling coeff in T*S (=0 for linear eos) 650 661 / 651 662 !----------------------------------------------------------------------- 652 663 &namtra_adv ! advection scheme for tracer 653 664 !----------------------------------------------------------------------- 654 ln_traadv_cen2 = .false. ! 2nd order centered scheme655 ln_traadv_tvd = .true. ! TVD scheme656 ln_traadv_muscl = .false. ! MUSCL scheme657 ln_traadv_muscl2 = .false. ! MUSCL2 scheme + cen2 at boundaries658 ln_traadv_ubs = .false. ! UBS scheme659 ln_traadv_qck = .false. ! QUICKEST scheme660 ln_traadv_msc_ups= .false. ! use upstream scheme within muscl665 ln_traadv_cen2 = .false. ! 2nd order centered scheme 666 ln_traadv_tvd = .true. ! TVD scheme 667 ln_traadv_muscl = .false. ! MUSCL scheme 668 ln_traadv_muscl2 = .false. ! MUSCL2 scheme + cen2 at boundaries 669 ln_traadv_ubs = .false. ! UBS scheme 670 ln_traadv_qck = .false. ! QUICKEST scheme 671 ln_traadv_msc_ups= .false. ! use upstream scheme within muscl 661 672 / 662 673 !----------------------------------------------------------------------- … … 914 925 !! *** Miscellaneous namelists *** 915 926 !!====================================================================== 927 !! namsol elliptic solver / island / free surface 916 928 !! nammpp Massively Parallel Processing ("key_mpp_mpi) 917 929 !! namctl Control prints & Benchmark 918 !! namsol elliptic solver / island / free surface 930 !! namc1d 1D configuration options ("key_c1d") 931 !! namc1d_uvd data: U & V currents ("key_c1d") 932 !! namc1d_dyndmp U & V newtonian damping ("key_c1d") 919 933 !!====================================================================== 920 934 ! … … 981 995 ln_dyndmp = .false. ! add a damping term (T) or not (F) 982 996 / 997 983 998 !!====================================================================== 984 999 !! *** Diagnostics namelists *** 985 1000 !!====================================================================== 986 1001 !! namnc4 netcdf4 chunking and compression settings ("key_netcdf4") 987 !! namtrd dynamics and/or tracer trends ("key_trddyn","key_trdtra","key_trdmld")1002 !! namtrd dynamics and/or tracer trends 988 1003 !! namflo float parameters ("key_float") 989 1004 !! namptr Poleward Transport Diagnostics … … 1003 1018 / 1004 1019 !----------------------------------------------------------------------- 1005 &namtrd ! diagnostics on dynamics and/or tracer trends ("key_trddyn" and/or "key_trdtra") 1006 ! ! or mixed-layer trends or barotropic vorticity ("key_trdmld" or "key_trdvor") 1007 !----------------------------------------------------------------------- 1008 nn_trd = 365 ! time step frequency dynamics and tracers trends 1009 nn_ctls = 0 ! control surface type in mixed-layer trends (0,1 or n<jpk) 1010 rn_ucf = 1. ! unit conversion factor (=1 -> /seconds ; =86400. -> /day) 1011 cn_trdrst_in = "restart_mld" ! suffix of ocean restart name (input) 1012 cn_trdrst_out = "restart_mld" ! suffix of ocean restart name (output) 1013 ln_trdmld_restart = .false. ! restart for ML diagnostics 1014 ln_trdmld_instant = .false. ! flag to diagnose trends of instantantaneous or mean ML T/S 1015 / 1020 &namtrd ! diagnostics on dynamics and/or tracer trends 1021 ! ! and/or mixed-layer trends and/or barotropic vorticity 1022 !----------------------------------------------------------------------- 1023 ln_glo_trd = .false. ! (T) global domain averaged diag for T, T^2, KE, and PE 1024 ln_dyn_trd = .false. ! (T) 3D momentum trend output 1025 ln_dyn_mxl = .FALSE. ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 1026 ln_vor_trd = .FALSE. ! (T) 2D barotropic vorticity trends (not coded yet) 1027 ln_KE_trd = .false. ! (T) 3D Kinetic Energy trends 1028 ln_PE_trd = .false. ! (T) 3D Potential Energy trends 1029 ln_tra_trd = .true. ! (T) 3D tracer trend output 1030 ln_tra_mxl = .false. ! (T) 2D tracer trends averaged over the mixed layer (not coded yet) 1031 nn_trd = 365 ! print frequency (ln_glo_trd=T) (unit=time step) 1032 / 1033 !!gm nn_ctls = 0 ! control surface type in mixed-layer trends (0,1 or n<jpk) 1034 !!gm rn_ucf = 1. ! unit conversion factor (=1 -> /seconds ; =86400. -> /day) 1035 !!gm cn_trdrst_in = "restart_mld" ! suffix of ocean restart name (input) 1036 !!gm cn_trdrst_out = "restart_mld" ! suffix of ocean restart name (output) 1037 !!gm ln_trdmld_restart = .false. ! restart for ML diagnostics 1038 !!gm ln_trdmld_instant = .false. ! flag to diagnose trends of instantantaneous or mean ML T/S 1039 !!gm 1016 1040 !----------------------------------------------------------------------- 1017 1041 &namflo ! float parameters ("key_float") -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90
r3625 r4896 86 86 zdiv0(:, 1 ) = 0._wp 87 87 zdiv0(:,jpj) = 0._wp 88 IF( .NOT.lk_vopt_loop ) THEN 89 zflu (jpi,:) = 0._wp 90 zflv (jpi,:) = 0._wp 91 zdiv0(1, :) = 0._wp 92 zdiv0(jpi,:) = 0._wp 93 ENDIF 88 zflu (jpi,:) = 0._wp 89 zflv (jpi,:) = 0._wp 90 zdiv0(1, :) = 0._wp 91 zdiv0(jpi,:) = 0._wp 94 92 95 93 zconv = 1._wp !== horizontal diffusion using a Crant-Nicholson scheme ==! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90
r4147 r4896 14 14 !! 'key_lim2' : LIM 2.0 sea-ice model 15 15 !!---------------------------------------------------------------------- 16 !!----------------------------------------------------------------------17 16 !! lim_istate_2 : Initialisation of diagnostics ice variables 18 17 !! lim_istate_init_2 : initialization of ice state and namelist read … … 34 33 PUBLIC lim_istate_2 ! routine called by lim_init_2.F90 35 34 36 ! !! ** namelist (namiceini) **37 LOGICAL :: ln_limini ! :Ice initialization state35 ! !! ** namelist (namiceini) ** 36 LOGICAL :: ln_limini ! Ice initialization state 38 37 REAL(wp) :: ttest ! threshold water temperature for initial sea ice 39 38 REAL(wp) :: hninn ! initial snow thickness in the north … … 51 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 52 51 !!---------------------------------------------------------------------- 53 54 52 CONTAINS 55 53 … … 71 69 IF( .NOT. ln_limini ) THEN 72 70 73 tfu(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1) ! freezing/melting point of sea water [Celcius]71 tfu(:,:) = eos_fzp( tsn(:,:,1,jp_sal) ) * tmask(:,:,1) ! freezing/melting point of sea water [Celcius] 74 72 75 73 DO jj = 1, jpj -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r4333 r4896 83 83 zdiv0(:, 1 ) = 0._wp 84 84 zdiv0(:,jpj) = 0._wp 85 IF( .NOT.lk_vopt_loop ) THEN 86 zflu (jpi,:) = 0._wp 87 zflv (jpi,:) = 0._wp 88 zdiv0(1, :) = 0._wp 89 zdiv0(jpi,:) = 0._wp 90 ENDIF 85 zflu (jpi,:) = 0._wp 86 zflv (jpi,:) = 0._wp 87 zdiv0(1, :) = 0._wp 88 zdiv0(jpi,:) = 0._wp 91 89 92 90 zconv = 1._wp !== horizontal diffusion using a Crant-Nicholson scheme ==! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r4335 r4896 36 36 PUBLIC lim_istate ! routine called by lim_init.F90 37 37 38 !! * Module variables39 38 ! !!** init namelist (namiceini) ** 40 39 REAL(wp) :: ttest ! threshold water temperature for initial sea ice … … 53 52 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 54 53 !!---------------------------------------------------------------------- 55 56 54 CONTAINS 57 55 … … 121 119 122 120 ! Basal temperature is set to the freezing point of seawater in Celsius 123 t_bo(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1) ! freezing/melting point of sea water [Celcius]121 t_bo(:,:) = eos_fzp( tsn(:,:,1,jp_sal) ) * tmask(:,:,1) ! freezing/melting point of sea water [Celcius] 124 122 125 123 DO jj = 1, jpj ! ice if sst <= t-freez + ttest -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r4570 r4896 535 535 !!--------------------------------------------------------------------- 536 536 #if defined key_ldfslp && ! defined key_c1d 537 CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) ) ! Time-filtered in situ density538 CALL bn2 ( pts, rn2 ) ! before Brunt-Vaisala frequency537 CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points 538 CALL bn2 ( pts, rab_n, rn2 ) ! now Brunt-Vaisala 539 539 IF( ln_zps ) & 540 540 & CALL zps_hde( kt, jpts, pts, gtsu, gtsv, rhd, gru, grv ) ! Partial steps: before Horizontal DErivative -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r4313 r4896 109 109 !! ** Action : 110 110 !!---------------------------------------------------------------------- 111 INTEGER :: ji, jj, jk 112 INTEGER :: jt 113 INTEGER :: imid 114 INTEGER :: inum 111 INTEGER :: ji, jj, jk, jt ! dummy loop indices 112 INTEGER :: imid, inum ! local integers 113 INTEGER :: ios ! Local integer output status for namelist read 115 114 INTEGER :: iiauper ! Number of time steps in the IAU period 116 115 INTEGER :: icycper ! Number of time steps in the cycle … … 120 119 INTEGER :: iitiaustr_date ! Date YYYYMMDD of IAU interval start time step 121 120 INTEGER :: iitiaufin_date ! Date YYYYMMDD of IAU interval final time step 122 INTEGER :: ios ! Local integer output status for namelist read 123 121 ! 124 122 REAL(wp) :: znorm ! Normalization factor for IAU weights 125 REAL(wp) :: ztotwgt ! Value of time-integrated IAU weights 126 ! (should be equal to one) 123 REAL(wp) :: ztotwgt ! Value of time-integrated IAU weights (should be equal to one) 127 124 REAL(wp) :: z_inc_dateb ! Start date of interval on which increment is valid 128 125 REAL(wp) :: z_inc_datef ! End date of interval on which increment is valid 129 126 REAL(wp) :: zdate_bkg ! Date in background state file for DI 130 127 REAL(wp) :: zdate_inc ! Time axis in increments file 131 132 REAL(wp), POINTER, DIMENSION(:,:) :: hdiv128 ! 129 REAL(wp), POINTER, DIMENSION(:,:) :: hdiv ! 2D workspace 133 130 !! 134 131 NAMELIST/nam_asminc/ ln_bkgwri, & … … 136 133 & ln_asmdin, ln_asmiau, & 137 134 & nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, & 138 & ln_salfix, salfixmin, & 139 & nn_divdmp 135 & ln_salfix, salfixmin, nn_divdmp 140 136 !!---------------------------------------------------------------------- 141 137 … … 143 139 ! Read Namelist nam_asminc : assimilation increment interface 144 140 !----------------------------------------------------------------------- 145 146 141 ln_seaiceinc = .FALSE. 147 142 ln_temnofreeze = .FALSE. … … 186 181 icycper = nitend - nit000 + 1 ! Cycle interval length 187 182 188 ! Date of final time step 189 CALL calc_date( nit000, nitend, ndate0, iitend_date ) 190 191 ! Background time for Jb referenced to ndate0 192 CALL calc_date( nit000, nitbkg_r, ndate0, iitbkg_date ) 193 194 ! Background time for DI referenced to ndate0 195 CALL calc_date( nit000, nitdin_r, ndate0, iitdin_date ) 196 197 ! IAU start time referenced to ndate0 198 CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date ) 199 200 ! IAU end time referenced to ndate0 201 CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date ) 202 183 CALL calc_date( nit000, nitend , ndate0, iitend_date ) ! Date of final time step 184 CALL calc_date( nit000, nitbkg_r , ndate0, iitbkg_date ) ! Background time for Jb referenced to ndate0 185 CALL calc_date( nit000, nitdin_r , ndate0, iitdin_date ) ! Background time for DI referenced to ndate0 186 CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date ) ! IAU start time referenced to ndate0 187 CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date ) ! IAU end time referenced to ndate0 188 ! 203 189 IF(lwp) THEN 204 190 WRITE(numout,*) … … 675 661 ! used to prevent the applied increments taking the temperature below the local freezing point 676 662 677 DO jk =1, jpkm1678 fzptnz (:,:,jk) = tfreez( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) )679 END DO663 DO jk = 1, jpkm1 664 fzptnz(:,:,jk) = eos_fzp( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) ) 665 END DO 680 666 681 667 IF ( ln_asmiau ) THEN … … 692 678 IF(lwp) THEN 693 679 WRITE(numout,*) 694 WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', & 695 & kt,' with IAU weight = ', wgtiau(it) 680 WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 696 681 WRITE(numout,*) '~~~~~~~~~~~~' 697 682 ENDIF … … 741 726 IF (ln_temnofreeze) THEN 742 727 ! Do not apply negative increments if the temperature will fall below freezing 743 WHERE(t_bkginc(:,:,:) > 0.0_wp .OR. & 744 & tsn(:,:,:,jp_tem) + t_bkginc(:,:,:) > fzptnz(:,:,:) ) 728 WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_tem) + t_bkginc(:,:,:) > fzptnz(:,:,:) ) 745 729 tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:) 746 730 END WHERE … … 751 735 ! Do not apply negative increments if the salinity will fall below a specified 752 736 ! minimum value salfixmin 753 WHERE(s_bkginc(:,:,:) > 0.0_wp .OR. & 754 & tsn(:,:,:,jp_sal) + s_bkginc(:,:,:) > salfixmin ) 737 WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. tsn(:,:,:,jp_sal) + s_bkginc(:,:,:) > salfixmin ) 755 738 tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:) 756 739 END WHERE … … 761 744 tsb(:,:,:,:) = tsn(:,:,:,:) ! Update before fields 762 745 746 !!gm orig 763 747 CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) ) ! Before potential and in situ densities 764 748 !!gm fabien 749 ! CALL eos( tsb, rhd, rhop ) ! Before potential and in situ densities 750 !!gm 751 752 765 753 IF( ln_zps .AND. .NOT. lk_c1d ) & 766 754 & CALL zps_hde( nit000, jpts, tsb, & ! Partial steps: before horizontal derivative … … 770 758 #if defined key_zdfkpp 771 759 CALL eos( tsn, rhd, fsdept_n(:,:,:) ) ! Compute rhd 760 !!gm fabien CALL eos( tsn, rhd ) ! Compute rhd 772 761 #endif 773 762 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
r4367 r4896 15 15 USE dom_oce ! ocean: domain variables 16 16 USE c1d ! 1D vertical configuration 17 USE trdmod ! ocean: trends18 USE trdmod_oce ! ocean: trends variables19 17 USE tradmp ! ocean: internal damping 20 18 USE zdf_oce ! ocean: vertical physics … … 164 162 !! ** Action : - (ua,va) momentum trends updated with the damping trend 165 163 !!---------------------------------------------------------------------- 166 !167 164 INTEGER, INTENT(in) :: kt ! ocean time-step index 168 165 !! … … 236 233 END SELECT 237 234 ! 238 ! ! Trend diagnostic239 IF( l_trddyn ) CALL trd_mod( utrdmp, vtrdmp, jpdyn_trd_dat, 'DYN', kt )235 !!gm ! ! Trend diagnostic 236 !!gm IF( l_trddyn ) CALL trd_mod( utrdmp, vtrdmp, jpdyn_trd_dat, 'DYN', kt ) 240 237 ! 241 238 ! ! Control print -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
r4313 r4896 72 72 ! Ocean physics update (ua, va, ta, sa used as workspace) 73 73 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 74 CALL bn2( tsb, r n2b )! before Brunt-Vaisala frequency75 CALL bn2( tsn, r n2 )! now Brunt-Vaisala frequency74 CALL bn2( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency 75 CALL bn2( tsn, rab_n, rn2 ) ! now Brunt-Vaisala frequency 76 76 ! VERTICAL PHYSICS 77 77 CALL zdf_bfr( kstp ) ! bottom friction … … 115 115 ! Passive Tracer Model 116 116 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 117 CALL trc_stp( kstp )! time-stepping117 CALL trc_stp( kstp ) ! time-stepping 118 118 #endif 119 119 … … 121 121 ! Active tracers (ua, va used as workspace) 122 122 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 123 tsa(:,:,:,:) = 0.e0! set tracer trends to zero123 tsa(:,:,:,:) = 0._wp ! set tracer trends to zero 124 124 125 CALL tra_sbc ( kstp )! surface boundary condition126 IF( ln_traqsr ) CALL tra_qsr ( kstp )! penetrative solar radiation qsr127 IF( ln_tradmp ) CALL tra_dmp ( kstp )! internal damping trends- tracers128 IF( lk_zdfkpp ) CALL tra_kpp ( kstp )! KPP non-local tracer fluxes129 CALL tra_zdf ( kstp )! vertical mixing130 CALL tra_nxt ( kstp ) ! tracer fields at next time step131 IF( ln_zdfnpc ) CALL tra_npc ( kstp )! applied non penetrative convective adjustment on (t,s)132 CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) ) ! now (swap=before) in situ density for dynhpg module125 CALL tra_sbc( kstp ) ! surface boundary condition 126 IF( ln_traqsr ) CALL tra_qsr( kstp ) ! penetrative solar radiation qsr 127 IF( ln_tradmp ) CALL tra_dmp( kstp ) ! internal damping trends- tracers 128 IF( lk_zdfkpp ) CALL tra_kpp( kstp ) ! KPP non-local tracer fluxes 129 CALL tra_zdf( kstp ) ! vertical mixing 130 CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) ) ! now potential density for zdfmxl 131 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! applied non penetrative convective adjustment on (t,s) 132 CALL tra_nxt( kstp ) ! tracer fields at next time step 133 133 134 134 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 135 135 ! Dynamics (ta, sa used as workspace) 136 136 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 137 ua(:,:,:) = 0.e0! set dynamics trends to zero138 va(:,:,:) = 0.e0137 ua(:,:,:) = 0._wp ! set dynamics trends to zero 138 va(:,:,:) = 0._wp 139 139 140 IF( ln_dyndmp ) CALL dyn_dmp ( kstp )! internal damping trends- momentum141 CALL dyn_cor_c1d( kstp )! vorticity term including Coriolis142 CALL dyn_zdf ( kstp )! vertical diffusion143 CALL dyn_nxt_c1d( kstp )! lateral velocity at next time step140 IF( ln_dyndmp ) CALL dyn_dmp ( kstp ) ! internal damping trends- momentum 141 CALL dyn_cor_c1d( kstp ) ! vorticity term including Coriolis 142 CALL dyn_zdf ( kstp ) ! vertical diffusion 143 CALL dyn_nxt_c1d( kstp ) ! lateral velocity at next time step 144 144 145 145 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 146 146 ! Control and restarts 147 147 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 148 149 IF( kstp == nit000 ) CALL iom_close( numror )! close input ocean restart file150 IF( lrst_oce ) CALL rst_write ( kstp )! write output ocean restart file148 CALL stp_ctl( kstp, indic ) 149 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 150 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 151 151 ! 152 152 END SUBROUTINE stp_c1d -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r4292 r4896 573 573 !!-------------------------------------------------------------------- 574 574 ! 575 CALL wrk_alloc( jpj , zphi , zfoo )576 CALL wrk_alloc( jpj , jpk , z_1)575 CALL wrk_alloc( jpj , zphi , zfoo ) 576 CALL wrk_alloc( jpj , jpk , z_1 ) 577 577 578 578 ! define time axis -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r4570 r4896 89 89 INTEGER, DIMENSION(2) :: ierr 90 90 !!---------------------------------------------------------------------- 91 !92 91 ierr = 0 93 !94 92 ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) , & 95 93 & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , & … … 165 163 CALL iom_put( "sss2" , tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) ) ! square of sea surface salinity 166 164 END IF 165 !!gm I don't understand why not thickness weighted velocity if ln_dynadv_vec .... 167 166 IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN 168 167 CALL iom_put( "uoce" , un(:,:,:) * fse3u_n(:,:,:) ) ! i-transport -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r4370 r4896 34 34 USE dtatsd ! data temperature and salinity (dta_tsd routine) 35 35 USE dtauvd ! data: U & V current (dta_uvd routine) 36 USE in_out_manager ! I/O manager37 USE iom ! I/O library38 36 USE zpshde ! partial step: hor. derivative (zps_hde routine) 39 37 USE eosbn2 ! equation of state (eos bn2 routine) … … 42 40 USE dynspg_flt ! filtered free surface 43 41 USE sol_oce ! ocean solver variables 42 ! 43 USE in_out_manager ! I/O manager 44 USE iom ! I/O library 44 45 USE lib_mpp ! MPP library 45 46 USE restart ! restart … … 56 57 # include "vectopt_loop_substitute.h90" 57 58 !!---------------------------------------------------------------------- 58 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)59 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 59 60 !! $Id$ 60 61 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 73 74 !!---------------------------------------------------------------------- 74 75 ! 75 IF( nn_timing == 1 ) CALL timing_start('istate_init')76 IF( nn_timing == 1 ) CALL timing_start('istate_init') 76 77 ! 77 78 … … 83 84 IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data 84 85 85 rhd (:,:,: ) = 0.e0 86 rhop (:,:,: ) = 0.e0 87 rn2 (:,:,: ) = 0.e0 88 tsa (:,:,:,:) = 0.e0 86 rhd (:,:,: ) = 0._wp 87 rhop (:,:,: ) = 0._wp 88 rn2 (:,:,: ) = 0._wp 89 tsa (:,:,:,:) = 0._wp 90 rab_b(:,:,:,:) = 0._wp 91 rab_n(:,:,:,:) = 0._wp 89 92 90 93 IF( ln_rstart ) THEN ! Restart from a file … … 162 165 ! 163 166 DO jk = 1, jpkm1 164 #if defined key_vectopt_loop165 DO jj = 1, 1 !Vector opt. => forced unrolling166 DO ji = 1, jpij167 #else168 167 DO jj = 1, jpj 169 168 DO ji = 1, jpi 170 #endif171 169 un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 172 170 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) … … 185 183 ! 186 184 ! 187 IF( nn_timing == 1 ) CALL timing_stop('istate_init')185 IF( nn_timing == 1 ) CALL timing_stop('istate_init') 188 186 ! 189 187 END SUBROUTINE istate_init 188 190 189 191 190 SUBROUTINE istate_t_s … … 219 218 END SUBROUTINE istate_t_s 220 219 220 221 221 SUBROUTINE istate_eel 222 222 !!---------------------------------------------------------------------- … … 233 233 USE divcur ! hor. divergence & rel. vorticity (div_cur routine) 234 234 USE iom 235 235 ! 236 236 INTEGER :: inum ! temporary logical unit 237 237 INTEGER :: ji, jj, jk ! dummy loop indices … … 244 244 REAL(wp), DIMENSION(jpiglo,jpjglo) :: zssh ! initial ssh over the global domain 245 245 !!---------------------------------------------------------------------- 246 246 ! 247 247 SELECT CASE ( jp_cfg ) 248 248 ! ! ==================== … … 375 375 INTEGER, PARAMETER :: ntsinit = 0 ! (0/1) (analytical/input data files) T&S initialization 376 376 !!---------------------------------------------------------------------- 377 377 ! 378 378 SELECT CASE ( ntsinit) 379 379 ! 380 380 CASE ( 0 ) ! analytical T/S profil deduced from LEVITUS 381 381 IF(lwp) WRITE(numout,*) 382 382 IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS ' 383 383 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 384 384 ! 385 385 DO jk = 1, jpk 386 386 DO jj = 1, jpj … … 407 407 END DO 408 408 END DO 409 409 ! 410 410 CASE ( 1 ) ! T/S data fields read in dta_tem.nc/data_sal.nc files 411 411 IF(lwp) WRITE(numout,*) … … 431 431 tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:) 432 432 tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 433 433 ! 434 434 END SELECT 435 435 ! 436 436 IF(lwp) THEN 437 437 WRITE(numout,*) … … 440 440 WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_1d(jk), tsn(2,2,jk,jp_tem), tsn(2,2,jk,jp_sal), jk = 1, jpk ) 441 441 ENDIF 442 442 ! 443 443 END SUBROUTINE istate_gyre 444 444 445 445 446 SUBROUTINE istate_uvg … … 457 458 USE divcur ! hor. divergence & rel. vorticity (div_cur routine) 458 459 USE lbclnk ! ocean lateral boundary condition (or mpp link) 459 460 ! 460 461 INTEGER :: ji, jj, jk ! dummy loop indices 461 462 INTEGER :: indic ! ??? … … 567 568 !!===================================================================== 568 569 END MODULE istate 569 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r3625 r4896 47 47 REAL(wp), PUBLIC :: rt0_ice = 273.05_wp !: melting point of ice [Kelvin] 48 48 #endif 49 #if defined key_cice 50 REAL(wp), PUBLIC :: rau0 = 1026._wp !: volumic mass of reference [kg/m3] 51 #else 52 REAL(wp), PUBLIC :: rau0 = 1035._wp !: volumic mass of reference [kg/m3] 53 #endif 49 REAL(wp), PUBLIC :: rau0 !: volumic mass of reference [kg/m3] 54 50 REAL(wp), PUBLIC :: r1_rau0 !: = 1. / rau0 [m3/kg] 55 REAL(wp), PUBLIC :: rauw = 1000._wp !: volumic mass of pure water [m3/kg] 56 REAL(wp), PUBLIC :: rcp = 4.e3_wp !: ocean specific heat [J/Kelvin] 51 REAL(wp), PUBLIC :: rcp !: ocean specific heat [J/Kelvin] 57 52 REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J] 58 53 REAL(wp), PUBLIC :: r1_rau0_rcp !: = 1. / ( rau0 * rcp ) … … 163 158 IF(lwp) WRITE(numout,*) ' melting point of ice rt0_ice = ', rt0_ice , ' K' 164 159 165 r1_rau0 = 1._wp / rau0 166 r1_rcp = 1._wp / rcp 167 r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 168 IF(lwp) WRITE(numout,*) 169 IF(lwp) WRITE(numout,*) ' volumic mass of pure water rauw = ', rauw , ' kg/m^3' 170 IF(lwp) WRITE(numout,*) ' volumic mass of reference rau0 = ', rau0 , ' kg/m^3' 171 IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0 = ', r1_rau0, ' m^3/kg' 172 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin' 173 IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp 174 175 160 IF(lwp) WRITE(numout,*) ' reference density and heat capacity now defined in eosbn2.f90' 161 176 162 #if defined key_lim3 || defined key_cice 177 163 xlsn = lfus * rhosn ! volumetric latent heat fusion of snow [J/m3] -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r3294 r4896 15 15 USE oce ! ocean dynamics and tracers 16 16 USE dom_oce ! ocean space and time domain 17 USE trdmod_oce ! ocean variables trends 18 USE trdmod ! ocean dynamics trends 17 USE trd_oce ! trends: ocean variables 18 USE trddyn ! trend manager: dynamics 19 ! 19 20 USE in_out_manager ! I/O manager 20 21 USE lib_mpp ! MPP library 21 22 USE prtctl ! Print control 22 USE wrk_nemo 23 USE timing 23 USE wrk_nemo ! Memory Allocation 24 USE timing ! Timing 24 25 25 26 IMPLICIT NONE … … 103 104 zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:) 104 105 zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:) 105 CALL trd_ mod( zfu_uw, zfv_vw, jpdyn_trd_had, 'DYN', kt )106 CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt ) 106 107 zfu_t(:,:,:) = ua(:,:,:) 107 108 zfv_t(:,:,:) = va(:,:,:) … … 153 154 zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:) 154 155 zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:) 155 CALL trd_ mod( zfu_t, zfv_t, jpdyn_trd_zad, 'DYN', kt )156 CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt ) 156 157 ENDIF 157 158 ! ! Control print -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r4153 r4896 16 16 USE oce ! ocean dynamics and tracers 17 17 USE dom_oce ! ocean space and time domain 18 USE trdmod ! ocean dynamics trends 19 USE trdmod_oce ! ocean variables trends 18 USE trd_oce ! trends: ocean variables 19 USE trddyn ! trend manager: dynamics 20 ! 20 21 USE in_out_manager ! I/O manager 21 22 USE prtctl ! Print control 22 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 24 USE lib_mpp ! MPP library 24 USE wrk_nemo 25 USE timing 25 USE wrk_nemo ! Memory Allocation 26 USE timing ! Timing 26 27 27 28 IMPLICIT NONE … … 196 197 zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:) 197 198 zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:) 198 CALL trd_ mod( zfu_uw, zfv_vw, jpdyn_trd_had, 'DYN', kt )199 CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt ) 199 200 zfu_t(:,:,:) = ua(:,:,:) 200 201 zfv_t(:,:,:) = va(:,:,:) … … 245 246 zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:) 246 247 zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:) 247 CALL trd_ mod( zfu_t, zfv_t, jpdyn_trd_zad, 'DYN', kt )248 CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt ) 248 249 ENDIF 249 250 ! ! Control print -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r3294 r4896 10 10 11 11 !!---------------------------------------------------------------------- 12 !! dyn_bfr : Update the momentum trend with the bottom friction contribution12 !! dyn_bfr : Update the momentum trend with the bottom friction contribution 13 13 !!---------------------------------------------------------------------- 14 USE oce 15 USE dom_oce 16 USE zdf_oce 17 USE zdfbfr 18 USE trd mod ! ocean active dynamics and tracers trends19 USE trd mod_oce ! ocean variables trends20 USE in_out_manager 21 USE prtctl 22 USE timing 23 USE wrk_nemo 14 USE oce ! ocean dynamics and tracers variables 15 USE dom_oce ! ocean space and time domain variables 16 USE zdf_oce ! ocean vertical physics variables 17 USE zdfbfr ! ocean bottom friction variables 18 USE trd_oce ! trends: ocean variables 19 USE trddyn ! trend manager: dynamics 20 USE in_out_manager ! I/O manager 21 USE prtctl ! Print control 22 USE timing ! Timing 23 USE wrk_nemo ! Memory Allocation 24 24 25 25 IMPLICIT NONE 26 26 PRIVATE 27 27 28 PUBLIC dyn_bfr 28 PUBLIC dyn_bfr ! routine called by step.F90 29 29 30 30 !! * Substitutions … … 57 57 IF( nn_timing == 1 ) CALL timing_start('dyn_bfr') 58 58 ! 59 !!gm issue: better to put the logical in step to control the call of zdf_bfr 60 !! ==> change the logical from ln_bfrimp to ln_bfr_exp !! 59 61 IF( .NOT.ln_bfrimp) THEN ! only for explicit bottom friction form 60 62 ! implicit bfr is implemented in dynzdf_imp 61 63 64 !!gm bug : time step is only rdt (not 2 rdt if euler start !) 62 65 zm1_2dt = - 1._wp / ( 2._wp * rdt ) 63 66 … … 69 72 70 73 71 # if defined key_vectopt_loop72 DO jj = 1, 173 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)74 # else75 74 DO jj = 2, jpjm1 76 75 DO ji = 2, jpim1 77 # endif78 76 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 79 77 ikbv = mbkv(ji,jj) … … 89 87 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 90 88 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 91 CALL trd_ mod( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_trd_bfr, 'DYN', kt )89 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 92 90 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 93 91 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r4292 r4896 31 31 USE dom_oce ! ocean space and time domain 32 32 USE phycst ! physical constants 33 USE trdmod ! ocean dynamics trends 34 USE trdmod_oce ! ocean variables trends 33 USE trd_oce ! trends: ocean variables 34 USE trddyn ! trend manager: dynamics 35 ! 35 36 USE in_out_manager ! I/O manager 36 37 USE prtctl ! Print control 37 USE lbclnk ! lateral boundary condition 38 USE lbclnk ! lateral boundary condition 38 39 USE lib_mpp ! MPP library 39 40 USE wrk_nemo ! Memory Allocation … … 74 75 !! 75 76 !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 76 !! - Save the trend(l_trddyn=T)77 !! - send trends to trd_dyn for futher diagnostics (l_trddyn=T) 77 78 !!---------------------------------------------------------------------- 78 79 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 99 100 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 100 101 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 101 CALL trd_ mod( ztrdu, ztrdv, jpdyn_trd_hpg, 'DYN', kt )102 CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 102 103 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 103 104 ENDIF … … 315 316 316 317 ! partial steps correction at the last level (use gru & grv computed in zpshde.F90) 317 # if defined key_vectopt_loop318 jj = 1319 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)320 # else321 318 DO jj = 2, jpjm1 322 319 DO ji = 2, jpim1 323 # endif324 320 iku = mbku(ji,jj) 325 321 ikv = mbkv(ji,jj) … … 338 334 va (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv) ! add the new one to the general momentum trend 339 335 ENDIF 340 # if ! defined key_vectopt_loop 341 END DO 342 # endif 336 END DO 343 337 END DO 344 338 ! … … 434 428 END SUBROUTINE hpg_sco 435 429 430 436 431 SUBROUTINE hpg_djc( kt ) 437 432 !!--------------------------------------------------------------------- … … 671 666 !! 672 667 !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 673 !! - Save the trend (l_trddyn=T)674 !!675 668 !!---------------------------------------------------------------------- 676 669 INTEGER, PARAMETER :: polynomial_type = 1 ! 1: cubic spline, 2: linear … … 724 717 725 718 ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 726 DO jj = 1, jpj; DO ji = 1, jpi 727 zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad 728 END DO ; END DO 729 730 DO jk = 2, jpk; DO jj = 1, jpj; DO ji = 1, jpi 731 zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk) 732 END DO ; END DO ; END DO 733 734 fsp(:,:,:) = zrhh(:,:,:) 719 DO jj = 1, jpj 720 DO ji = 1, jpi 721 zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad 722 END DO 723 END DO 724 725 DO jk = 2, jpk 726 DO jj = 1, jpj 727 DO ji = 1, jpi 728 zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk) 729 END DO 730 END DO 731 END DO 732 733 fsp(:,:,:) = zrhh (:,:,:) 735 734 xsp(:,:,:) = zdept(:,:,:) 736 735 … … 933 932 END SUBROUTINE hpg_prj 934 933 934 935 935 SUBROUTINE cspline(fsp, xsp, asp, bsp, csp, dsp, polynomial_type) 936 936 !!---------------------------------------------------------------------- … … 940 940 !! 941 941 !! ** Method : f(x) = asp + bsp*x + csp*x^2 + dsp*x^3 942 !! 942 943 !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation 943 !!944 944 !!---------------------------------------------------------------------- 945 945 IMPLICIT NONE … … 949 949 INTEGER, INTENT(in) :: polynomial_type ! 1: cubic spline 950 950 ! 2: Linear 951 952 ! Local Variables 951 ! 953 952 INTEGER :: ji, jj, jk ! dummy loop indices 954 953 INTEGER :: jpi, jpj, jpkm1 … … 1040 1039 ENDIF 1041 1040 1042 1043 1041 END SUBROUTINE cspline 1044 1042 … … 1050 1048 !! ** Purpose : 1-d linear interpolation 1051 1049 !! 1052 !! ** Method : 1053 !! interpolation is straight forward 1050 !! ** Method : interpolation is straight forward 1054 1051 !! extrapolation is also permitted (no value limit) 1055 !!1056 1052 !!---------------------------------------------------------------------- 1057 1053 IMPLICIT NONE … … 1070 1066 END FUNCTION interp1 1071 1067 1068 1072 1069 FUNCTION interp2(x, a, b, c, d) RESULT(f) 1073 1070 !!---------------------------------------------------------------------- … … 1133 1130 END FUNCTION integ_spline 1134 1131 1135 1136 1132 !!====================================================================== 1137 1133 END MODULE dynhpg -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r3294 r4896 14 14 USE oce ! ocean dynamics and tracers 15 15 USE dom_oce ! ocean space and time domain 16 USE trdmod ! ocean dynamics trends 17 USE trdmod_oce ! ocean variables trends 16 USE trd_oce ! trends: ocean variables 17 USE trddyn ! trend manager: dynamics 18 ! 18 19 USE in_out_manager ! I/O manager 19 20 USE lib_mpp ! MPP library … … 52 53 !! 53 54 !! ** Action : - Update the (ua, va) with the hor. ke gradient trend 54 !! - s ave this trends(l_trddyn=T) for post-processing55 !! - send this trends to trd_dyn (l_trddyn=T) for post-processing 55 56 !!---------------------------------------------------------------------- 56 57 INTEGER, INTENT( in ) :: kt ! ocean time-step index 57 ! !58 ! 58 59 INTEGER :: ji, jj, jk ! dummy loop indices 59 60 REAL(wp) :: zu, zv ! temporary scalars … … 131 132 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 132 133 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 133 CALL trd_ mod( ztrdu, ztrdv, jpdyn_trd_keg, 'DYN', kt )134 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 134 135 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 135 136 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r4522 r4896 15 15 USE phycst ! physical constants 16 16 USE ldfdyn_oce ! ocean dynamics lateral physics 17 USE ldftra_oce ! ocean tracers lateral physics 17 18 USE ldfslp ! lateral mixing: slopes of mixing orientation 18 19 USE dynldf_bilapg ! lateral mixing (dyn_ldf_bilapg routine) … … 20 21 USE dynldf_iso ! lateral mixing (dyn_ldf_iso routine) 21 22 USE dynldf_lap ! lateral mixing (dyn_ldf_lap routine) 22 USE ldftra_oce, ONLY: ln_traldf_hor ! ocean tracers lateral physics23 USE trd mod ! ocean dynamics and tracer trends24 USE trdmod_oce ! ocean variables trends23 USE trd_oce ! trends: ocean variables 24 USE trddyn ! trend manager: dynamics (trd_dyn routine) 25 ! 25 26 USE prtctl ! Print control 26 27 USE in_out_manager ! I/O manager … … 30 31 USE timing ! Timing 31 32 32 33 33 IMPLICIT NONE 34 34 PRIVATE … … 55 55 !! ** Purpose : compute the lateral ocean dynamics physics. 56 56 !!---------------------------------------------------------------------- 57 !58 57 INTEGER, INTENT(in) :: kt ! ocean time-step index 59 58 ! … … 107 106 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 108 107 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 109 CALL trd_ mod( ztrdu, ztrdv, jpdyn_trd_ldf, 'DYN', kt )108 CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 110 109 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 111 110 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
r3634 r4896 19 19 USE dom_oce ! ocean space and time domain 20 20 USE ldfdyn_oce ! ocean dynamics: lateral physics 21 ! 21 22 USE in_out_manager ! I/O manager 22 USE trdmod ! ocean dynamics trends23 USE trdmod_oce ! ocean variables trends24 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 24 USE wrk_nemo ! Memory Allocation … … 70 69 !! Add this before trend to the general trend (ua,va): 71 70 !! (ua,va) = (ua,va) + (diffu,diffv) 72 !! 'key_trddyn' defined: the two components of the horizontal73 !! diffusion trend are saved.74 71 !! 75 72 !! ** Action : - Update (ua,va) with the before iso-level biharmonic 76 73 !! mixing trend. 77 74 !!---------------------------------------------------------------------- 78 !79 75 INTEGER, INTENT(in) :: kt ! ocean time-step index 80 76 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r4488 r4896 19 19 USE dom_oce ! ocean space and time domain 20 20 USE ldfdyn_oce ! ocean dynamics lateral physics 21 USE zdf_oce ! ocean vertical physics 22 USE ldfslp ! iso-neutral slopes available 21 23 USE ldftra_oce, ONLY: ln_traldf_iso 22 USE zdf_oce ! ocean vertical physics 23 USE trdmod ! ocean dynamics trends 24 USE trdmod_oce ! ocean variables trends 25 USE ldfslp ! iso-neutral slopes available 24 ! 26 25 USE in_out_manager ! I/O manager 27 26 USE lib_mpp ! MPP library … … 81 80 !! -3- Add this trend to the general trend (ta,sa): 82 81 !! (ua,va) = (ua,va) + (zwk3,zwk4) 83 !! 'key_trddyn' defined: the trend is saved for diagnostics.84 82 !! 85 83 !! ** Action : - Update (ua,va) arrays with the before geopotential 86 84 !! biharmonic mixing trend. 87 !! - save the trend in (zwk3,zwk4) ('key_trddyn')88 85 !!---------------------------------------------------------------------- 89 86 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 201 198 !! pu and pv (all the components except 202 199 !! second order vertical derivative term) 203 !! 'key_trddyn' defined: the trend is saved for diagnostics. 204 !!---------------------------------------------------------------------- 205 !! 200 !!---------------------------------------------------------------------- 206 201 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu , pv ! 1st call: before horizontal velocity 207 202 ! ! 2nd call: ahm x these fields -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r4488 r4896 22 22 USE ldftra_oce ! ocean tracer lateral physics 23 23 USE zdf_oce ! ocean vertical physics 24 USE trdmod ! ocean dynamics trends25 USE trdmod_oce ! ocean variables trends26 24 USE ldfslp ! iso-neutral slopes 25 ! 27 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 28 27 USE in_out_manager ! I/O manager -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
r3294 r4896 19 19 USE ldfdyn_oce ! ocean dynamics: lateral physics 20 20 USE zdf_oce ! ocean vertical physics 21 ! 21 22 USE in_out_manager ! I/O manager 22 USE trdmod ! ocean dynamics trends23 USE trdmod_oce ! ocean variables trends24 USE ldfslp ! iso-neutral slopes25 23 USE timing ! Timing 26 24 … … 57 55 !! Add this before trend to the general trend (ua,va): 58 56 !! (ua,va) = (ua,va) + (diffu,diffv) 59 !! 'key_trddyn' activated: the two components of the horizontal60 !! diffusion trend are saved.61 57 !! 62 !! ** Action : - Update (ua,va) with the before iso-level harmonic 63 !! mixing trend. 58 !! ** Action : - Update (ua,va) with the iso-level harmonic mixing trend 64 59 !!---------------------------------------------------------------------- 65 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r4370 r4896 18 18 !! 3.3 ! 2011-03 (P. Oddo) Bug fix for time-splitting+(BDY-OBC) and not VVL 19 19 !! 3.5 ! 2013-07 (J. Chanut) Compliant with time splitting changes 20 !! 3.7 ! 2014-04 (G. Madec) add the diagnostic of the time filter trends 20 21 !!------------------------------------------------------------------------- 21 22 … … 34 35 USE bdydyn ! ocean open boundary conditions 35 36 USE bdyvol ! ocean open boundary condition (bdy_vol routines) 37 USE trd_oce ! trends: ocean variables 38 USE trddyn ! trend manager: dynamics 39 USE trdken ! trend manager: kinetic energy 40 ! 36 41 USE in_out_manager ! I/O manager 42 USE iom ! I/O manager library 37 43 USE lbclnk ! lateral boundary condition (or mpp link) 38 44 USE lib_mpp ! MPP library 39 45 USE wrk_nemo ! Memory Allocation 40 46 USE prtctl ! Print control 41 47 USE timing ! Timing 42 48 #if defined key_agrif 43 49 USE agrif_opa_interp 44 50 #endif 45 USE timing ! Timing46 51 47 52 IMPLICIT NONE … … 79 84 !! at the local domain boundaries through lbc_lnk call, 80 85 !! at the one-way open boundaries (lk_bdy=T), 81 !! at the AGRIF zoom 86 !! at the AGRIF zoom boundaries (lk_agrif=T) 82 87 !! 83 88 !! * Apply the time filter applied and swap of the dynamics … … 99 104 REAL(wp) :: z2dt ! temporary scalar 100 105 #endif 101 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zec ! local scalars102 REAL(wp) :: zve3a, zve3n, zve3b, zvf 103 REAL(wp), POINTER, DIMENSION(:,:) :: zu a, zva104 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3u_f, ze3v_f 106 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zec ! local scalars 107 REAL(wp) :: zve3a, zve3n, zve3b, zvf, z1_2dt ! - - 108 REAL(wp), POINTER, DIMENSION(:,:) :: zue, zve 109 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3u_f, ze3v_f, zua, zva 105 110 !!---------------------------------------------------------------------- 106 111 ! 107 IF( nn_timing == 1 ) CALL timing_start('dyn_nxt')108 ! 109 CALL wrk_alloc( jpi,jpj,jpk, ze3u_f, ze3v_f)110 IF ( lk_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zua, zva)112 IF( nn_timing == 1 ) CALL timing_start('dyn_nxt') 113 ! 114 CALL wrk_alloc( jpi,jpj,jpk, ze3u_f, ze3v_f, zua, zva ) 115 IF( lk_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zue, zve ) 111 116 ! 112 117 IF( kt == nit000 ) THEN … … 152 157 153 158 # if defined key_dynspg_ts 159 !!gm IF ( lk_dynspg_ts ) THEN .... 154 160 ! Ensure below that barotropic velocities match time splitting estimate 155 161 ! Compute actual transport and replace it with ts estimate at "after" time step 156 zu a(:,:) = 0._wp157 zv a(:,:) = 0._wp158 DO jk = 1, jpkm1159 zu a(:,:) = zua(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)160 zv a(:,:) = zva(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)162 zue(:,:) = fse3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 163 zve(:,:) = fse3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 164 DO jk = 2, jpkm1 165 zue(:,:) = zue(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 166 zve(:,:) = zve(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 161 167 END DO 162 168 DO jk = 1, jpkm1 163 ua(:,:,jk) = ( ua(:,:,jk) - zu a(:,:) * hur_a(:,:) + ua_b(:,:) ) * umask(:,:,jk)164 va(:,:,jk) = ( va(:,:,jk) - zv a(:,:) * hvr_a(:,:) + va_b(:,:) ) * vmask(:,:,jk)169 ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * hur_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 170 va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * hvr_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 165 171 END DO 166 172 … … 175 181 END DO 176 182 ENDIF 183 !!gm ENDIF 177 184 # endif 178 185 … … 195 202 # endif 196 203 #endif 204 205 IF( l_trddyn ) THEN ! prepare the atf trend computation + some diagnostics 206 z1_2dt = 1._wp / (2. * rdt) ! Euler or leap-frog time step 207 IF( neuler == 0 .AND. kt == nit000 ) z1_2dt = 1._wp / rdt 208 ! 209 ! ! Kinetic energy and Conversion 210 IF( ln_KE_trd ) CALL trd_dyn( ua, va, jpdyn_ken, kt ) 211 ! 212 IF( ln_dyn_trd ) THEN ! 3D output: total momentum trends 213 zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 214 zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 215 CALL iom_put( "utrd_tot", zua ) ! total momentum trends, except the asselin time filter 216 CALL iom_put( "vtrd_tot", zva ) 217 ENDIF 218 ! 219 zua(:,:,:) = un(:,:,:) ! save the now velocity before the asselin filter 220 zva(:,:,:) = vn(:,:,:) ! (caution: there will be a shift by 1 timestep in the 221 ! ! computation of the asselin filter trends) 222 ENDIF 197 223 198 224 ! Time filter and swap of dynamics arrays … … 217 243 DO jj = 1, jpj 218 244 DO ji = 1, jpi 219 zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2. e0_wp * un(ji,jj,jk) + ua(ji,jj,jk) )220 zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2. e0_wp * vn(ji,jj,jk) + va(ji,jj,jk) )245 zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) ) 246 zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) ) 221 247 ! 222 248 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity … … 301 327 ! Revert "before" velocities to time split estimate 302 328 ! Doing it here also means that asselin filter contribution is removed 303 zu a(:,:) = 0._wp304 zv a(:,:) = 0._wp305 DO jk = 1, jpkm1306 zu a(:,:) = zua(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)307 zv a(:,:) = zva(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)329 zue(:,:) = fse3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 330 zve(:,:) = fse3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 331 DO jk = 2, jpkm1 332 zue(:,:) = zue(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 333 zve(:,:) = zve(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 308 334 END DO 309 335 DO jk = 1, jpkm1 310 ub(:,:,jk) = ub(:,:,jk) - (zu a(:,:) * hur(:,:) - un_b(:,:)) * umask(:,:,jk)311 vb(:,:,jk) = vb(:,:,jk) - (zv a(:,:) * hvr(:,:) - vn_b(:,:)) * vmask(:,:,jk)336 ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * hur(:,:) - un_b(:,:)) * umask(:,:,jk) 337 vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * hvr(:,:) - vn_b(:,:)) * vmask(:,:,jk) 312 338 END DO 313 339 ENDIF … … 335 361 ! 336 362 DO jk = 1, jpkm1 337 #if defined key_vectopt_loop338 DO jj = 1, 1 !Vector opt. => forced unrolling339 DO ji = 1, jpij340 #else341 363 DO jj = 1, jpj 342 364 DO ji = 1, jpi 343 #endif344 365 un_b(ji,jj) = un_b(ji,jj) + fse3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 345 366 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) … … 358 379 ! 359 380 ! 381 382 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 383 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 384 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 385 CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 386 ENDIF 387 ! 360 388 IF(ln_ctl) CALL prt_ctl( tab3d_1=un, clinfo1=' nxt - Un: ', mask1=umask, & 361 389 & tab3d_2=vn, clinfo2=' Vn: ' , mask2=vmask ) 362 390 ! 363 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f)364 IF ( lk_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zua, zva)391 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f, zua, zva ) 392 IF( lk_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zue, zve ) 365 393 ! 366 394 IF( nn_timing == 1 ) CALL timing_stop('dyn_nxt') … … 370 398 !!========================================================================= 371 399 END MODULE dynnxt 372 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r4496 r4896 26 26 USE sbctide 27 27 USE updtide 28 USE trdmod ! ocean dynamics trends 29 USE trdmod_oce ! ocean variables trends 28 USE trd_oce ! trends: ocean variables 29 USE trddyn ! trend manager: dynamics 30 ! 30 31 USE prtctl ! Print control (prt_ctl routine) 31 32 USE in_out_manager ! I/O manager 32 33 USE lib_mpp ! MPP library 33 USE solver 34 USE wrk_nemo 35 USE timing 34 USE solver ! solver initialization 35 USE wrk_nemo ! Memory Allocation 36 USE timing ! Timing 36 37 37 38 … … 163 164 END DO 164 165 END DO 165 END DO 166 END DO 167 168 !!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ???? 169 166 170 ENDIF 167 171 … … 191 195 CASE( 2 ) 192 196 z2dt = 2. * rdt 193 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt197 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 194 198 ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / z2dt - ztrdu(:,:,:) 195 199 ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:) 196 200 END SELECT 197 CALL trd_ mod( ztrdu, ztrdv, jpdyn_trd_spg, 'DYN', kt )201 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 198 202 ! 199 203 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r4328 r4896 19 19 USE sbc_oce ! surface boundary condition: ocean 20 20 USE phycst ! physical constants 21 ! 21 22 USE in_out_manager ! I/O manager 22 23 USE lib_mpp ! distributed memory computing library -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r4328 r4896 13 13 !! - ! 2006-08 (J.Chanut, A.Sellar) Calls to BDY routines. 14 14 !! 3.2 ! 2009-03 (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module 15 !! 3.7 ! 2014-04 (F. Roquet, G. Madec) add some trends diag 15 16 !!---------------------------------------------------------------------- 16 17 #if defined key_dynspg_flt || defined key_esopa … … 36 37 USE bdyvol ! ocean open boundary condition (bdy_vol routine) 37 38 USE cla ! cross land advection 39 USE trd_oce ! trends: ocean variables 40 USE trddyn ! trend manager: dynamics 41 ! 38 42 USE in_out_manager ! I/O manager 39 43 USE lib_mpp ! distributed memory computing library … … 43 47 USE iom 44 48 USE lib_fortran 49 USE timing ! Timing 45 50 #if defined key_agrif 46 51 USE agrif_opa_interp 47 52 #endif 48 USE timing ! Timing49 53 50 54 IMPLICIT NONE … … 99 103 !! ** Action : - Update (ua,va) with the surf. pressure gradient trend 100 104 !! 101 !! References : Roullet and Madec 1999, JGR.105 !! References : Roullet and Madec, JGR, 2000. 102 106 !!--------------------------------------------------------------------- 103 107 INTEGER, INTENT(in ) :: kt ! ocean time-step index 104 108 INTEGER, INTENT( out) :: kindic ! solver convergence flag (<0 if not converge) 105 ! !109 ! 106 110 INTEGER :: ji, jj, jk ! dummy loop indices 107 111 REAL(wp) :: z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv ! local scalars 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 113 REAL(wp), POINTER, DIMENSION(:,:) :: zpw 108 114 !!---------------------------------------------------------------------- 109 115 ! 110 116 IF( nn_timing == 1 ) CALL timing_start('dyn_spg_flt') 111 !112 117 ! 113 118 IF( kt == nit000 ) THEN … … 179 184 END DO 180 185 ! 186 IF( l_trddyn ) THEN ! temporary save of spg trends 187 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 188 DO jk = 1, jpkm1 ! unweighted time stepping 189 DO jj = 2, jpjm1 190 DO ji = fs_2, fs_jpim1 ! vector opt. 191 ztrdu(ji,jj,jk) = spgu(ji,jj) * umask(ji,jj,jk) 192 ztrdv(ji,jj,jk) = spgv(ji,jj) * vmask(ji,jj,jk) 193 END DO 194 END DO 195 END DO 196 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spgexp, kt ) 197 ENDIF 198 ! 181 199 ENDIF 182 200 … … 194 212 DO jj = 2, jpjm1 195 213 DO ji = fs_2, fs_jpim1 ! vector opt. 196 spgu(ji,jj) = 0._wp 197 spgv(ji,jj) = 0._wp 198 END DO 199 END DO 200 201 ! vertical sum 202 !CDIR NOLOOPCHG 203 IF( lk_vopt_loop ) THEN ! vector opt., forced unroll 204 DO jk = 1, jpkm1 205 DO ji = 1, jpij 206 spgu(ji,1) = spgu(ji,1) + fse3u_a(ji,1,jk) * ua(ji,1,jk) 207 spgv(ji,1) = spgv(ji,1) + fse3v_a(ji,1,jk) * va(ji,1,jk) 208 END DO 209 END DO 210 ELSE ! No vector opt. 211 DO jk = 1, jpkm1 212 DO jj = 2, jpjm1 213 DO ji = 2, jpim1 214 spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk) 215 spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk) 216 END DO 217 END DO 218 END DO 219 ENDIF 220 221 ! transport: multiplied by the horizontal scale factor 222 DO jj = 2, jpjm1 214 spgu(ji,jj) = fse3u_a(ji,jj,1) * ua(ji,jj,1) 215 spgv(ji,jj) = fse3v_a(ji,jj,1) * va(ji,jj,1) 216 END DO 217 END DO 218 DO jk = 2, jpkm1 ! vertical sum 219 DO jj = 2, jpjm1 220 DO ji = fs_2, fs_jpim1 ! vector opt. 221 spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk) 222 spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk) 223 END DO 224 END DO 225 END DO 226 227 DO jj = 2, jpjm1 ! transport: multiplied by the horizontal scale factor 223 228 DO ji = fs_2, fs_jpim1 ! vector opt. 224 229 spgu(ji,jj) = spgu(ji,jj) * e2u(ji,jj) … … 322 327 ENDIF 323 328 #endif 329 330 IF( l_trddyn ) THEN 331 ztrdu(:,:,:) = ua(:,:,:) ! save the after velocity before the filtered SPG 332 ztrdv(:,:,:) = va(:,:,:) 333 ! 334 CALL wrk_alloc( jpi, jpj, zpw ) 335 ! 336 zpw(:,:) = - z2dt * gcx(:,:) 337 CALL iom_put( "ssh_flt" , zpw ) ! output equivalent ssh modification due to implicit filter 338 ! 339 ! ! save surface pressure flux: -pw at z=0 340 zpw(:,:) = - rau0 * grav * sshn(:,:) * wn(:,:,1) * tmask(:,:,1) 341 CALL iom_put( "pw0_exp" , zpw ) 342 zpw(:,:) = wn(:,:,1) 343 CALL iom_put( "w0" , zpw ) 344 zpw(:,:) = rau0 * z2dtg * gcx(:,:) * wn(:,:,1) * tmask(:,:,1) 345 CALL iom_put( "pw0_flt" , zpw ) 346 ! 347 CALL wrk_dealloc( jpi, jpj, zpw ) 348 ! 349 ENDIF 350 324 351 ! Add the trends multiplied by z2dt to the after velocity 325 352 ! ------------------------------------------------------- … … 336 363 END DO 337 364 338 ! write filtered free surface arrays in restart file 339 ! -------------------------------------------------- 340 IF( lrst_oce ) CALL flt_rst( kt, 'WRITE' ) 341 ! 342 ! 343 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_flt') 365 IF( l_trddyn ) THEN ! save the explicit SPG trends for further diagnostics 366 ztrdu(:,:,:) = ( ua(:,:,:) - ztrdu(:,:,:) ) / z2dt 367 ztrdv(:,:,:) = ( va(:,:,:) - ztrdv(:,:,:) ) / z2dt 368 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spgflt, kt ) 369 ! 370 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 371 ENDIF 372 373 IF( lrst_oce ) CALL flt_rst( kt, 'WRITE' ) ! write filtered free surface arrays in restart file 374 ! 375 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_flt') 344 376 ! 345 377 END SUBROUTINE dyn_spg_flt … … 352 384 !! ** Purpose : Read or write filtered free surface arrays in restart file 353 385 !!---------------------------------------------------------------------- 354 INTEGER , INTENT(in) :: kt 355 CHARACTER(len=*), INTENT(in) :: cdrw 386 INTEGER , INTENT(in) :: kt ! ocean time-step 387 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 356 388 !!---------------------------------------------------------------------- 357 389 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4496 r4896 105 105 END FUNCTION dyn_spg_ts_alloc 106 106 107 107 108 SUBROUTINE dyn_spg_ts( kt ) 108 109 !!---------------------------------------------------------------------- 110 !! *** routine dyn_spg_ts *** 109 111 !! 110 !! ** Purpose : 111 !! -Compute the now trend due to the explicit time stepping 112 !! of the quasi-linear barotropic system. 112 !! ** Purpose : Compute the now trend due to the explicit time stepping 113 !! of the quasi-linear barotropic system. 113 114 !! 114 115 !! ** Method : … … 128 129 !! -Update 3d trend (ua, va) with barotropic component. 129 130 !! 130 !! References : Shchepetkin, A.F. and J.C. McWilliams, 2005: 131 !! The regional oceanic modeling system (ROMS): 132 !! a split-explicit, free-surface, 133 !! topography-following-coordinate oceanic model. 134 !! Ocean Modelling, 9, 347-404. 131 !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005 135 132 !!--------------------------------------------------------------------- 136 !137 133 INTEGER, INTENT(in) :: kt ! ocean time-step index 138 134 ! … … 290 286 ! 291 287 DO jk = 1, jpkm1 292 #if defined key_vectopt_loop293 DO jj = 1, 1 !Vector opt. => forced unrolling294 DO ji = 1, jpij295 #else296 288 DO jj = 1, jpj 297 289 DO ji = 1, jpi 298 #endif299 290 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 300 291 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) … … 908 899 END SUBROUTINE dyn_spg_ts 909 900 901 910 902 SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2) 911 903 !!--------------------------------------------------------------------- … … 1037 1029 ! 1038 1030 END SUBROUTINE ts_rst 1031 1039 1032 1040 1033 SUBROUTINE dyn_spg_ts_init( kt ) … … 1172 1165 !!====================================================================== 1173 1166 END MODULE dynspg_ts 1174 1175 1176 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r4601 r4896 15 15 !! 3.2 ! 2009-04 (R. Benshila) vvl: correction of een scheme 16 16 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 17 !! 3.7 ! 2014-04 (G. Madec) trend simplification: suppress jpdyn_trd_dat vorticity 17 18 !!---------------------------------------------------------------------- 18 19 … … 29 30 USE dommsk ! ocean mask 30 31 USE dynadv ! momentum advection (use ln_dynadv_vec value) 31 USE trd mod ! ocean dynamics trends32 USE trd mod_oce ! ocean variables trends32 USE trd_oce ! trends: ocean variables 33 USE trddyn ! trend manager: dynamics 33 34 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 34 35 USE prtctl ! Print control … … 73 74 !! ** Action : - Update (ua,va) with the now vorticity term trend 74 75 !! - save the trends in (ztrdu,ztrdv) in 2 parts (relative 75 !! and planetary vorticity trends) ('key_trddyn') 76 !! and planetary vorticity trends) and send them to trd_dyn 77 !! for futher diagnostics (l_trddyn=T) 76 78 !!---------------------------------------------------------------------- 77 79 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 108 110 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 109 111 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 110 CALL trd_ mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt )112 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 111 113 ztrdu(:,:,:) = ua(:,:,:) 112 114 ztrdv(:,:,:) = va(:,:,:) … … 114 116 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 115 117 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 116 CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt ) 117 CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 118 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 118 119 ELSE 119 120 CALL vor_ene( kt, ntot, ua, va ) ! total vorticity … … 127 128 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 128 129 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 129 CALL trd_ mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt )130 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 130 131 ztrdu(:,:,:) = ua(:,:,:) 131 132 ztrdv(:,:,:) = va(:,:,:) … … 133 134 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 134 135 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 135 CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt ) 136 CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 136 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 137 137 ELSE 138 138 CALL vor_ens( kt, ntot, ua, va ) ! total vorticity … … 146 146 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 147 147 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 148 CALL trd_ mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt )148 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 149 149 ztrdu(:,:,:) = ua(:,:,:) 150 150 ztrdv(:,:,:) = va(:,:,:) … … 152 152 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 153 153 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 154 CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt ) 155 CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 154 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 156 155 ELSE 157 156 CALL vor_mix( kt ) ! total vorticity (mix=ens-ene) … … 165 164 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 166 165 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 167 CALL trd_ mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt )166 CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 168 167 ztrdu(:,:,:) = ua(:,:,:) 169 168 ztrdv(:,:,:) = va(:,:,:) … … 171 170 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 172 171 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 173 CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt ) 174 CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 172 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 175 173 ELSE 176 174 CALL vor_een( kt, ntot, ua, va ) ! total vorticity … … 211 209 !! 212 210 !! ** Action : - Update (ua,va) with the now vorticity term trend 213 !! - save the trends in (ztrdu,ztrdv) in 2 parts (relative214 !! and planetary vorticity trends) ('key_trddyn')215 211 !! 216 212 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. … … 328 324 !! 329 325 !! ** Action : - Update (ua,va) arrays with the now vorticity term trend 330 !! - Save the trends in (ztrdu,ztrdv) in 2 parts (relative331 !! and planetary vorticity trends) ('key_trddyn')332 326 !! 333 327 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. … … 444 438 !! 445 439 !! ** Action : - Update (ua,va) arrays with the now vorticity term trend 446 !! - Save the trends in (ztrdu,ztrdv) in 2 parts (relative447 !! and planetary vorticity trends) ('key_trddyn')448 440 !! 449 441 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. … … 557 549 !! 558 550 !! ** Action : - Update (ua,va) with the now vorticity term trend 559 !! - save the trends in (ztrdu,ztrdv) in 2 parts (relative560 !! and planetary vorticity trends) ('key_trddyn')561 551 !! 562 552 !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 … … 601 591 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'dyn:vor_een : unable to allocate arrays' ) 602 592 ENDIF 603 ze3f(:,:,:) = 0. d0593 ze3f(:,:,:) = 0._wp 604 594 #endif 605 595 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r3294 r4896 16 16 USE dom_oce ! ocean space and time domain 17 17 USE sbc_oce ! surface boundary condition: ocean 18 USE trdmod_oce ! ocean variables trends 19 USE trdmod ! ocean dynamics trends 18 USE trd_oce ! trends: ocean variables 19 USE trddyn ! trend manager: dynamics 20 ! 20 21 USE in_out_manager ! I/O manager 21 USE lib_mpp 22 USE lib_mpp ! MPP library 22 23 USE prtctl ! Print control 23 USE wrk_nemo 24 USE timing 24 USE wrk_nemo ! Memory Allocation 25 USE timing ! Timing 25 26 26 27 IMPLICIT NONE … … 53 54 !! 54 55 !! ** Action : - Update (ua,va) with the vert. momentum adv. trends 55 !! - S ave the trends in (ztrdu,ztrdv) ('key_trddyn')56 !! - Send the trends to trddyn for diagnostics (l_trddyn=T) 56 57 !!---------------------------------------------------------------------- 57 58 INTEGER, INTENT(in) :: kt ! ocean time-step inedx … … 118 119 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 119 120 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 120 CALL trd_ mod(ztrdu, ztrdv, jpdyn_trd_zad, 'DYN', kt)121 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 121 122 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 122 123 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r3294 r4896 20 20 21 21 USE ldfdyn_oce ! ocean dynamics: lateral physics 22 USE trd mod ! ocean active dynamics and tracers trends23 USE trd mod_oce ! ocean variables trends22 USE trd_oce ! trends: ocean variables 23 USE trddyn ! trend manager: dynamics 24 24 USE in_out_manager ! I/O manager 25 25 USE lib_mpp ! MPP library … … 91 91 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 92 92 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 93 CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_zdf, 'DYN', kt ) 94 ! 93 CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 95 94 CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv ) 96 95 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r4370 r4896 70 70 REAL(wp) :: z1_p2dt, zcoef, zzwi, zzws, zrhs ! local scalars 71 71 REAL(wp) :: ze3ua, ze3va 72 !!----------------------------------------------------------------------73 74 72 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwd, zws 75 73 !!---------------------------------------------------------------------- … … 101 99 102 100 IF( ln_bfrimp ) THEN 103 # if defined key_vectopt_loop104 DO jj = 1, 1105 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)106 # else107 101 DO jj = 2, jpjm1 108 102 DO ji = 2, jpim1 109 # endif110 103 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 111 104 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) … … 138 131 ua(:,:,jk) = (ua(:,:,jk) - ua_b(:,:)) * umask(:,:,jk) 139 132 va(:,:,jk) = (va(:,:,jk) - va_b(:,:)) * vmask(:,:,jk) 140 END DO133 END DO 141 134 ! Add bottom stress due to barotropic component only: 142 135 DO jj = 2, jpjm1 … … 352 345 !! restore bottom layer avmu(v) 353 346 IF( ln_bfrimp ) THEN 354 # if defined key_vectopt_loop 355 DO jj = 1, 1 356 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 357 # else 358 DO jj = 2, jpjm1 359 DO ji = 2, jpim1 360 # endif 361 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 362 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 363 avmu(ji,jj,ikbu+1) = 0.e0 364 avmv(ji,jj,ikbv+1) = 0.e0 365 END DO 366 END DO 347 DO jj = 2, jpjm1 348 DO ji = 2, jpim1 349 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 350 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 351 avmu(ji,jj,ikbu+1) = 0.e0 352 avmv(ji,jj,ikbv+1) = 0.e0 353 END DO 354 END DO 367 355 ENDIF 368 356 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r4334 r4896 22 22 USE iom ! I/O module 23 23 USE eosbn2 ! equation of state (eos bn2 routine) 24 USE trdm ld_oce ! ocean active mixed layer tracers trends variables24 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 25 25 USE divcur ! hor. divergence and curl (div & cur routines) 26 26 USE sbc_ice, ONLY : lk_lim3 … … 138 138 IF( kt == nitrst ) THEN 139 139 CALL iom_close( numrow ) ! close the restart file (only at last time step) 140 IF( .NOT. lk_trdmld ) lrst_oce = .FALSE. 140 !!gm IF( .NOT. lk_trdmld ) lrst_oce = .FALSE. 141 !!gm not sure what to do here ===>>> ask to Sebastian 142 lrst_oce = .FALSE. 141 143 ENDIF 142 144 ! 143 145 END SUBROUTINE rst_write 146 144 147 145 148 SUBROUTINE rst_read_open … … 155 158 LOGICAL :: llok 156 159 !!---------------------------------------------------------------------- 157 158 IF( numror .LE.0 ) THEN160 ! 161 IF( numror <= 0 ) THEN 159 162 IF(lwp) THEN ! Contol prints 160 163 WRITE(numout,*) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
r3294 r4896 84 84 IF( ln_traldf_grif ) THEN 85 85 DO jk = 1, jpk 86 # if defined key_vectopt_loop87 !CDIR NOVERRCHK88 DO ji = 1, jpij ! vector opt.89 ! Take the max of N^2 and zero then take the vertical sum90 ! of the square root of the resulting N^2 ( required to compute91 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f92 zn2 = MAX( rn2b(ji,1,jk), 0._wp )93 zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk)94 ! Compute elements required for the inverse time scale of baroclinic95 ! eddies using the isopycnal slopes calculated in ldfslp.F :96 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))97 ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk)98 zah(ji,1) = zah(ji,1) + zn2 * wslp2(ji,1,jk) * ze3w99 zhw(ji,1) = zhw(ji,1) + ze3w100 END DO101 # else102 86 DO jj = 2, jpjm1 103 !CDIR NOVERRCHK104 87 DO ji = 2, jpim1 105 88 ! Take the max of N^2 and zero then take the vertical sum … … 116 99 END DO 117 100 END DO 118 # endif119 101 END DO 120 102 ELSE 121 103 DO jk = 1, jpk 122 # if defined key_vectopt_loop123 !CDIR NOVERRCHK124 DO ji = 1, jpij ! vector opt.125 ! Take the max of N^2 and zero then take the vertical sum126 ! of the square root of the resulting N^2 ( required to compute127 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f128 zn2 = MAX( rn2b(ji,1,jk), 0._wp )129 zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk)130 ! Compute elements required for the inverse time scale of baroclinic131 ! eddies using the isopycnal slopes calculated in ldfslp.F :132 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))133 ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk)134 zah(ji,1) = zah(ji,1) + zn2 * ( wslpi(ji,1,jk) * wslpi(ji,1,jk) &135 & + wslpj(ji,1,jk) * wslpj(ji,1,jk) ) * ze3w136 zhw(ji,1) = zhw(ji,1) + ze3w137 END DO138 # else139 104 DO jj = 2, jpjm1 140 !CDIR NOVERRCHK141 105 DO ji = 2, jpim1 142 106 ! Take the max of N^2 and zero then take the vertical sum … … 154 118 END DO 155 119 END DO 156 # endif157 120 END DO 158 121 END IF 159 122 160 123 DO jj = 2, jpjm1 161 !CDIR NOVERRCHK162 124 DO ji = fs_2, fs_jpim1 ! vector opt. 163 125 zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r4488 r4896 28 28 USE zdfmxl ! mixed layer depth 29 29 USE eosbn2 ! equation of states 30 ! 31 USE in_out_manager ! I/O manager 30 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 USE in_out_manager ! I/O manager32 33 USE prtctl ! Print control 33 34 USE wrk_nemo ! work arrays … … 136 137 END DO 137 138 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 138 # if defined key_vectopt_loop139 DO jj = 1, 1140 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)141 # else142 139 DO jj = 1, jpjm1 143 140 DO ji = 1, jpim1 144 # endif145 141 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 146 142 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) … … 435 431 REAL(wp) :: zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 436 432 REAL(wp) :: zdzrho_raw 437 REAL(wp) :: zbeta0438 433 REAL(wp), POINTER, DIMENSION(:,:) :: z1_mlbw 439 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalbet440 434 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zdxrho , zdyrho, zdzrho ! Horizontal and vertical density gradients 441 435 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zti_mlb, ztj_mlb ! for Griffies operator only … … 445 439 ! 446 440 CALL wrk_alloc( jpi,jpj, z1_mlbw ) 447 CALL wrk_alloc( jpi,jpj,jpk, zalbet )448 441 CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 ) 449 442 CALL wrk_alloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 ) … … 452 445 ! Some preliminary calculation ! 453 446 !--------------------------------! 454 !455 CALL eos_alpbet( tsb, zalbet, zbeta0 ) !== before local thermal/haline expension ratio at T-points ==!456 447 ! 457 448 DO jl = 0, 1 !== unmasked before density i- j-, k-gradients ==! … … 465 456 zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) ! j-gradient of T & S at v-point 466 457 zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 467 zdxrho_raw = ( - zalbet(ji+ip,jj ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj)468 zdyrho_raw = ( - zalbet(ji ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)469 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( 458 zdxrho_raw = ( - rab_b(ji+ip,jj ,jk,jp_tem) * zdit + rab_b(ji+ip,jj ,jk,jp_sal) * zdis ) / e1u(ji,jj) 459 zdyrho_raw = ( - rab_b(ji ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji ,jj+jp,jk,jp_sal) * zdjs ) / e2v(ji,jj) 460 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 470 461 zdyrho(ji ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 471 462 END DO … … 473 464 END DO 474 465 ! 475 IF( ln_zps.and.l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 476 # if defined key_vectopt_loop 477 DO jj = 1, 1 478 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 479 # else 466 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 480 467 DO jj = 1, jpjm1 481 468 DO ji = 1, jpim1 482 # endif483 469 iku = mbku(ji,jj) ; ikv = mbkv(ji,jj) ! last ocean level (u- & v-points) 484 470 zdit = gtsu(ji,jj,jp_tem) ; zdjt = gtsv(ji,jj,jp_tem) ! i- & j-gradient of Temperature 485 471 zdis = gtsu(ji,jj,jp_sal) ; zdjs = gtsv(ji,jj,jp_sal) ! i- & j-gradient of Salinity 486 zdxrho_raw = ( - zalbet(ji+ip,jj ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj)487 zdyrho_raw = ( - zalbet(ji ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)472 zdxrho_raw = ( - rab_b(ji+ip,jj ,iku,jp_tem) * zdit + rab_b(ji+ip,jj ,iku,jp_sal) * zdis ) / e1u(ji,jj) 473 zdyrho_raw = ( - rab_b(ji ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji ,jj+jp,ikv,jp_sal) * zdjs ) / e2v(ji,jj) 488 474 zdxrho(ji+ip,jj ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 489 475 zdyrho(ji ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) … … 505 491 zdks = 0._wp 506 492 ENDIF 507 zdzrho_raw = ( - zalbet(ji ,jj ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp)508 zdzrho(ji ,jj ,jk, kp) = - MIN( - repsln,zdzrho_raw ) ! force zdzrho >= repsln493 zdzrho_raw = ( - rab_b(ji,jj,jk,jp_tem) * zdkt + rab_b(ji,jj,jk,jp_sal) * zdks ) / fse3w(ji,jj,jk+kp) 494 zdzrho(ji,jj,jk,kp) = - MIN( - repsln, zdzrho_raw ) ! force zdzrho >= repsln 509 495 END DO 510 496 END DO … … 650 636 ! 651 637 CALL wrk_dealloc( jpi,jpj, z1_mlbw ) 652 CALL wrk_dealloc( jpi,jpj,jpk, zalbet )653 638 CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 ) 654 639 CALL wrk_dealloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 ) … … 701 686 ! !== surface mixed layer mask ! 702 687 DO jk = 1, jpk ! =1 inside the mixed layer, =0 otherwise 703 # if defined key_vectopt_loop704 DO jj = 1, 1705 DO ji = 1, jpij ! vector opt. (forced unrolling)706 # else707 688 DO jj = 1, jpj 708 689 DO ji = 1, jpi 709 # endif710 690 ik = nmln(ji,jj) - 1 711 691 IF( jk <= ik ) THEN ; omlmask(ji,jj,jk) = 1._wp … … 727 707 !----------------------------------------------------------------------- 728 708 ! 729 # if defined key_vectopt_loop730 DO jj = 1, 1731 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)732 # else733 709 DO jj = 2, jpjm1 734 710 DO ji = 2, jpim1 735 # endif736 711 ! !== Slope at u- & v-points just below the Mixed Layer ==! 737 712 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r4333 r4896 269 269 zwnd_j(:,:) = 0.e0 270 270 #if defined key_cyclone 271 # if defined key_vectopt_loop 272 !CDIR COLLAPSE 273 # endif 274 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add Manu ! 271 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) 275 272 DO jj = 2, jpjm1 276 273 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 279 276 END DO 280 277 END DO 281 #endif282 #if defined key_vectopt_loop283 !CDIR COLLAPSE284 278 #endif 285 279 DO jj = 2, jpjm1 … … 292 286 CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. ) 293 287 ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 294 !CDIR NOVERRCHK295 !CDIR COLLAPSE296 288 wndm(:,:) = SQRT( zwnd_i(:,:) * zwnd_i(:,:) & 297 289 & + zwnd_j(:,:) * zwnd_j(:,:) ) * tmask(:,:,1) … … 443 435 END SUBROUTINE blk_oce_core 444 436 437 445 438 SUBROUTINE blk_bio_meanqsr 446 439 !!--------------------------------------------------------------------- … … 453 446 !! 454 447 !!--------------------------------------------------------------------- 455 IF( nn_timing == 1 ) CALL timing_start('blk_bio_meanqsr')456 457 qsr_mean(:,:) = (1. - albo ) * 458 459 IF( nn_timing == 1 ) CALL timing_stop('blk_bio_meanqsr')460 448 IF( nn_timing == 1 ) CALL timing_start('blk_bio_meanqsr') 449 ! 450 qsr_mean(:,:) = (1. - albo ) * sf(jp_qsr)%fnow(:,:,1) 451 ! 452 IF( nn_timing == 1 ) CALL timing_stop('blk_bio_meanqsr') 453 ! 461 454 END SUBROUTINE blk_bio_meanqsr 462 455 … … 604 597 ! 605 598 CASE( 'C' ) ! C-grid ice dynamics : U & V-points (same as ocean) 606 #if defined key_vectopt_loop607 !CDIR COLLAPSE608 #endif609 599 DO jj = 2, jpj 610 600 DO ji = fs_2, jpi ! vect. opt. … … 614 604 END DO 615 605 END DO 616 #if defined key_vectopt_loop617 !CDIR COLLAPSE618 #endif619 606 DO jj = 2, jpjm1 620 607 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 635 622 DO jl = 1, ijpl ! Loop over ice categories ! 636 623 ! ! ========================== ! 637 !CDIR NOVERRCHK638 !CDIR COLLAPSE639 624 DO jj = 1 , jpj 640 !CDIR NOVERRCHK641 625 DO ji = 1, jpi 642 626 ! ----------------------------! … … 700 684 p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 701 685 CALL iom_put( 'snowpre', p_spr * 86400. ) ! Snow precipitation 702 CALL iom_put( 'precip' , p_tpr * 86400. )! Total precipitation686 CALL iom_put( 'precip' , p_tpr * 86400. ) ! Total precipitation 703 687 ! 704 688 IF(ln_ctl) THEN … … 810 794 811 795 !! Estimate the Monin-Obukov length : 812 L = (U_star**2)/( kappa*grav*(T_star/T_vpot + q_star/(q_a + 1./0.608)) ) 796 L = U_star*U_star / ( kappa*grav*(T_star/T_vpot + q_star/(q_a + 1./0.608)) ) 797 !!gm !lolo suggestion ...... TO BE TAKEN ? 798 !! L = U_star*U_star / ( kappa*grav/T_vpot*(T_star*(1. + 0.608*q_a) + 0.608*T_a*q_star) ) 799 !!gm !lolo. 813 800 814 801 !! Stability parameters : … … 1034 1021 REAL(wp), DIMENSION(:,:), POINTER :: X2, X, stabit 1035 1022 !------------------------------------------------------------------------------- 1036 1023 ! 1037 1024 CALL wrk_alloc( jpi,jpj, X2, X, stabit ) 1038 1025 ! 1039 1026 X2 = sqrt(abs(1. - 16.*zta)) ; X2 = max(X2 , 1.) ; X = sqrt(X2) 1040 1027 stabit = 0.5 + sign(0.5,zta) 1041 psi_h = -5.*zta*stabit & ! Stable1028 psi_h = -5.*zta*stabit & ! Stable 1042 1029 & + (1. - stabit)*(2.*log( (1. + X2)/2. )) ! Unstable 1043 1030 ! 1044 1031 CALL wrk_dealloc( jpi,jpj, X2, X, stabit ) 1045 1032 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r4161 r4896 99 99 ! ( d rho / dt ) / ( d rho / ds ) ( s = 34, t = -1.8 ) 100 100 101 fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius]101 fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius] 102 102 103 ! OM : probleme. a_i pas defini dans les cas lim3 et cice 103 !!OM : probleme. a_i pas defini dans les cas lim3 et cice 104 !!gm Not sure at all that a_i should be defined.... ==>>> to be checked 104 105 #if defined key_coupled && defined key_lim2 105 106 a_i(:,:,1) = fr_i(:,:) … … 107 108 108 109 ! Flux and ice fraction computation 109 !CDIR COLLAPSE110 110 DO jj = 1, jpj 111 111 DO ji = 1, jpi -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r4333 r4896 182 182 v_oce(:,:) = ssv_m(:,:) ! (C-grid dynamics : U- & V-points as the ocean) 183 183 ! 184 t_bo(:,:) = tfreez( sss_m ) + rt0! masked sea surface freezing temperature [Kelvin]184 t_bo(:,:) = eos_fzp( sss_m ) + rt0 ! masked sea surface freezing temperature [Kelvin] 185 185 ! ! (set to rt0 over land) 186 186 CALL albedo_ice( t_su, ht_i, ht_s, zalb_ice_cs, zalb_ice_os ) ! ... ice albedo … … 672 672 !! n : number of the option 673 673 !!------------------------------------------------------------------- 674 INTEGER , INTENT(in) :: kt ! ocean time step674 INTEGER , INTENT(in) :: kt ! ocean time step 675 675 INTEGER , INTENT(in) :: ki, kj, kn ! ocean gridpoint indices 676 676 CHARACTER(len=*), INTENT(in) :: cd1 ! … … 850 850 END DO 851 851 END DO 852 852 ! 853 853 END SUBROUTINE lim_prt_state 854 854 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r4306 r4896 140 140 141 141 ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 142 tfu(:,:) = tfreez( sss_m ) + rt0142 tfu(:,:) = eos_fzp( sss_m ) + rt0 143 143 144 144 zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r4292 r4896 14 14 USE oce ! ocean dynamics and tracers 15 15 USE dom_oce ! ocean space and time domain 16 USE sbc_oce ! Surface boundary condition: ocean fields17 16 USE sbc_oce ! surface boundary condition: ocean fields 18 17 USE sbcapr ! surface boundary condition: atmospheric pressure 19 USE prtctl ! Print control (prt_ctl routine)20 USE iom18 USE eosbn2 ! equation of state and related derivatives 19 ! 21 20 USE in_out_manager ! I/O manager 21 USE prtctl ! Print control 22 USE iom ! IOM library 22 23 23 24 IMPLICIT NONE … … 61 62 ssu_m(:,:) = ub(:,:,1) 62 63 ssv_m(:,:) = vb(:,:,1) 63 sst_m(:,:) = tsn(:,:,1,jp_tem) 64 IF( ln_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 65 ELSE ; sst_m(:,:) = tsn(:,:,1,jp_tem) 66 ENDIF 64 67 sss_m(:,:) = tsn(:,:,1,jp_sal) 65 68 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) … … 79 82 ssu_m(:,:) = zcoef * ub(:,:,1) 80 83 ssv_m(:,:) = zcoef * vb(:,:,1) 81 sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem) 84 IF( ln_useCT ) THEN ; sst_m(:,:) = zcoef * eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 85 ELSE ; sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem) 86 ENDIF 82 87 sss_m(:,:) = zcoef * tsn(:,:,1,jp_sal) 83 88 ! ! removed inverse barometer ssh when Patm forcing is used … … 101 106 ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 102 107 ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 103 sst_m(:,:) = sst_m(:,:) + tsn(:,:,1,jp_tem) 108 IF( ln_useCT ) THEN ; sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 109 ELSE ; sst_m(:,:) = sst_m(:,:) + tsn(:,:,1,jp_tem) 110 ENDIF 104 111 sss_m(:,:) = sss_m(:,:) + tsn(:,:,1,jp_sal) 105 112 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r4147 r4896 10 10 !!---------------------------------------------------------------------- 11 11 !! sbc_ssr : add to sbc a restoring term toward SST/SSS climatology 12 !! sbc_ssr_init : initialisation of surface restoring 12 13 !!---------------------------------------------------------------------- 13 14 USE oce ! ocean dynamics and tracers … … 16 17 USE phycst ! physical constants 17 18 USE sbcrnf ! surface boundary condition : runoffs 19 ! 18 20 USE fldread ! read input fields 19 21 USE iom ! I/O manager … … 93 95 ! 94 96 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 95 !CDIR COLLAPSE96 97 DO jj = 1, jpj 97 98 DO ji = 1, jpi -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r4292 r4896 15 15 !! - ! 2002-11 (G. Madec, A. Bozec) partial step, eos_insitu_2d 16 16 !! - ! 2003-08 (G. Madec) F90, free form 17 !! 3.0 ! 2006-08 (G. Madec) add tfreez function 17 !! 3.0 ! 2006-08 (G. Madec) add tfreez function (now eos_fzp function) 18 18 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 19 !! - ! 2010-10 (G. Nurser, G. Madec) add eos_alpbet used in ldfslp 19 !! - ! 2010-10 (G. Nurser, G. Madec) add alpha/beta used in ldfslp 20 !! 3.7 ! 2012-03 (F. Roquet, G. Madec) add primitive of alpha and beta used in PE computation 21 !! - ! 2012-05 (F. Roquet) add Vallis and original JM95 equation of state 22 !! - ! 2013-04 (F. Roquet, G. Madec) add eos_rab, change bn2 computation and reorganize the module 23 !! - ! 2014-09 (F. Roquet) add TEOS-10, S-EOS, and modify EOS-80 20 24 !!---------------------------------------------------------------------- 21 25 … … 23 27 !! eos : generic interface of the equation of state 24 28 !! eos_insitu : Compute the in situ density 25 !! eos_insitu_pot : Compute the insitu and surface referenced potential 26 !! volumic mass 29 !! eos_insitu_pot : Compute the insitu and surface referenced potential volumic mass 27 30 !! eos_insitu_2d : Compute the in situ density for 2d fields 28 !! eos_bn2 : Compute the Brunt-Vaisala frequency 29 !! eos_alpbet : calculates the in situ thermal/haline expansion ratio 30 !! tfreez : Compute the surface freezing temperature 31 !! bn2 : Compute the Brunt-Vaisala frequency 32 !! eos_rab : generic interface of in situ thermal/haline expansion ratio 33 !! eos_rab_3d : compute in situ thermal/haline expansion ratio 34 !! eos_rab_2d : compute in situ thermal/haline expansion ratio for 2d fields 35 !! eos_fzp : freezing temperature 31 36 !! eos_init : set eos parameters (namelist) 32 37 !!---------------------------------------------------------------------- 33 38 USE dom_oce ! ocean space and time domain 34 39 USE phycst ! physical constants 35 USE zdfddm ! vertical physics: double diffusion40 ! 36 41 USE in_out_manager ! I/O manager 37 42 USE lib_mpp ! MPP library 43 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 38 44 USE prtctl ! Print control 39 45 USE wrk_nemo ! Memory Allocation … … 47 53 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 48 54 END INTERFACE 49 INTERFACE bn2 50 MODULE PROCEDURE eos_bn2 55 ! 56 INTERFACE eos_rab 57 MODULE PROCEDURE rab_3d, rab_2d 51 58 END INTERFACE 52 53 PUBLIC eos ! called by step, istate, tranpc and zpsgrd modules 54 PUBLIC eos_init ! called by istate module 55 PUBLIC bn2 ! called by step module 56 PUBLIC eos_alpbet ! called by ldfslp module 57 PUBLIC tfreez ! called by sbcice_... modules 58 59 ! !!* Namelist (nameos) * 60 INTEGER , PUBLIC :: nn_eos !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 61 REAL(wp), PUBLIC :: rn_alpha !: thermal expension coeff. (linear equation of state) 62 REAL(wp), PUBLIC :: rn_beta !: saline expension coeff. (linear equation of state) 63 64 REAL(wp), PUBLIC :: ralpbet !: alpha / beta ratio 59 ! 60 PUBLIC eos ! called by step, istate, tranpc and zpsgrd modules 61 PUBLIC bn2 ! called by step module 62 PUBLIC eos_rab ! called by ldfslp, zdfddm, trabbl 63 PUBLIC eos_pt_from_ct ! called by sbcssm 64 PUBLIC eos_fzp ! called by traadv_cen2 and sbcice_... modules 65 PUBLIC eos_pen ! used for pe diagnostics in trdpen module 66 PUBLIC eos_init ! called by istate module 67 68 ! !!* Namelist (nameos) * 69 INTEGER , PUBLIC :: nn_eos = 0 !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 70 LOGICAL , PUBLIC :: ln_useCT = .FALSE. ! determine if eos_pt_from_ct is used to compute sst_m 71 72 ! !!! simplified eos coefficients 73 ! default value: Vallis 2006 74 REAL(wp) :: rn_a0 = 1.6550e-1_wp ! thermal expansion coeff. 75 REAL(wp) :: rn_b0 = 7.6554e-1_wp ! saline expansion coeff. 76 REAL(wp) :: rn_lambda1 = 5.9520e-2_wp ! cabbeling coeff. in T^2 77 REAL(wp) :: rn_lambda2 = 5.4914e-4_wp ! cabbeling coeff. in S^2 78 REAL(wp) :: rn_mu1 = 1.4970e-4_wp ! thermobaric coeff. in T 79 REAL(wp) :: rn_mu2 = 1.1090e-5_wp ! thermobaric coeff. in S 80 REAL(wp) :: rn_nu = 2.4341e-3_wp ! cabbeling coeff. in theta*salt 81 82 ! TEOS10/EOS80 parameters 83 REAL(wp) :: r1_S0, r1_T0, r1_Z0, rdeltaS 84 85 ! EOS parameters 86 REAL(wp) :: EOS000 , EOS100 , EOS200 , EOS300 , EOS400 , EOS500 , EOS600 87 REAL(wp) :: EOS010 , EOS110 , EOS210 , EOS310 , EOS410 , EOS510 88 REAL(wp) :: EOS020 , EOS120 , EOS220 , EOS320 , EOS420 89 REAL(wp) :: EOS030 , EOS130 , EOS230 , EOS330 90 REAL(wp) :: EOS040 , EOS140 , EOS240 91 REAL(wp) :: EOS050 , EOS150 92 REAL(wp) :: EOS060 93 REAL(wp) :: EOS001 , EOS101 , EOS201 , EOS301 , EOS401 94 REAL(wp) :: EOS011 , EOS111 , EOS211 , EOS311 95 REAL(wp) :: EOS021 , EOS121 , EOS221 96 REAL(wp) :: EOS031 , EOS131 97 REAL(wp) :: EOS041 98 REAL(wp) :: EOS002 , EOS102 , EOS202 99 REAL(wp) :: EOS012 , EOS112 100 REAL(wp) :: EOS022 101 REAL(wp) :: EOS003 , EOS103 102 REAL(wp) :: EOS013 103 104 ! ALPHA parameters 105 REAL(wp) :: ALP000 , ALP100 , ALP200 , ALP300 , ALP400 , ALP500 106 REAL(wp) :: ALP010 , ALP110 , ALP210 , ALP310 , ALP410 107 REAL(wp) :: ALP020 , ALP120 , ALP220 , ALP320 108 REAL(wp) :: ALP030 , ALP130 , ALP230 109 REAL(wp) :: ALP040 , ALP140 110 REAL(wp) :: ALP050 111 REAL(wp) :: ALP001 , ALP101 , ALP201 , ALP301 112 REAL(wp) :: ALP011 , ALP111 , ALP211 113 REAL(wp) :: ALP021 , ALP121 114 REAL(wp) :: ALP031 115 REAL(wp) :: ALP002 , ALP102 116 REAL(wp) :: ALP012 117 REAL(wp) :: ALP003 118 119 ! BETA parameters 120 REAL(wp) :: BET000 , BET100 , BET200 , BET300 , BET400 , BET500 121 REAL(wp) :: BET010 , BET110 , BET210 , BET310 , BET410 122 REAL(wp) :: BET020 , BET120 , BET220 , BET320 123 REAL(wp) :: BET030 , BET130 , BET230 124 REAL(wp) :: BET040 , BET140 125 REAL(wp) :: BET050 126 REAL(wp) :: BET001 , BET101 , BET201 , BET301 127 REAL(wp) :: BET011 , BET111 , BET211 128 REAL(wp) :: BET021 , BET121 129 REAL(wp) :: BET031 130 REAL(wp) :: BET002 , BET102 131 REAL(wp) :: BET012 132 REAL(wp) :: BET003 133 134 ! PEN parameters 135 REAL(wp) :: PEN000 , PEN100 , PEN200 , PEN300 , PEN400 136 REAL(wp) :: PEN010 , PEN110 , PEN210 , PEN310 137 REAL(wp) :: PEN020 , PEN120 , PEN220 138 REAL(wp) :: PEN030 , PEN130 139 REAL(wp) :: PEN040 140 REAL(wp) :: PEN001 , PEN101 , PEN201 141 REAL(wp) :: PEN011 , PEN111 142 REAL(wp) :: PEN021 143 REAL(wp) :: PEN002 , PEN102 144 REAL(wp) :: PEN012 145 146 ! ALPHA_PEN parameters 147 REAL(wp) :: APE000 , APE100 , APE200 , APE300 148 REAL(wp) :: APE010 , APE110 , APE210 149 REAL(wp) :: APE020 , APE120 150 REAL(wp) :: APE030 151 REAL(wp) :: APE001 , APE101 152 REAL(wp) :: APE011 153 REAL(wp) :: APE002 154 155 ! BETA_PEN parameters 156 REAL(wp) :: BPE000 , BPE100 , BPE200 , BPE300 157 REAL(wp) :: BPE010 , BPE110 , BPE210 158 REAL(wp) :: BPE020 , BPE120 159 REAL(wp) :: BPE030 160 REAL(wp) :: BPE001 , BPE101 161 REAL(wp) :: BPE011 162 REAL(wp) :: BPE002 65 163 66 164 !! * Substitutions … … 68 166 # include "vectopt_loop_substitute.h90" 69 167 !!---------------------------------------------------------------------- 70 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)168 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 71 169 !! $Id$ 72 170 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 82 180 !! defined through the namelist parameter nn_eos. 83 181 !! 84 !! ** Method : 3 cases: 85 !! nn_eos = 0 : Jackett and McDougall (1994) equation of state. 86 !! the in situ density is computed directly as a function of 87 !! potential temperature relative to the surface (the opa t 88 !! variable), salt and pressure (assuming no pressure variation 89 !! along geopotential surfaces, i.e. the pressure p in decibars 90 !! is approximated by the depth in meters. 91 !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 92 !! with pressure p decibars 93 !! potential temperature t deg celsius 94 !! salinity s psu 95 !! reference volumic mass rau0 kg/m**3 96 !! in situ volumic mass rho kg/m**3 97 !! in situ density anomalie prd no units 98 !! Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 99 !! t = 40 deg celcius, s=40 psu 100 !! nn_eos = 1 : linear equation of state function of temperature only 101 !! prd(t) = 0.0285 - rn_alpha * t 102 !! nn_eos = 2 : linear equation of state function of temperature and 103 !! salinity 104 !! prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 105 !! Note that no boundary condition problem occurs in this routine 106 !! as pts are defined over the whole domain. 182 !! ** Method : prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0 183 !! with prd in situ density anomaly no units 184 !! t TEOS10: CT or EOS80: PT Celsius 185 !! s TEOS10: SA or EOS80: SP TEOS10: g/kg or EOS80: psu 186 !! z depth meters 187 !! rho in situ density kg/m^3 188 !! rau0 reference density kg/m^3 189 !! 190 !! nn_eos = -1 : polynomial TEOS-10 equation of state is used for rho(t,s,z). 191 !! Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celcius, sa=35.5 g/kg 192 !! 193 !! nn_eos = 0 : polynomial EOS-80 equation of state is used for rho(t,s,z). 194 !! Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celcius, sp=35.5 psu 195 !! 196 !! nn_eos = 1 : simplified equation of state 197 !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0 198 !! linear case function of T only: rn_alpha<>0, other coefficients = 0 199 !! linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0 200 !! Vallis like equation: use default values of coefficients 107 201 !! 108 202 !! ** Action : compute prd , the in situ density (no units) 109 203 !! 110 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 111 !!---------------------------------------------------------------------- 112 !! 113 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 114 ! ! 2 : salinity [psu] 115 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 116 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 117 !! 118 INTEGER :: ji, jj, jk ! dummy loop indices 119 REAL(wp) :: zt , zs , zh , zsr ! local scalars 120 REAL(wp) :: zr1, zr2, zr3, zr4 ! - - 121 REAL(wp) :: zrhop, ze, zbw, zb ! - - 122 REAL(wp) :: zd , zc , zaw, za ! - - 123 REAL(wp) :: zb1, za1, zkw, zk0 ! - - 124 REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 125 !!---------------------------------------------------------------------- 126 127 ! 128 IF( nn_timing == 1 ) CALL timing_start('eos') 129 ! 130 CALL wrk_alloc( jpi, jpj, jpk, zws ) 204 !! References : Roquet et al, Ocean Modelling, in preparation (2014) 205 !! Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006 206 !! TEOS-10 Manual, 2010 207 !!---------------------------------------------------------------------- 208 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 209 ! ! 2 : salinity [psu] 210 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 211 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 212 ! 213 INTEGER :: ji, jj, jk ! dummy loop indices 214 REAL(wp) :: zt , zh , zs , ztm ! local scalars 215 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 216 !!---------------------------------------------------------------------- 217 ! 218 IF( nn_timing == 1 ) CALL timing_start('eos-insitu') 131 219 ! 132 220 SELECT CASE( nn_eos ) 133 221 ! 134 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 135 !CDIR NOVERRCHK 136 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 222 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 137 223 ! 138 224 DO jk = 1, jpkm1 139 225 DO jj = 1, jpj 140 226 DO ji = 1, jpi 141 zt = pts (ji,jj,jk,jp_tem) 142 zs = pts (ji,jj,jk,jp_sal) 143 zh = pdep(ji,jj,jk) ! depth 144 zsr= zws (ji,jj,jk) ! square root salinity 145 ! 146 ! compute volumic mass pure water at atm pressure 147 zr1= ( ( ( ( 6.536332e-9_wp *zt - 1.120083e-6_wp )*zt + 1.001685e-4_wp )*zt & 148 & -9.095290e-3_wp )*zt + 6.793952e-2_wp )*zt + 999.842594_wp 149 ! seawater volumic mass atm pressure 150 zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt & 151 & -4.0899e-3_wp ) *zt+0.824493_wp 152 zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp 153 zr4= 4.8314e-4_wp 154 ! 155 ! potential volumic mass (reference to the surface) 156 zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 157 ! 158 ! add the compression terms 159 ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 160 zbw= ( 1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 161 zb = zbw + ze * zs 162 ! 163 zd = -2.042967e-2_wp 164 zc = (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 165 zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp 166 za = ( zd*zsr + zc ) *zs + zaw 167 ! 168 zb1= (-0.1909078_wp*zt+7.390729_wp ) *zt-55.87545_wp 169 za1= ( ( 2.326469e-3_wp*zt+1.553190_wp) *zt-65.00517_wp ) *zt+1044.077_wp 170 zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp 171 zk0= ( zb1*zsr + za1 )*zs + zkw 172 ! 173 ! masked in situ density anomaly 174 prd(ji,jj,jk) = ( zrhop / ( 1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) ) ) & 175 & - rau0 ) * r1_rau0 * tmask(ji,jj,jk) 227 ! 228 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 229 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 230 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 231 ztm = tmask(ji,jj,jk) ! tmask 232 ! 233 zn3 = EOS013*zt & 234 & + EOS103*zs+EOS003 235 ! 236 zn2 = (EOS022*zt & 237 & + EOS112*zs+EOS012)*zt & 238 & + (EOS202*zs+EOS102)*zs+EOS002 239 ! 240 zn1 = (((EOS041*zt & 241 & + EOS131*zs+EOS031)*zt & 242 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 243 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 244 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 245 ! 246 zn0 = (((((EOS060*zt & 247 & + EOS150*zs+EOS050)*zt & 248 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 249 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 250 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 251 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 252 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 253 ! 254 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 255 ! 256 prd(ji,jj,jk) = ( zn * r1_rau0 - 1._wp ) * ztm ! density anomaly (masked) 257 ! 176 258 END DO 177 259 END DO 178 260 END DO 179 261 ! 180 CASE( 1 ) !== Linear formulation function of temperature only ==! 262 CASE( 1 ) !== simplified EOS ==! 263 ! 181 264 DO jk = 1, jpkm1 182 prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 265 DO jj = 1, jpj 266 DO ji = 1, jpi 267 zt = pts (ji,jj,jk,jp_tem) - 10._wp 268 zs = pts (ji,jj,jk,jp_sal) - 35._wp 269 zh = pdep (ji,jj,jk) 270 ztm = tmask(ji,jj,jk) 271 ! 272 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 273 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 274 & - rn_nu * zt * zs 275 ! 276 prd(ji,jj,jk) = zn * r1_rau0 * ztm ! density anomaly (masked) 277 END DO 278 END DO 183 279 END DO 184 280 ! 185 CASE( 2 ) !== Linear formulation function of temperature and salinity ==!186 DO jk = 1, jpkm1187 prd(:,:,jk) = ( rn_beta * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)188 END DO189 !190 281 END SELECT 191 282 ! 192 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos : ', ovlap=1, kdim=jpk ) 193 ! 194 CALL wrk_dealloc( jpi, jpj, jpk, zws ) 195 ! 196 IF( nn_timing == 1 ) CALL timing_stop('eos') 283 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', ovlap=1, kdim=jpk ) 284 ! 285 IF( nn_timing == 1 ) CALL timing_stop('eos-insitu') 197 286 ! 198 287 END SUBROUTINE eos_insitu … … 208 297 !! namelist parameter nn_eos. 209 298 !! 210 !! ** Method :211 !! nn_eos = 0 : Jackett and McDougall (1994) equation of state.212 !! the in situ density is computed directly as a function of213 !! potential temperature relative to the surface (the opa t214 !! variable), salt and pressure (assuming no pressure variation215 !! along geopotential surfaces, i.e. the pressure p in decibars216 !! is approximated by the depth in meters.217 !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0218 !! rhop(t,s) = rho(t,s,0)219 !! with pressure p decibars220 !! potential temperature t deg celsius221 !! salinity s psu222 !! reference volumic mass rau0 kg/m**3223 !! in situ volumic mass rho kg/m**3224 !! in situ density anomalie prd no units225 !!226 !! Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,227 !! t = 40 deg celcius, s=40 psu228 !!229 !! nn_eos = 1 : linear equation of state function of temperature only230 !! prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - rn_alpha * t231 !! rhop(t,s) = rho(t,s)232 !!233 !! nn_eos = 2 : linear equation of state function of temperature and234 !! salinity235 !! prd(t,s) = ( rho(t,s) - rau0 ) / rau0236 !! = rn_beta * s - rn_alpha * tn - 1.237 !! rhop(t,s) = rho(t,s)238 !! Note that no boundary condition problem occurs in this routine239 !! as (tn,sn) or (ta,sa) are defined over the whole domain.240 !!241 299 !! ** Action : - prd , the in situ density (no units) 242 300 !! - prhop, the potential volumic mass (Kg/m3) 243 301 !! 244 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 245 !! Brown and Campana, Mon. Weather Rev., 1978 246 !!---------------------------------------------------------------------- 247 !! 302 !!---------------------------------------------------------------------- 248 303 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 249 304 ! ! 2 : salinity [psu] … … 252 307 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 253 308 ! 254 INTEGER :: ji, jj, jk ! dummy loop indices 255 REAL(wp) :: zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw ! local scalars 256 REAL(wp) :: zb, zd, zc, zaw, za, zb1, za1, zkw, zk0 ! - - 257 REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 258 !!---------------------------------------------------------------------- 259 ! 260 IF( nn_timing == 1 ) CALL timing_start('eos-p') 261 ! 262 CALL wrk_alloc( jpi, jpj, jpk, zws ) 309 INTEGER :: ji, jj, jk ! dummy loop indices 310 REAL(wp) :: zt , zh , zs , ztm ! local scalars 311 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 312 !!---------------------------------------------------------------------- 313 ! 314 IF( nn_timing == 1 ) CALL timing_start('eos-pot') 263 315 ! 264 316 SELECT CASE ( nn_eos ) 265 317 ! 266 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 267 !CDIR NOVERRCHK 268 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 318 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 269 319 ! 270 320 DO jk = 1, jpkm1 271 321 DO jj = 1, jpj 272 322 DO ji = 1, jpi 273 zt = pts (ji,jj,jk,jp_tem) 274 zs = pts (ji,jj,jk,jp_sal) 275 zh = pdep(ji,jj,jk) ! depth 276 zsr= zws (ji,jj,jk) ! square root salinity 277 ! 278 ! compute volumic mass pure water at atm pressure 279 zr1= ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt & 280 & -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp 281 ! seawater volumic mass atm pressure 282 zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt & 283 & -4.0899e-3_wp ) *zt+0.824493_wp 284 zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp 285 zr4= 4.8314e-4_wp 286 ! 287 ! potential volumic mass (reference to the surface) 288 zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 289 ! 290 ! save potential volumic mass 291 prhop(ji,jj,jk) = zrhop * tmask(ji,jj,jk) 292 ! 293 ! add the compression terms 294 ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 295 zbw= ( 1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 296 zb = zbw + ze * zs 297 ! 298 zd = -2.042967e-2_wp 299 zc = (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 300 zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp 301 za = ( zd*zsr + zc ) *zs + zaw 302 ! 303 zb1= ( -0.1909078_wp *zt+7.390729_wp ) *zt-55.87545_wp 304 za1= ( ( 2.326469e-3_wp*zt+1.553190_wp ) *zt-65.00517_wp ) *zt + 1044.077_wp 305 zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp 306 zk0= ( zb1*zsr + za1 )*zs + zkw 307 ! 308 ! masked in situ density anomaly 309 prd(ji,jj,jk) = ( zrhop / ( 1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) ) ) & 310 & - rau0 ) * r1_rau0 * tmask(ji,jj,jk) 323 ! 324 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 325 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 326 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 327 ztm = tmask(ji,jj,jk) ! tmask 328 ! 329 zn3 = EOS013*zt & 330 & + EOS103*zs+EOS003 331 ! 332 zn2 = (EOS022*zt & 333 & + EOS112*zs+EOS012)*zt & 334 & + (EOS202*zs+EOS102)*zs+EOS002 335 ! 336 zn1 = (((EOS041*zt & 337 & + EOS131*zs+EOS031)*zt & 338 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 339 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 340 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 341 ! 342 zn0 = (((((EOS060*zt & 343 & + EOS150*zs+EOS050)*zt & 344 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 345 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 346 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 347 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 348 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 349 ! 350 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 351 ! 352 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 353 ! 354 prd(ji,jj,jk) = ( zn * r1_rau0 - 1._wp ) * ztm ! density anomaly (masked) 311 355 END DO 312 356 END DO 313 357 END DO 314 358 ! 315 CASE( 1 ) !== Linear formulation = F( temperature ) ==! 359 CASE( 1 ) !== simplified EOS ==! 360 ! 316 361 DO jk = 1, jpkm1 317 prd (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 318 prhop(:,:,jk) = ( 1.e0_wp + prd (:,:,jk) ) * rau0 * tmask(:,:,jk) 362 DO jj = 1, jpj 363 DO ji = 1, jpi 364 zt = pts (ji,jj,jk,jp_tem) - 10._wp 365 zs = pts (ji,jj,jk,jp_sal) - 35._wp 366 zh = pdep (ji,jj,jk) 367 ztm = tmask(ji,jj,jk) 368 ! ! potential density referenced at the surface 369 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 370 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 371 & - rn_nu * zt * zs 372 prhop(ji,jj,jk) = ( rau0 + zn ) * ztm 373 ! ! density anomaly (masked) 374 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 375 prd(ji,jj,jk) = zn * r1_rau0 * ztm 376 ! 377 END DO 378 END DO 319 379 END DO 320 380 ! 321 CASE( 2 ) !== Linear formulation = F( temperature , salinity ) ==!322 DO jk = 1, jpkm1323 prd (:,:,jk) = ( rn_beta * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)324 prhop(:,:,jk) = ( 1.e0_wp + prd (:,:,jk) ) * rau0 * tmask(:,:,jk)325 END DO326 !327 381 END SELECT 328 382 ! 329 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 330 ! 331 CALL wrk_dealloc( jpi, jpj, jpk, zws ) 332 ! 333 IF( nn_timing == 1 ) CALL timing_stop('eos-p') 383 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 384 ! 385 IF( nn_timing == 1 ) CALL timing_stop('eos-pot') 334 386 ! 335 387 END SUBROUTINE eos_insitu_pot … … 344 396 !! defined through the namelist parameter nn_eos. * 2D field case 345 397 !! 346 !! ** Method : 347 !! nn_eos = 0 : Jackett and McDougall (1994) equation of state. 348 !! the in situ density is computed directly as a function of 349 !! potential temperature relative to the surface (the opa t 350 !! variable), salt and pressure (assuming no pressure variation 351 !! along geopotential surfaces, i.e. the pressure p in decibars 352 !! is approximated by the depth in meters. 353 !! prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0 354 !! with pressure p decibars 355 !! potential temperature t deg celsius 356 !! salinity s psu 357 !! reference volumic mass rau0 kg/m**3 358 !! in situ volumic mass rho kg/m**3 359 !! in situ density anomalie prd no units 360 !! Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 361 !! t = 40 deg celcius, s=40 psu 362 !! nn_eos = 1 : linear equation of state function of temperature only 363 !! prd(t) = 0.0285 - rn_alpha * t 364 !! nn_eos = 2 : linear equation of state function of temperature and 365 !! salinity 366 !! prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 367 !! Note that no boundary condition problem occurs in this routine 368 !! as pts are defined over the whole domain. 369 !! 370 !! ** Action : - prd , the in situ density (no units) 371 !! 372 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 373 !!---------------------------------------------------------------------- 374 !! 398 !! ** Action : - prd , the in situ density (no units) (unmasked) 399 !! 400 !!---------------------------------------------------------------------- 375 401 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 376 402 ! ! 2 : salinity [psu] 377 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m]403 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 378 404 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 379 !! 380 INTEGER :: ji, jj ! dummy loop indices 381 REAL(wp) :: zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw ! temporary scalars 382 REAL(wp) :: zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask ! - - 383 REAL(wp), POINTER, DIMENSION(:,:) :: zws 384 !!---------------------------------------------------------------------- 385 ! 386 IF( nn_timing == 1 ) CALL timing_start('eos2d') 387 ! 388 CALL wrk_alloc( jpi, jpj, zws ) 389 ! 390 405 ! 406 INTEGER :: ji, jj, jk ! dummy loop indices 407 REAL(wp) :: zt , zh , zs ! local scalars 408 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 409 !!---------------------------------------------------------------------- 410 ! 411 IF( nn_timing == 1 ) CALL timing_start('eos2d') 412 ! 391 413 prd(:,:) = 0._wp 392 414 ! 393 415 SELECT CASE( nn_eos ) 394 416 ! 395 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 396 ! 397 !CDIR NOVERRCHK 417 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 418 ! 398 419 DO jj = 1, jpjm1 399 !CDIR NOVERRCHK400 420 DO ji = 1, fs_jpim1 ! vector opt. 401 zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) ) 421 ! 422 zh = pdep(ji,jj) * r1_Z0 ! depth 423 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 424 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 425 ! 426 zn3 = EOS013*zt & 427 & + EOS103*zs+EOS003 428 ! 429 zn2 = (EOS022*zt & 430 & + EOS112*zs+EOS012)*zt & 431 & + (EOS202*zs+EOS102)*zs+EOS002 432 ! 433 zn1 = (((EOS041*zt & 434 & + EOS131*zs+EOS031)*zt & 435 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 436 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 437 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 438 ! 439 zn0 = (((((EOS060*zt & 440 & + EOS150*zs+EOS050)*zt & 441 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 442 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 443 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 444 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 445 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 446 ! 447 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 448 ! 449 prd(ji,jj) = zn * r1_rau0 - 1._wp ! unmasked in situ density anomaly 450 ! 402 451 END DO 403 452 END DO 453 ! 454 CASE( 1 ) !== simplified EOS ==! 455 ! 404 456 DO jj = 1, jpjm1 405 457 DO ji = 1, fs_jpim1 ! vector opt. 406 zmask = tmask(ji,jj,1) ! land/sea bottom mask = surf. mask 407 zt = pts (ji,jj,jp_tem) ! interpolated T 408 zs = pts (ji,jj,jp_sal) ! interpolated S 409 zsr = zws (ji,jj) ! square root of interpolated S 410 zh = pdep (ji,jj) ! depth at the partial step level 411 ! 412 ! compute volumic mass pure water at atm pressure 413 zr1 = ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt & 414 & -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp 415 ! seawater volumic mass atm pressure 416 zr2 = ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp )*zt+7.6438e-5_wp ) *zt & 417 & -4.0899e-3_wp ) *zt+0.824493_wp 418 zr3 = ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp 419 zr4 = 4.8314e-4_wp 420 ! 421 ! potential volumic mass (reference to the surface) 422 zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1 423 ! 424 ! add the compression terms 425 ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp 426 zbw= ( 1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp 427 zb = zbw + ze * zs 428 ! 429 zd = -2.042967e-2_wp 430 zc = (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp 431 zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt -4.721788_wp 432 za = ( zd*zsr + zc ) *zs + zaw 433 ! 434 zb1= (-0.1909078_wp *zt+7.390729_wp ) *zt-55.87545_wp 435 za1= ( ( 2.326469e-3_wp*zt+1.553190_wp ) *zt-65.00517_wp ) *zt+1044.077_wp 436 zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt & 437 & +2098.925_wp ) *zt+190925.6_wp 438 zk0= ( zb1*zsr + za1 )*zs + zkw 439 ! 440 ! masked in situ density anomaly 441 prd(ji,jj) = ( zrhop / ( 1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) ) ) - rau0 ) / rau0 * zmask 458 ! 459 zt = pts (ji,jj,jp_tem) - 10._wp 460 zs = pts (ji,jj,jp_sal) - 35._wp 461 zh = pdep (ji,jj) ! depth at the partial step level 462 ! 463 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 464 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 465 & - rn_nu * zt * zs 466 ! 467 prd(ji,jj) = zn * r1_rau0 ! unmasked in situ density anomaly 468 ! 442 469 END DO 443 470 END DO 444 471 ! 445 CASE( 1 ) !== Linear formulation = F( temperature ) ==!446 DO jj = 1, jpjm1447 DO ji = 1, fs_jpim1 ! vector opt.448 prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1)449 END DO450 END DO451 !452 CASE( 2 ) !== Linear formulation = F( temperature , salinity ) ==!453 DO jj = 1, jpjm1454 DO ji = 1, fs_jpim1 ! vector opt.455 prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1)456 END DO457 END DO458 !459 472 END SELECT 460 473 ! 461 474 IF(ln_ctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 462 475 ! 463 CALL wrk_dealloc( jpi, jpj, zws ) 464 ! 465 IF( nn_timing == 1 ) CALL timing_stop('eos2d') 476 IF( nn_timing == 1 ) CALL timing_stop('eos2d') 466 477 ! 467 478 END SUBROUTINE eos_insitu_2d 468 479 469 480 470 SUBROUTINE eos_bn2( pts, pn2 ) 471 !!---------------------------------------------------------------------- 472 !! *** ROUTINE eos_bn2 *** 473 !! 474 !! ** Purpose : Compute the local Brunt-Vaisala frequency at the time- 475 !! step of the input arguments 476 !! 477 !! ** Method : 478 !! * nn_eos = 0 : UNESCO sea water properties 479 !! The brunt-vaisala frequency is computed using the polynomial 480 !! polynomial expression of McDougall (1987): 481 !! N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w 482 !! If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is 483 !! computed and used in zdfddm module : 484 !! Rrau = alpha/beta * ( dk[ t ] / dk[ s ] ) 485 !! * nn_eos = 1 : linear equation of state (temperature only) 486 !! N^2 = grav * rn_alpha * dk[ t ]/e3w 487 !! * nn_eos = 2 : linear equation of state (temperature & salinity) 488 !! N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w 489 !! The use of potential density to compute N^2 introduces e r r o r 490 !! in the sign of N^2 at great depths. We recommand the use of 491 !! nn_eos = 0, except for academical studies. 492 !! Macro-tasked on horizontal slab (jk-loop) 493 !! N.B. N^2 is set to zero at the first level (JK=1) in inidtr 494 !! and is never used at this level. 495 !! 496 !! ** Action : - pn2 : the brunt-vaisala frequency 497 !! 498 !! References : McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987. 499 !!---------------------------------------------------------------------- 500 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 501 ! ! 2 : salinity [psu] 502 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency [s-1] 503 !! 504 INTEGER :: ji, jj, jk ! dummy loop indices 505 REAL(wp) :: zgde3w, zt, zs, zh, zalbet, zbeta ! local scalars 506 #if defined key_zdfddm 507 REAL(wp) :: zds ! local scalars 508 #endif 509 !!---------------------------------------------------------------------- 510 511 ! 512 IF( nn_timing == 1 ) CALL timing_start('bn2') 513 ! 514 ! pn2 : interior points only (2=< jk =< jpkm1 ) 515 ! -------------------------- 516 ! 517 SELECT CASE( nn_eos ) 518 ! 519 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 520 DO jk = 2, jpkm1 481 SUBROUTINE rab_3d( pts, pab ) 482 !!---------------------------------------------------------------------- 483 !! *** ROUTINE rab_3d *** 484 !! 485 !! ** Purpose : Calculates thermal/haline expansion ratio at T-points 486 !! 487 !! ** Method : calculates alpha / beta at T-points 488 !! 489 !! ** Action : - pab : thermal/haline expansion ratio at T-points 490 !!---------------------------------------------------------------------- 491 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 492 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab ! thermal/haline expansion ratio 493 ! 494 INTEGER :: ji, jj, jk ! dummy loop indices 495 REAL(wp) :: zt , zh , zs , ztm ! local scalars 496 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 497 !!---------------------------------------------------------------------- 498 ! 499 IF( nn_timing == 1 ) CALL timing_start('rab_3d') 500 ! 501 SELECT CASE ( nn_eos ) 502 ! 503 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 504 ! 505 DO jk = 1, jpkm1 521 506 DO jj = 1, jpj 522 507 DO ji = 1, jpi 523 zgde3w = grav / fse3w(ji,jj,jk) 524 zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) ) ! potential temperature at w-pt 525 zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0 ! salinity anomaly (s-35) at w-pt 526 zh = fsdepw(ji,jj,jk) ! depth in meters at w-point 527 ! 528 zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt & ! ratio alpha/beta 529 & - 0.203814e-03_wp ) * zt & 530 & + 0.170907e-01_wp ) * zt & 531 & + 0.665157e-01_wp & 532 & + ( - 0.678662e-05_wp * zs & 533 & - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs & 534 & + ( ( - 0.302285e-13_wp * zh & 535 & - 0.251520e-11_wp * zs & 536 & + 0.512857e-12_wp * zt * zt ) * zh & 537 & - 0.164759e-06_wp * zs & 538 & +( 0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt & 539 & + 0.380374e-04_wp ) * zh 540 ! 541 zbeta = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt & ! beta 542 & - 0.301985e-05_wp ) * zt & 543 & + 0.785567e-03_wp & 544 & + ( 0.515032e-08_wp * zs & 545 & + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs & 546 & + ( ( 0.121551e-17_wp * zh & 547 & - 0.602281e-15_wp * zs & 548 & - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh & 549 & + 0.408195e-10_wp * zs & 550 & + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt & 551 & - 0.121555e-07_wp ) * zh 552 ! 553 pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk) & ! N^2 554 & * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 555 & - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) 556 #if defined key_zdfddm 557 ! !!bug **** caution a traiter zds=dk[S]= 0 !!!! 558 zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ! Rrau = (alpha / beta) (dk[t] / dk[s]) 559 IF ( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 560 rrau(ji,jj,jk) = zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds 561 #endif 508 ! 509 zh = fsdept(ji,jj,jk) * r1_Z0 ! depth 510 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 511 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 512 ztm = tmask(ji,jj,jk) ! tmask 513 ! 514 ! alpha 515 zn3 = ALP003 516 ! 517 zn2 = ALP012*zt + ALP102*zs+ALP002 518 ! 519 zn1 = ((ALP031*zt & 520 & + ALP121*zs+ALP021)*zt & 521 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 522 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 523 ! 524 zn0 = ((((ALP050*zt & 525 & + ALP140*zs+ALP040)*zt & 526 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 527 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 528 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 529 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 530 ! 531 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 532 ! 533 pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm 534 ! 535 ! beta 536 zn3 = BET003 537 ! 538 zn2 = BET012*zt + BET102*zs+BET002 539 ! 540 zn1 = ((BET031*zt & 541 & + BET121*zs+BET021)*zt & 542 & + (BET211*zs+BET111)*zs+BET011)*zt & 543 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 544 ! 545 zn0 = ((((BET050*zt & 546 & + BET140*zs+BET040)*zt & 547 & + (BET230*zs+BET130)*zs+BET030)*zt & 548 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 549 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 550 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 551 ! 552 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 553 ! 554 pab(ji,jj,jk,jp_sal) = zn / zs * r1_rau0 * ztm 555 ! 562 556 END DO 563 557 END DO 564 558 END DO 565 559 ! 566 CASE( 1 ) !== Linear formulation = F( temperature ) ==! 567 DO jk = 2, jpkm1 568 pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 569 END DO 570 ! 571 CASE( 2 ) !== Linear formulation = F( temperature , salinity ) ==! 572 DO jk = 2, jpkm1 573 pn2(:,:,jk) = grav * ( rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) & 574 & - rn_beta * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) ) ) & 575 & / fse3w(:,:,jk) * tmask(:,:,jk) 576 END DO 577 #if defined key_zdfddm 578 DO jk = 2, jpkm1 ! Rrau = (alpha / beta) (dk[t] / dk[s]) 560 CASE( 1 ) !== simplified EOS ==! 561 ! 562 DO jk = 1, jpkm1 579 563 DO jj = 1, jpj 580 564 DO ji = 1, jpi 581 zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 582 IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp 583 rrau(ji,jj,jk) = ralpbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds 565 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 566 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 567 zh = fsdept(ji,jj,jk) ! depth in meters at t-point 568 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 569 ! 570 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 571 pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm ! alpha 572 ! 573 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 574 pab(ji,jj,jk,jp_sal) = zn * r1_rau0 * ztm ! beta 575 ! 584 576 END DO 585 577 END DO 586 578 END DO 587 #endif588 END SELECT589 590 IF(ln_ctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ', ovlap=1, kdim=jpk )591 #if defined key_zdfddm592 IF(ln_ctl) CALL prt_ctl( tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk )593 #endif594 !595 IF( nn_timing == 1 ) CALL timing_stop('bn2')596 !597 END SUBROUTINE eos_bn2598 599 600 SUBROUTINE eos_alpbet( pts, palpbet, beta0 )601 !!----------------------------------------------------------------------602 !! *** ROUTINE eos_alpbet ***603 !!604 !! ** Purpose : Calculates the in situ thermal/haline expansion ratio at T-points605 !!606 !! ** Method : calculates alpha / beta ratio at T-points607 !! * nn_eos = 0 : UNESCO sea water properties608 !! The alpha/beta ratio is returned as 3-D array palpbet using the polynomial609 !! polynomial expression of McDougall (1987).610 !! Scalar beta0 is returned = 1.611 !! * nn_eos = 1 : linear equation of state (temperature only)612 !! The ratio is undefined, so we return alpha as palpbet613 !! Scalar beta0 is returned = 0.614 !! * nn_eos = 2 : linear equation of state (temperature & salinity)615 !! The alpha/beta ratio is returned as ralpbet616 !! Scalar beta0 is returned = 1.617 !!618 !! ** Action : - palpbet : thermal/haline expansion ratio at T-points619 !! : beta0 : 1. or 0.620 !!----------------------------------------------------------------------621 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity622 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: palpbet ! thermal/haline expansion ratio623 REAL(wp), INTENT( out) :: beta0 ! set = 1 except with case 1 eos, rho=rho(T)624 !!625 INTEGER :: ji, jj, jk ! dummy loop indices626 REAL(wp) :: zt, zs, zh ! local scalars627 !!----------------------------------------------------------------------628 !629 IF( nn_timing == 1 ) CALL timing_start('eos_alpbet')630 !631 SELECT CASE ( nn_eos )632 !633 CASE ( 0 ) ! Jackett and McDougall (1994) formulation634 DO jk = 1, jpk635 DO jj = 1, jpj636 DO ji = 1, jpi637 zt = pts(ji,jj,jk,jp_tem) ! potential temperature638 zs = pts(ji,jj,jk,jp_sal) - 35._wp ! salinity anomaly (s-35)639 zh = fsdept(ji,jj,jk) ! depth in meters640 !641 palpbet(ji,jj,jk) = &642 & ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt &643 & - 0.203814e-03_wp ) * zt &644 & + 0.170907e-01_wp ) * zt &645 & + 0.665157e-01_wp &646 & + ( - 0.678662e-05_wp * zs &647 & - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs &648 & + ( ( - 0.302285e-13_wp * zh &649 & - 0.251520e-11_wp * zs &650 & + 0.512857e-12_wp * zt * zt ) * zh &651 & - 0.164759e-06_wp * zs &652 & +( 0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt &653 & + 0.380374e-04_wp ) * zh654 END DO655 END DO656 END DO657 beta0 = 1._wp658 !659 CASE ( 1 ) !== Linear formulation = F( temperature ) ==!660 palpbet(:,:,:) = rn_alpha661 beta0 = 0._wp662 !663 CASE ( 2 ) !== Linear formulation = F( temperature , salinity ) ==!664 palpbet(:,:,:) = ralpbet665 beta0 = 1._wp666 579 ! 667 580 CASE DEFAULT … … 672 585 END SELECT 673 586 ! 674 IF( nn_timing == 1 ) CALL timing_stop('eos_alpbet') 675 ! 676 END SUBROUTINE eos_alpbet 677 678 679 FUNCTION tfreez( psal, pdep ) RESULT( ptf ) 587 IF( nn_timing == 1 ) CALL timing_stop('rab_3d') 588 ! 589 END SUBROUTINE rab_3d 590 591 592 SUBROUTINE rab_2d( pts, pdep, pab ) 593 !!---------------------------------------------------------------------- 594 !! *** ROUTINE rab_2d *** 595 !! 596 !! ** Purpose : Calculates thermal/haline expansion ratio for a 2d field (unmasked) 597 !! 598 !! ** Action : - pab : thermal/haline expansion ratio at T-points 599 !!---------------------------------------------------------------------- 600 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT(in ) :: pts ! pot. temperature & salinity 601 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 602 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT( out) :: pab ! thermal/haline expansion ratio 603 ! 604 INTEGER :: ji, jj, jk ! dummy loop indices 605 REAL(wp) :: zt , zh , zs ! local scalars 606 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 607 !!---------------------------------------------------------------------- 608 ! 609 IF( nn_timing == 1 ) CALL timing_start('rab_2d') 610 ! 611 pab(:,:,:) = 0._wp 612 ! 613 SELECT CASE ( nn_eos ) 614 ! 615 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 616 ! 617 DO jj = 1, jpjm1 618 DO ji = 1, fs_jpim1 ! vector opt. 619 ! 620 zh = pdep(ji,jj) * r1_Z0 ! depth 621 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 622 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 623 ! 624 ! alpha 625 zn3 = ALP003 626 ! 627 zn2 = ALP012*zt + ALP102*zs+ALP002 628 ! 629 zn1 = ((ALP031*zt & 630 & + ALP121*zs+ALP021)*zt & 631 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 632 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 633 ! 634 zn0 = ((((ALP050*zt & 635 & + ALP140*zs+ALP040)*zt & 636 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 637 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 638 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 639 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 640 ! 641 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 642 ! 643 pab(ji,jj,jp_tem) = zn * r1_rau0 644 ! 645 ! beta 646 zn3 = BET003 647 ! 648 zn2 = BET012*zt + BET102*zs+BET002 649 ! 650 zn1 = ((BET031*zt & 651 & + BET121*zs+BET021)*zt & 652 & + (BET211*zs+BET111)*zs+BET011)*zt & 653 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 654 ! 655 zn0 = ((((BET050*zt & 656 & + BET140*zs+BET040)*zt & 657 & + (BET230*zs+BET130)*zs+BET030)*zt & 658 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 659 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 660 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 661 ! 662 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 663 ! 664 pab(ji,jj,jp_sal) = zn / zs * r1_rau0 665 ! 666 ! 667 END DO 668 END DO 669 ! 670 CASE( 1 ) !== simplified EOS ==! 671 ! 672 DO jj = 1, jpjm1 673 DO ji = 1, fs_jpim1 ! vector opt. 674 ! 675 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 676 zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 677 zh = pdep (ji,jj) ! depth at the partial step level 678 ! 679 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 680 pab(ji,jj,jp_tem) = zn * r1_rau0 ! alpha 681 ! 682 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 683 pab(ji,jj,jp_sal) = zn * r1_rau0 ! beta 684 ! 685 END DO 686 END DO 687 ! 688 CASE DEFAULT 689 IF(lwp) WRITE(numout,cform_err) 690 IF(lwp) WRITE(numout,*) ' bad flag value for nn_eos = ', nn_eos 691 nstop = nstop + 1 692 ! 693 END SELECT 694 ! 695 IF( nn_timing == 1 ) CALL timing_stop('rab_2d') 696 ! 697 END SUBROUTINE rab_2d 698 699 700 SUBROUTINE bn2( pts, pab, pn2 ) 701 !!---------------------------------------------------------------------- 702 !! *** ROUTINE bn2 *** 703 !! 704 !! ** Purpose : Compute the local Brunt-Vaisala frequency at the 705 !! time-step of the input arguments 706 !! 707 !! ** Method : pn2 = grav * (alpha dk[T] + beta dk[S] ) / e3w 708 !! where alpha and beta are given in pab, and computed on T-points. 709 !! N.B. N^2 is set one for all to zero at jk=1 in istate module. 710 !! 711 !! ** Action : pn2 : square of the brunt-vaisala frequency at w-point 712 !! 713 !!---------------------------------------------------------------------- 714 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celcius,psu] 715 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celcius-1,psu-1] 716 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 717 ! 718 INTEGER :: ji, jj, jk ! dummy loop indices 719 REAL(wp) :: zaw, zbw, zrw ! local scalars 720 !!---------------------------------------------------------------------- 721 ! 722 IF( nn_timing == 1 ) CALL timing_start('bn2') 723 ! 724 DO jk = 2, jpkm1 ! interior points only (2=< jk =< jpkm1 ) 725 DO jj = 1, jpj ! surface and bottom value set to zero one for all in istate.F90 726 DO ji = 1, jpi 727 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) & 728 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 729 ! 730 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 731 zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 732 ! 733 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 734 & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 735 & / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 736 END DO 737 END DO 738 END DO 739 ! 740 IF(ln_ctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ', ovlap=1, kdim=jpk ) 741 ! 742 IF( nn_timing == 1 ) CALL timing_stop('bn2') 743 ! 744 END SUBROUTINE bn2 745 746 747 FUNCTION eos_pt_from_ct( ctmp, psal ) RESULT( ptmp ) 748 !!---------------------------------------------------------------------- 749 !! *** ROUTINE eos_pt_from_ct *** 750 !! 751 !! ** Purpose : Compute pot.temp. from cons. temp. [Celcius] 752 !! 753 !! ** Method : rational approximation (5/3th order) of TEOS-10 algorithm 754 !! checkvalue: pt=20.02391895 Celsius for sa=35.7g/kg, ct=20degC 755 !! 756 !! Reference : TEOS-10, UNESCO 757 !! Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC) 758 !!---------------------------------------------------------------------- 759 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celcius] 760 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 761 ! Leave result array automatic rather than making explicitly allocated 762 REAL(wp), DIMENSION(jpi,jpj) :: ptmp ! potential temperature [Celcius] 763 ! 764 INTEGER :: ji, jj ! dummy loop indices 765 REAL(wp) :: zt , zs , ztm ! local scalars 766 REAL(wp) :: zn , zd ! local scalars 767 REAL(wp) :: zdeltaS , z1_S0 , z1_T0 768 !!---------------------------------------------------------------------- 769 ! 770 IF ( nn_timing == 1 ) CALL timing_start('eos_pt_from_ct') 771 ! 772 zdeltaS = 5._wp 773 z1_S0 = 0.875_wp/35.16504_wp 774 z1_T0 = 1._wp/40._wp 775 ! 776 DO jj = 1, jpj 777 DO ji = 1, jpi 778 ! 779 zt = ctmp (ji,jj) * z1_T0 780 zs = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 781 ztm = tmask(ji,jj,1) 782 ! 783 zn = ((((-2.1385727895e-01_wp*zt & 784 & - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt & 785 & + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt & 786 & + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt & 787 & + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs & 788 & +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt & 789 & + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs & 790 & -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 791 ! 792 zd = (2.0035003456_wp*zt & 793 & -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt & 794 & + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 795 ! 796 ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 797 ! 798 END DO 799 END DO 800 ! 801 IF( nn_timing == 1 ) CALL timing_stop('eos_pt_from_ct') 802 ! 803 END FUNCTION eos_pt_from_ct 804 805 806 FUNCTION eos_fzp( psal, pdep ) RESULT( ptf ) 807 !!---------------------------------------------------------------------- 808 !! *** ROUTINE eos_fzp *** 809 !! 810 !! ** Purpose : Compute the freezing point temperature [Celcius] 811 !! 812 !! ** Method : UNESCO freezing point (ptf) in Celcius is given by 813 !! ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 814 !! checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m 815 !! 816 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978 817 !!---------------------------------------------------------------------- 818 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 819 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 820 REAL(wp), DIMENSION(jpi,jpj) :: ptf ! freezing temperature [Celcius] 821 ! 822 INTEGER :: ji, jj ! dummy loop indices 823 REAL(wp) :: zt, zs ! local scalars 824 !!---------------------------------------------------------------------- 825 ! 826 SELECT CASE ( nn_eos ) 827 ! 828 CASE ( -1, 1 ) !== CT,SA (TEOS-10 formulation) ==! 829 ! 830 DO jj = 1, jpj 831 DO ji = 1, jpi 832 zs= SQRT( ABS( psal(ji,jj) ) * r1_S0 ) ! square root salinity 833 ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 834 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 835 END DO 836 END DO 837 ptf(:,:) = ptf(:,:) * psal(:,:) 838 ! 839 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 840 ! 841 CASE ( 0 ) !== PT,SP (UNESCO formulation) ==! 842 ! 843 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) & 844 & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:) 845 ! 846 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 847 ! 848 CASE DEFAULT 849 IF(lwp) WRITE(numout,cform_err) 850 IF(lwp) WRITE(numout,*) ' bad flag value for nn_eos = ', nn_eos 851 nstop = nstop + 1 852 ! 853 END SELECT 854 ! 855 END FUNCTION eos_fzp 856 857 858 SUBROUTINE eos_pen( pts, pab_pe, ppen ) 859 !!---------------------------------------------------------------------- 860 !! *** ROUTINE eos_pen *** 861 !! 862 !! ** Purpose : Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points 863 !! 864 !! ** Method : PE is defined analytically as the vertical 865 !! primitive of EOS times -g integrated between 0 and z>0. 866 !! pen is the nonlinear bsq-PE anomaly: pen = ( PE - rau0 gz ) / rau0 gz - rd 867 !! = 1/z * /int_0^z rd dz - rd 868 !! where rd is the density anomaly (see eos_rhd function) 869 !! ab_pe are partial derivatives of PE anomaly with respect to T and S: 870 !! ab_pe(1) = - 1/(rau0 gz) * dPE/dT + drd/dT = - d(pen)/dT 871 !! ab_pe(2) = 1/(rau0 gz) * dPE/dS + drd/dS = d(pen)/dS 872 !! 873 !! ** Action : - pen : PE anomaly given at T-points 874 !! : - pab_pe : given at T-points 875 !! pab_pe(:,:,:,jp_tem) is alpha_pe 876 !! pab_pe(:,:,:,jp_sal) is beta_pe 877 !!---------------------------------------------------------------------- 878 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 879 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab_pe ! alpha_pe and beta_pe 880 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: ppen ! potential energy anomaly 881 ! 882 INTEGER :: ji, jj, jk ! dummy loop indices 883 REAL(wp) :: zt , zh , zs , ztm ! local scalars 884 REAL(wp) :: zn , zn0, zn1, zn2 ! - - 885 !!---------------------------------------------------------------------- 886 ! 887 IF( nn_timing == 1 ) CALL timing_start('eos_pen') 888 ! 889 SELECT CASE ( nn_eos ) 890 ! 891 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 892 ! 893 DO jk = 1, jpkm1 894 DO jj = 1, jpj 895 DO ji = 1, jpi 896 ! 897 zh = fsdept(ji,jj,jk) * r1_Z0 ! depth 898 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 899 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 900 ztm = tmask(ji,jj,jk) ! tmask 901 ! 902 ! potential energy non-linear anomaly 903 zn2 = (PEN012)*zt & 904 & + PEN102*zs+PEN002 905 ! 906 zn1 = ((PEN021)*zt & 907 & + PEN111*zs+PEN011)*zt & 908 & + (PEN201*zs+PEN101)*zs+PEN001 909 ! 910 zn0 = ((((PEN040)*zt & 911 & + PEN130*zs+PEN030)*zt & 912 & + (PEN220*zs+PEN120)*zs+PEN020)*zt & 913 & + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt & 914 & + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 915 ! 916 zn = ( zn2 * zh + zn1 ) * zh + zn0 917 ! 918 ppen(ji,jj,jk) = zn * zh * r1_rau0 * ztm 919 ! 920 ! alphaPE non-linear anomaly 921 zn2 = APE002 922 ! 923 zn1 = (APE011)*zt & 924 & + APE101*zs+APE001 925 ! 926 zn0 = (((APE030)*zt & 927 & + APE120*zs+APE020)*zt & 928 & + (APE210*zs+APE110)*zs+APE010)*zt & 929 & + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 930 ! 931 zn = ( zn2 * zh + zn1 ) * zh + zn0 932 ! 933 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rau0 * ztm 934 ! 935 ! betaPE non-linear anomaly 936 zn2 = BPE002 937 ! 938 zn1 = (BPE011)*zt & 939 & + BPE101*zs+BPE001 940 ! 941 zn0 = (((BPE030)*zt & 942 & + BPE120*zs+BPE020)*zt & 943 & + (BPE210*zs+BPE110)*zs+BPE010)*zt & 944 & + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 945 ! 946 zn = ( zn2 * zh + zn1 ) * zh + zn0 947 ! 948 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rau0 * ztm 949 ! 950 END DO 951 END DO 952 END DO 953 ! 954 CASE( 1 ) !== Vallis (2006) simplified EOS ==! 955 ! 956 DO jk = 1, jpkm1 957 DO jj = 1, jpj 958 DO ji = 1, jpi 959 zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0) 960 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 961 zh = fsdept(ji,jj,jk) ! depth in meters at t-point 962 ztm = tmask(ji,jj,jk) ! tmask 963 zn = 0.5_wp * zh * r1_rau0 * ztm 964 ! ! Potential Energy 965 ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 966 ! ! alphaPE 967 pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 968 pab_pe(ji,jj,jk,jp_sal) = rn_b0 * rn_mu2 * zn 969 ! 970 END DO 971 END DO 972 END DO 973 ! 974 CASE DEFAULT 975 IF(lwp) WRITE(numout,cform_err) 976 IF(lwp) WRITE(numout,*) ' bad flag value for nn_eos = ', nn_eos 977 nstop = nstop + 1 978 ! 979 END SELECT 980 ! 981 IF( nn_timing == 1 ) CALL timing_stop('eos_pen') 982 ! 983 END SUBROUTINE eos_pen 984 985 986 SUBROUTINE eos_init 680 987 !!---------------------------------------------------------------------- 681 988 !! *** ROUTINE eos_init *** 682 989 !! 683 !! ** Purpose : Compute the sea surface freezing temperature [Celcius]684 !!685 !! ** Method : UNESCO freezing point at the surface (pressure = 0???)686 !! freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p687 !! checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars688 !!689 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978690 !!----------------------------------------------------------------------691 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu]692 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [decibars]693 ! Leave result array automatic rather than making explicitly allocated694 REAL(wp), DIMENSION(jpi,jpj) :: ptf ! freezing temperature [Celcius]695 !!----------------------------------------------------------------------696 !697 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) &698 & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:)699 IF ( PRESENT( pdep ) ) THEN700 ptf(:,:) = ptf(:,:) - 7.53e-4_wp * pdep(:,:)701 ENDIF702 !703 END FUNCTION tfreez704 705 706 SUBROUTINE eos_init707 !!----------------------------------------------------------------------708 !! *** ROUTINE eos_init ***709 !!710 990 !! ** Purpose : initializations for the equation of state 711 991 !! 712 992 !! ** Method : Read the namelist nameos and control the parameters 713 993 !!---------------------------------------------------------------------- 714 NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta 715 !!---------------------------------------------------------------------- 716 INTEGER :: ios 994 INTEGER :: ios ! local integer 995 !! 996 NAMELIST/nameos/ nn_eos, ln_useCT, rn_a0, rn_b0, rn_lambda1, rn_mu1, & 997 & rn_lambda2, rn_mu2, rn_nu 998 !!---------------------------------------------------------------------- 717 999 ! 718 1000 REWIND( numnam_ref ) ! Namelist nameos in reference namelist : equation of state 719 1001 READ ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 720 1002 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist', lwp ) 721 1003 ! 722 1004 REWIND( numnam_cfg ) ! Namelist nameos in configuration namelist : equation of state 723 1005 READ ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 724 1006 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp ) 725 1007 WRITE( numond, nameos ) 1008 ! 1009 rau0 = 1026._wp !: volumic mass of reference [kg/m3] 1010 rcp = 3991.86795711963_wp !: heat capacity [J/K] 726 1011 ! 727 1012 IF(lwp) THEN ! Control print … … 731 1016 WRITE(numout,*) ' Namelist nameos : set eos parameters' 732 1017 WRITE(numout,*) ' flag for eq. of state and N^2 nn_eos = ', nn_eos 733 WRITE(numout,*) ' thermal exp. coef. (linear) rn_alpha = ', rn_alpha 734 WRITE(numout,*) ' saline exp. coef. (linear) rn_beta = ', rn_beta 1018 IF( ln_useCT ) THEN 1019 WRITE(numout,*) ' model uses Conservative Temperature' 1020 WRITE(numout,*) ' Important: model must be initialized with CT and SA fields' 1021 ENDIF 735 1022 ENDIF 736 1023 ! 737 1024 SELECT CASE( nn_eos ) ! check option 738 1025 ! 739 CASE( 0 ) !== Jackett and McDougall (1994) formulation==!1026 CASE( -1 ) !== polynomial TEOS-10 ==! 740 1027 IF(lwp) WRITE(numout,*) 741 IF(lwp) WRITE(numout,*) ' use of Jackett & McDougall (1994) equation of state and' 742 IF(lwp) WRITE(numout,*) ' McDougall (1987) Brunt-Vaisala frequency' 743 ! 744 CASE( 1 ) !== Linear formulation = F( temperature ) ==! 1028 IF(lwp) WRITE(numout,*) ' use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 1029 ! 1030 rdeltaS = 32._wp 1031 r1_S0 = 0.875_wp/35.16504_wp 1032 r1_T0 = 1._wp/40._wp 1033 r1_Z0 = 1.e-4_wp 1034 ! 1035 EOS000 = 8.0189615746e+02_wp 1036 EOS100 = 8.6672408165e+02_wp 1037 EOS200 = -1.7864682637e+03_wp 1038 EOS300 = 2.0375295546e+03_wp 1039 EOS400 = -1.2849161071e+03_wp 1040 EOS500 = 4.3227585684e+02_wp 1041 EOS600 = -6.0579916612e+01_wp 1042 EOS010 = 2.6010145068e+01_wp 1043 EOS110 = -6.5281885265e+01_wp 1044 EOS210 = 8.1770425108e+01_wp 1045 EOS310 = -5.6888046321e+01_wp 1046 EOS410 = 1.7681814114e+01_wp 1047 EOS510 = -1.9193502195_wp 1048 EOS020 = -3.7074170417e+01_wp 1049 EOS120 = 6.1548258127e+01_wp 1050 EOS220 = -6.0362551501e+01_wp 1051 EOS320 = 2.9130021253e+01_wp 1052 EOS420 = -5.4723692739_wp 1053 EOS030 = 2.1661789529e+01_wp 1054 EOS130 = -3.3449108469e+01_wp 1055 EOS230 = 1.9717078466e+01_wp 1056 EOS330 = -3.1742946532_wp 1057 EOS040 = -8.3627885467_wp 1058 EOS140 = 1.1311538584e+01_wp 1059 EOS240 = -5.3563304045_wp 1060 EOS050 = 5.4048723791e-01_wp 1061 EOS150 = 4.8169980163e-01_wp 1062 EOS060 = -1.9083568888e-01_wp 1063 EOS001 = 1.9681925209e+01_wp 1064 EOS101 = -4.2549998214e+01_wp 1065 EOS201 = 5.0774768218e+01_wp 1066 EOS301 = -3.0938076334e+01_wp 1067 EOS401 = 6.6051753097_wp 1068 EOS011 = -1.3336301113e+01_wp 1069 EOS111 = -4.4870114575_wp 1070 EOS211 = 5.0042598061_wp 1071 EOS311 = -6.5399043664e-01_wp 1072 EOS021 = 6.7080479603_wp 1073 EOS121 = 3.5063081279_wp 1074 EOS221 = -1.8795372996_wp 1075 EOS031 = -2.4649669534_wp 1076 EOS131 = -5.5077101279e-01_wp 1077 EOS041 = 5.5927935970e-01_wp 1078 EOS002 = 2.0660924175_wp 1079 EOS102 = -4.9527603989_wp 1080 EOS202 = 2.5019633244_wp 1081 EOS012 = 2.0564311499_wp 1082 EOS112 = -2.1311365518e-01_wp 1083 EOS022 = -1.2419983026_wp 1084 EOS003 = -2.3342758797e-02_wp 1085 EOS103 = -1.8507636718e-02_wp 1086 EOS013 = 3.7969820455e-01_wp 1087 ! 1088 ALP000 = -6.5025362670e-01_wp 1089 ALP100 = 1.6320471316_wp 1090 ALP200 = -2.0442606277_wp 1091 ALP300 = 1.4222011580_wp 1092 ALP400 = -4.4204535284e-01_wp 1093 ALP500 = 4.7983755487e-02_wp 1094 ALP010 = 1.8537085209_wp 1095 ALP110 = -3.0774129064_wp 1096 ALP210 = 3.0181275751_wp 1097 ALP310 = -1.4565010626_wp 1098 ALP410 = 2.7361846370e-01_wp 1099 ALP020 = -1.6246342147_wp 1100 ALP120 = 2.5086831352_wp 1101 ALP220 = -1.4787808849_wp 1102 ALP320 = 2.3807209899e-01_wp 1103 ALP030 = 8.3627885467e-01_wp 1104 ALP130 = -1.1311538584_wp 1105 ALP230 = 5.3563304045e-01_wp 1106 ALP040 = -6.7560904739e-02_wp 1107 ALP140 = -6.0212475204e-02_wp 1108 ALP050 = 2.8625353333e-02_wp 1109 ALP001 = 3.3340752782e-01_wp 1110 ALP101 = 1.1217528644e-01_wp 1111 ALP201 = -1.2510649515e-01_wp 1112 ALP301 = 1.6349760916e-02_wp 1113 ALP011 = -3.3540239802e-01_wp 1114 ALP111 = -1.7531540640e-01_wp 1115 ALP211 = 9.3976864981e-02_wp 1116 ALP021 = 1.8487252150e-01_wp 1117 ALP121 = 4.1307825959e-02_wp 1118 ALP031 = -5.5927935970e-02_wp 1119 ALP002 = -5.1410778748e-02_wp 1120 ALP102 = 5.3278413794e-03_wp 1121 ALP012 = 6.2099915132e-02_wp 1122 ALP003 = -9.4924551138e-03_wp 1123 ! 1124 BET000 = 1.0783203594e+01_wp 1125 BET100 = -4.4452095908e+01_wp 1126 BET200 = 7.6048755820e+01_wp 1127 BET300 = -6.3944280668e+01_wp 1128 BET400 = 2.6890441098e+01_wp 1129 BET500 = -4.5221697773_wp 1130 BET010 = -8.1219372432e-01_wp 1131 BET110 = 2.0346663041_wp 1132 BET210 = -2.1232895170_wp 1133 BET310 = 8.7994140485e-01_wp 1134 BET410 = -1.1939638360e-01_wp 1135 BET020 = 7.6574242289e-01_wp 1136 BET120 = -1.5019813020_wp 1137 BET220 = 1.0872489522_wp 1138 BET320 = -2.7233429080e-01_wp 1139 BET030 = -4.1615152308e-01_wp 1140 BET130 = 4.9061350869e-01_wp 1141 BET230 = -1.1847737788e-01_wp 1142 BET040 = 1.4073062708e-01_wp 1143 BET140 = -1.3327978879e-01_wp 1144 BET050 = 5.9929880134e-03_wp 1145 BET001 = -5.2937873009e-01_wp 1146 BET101 = 1.2634116779_wp 1147 BET201 = -1.1547328025_wp 1148 BET301 = 3.2870876279e-01_wp 1149 BET011 = -5.5824407214e-02_wp 1150 BET111 = 1.2451933313e-01_wp 1151 BET211 = -2.4409539932e-02_wp 1152 BET021 = 4.3623149752e-02_wp 1153 BET121 = -4.6767901790e-02_wp 1154 BET031 = -6.8523260060e-03_wp 1155 BET002 = -6.1618945251e-02_wp 1156 BET102 = 6.2255521644e-02_wp 1157 BET012 = -2.6514181169e-03_wp 1158 BET003 = -2.3025968587e-04_wp 1159 ! 1160 PEN000 = -9.8409626043_wp 1161 PEN100 = 2.1274999107e+01_wp 1162 PEN200 = -2.5387384109e+01_wp 1163 PEN300 = 1.5469038167e+01_wp 1164 PEN400 = -3.3025876549_wp 1165 PEN010 = 6.6681505563_wp 1166 PEN110 = 2.2435057288_wp 1167 PEN210 = -2.5021299030_wp 1168 PEN310 = 3.2699521832e-01_wp 1169 PEN020 = -3.3540239802_wp 1170 PEN120 = -1.7531540640_wp 1171 PEN220 = 9.3976864981e-01_wp 1172 PEN030 = 1.2324834767_wp 1173 PEN130 = 2.7538550639e-01_wp 1174 PEN040 = -2.7963967985e-01_wp 1175 PEN001 = -1.3773949450_wp 1176 PEN101 = 3.3018402659_wp 1177 PEN201 = -1.6679755496_wp 1178 PEN011 = -1.3709540999_wp 1179 PEN111 = 1.4207577012e-01_wp 1180 PEN021 = 8.2799886843e-01_wp 1181 PEN002 = 1.7507069098e-02_wp 1182 PEN102 = 1.3880727538e-02_wp 1183 PEN012 = -2.8477365341e-01_wp 1184 ! 1185 APE000 = -1.6670376391e-01_wp 1186 APE100 = -5.6087643219e-02_wp 1187 APE200 = 6.2553247576e-02_wp 1188 APE300 = -8.1748804580e-03_wp 1189 APE010 = 1.6770119901e-01_wp 1190 APE110 = 8.7657703198e-02_wp 1191 APE210 = -4.6988432490e-02_wp 1192 APE020 = -9.2436260751e-02_wp 1193 APE120 = -2.0653912979e-02_wp 1194 APE030 = 2.7963967985e-02_wp 1195 APE001 = 3.4273852498e-02_wp 1196 APE101 = -3.5518942529e-03_wp 1197 APE011 = -4.1399943421e-02_wp 1198 APE002 = 7.1193413354e-03_wp 1199 ! 1200 BPE000 = 2.6468936504e-01_wp 1201 BPE100 = -6.3170583896e-01_wp 1202 BPE200 = 5.7736640125e-01_wp 1203 BPE300 = -1.6435438140e-01_wp 1204 BPE010 = 2.7912203607e-02_wp 1205 BPE110 = -6.2259666565e-02_wp 1206 BPE210 = 1.2204769966e-02_wp 1207 BPE020 = -2.1811574876e-02_wp 1208 BPE120 = 2.3383950895e-02_wp 1209 BPE030 = 3.4261630030e-03_wp 1210 BPE001 = 4.1079296834e-02_wp 1211 BPE101 = -4.1503681096e-02_wp 1212 BPE011 = 1.7676120780e-03_wp 1213 BPE002 = 1.7269476440e-04_wp 1214 ! 1215 CASE( 0 ) !== polynomial EOS-80 formulation ==! 1216 ! 745 1217 IF(lwp) WRITE(numout,*) 746 IF(lwp) WRITE(numout,*) ' use of linear eos rho(T) = rau0 * ( 1.0285 - rn_alpha * T )' 747 IF( lk_zdfddm ) CALL ctl_stop( ' double diffusive mixing parameterization requires', & 748 & ' that T and S are used as state variables' ) 749 ! 750 CASE( 2 ) !== Linear formulation = F( temperature , salinity ) ==! 751 ralpbet = rn_alpha / rn_beta 752 IF(lwp) WRITE(numout,*) 753 IF(lwp) WRITE(numout,*) ' use of linear eos rho(T,S) = rau0 * ( rn_beta * S - rn_alpha * T )' 1218 IF(lwp) WRITE(numout,*) ' use of EOS-80 equation of state (pot. temp. and pract. salinity)' 1219 ! 1220 rdeltaS = 20._wp 1221 r1_S0 = 1._wp/40._wp 1222 r1_T0 = 1._wp/40._wp 1223 r1_Z0 = 1.e-4_wp 1224 ! 1225 EOS000 = 9.5356891948e+02_wp 1226 EOS100 = 1.7136499189e+02_wp 1227 EOS200 = -3.7501039454e+02_wp 1228 EOS300 = 5.1856810420e+02_wp 1229 EOS400 = -3.7264470465e+02_wp 1230 EOS500 = 1.4302533998e+02_wp 1231 EOS600 = -2.2856621162e+01_wp 1232 EOS010 = 1.0087518651e+01_wp 1233 EOS110 = -1.3647741861e+01_wp 1234 EOS210 = 8.8478359933_wp 1235 EOS310 = -7.2329388377_wp 1236 EOS410 = 1.4774410611_wp 1237 EOS510 = 2.0036720553e-01_wp 1238 EOS020 = -2.5579830599e+01_wp 1239 EOS120 = 2.4043512327e+01_wp 1240 EOS220 = -1.6807503990e+01_wp 1241 EOS320 = 8.3811577084_wp 1242 EOS420 = -1.9771060192_wp 1243 EOS030 = 1.6846451198e+01_wp 1244 EOS130 = -2.1482926901e+01_wp 1245 EOS230 = 1.0108954054e+01_wp 1246 EOS330 = -6.2675951440e-01_wp 1247 EOS040 = -8.0812310102_wp 1248 EOS140 = 1.0102374985e+01_wp 1249 EOS240 = -4.8340368631_wp 1250 EOS050 = 1.2079167803_wp 1251 EOS150 = 1.1515380987e-01_wp 1252 EOS060 = -2.4520288837e-01_wp 1253 EOS001 = 1.0748601068e+01_wp 1254 EOS101 = -1.7817043500e+01_wp 1255 EOS201 = 2.2181366768e+01_wp 1256 EOS301 = -1.6750916338e+01_wp 1257 EOS401 = 4.1202230403_wp 1258 EOS011 = -1.5852644587e+01_wp 1259 EOS111 = -7.6639383522e-01_wp 1260 EOS211 = 4.1144627302_wp 1261 EOS311 = -6.6955877448e-01_wp 1262 EOS021 = 9.9994861860_wp 1263 EOS121 = -1.9467067787e-01_wp 1264 EOS221 = -1.2177554330_wp 1265 EOS031 = -3.4866102017_wp 1266 EOS131 = 2.2229155620e-01_wp 1267 EOS041 = 5.9503008642e-01_wp 1268 EOS002 = 1.0375676547_wp 1269 EOS102 = -3.4249470629_wp 1270 EOS202 = 2.0542026429_wp 1271 EOS012 = 2.1836324814_wp 1272 EOS112 = -3.4453674320e-01_wp 1273 EOS022 = -1.2548163097_wp 1274 EOS003 = 1.8729078427e-02_wp 1275 EOS103 = -5.7238495240e-02_wp 1276 EOS013 = 3.8306136687e-01_wp 1277 ! 1278 ALP000 = -2.5218796628e-01_wp 1279 ALP100 = 3.4119354654e-01_wp 1280 ALP200 = -2.2119589983e-01_wp 1281 ALP300 = 1.8082347094e-01_wp 1282 ALP400 = -3.6936026529e-02_wp 1283 ALP500 = -5.0091801383e-03_wp 1284 ALP010 = 1.2789915300_wp 1285 ALP110 = -1.2021756164_wp 1286 ALP210 = 8.4037519952e-01_wp 1287 ALP310 = -4.1905788542e-01_wp 1288 ALP410 = 9.8855300959e-02_wp 1289 ALP020 = -1.2634838399_wp 1290 ALP120 = 1.6112195176_wp 1291 ALP220 = -7.5817155402e-01_wp 1292 ALP320 = 4.7006963580e-02_wp 1293 ALP030 = 8.0812310102e-01_wp 1294 ALP130 = -1.0102374985_wp 1295 ALP230 = 4.8340368631e-01_wp 1296 ALP040 = -1.5098959754e-01_wp 1297 ALP140 = -1.4394226233e-02_wp 1298 ALP050 = 3.6780433255e-02_wp 1299 ALP001 = 3.9631611467e-01_wp 1300 ALP101 = 1.9159845880e-02_wp 1301 ALP201 = -1.0286156825e-01_wp 1302 ALP301 = 1.6738969362e-02_wp 1303 ALP011 = -4.9997430930e-01_wp 1304 ALP111 = 9.7335338937e-03_wp 1305 ALP211 = 6.0887771651e-02_wp 1306 ALP021 = 2.6149576513e-01_wp 1307 ALP121 = -1.6671866715e-02_wp 1308 ALP031 = -5.9503008642e-02_wp 1309 ALP002 = -5.4590812035e-02_wp 1310 ALP102 = 8.6134185799e-03_wp 1311 ALP012 = 6.2740815484e-02_wp 1312 ALP003 = -9.5765341718e-03_wp 1313 ! 1314 BET000 = 2.1420623987_wp 1315 BET100 = -9.3752598635_wp 1316 BET200 = 1.9446303907e+01_wp 1317 BET300 = -1.8632235232e+01_wp 1318 BET400 = 8.9390837485_wp 1319 BET500 = -1.7142465871_wp 1320 BET010 = -1.7059677327e-01_wp 1321 BET110 = 2.2119589983e-01_wp 1322 BET210 = -2.7123520642e-01_wp 1323 BET310 = 7.3872053057e-02_wp 1324 BET410 = 1.2522950346e-02_wp 1325 BET020 = 3.0054390409e-01_wp 1326 BET120 = -4.2018759976e-01_wp 1327 BET220 = 3.1429341406e-01_wp 1328 BET320 = -9.8855300959e-02_wp 1329 BET030 = -2.6853658626e-01_wp 1330 BET130 = 2.5272385134e-01_wp 1331 BET230 = -2.3503481790e-02_wp 1332 BET040 = 1.2627968731e-01_wp 1333 BET140 = -1.2085092158e-01_wp 1334 BET050 = 1.4394226233e-03_wp 1335 BET001 = -2.2271304375e-01_wp 1336 BET101 = 5.5453416919e-01_wp 1337 BET201 = -6.2815936268e-01_wp 1338 BET301 = 2.0601115202e-01_wp 1339 BET011 = -9.5799229402e-03_wp 1340 BET111 = 1.0286156825e-01_wp 1341 BET211 = -2.5108454043e-02_wp 1342 BET021 = -2.4333834734e-03_wp 1343 BET121 = -3.0443885826e-02_wp 1344 BET031 = 2.7786444526e-03_wp 1345 BET002 = -4.2811838287e-02_wp 1346 BET102 = 5.1355066072e-02_wp 1347 BET012 = -4.3067092900e-03_wp 1348 BET003 = -7.1548119050e-04_wp 1349 ! 1350 PEN000 = -5.3743005340_wp 1351 PEN100 = 8.9085217499_wp 1352 PEN200 = -1.1090683384e+01_wp 1353 PEN300 = 8.3754581690_wp 1354 PEN400 = -2.0601115202_wp 1355 PEN010 = 7.9263222935_wp 1356 PEN110 = 3.8319691761e-01_wp 1357 PEN210 = -2.0572313651_wp 1358 PEN310 = 3.3477938724e-01_wp 1359 PEN020 = -4.9997430930_wp 1360 PEN120 = 9.7335338937e-02_wp 1361 PEN220 = 6.0887771651e-01_wp 1362 PEN030 = 1.7433051009_wp 1363 PEN130 = -1.1114577810e-01_wp 1364 PEN040 = -2.9751504321e-01_wp 1365 PEN001 = -6.9171176978e-01_wp 1366 PEN101 = 2.2832980419_wp 1367 PEN201 = -1.3694684286_wp 1368 PEN011 = -1.4557549876_wp 1369 PEN111 = 2.2969116213e-01_wp 1370 PEN021 = 8.3654420645e-01_wp 1371 PEN002 = -1.4046808820e-02_wp 1372 PEN102 = 4.2928871430e-02_wp 1373 PEN012 = -2.8729602515e-01_wp 1374 ! 1375 APE000 = -1.9815805734e-01_wp 1376 APE100 = -9.5799229402e-03_wp 1377 APE200 = 5.1430784127e-02_wp 1378 APE300 = -8.3694846809e-03_wp 1379 APE010 = 2.4998715465e-01_wp 1380 APE110 = -4.8667669469e-03_wp 1381 APE210 = -3.0443885826e-02_wp 1382 APE020 = -1.3074788257e-01_wp 1383 APE120 = 8.3359333577e-03_wp 1384 APE030 = 2.9751504321e-02_wp 1385 APE001 = 3.6393874690e-02_wp 1386 APE101 = -5.7422790533e-03_wp 1387 APE011 = -4.1827210323e-02_wp 1388 APE002 = 7.1824006288e-03_wp 1389 ! 1390 BPE000 = 1.1135652187e-01_wp 1391 BPE100 = -2.7726708459e-01_wp 1392 BPE200 = 3.1407968134e-01_wp 1393 BPE300 = -1.0300557601e-01_wp 1394 BPE010 = 4.7899614701e-03_wp 1395 BPE110 = -5.1430784127e-02_wp 1396 BPE210 = 1.2554227021e-02_wp 1397 BPE020 = 1.2166917367e-03_wp 1398 BPE120 = 1.5221942913e-02_wp 1399 BPE030 = -1.3893222263e-03_wp 1400 BPE001 = 2.8541225524e-02_wp 1401 BPE101 = -3.4236710714e-02_wp 1402 BPE011 = 2.8711395266e-03_wp 1403 BPE002 = 5.3661089288e-04_wp 1404 ! 1405 CASE( 1 ) !== Simplified EOS ==! 1406 IF(lwp) THEN 1407 WRITE(numout,*) 1408 WRITE(numout,*) ' use of simplified eos: rhd(dT=T-10,dS=S-35,Z) = ' 1409 WRITE(numout,*) ' [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0' 1410 WRITE(numout,*) 1411 WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a0 1412 WRITE(numout,*) ' saline cont. coef. rn_b0 = ', rn_b0 1413 WRITE(numout,*) ' cabbeling coef. rn_lambda1 = ', rn_lambda1 1414 WRITE(numout,*) ' cabbeling coef. rn_lambda2 = ', rn_lambda2 1415 WRITE(numout,*) ' thermobar. coef. rn_mu1 = ', rn_mu1 1416 WRITE(numout,*) ' thermobar. coef. rn_mu2 = ', rn_mu2 1417 WRITE(numout,*) ' 2nd cabbel. coef. rn_nu = ', rn_nu 1418 WRITE(numout,*) ' Caution: rn_beta0=0 incompatible with ddm parameterization ' 1419 ENDIF 754 1420 ! 755 1421 CASE DEFAULT !== ERROR in nn_eos ==! … … 759 1425 END SELECT 760 1426 ! 1427 r1_rau0 = 1._wp / rau0 1428 r1_rcp = 1._wp / rcp 1429 r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 1430 ! 1431 IF(lwp) WRITE(numout,*) 1432 IF(lwp) WRITE(numout,*) ' volumic mass of reference rau0 = ', rau0 , ' kg/m^3' 1433 IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0 = ', r1_rau0, ' m^3/kg' 1434 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin' 1435 IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp 1436 ! 761 1437 END SUBROUTINE eos_init 762 1438 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r4499 r4896 4 4 !! Ocean tracers: horizontal & vertical advective trend 5 5 !!====================================================================== 6 !! History : 8.2 ! 2001-08 (G. Madec, E. Durand)trahad+trazad=traadv7 !! 8 !! 9.0! 2004-08 (C. Talandier) New trends organization6 !! History : OPA ! 2001-08 (G. Madec, E. Durand) v8.2 trahad+trazad=traadv 7 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 8 !! - ! 2004-08 (C. Talandier) New trends organization 9 9 !! - ! 2005-11 (V. Garnier) Surface pressure gradient organization 10 10 !! 2.0 ! 2006-04 (R. Benshila, G. Madec) Step reorganization … … 21 21 USE dom_oce ! ocean space and time domain 22 22 USE eosbn2 ! equation of state 23 USE trd mod_oce ! tracers trends24 USE trdtra ! tr acers trends23 USE trd_oce ! trends: ocean variables 24 USE trdtra ! trends manager: tracers 25 25 USE closea ! closed sea 26 26 USE sbcrnf ! river runoffs … … 37 37 PRIVATE 38 38 39 PUBLIC tra_adv_cen2 ! routine called by step.F90 40 PUBLIC ups_orca_set ! routine used by traadv_cen2_jki.F90 41 42 LOGICAL :: l_trd ! flag to compute trends 39 PUBLIC tra_adv_cen2 ! routine called by traadv.F90 43 40 44 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits … … 55 52 56 53 SUBROUTINE tra_adv_cen2( kt, kit000, cdtype, pun, pvn, pwn, & 57 & ptb, ptn, pta, kjpt )54 & ptb, ptn, pta, kjpt ) 58 55 !!---------------------------------------------------------------------- 59 56 !! *** ROUTINE tra_adv_cen2 *** … … 85 82 !! * Add this trend now to the general trend of tracer (ta,sa): 86 83 !! pta = pta + ztra 87 !! * trend diagnostic ( 'key_trdtra' defined): the trend is84 !! * trend diagnostic (l_trdtra=T or l_trctra=T): the trend is 88 85 !! saved for diagnostics. The trends saved is expressed as 89 !! Uh.gradh(T), i.e. 90 !! save trend = ztra + ptn divn 86 !! Uh.gradh(T), i.e. save trend = ztra + ptn divn 91 87 !! 92 88 !! Part II : vertical advection … … 104 100 !! Add this trend now to the general trend of tracer (ta,sa): 105 101 !! pta = pta + ztra 106 !! Trend diagnostic ( 'key_trdtra' defined): the trend is102 !! Trend diagnostic (l_trdtra=T or l_trctra=T): the trend is 107 103 !! saved for diagnostics. The trends saved is expressed as : 108 104 !! save trend = w.gradz(T) = ztra - ptn divn. … … 111 107 !! - save trends if needed 112 108 !!---------------------------------------------------------------------- 113 USE oce , ONLY: zwx => ua , zwy => va ! (ua,va) used as 3D workspace114 !115 109 INTEGER , INTENT(in ) :: kt ! ocean time-step index 116 110 INTEGER , INTENT(in ) :: kit000 ! first time step index … … 128 122 REAL(wp) :: zupsut, zcenut, zupst ! - - 129 123 REAL(wp) :: zupsvt, zcenvt, zcent, zice ! - - 130 REAL(wp), POINTER, DIMENSION(:,: ) :: ztfreez 131 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind 124 REAL(wp), POINTER, DIMENSION(:,:) :: zfzp ! 2D workspace 125 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zwy ! 3D - 126 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind ! - - 132 127 !!---------------------------------------------------------------------- 133 128 ! 134 129 IF( nn_timing == 1 ) CALL timing_start('tra_adv_cen2') 135 130 ! 136 CALL wrk_alloc( jpi, jpj, z tfreez)137 CALL wrk_alloc( jpi, jpj, jpk, zw z, zind )131 CALL wrk_alloc( jpi, jpj, zfzp ) 132 CALL wrk_alloc( jpi, jpj, jpk, zwx, zwy, zwz, zind ) 138 133 ! 139 134 … … 144 139 IF(lwp) WRITE(numout,*) 145 140 ! 146 IF 141 IF( .NOT. ALLOCATED( upsmsk ) ) THEN 147 142 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 148 143 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') … … 162 157 ENDIF 163 158 ! 164 l_trd = .FALSE.165 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.166 !167 159 ! Upstream / centered scheme indicator 168 160 ! ------------------------------------ 169 161 !!gm not strickly exact : the freezing point should be computed at each ocean levels... 170 162 !!gm not a big deal since cen2 is no more used in global ice-ocean simulations 171 z tfreez(:,:) = tfreez( tsn(:,:,1,jp_sal) )163 zfzp(:,:) = eos_fzp( tsn(:,:,1,jp_sal) ) 172 164 DO jk = 1, jpk 173 165 DO jj = 1, jpj 174 166 DO ji = 1, jpi 175 167 ! ! below ice covered area (if tn < "freezing"+0.1 ) 176 IF( tsn(ji,jj,jk,jp_tem) <= z tfreez(ji,jj) + 0.1 ) THEN ; zice = 1.e0177 ELSE ; zice = 0.e0168 IF( tsn(ji,jj,jk,jp_tem) <= zfzp(ji,jj) + 0.1 ) THEN ; zice = 1._wp 169 ELSE ; zice = 0._wp 178 170 ENDIF 179 171 zind(ji,jj,jk) = MAX ( & … … 260 252 END DO 261 253 262 ! ! trend diagnostics (contribution of upstream fluxes) 263 IF( l_trd ) THEN 264 CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) ) 265 CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 266 CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptn(:,:,:,jn) ) 254 ! ! trend diagnostics 255 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. & 256 &( cdtype == 'TRC' .AND. l_trdtrc ) ) THEN 257 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 258 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 259 CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 267 260 END IF 268 261 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 269 262 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 270 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) )271 IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) )263 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) 264 IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) 272 265 ENDIF 273 266 ! 274 END DO267 END DO 275 268 276 269 ! --------------------------- required in restart file to ensure restartability) … … 281 274 ENDIF 282 275 ! 283 CALL wrk_dealloc( jpi, jpj, z tfreez)284 CALL wrk_dealloc( jpi, jpj, jpk, zw z, zind )276 CALL wrk_dealloc( jpi, jpj, zfzp ) 277 CALL wrk_dealloc( jpi, jpj, jpk, zwx, zwy, zwz, zind ) 285 278 ! 286 279 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_cen2') … … 303 296 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 304 297 !!---------------------------------------------------------------------- 305 306 298 ! 307 299 IF( nn_timing == 1 ) CALL timing_start('ups_orca_set') -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r4499 r4896 16 16 !!---------------------------------------------------------------------- 17 17 USE oce ! ocean dynamics and active tracers 18 USE trc_oce ! share passive tracers/Ocean variables 18 19 USE dom_oce ! ocean space and time domain 19 USE trdmod_oce ! tracers trends 20 USE trdtra ! tracers trends 21 USE in_out_manager ! I/O manager 20 USE trd_oce ! trends: ocean variables 21 USE trdtra ! tracers trends manager 22 22 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 23 USE trabbl ! tracers: bottom boundary layer 24 USE lib_mpp ! distribued memory computing 25 USE lbclnk ! ocean lateral boundary condition (or mpp link) 23 USE sbcrnf ! river runoffs 26 24 USE diaptr ! poleward transport diagnostics 27 USE trc_oce ! share passive tracers/Ocean variables25 ! 28 26 USE wrk_nemo ! Memory Allocation 29 27 USE timing ! Timing 30 28 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 31 USE eosbn2 ! equation of state 32 USE sbcrnf ! river runoffs 29 USE in_out_manager ! I/O manager 30 USE lib_mpp ! distribued memory computing 31 USE lbclnk ! ocean lateral boundary condition (or mpp link) 33 32 34 33 IMPLICIT NONE 35 34 PRIVATE 36 35 37 PUBLIC tra_adv_muscl ! routine called by step.F9038 39 LOGICAL :: l_trd ! flag to compute trends40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits41 ! ! and in closed seas (orca 2 and 4 configurations)42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xind !: mixed upstream/centered index36 PUBLIC tra_adv_muscl ! routine called by traadv.F90 37 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits 39 ! ! and in closed seas (orca 2 and 4 configurations) 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xind !: mixed upstream/centered index 41 43 42 !! * Substitutions 44 43 # include "domzgr_substitute.h90" … … 51 50 CONTAINS 52 51 53 SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn, &54 & ptb, pta, kjpt, ld_msc_ups )52 SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 53 & ptb, pta, kjpt, ld_msc_ups ) 55 54 !!---------------------------------------------------------------------- 56 55 !! *** ROUTINE tra_adv_muscl *** … … 68 67 !! IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 69 68 !!---------------------------------------------------------------------- 70 USE oce , ONLY: zwx => ua , zwy => va ! (ua,va) used as workspace71 !72 69 INTEGER , INTENT(in ) :: kt ! ocean time-step index 73 70 INTEGER , INTENT(in ) :: kit000 ! first time step index … … 79 76 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before tracer field 80 77 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 81 82 !83 INTEGER :: ji, jj, jk, jn ! dummy loop indices78 ! 79 INTEGER :: ji, jj, jk, jn ! dummy loop indices 80 INTEGER :: ierr ! local integer 84 81 REAL(wp) :: zu, z0u, zzwx, zw ! local scalars 85 82 REAL(wp) :: zv, z0v, zzwy, z0w ! - - 86 83 REAL(wp) :: ztra, zbtr, zdt, zalpha ! - - 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy88 INTEGER :: ierr84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy ! 3D workspace 85 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx , zwy ! - - 89 86 !!---------------------------------------------------------------------- 90 87 ! 91 88 IF( nn_timing == 1 ) CALL timing_start('tra_adv_muscl') 92 89 ! 93 CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy ) 94 ! 95 90 CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 91 ! 96 92 IF( kt == kit000 ) THEN 97 93 IF(lwp) WRITE(numout,*) … … 117 113 118 114 ! 119 ! Upstream / centeredscheme indicator115 ! Upstream / MUSCL scheme indicator 120 116 ! ------------------------------------ 117 !!gm useless 121 118 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 119 !!gm 122 120 ! 123 121 IF( ld_msc_ups ) THEN 124 DO jk = 1, jpk 125 DO jj = 1, jpj 126 DO ji = 1, jpi 127 xind(ji,jj,jk) = 1 - MAX ( & 128 rnfmsk(ji,jj) * rnfmsk_z(jk), & ! near runoff mouths (& closed sea outflows) 129 upsmsk(ji,jj) ) * tmask(ji,jj,jk) ! some of some straits 130 END DO 131 END DO 122 DO jk = 1, jpkm1 123 xind(:,:,jk) = 1._wp & ! =>1 where up-stream is not needed 124 & - MAX ( rnfmsk(:,:) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 125 & upsmsk(:,:) ) * tmask(:,:,jk) ! =>0 near some straits 132 126 END DO 133 127 ENDIF 134 128 ! 135 129 ENDIF 136 ! 137 l_trd = .FALSE. 138 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 139 130 ! 140 131 ! ! =========== 141 132 DO jn = 1, kjpt ! tracer loop … … 192 183 zalpha = 0.5 - z0u 193 184 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 194 zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji+1,jj,jk))195 zzwy = ptb(ji ,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji ,jj,jk))185 zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 186 zzwy = ptb(ji ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji ,jj,jk) 196 187 zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 197 188 ! … … 199 190 zalpha = 0.5 - z0v 200 191 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 201 zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj+1,jk))202 zzwy = ptb(ji,jj ,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj ,jk))192 zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 193 zzwy = ptb(ji,jj ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj ,jk) 203 194 zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 204 195 END DO … … 222 213 END DO 223 214 ! ! trend diagnostics (contribution of upstream fluxes) 224 IF( l_trd ) THEN 225 CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptb(:,:,:,jn) ) 226 CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptb(:,:,:,jn) ) 215 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. & 216 &( cdtype == 'TRC' .AND. l_trdtrc ) ) THEN 217 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) ) 218 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) ) 227 219 END IF 228 220 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) … … 274 266 zalpha = 0.5 + z0w 275 267 zw = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr 276 zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * (zw * zslpx(ji,jj,jk+1))277 zzwy = ptb(ji,jj,jk ,jn) + xind(ji,jj,jk) * (zw * zslpx(ji,jj,jk ))268 zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1) 269 zzwy = ptb(ji,jj,jk ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk ) 278 270 zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 279 271 END DO … … 281 273 END DO 282 274 283 ! Compute & add the vertical advective trend 284 DO jk = 1, jpkm1 275 DO jk = 1, jpkm1 ! Compute & add the vertical advective trend 285 276 DO jj = 2, jpjm1 286 277 DO ji = fs_2, fs_jpim1 ! vector opt. 287 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )278 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 288 279 ! vertical advective trends 289 280 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) … … 294 285 END DO 295 286 ! ! Save the vertical advective trends for diagnostic 296 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptb(:,:,:,jn) ) 297 ! 298 ENDDO 299 ! 300 CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy ) 287 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. & 288 &( cdtype == 'TRC' .AND. l_trdtrc ) ) & 289 CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 290 ! 291 END DO 292 ! 293 CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 301 294 ! 302 295 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_muscl') -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r4499 r4896 13 13 !!---------------------------------------------------------------------- 14 14 USE oce ! ocean dynamics and active tracers 15 USE trc_oce ! share passive tracers/Ocean variables 15 16 USE dom_oce ! ocean space and time domain 16 USE trd mod_oce ! tracers trends17 USE trdtra ! tr acers trends17 USE trd_oce ! trends: ocean variables 18 USE trdtra ! trends manager: tracers 18 19 USE in_out_manager ! I/O manager 19 20 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 20 USE trabbl ! tracers: bottom boundary layer 21 USE diaptr ! poleward transport diagnostics 22 ! 21 23 USE lib_mpp ! distribued memory computing 22 24 USE lbclnk ! ocean lateral boundary condition (or mpp link) 23 USE diaptr ! poleward transport diagnostics24 USE trc_oce ! share passive tracers/Ocean variables25 25 USE wrk_nemo ! Memory Allocation 26 26 USE timing ! Timing … … 31 31 32 32 PUBLIC tra_adv_muscl2 ! routine called by step.F90 33 34 LOGICAL :: l_trd ! flag to compute trends35 33 36 34 !! * Substitutions … … 61 59 !! IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 62 60 !!---------------------------------------------------------------------- 63 USE oce , ONLY: zwx => ua , zwy => va ! (ua,va) used as 3D workspace64 !!65 61 INTEGER , INTENT(in ) :: kt ! ocean time-step index 66 62 INTEGER , INTENT(in ) :: kit000 ! first time step index … … 76 72 REAL(wp) :: zv, z0v, zzwy, z0w ! - - 77 73 REAL(wp) :: ztra, zbtr, zdt, zalpha ! - - 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy , zwx, zwy 79 75 !!---------------------------------------------------------------------- 80 76 ! 81 77 IF( nn_timing == 1 ) CALL timing_start('tra_adv_muscl2') 82 78 ! 83 CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy )79 CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 84 80 ! 85 81 … … 90 86 ENDIF 91 87 ! 92 l_trd = .FALSE.93 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.94 95 88 ! ! =========== 96 89 DO jn = 1, kjpt ! tracer loop … … 200 193 END DO 201 194 ! ! trend diagnostics (contribution of upstream fluxes) 202 IF( l_trd ) THEN 203 CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptb(:,:,:,jn) ) 204 CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptb(:,:,:,jn) ) 195 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. & 196 &( cdtype == 'TRC' .AND. l_trdtrc ) ) THEN 197 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) ) 198 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) ) 205 199 END IF 206 200 … … 284 278 END DO 285 279 ! ! trend diagnostics (contribution of upstream fluxes) 286 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptb(:,:,:,jn) ) 280 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. & 281 &( cdtype == 'TRC' .AND. l_trdtrc ) ) & 282 CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 287 283 ! 288 284 END DO 289 285 ! 290 CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy )286 CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 291 287 ! 292 288 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_muscl2') -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r4499 r4896 17 17 USE oce ! ocean dynamics and active tracers 18 18 USE dom_oce ! ocean space and time domain 19 USE trdmod_oce ! ocean space and time domain 20 USE trdtra ! ocean tracers trends 21 USE trabbl ! advective term in the BBL 19 USE trc_oce ! share passive tracers/Ocean variables 20 USE trd_oce ! trends: ocean variables 21 USE trdtra ! trends manager: tracers 22 USE dynspg_oce ! surface pressure gradient variables 23 USE diaptr ! poleward transport diagnostics 24 ! 22 25 USE lib_mpp ! distribued memory computing 23 26 USE lbclnk ! ocean lateral boundary condition (or mpp link) 24 USE dynspg_oce ! surface pressure gradient variables25 27 USE in_out_manager ! I/O manager 26 USE diaptr ! poleward transport diagnostics27 USE trc_oce ! share passive tracers/Ocean variables28 28 USE wrk_nemo ! Memory Allocation 29 29 USE timing ! Timing … … 93 93 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 94 94 !!---------------------------------------------------------------------- 95 96 95 ! 97 96 IF( nn_timing == 1 ) CALL timing_start('tra_adv_qck') … … 103 102 IF(lwp) WRITE(numout,*) 104 103 ENDIF 105 !106 104 l_trd = .FALSE. 107 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.108 105 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 106 ! 109 107 ! I. The horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 110 108 CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt ) … … 124 122 !! 125 123 !!---------------------------------------------------------------------- 126 USE oce , ONLY: zwx => ua ! ua used as workspace127 !128 124 INTEGER , INTENT(in ) :: kt ! ocean time-step index 129 125 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) … … 136 132 INTEGER :: ji, jj, jk, jn ! dummy loop indices 137 133 REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk ! local scalars 138 REAL(wp), POINTER, DIMENSION(:,:,:) :: z fu, zfc, zfd134 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zfu, zfc, zfd 139 135 !---------------------------------------------------------------------- 140 136 ! 141 CALL wrk_alloc( jpi, jpj, jpk, z fu, zfc, zfd )137 CALL wrk_alloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd ) 142 138 ! ! =========== 143 139 DO jn = 1, kjpt ! tracer loop … … 233 229 END DO 234 230 ! ! trend diagnostics (contribution of upstream fluxes) 235 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) )231 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 236 232 ! 237 233 END DO 238 234 ! 239 CALL wrk_dealloc( jpi, jpj, jpk, z fu, zfc, zfd )235 CALL wrk_dealloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd ) 240 236 ! 241 237 END SUBROUTINE tra_adv_qck_i … … 247 243 !! 248 244 !!---------------------------------------------------------------------- 249 USE oce , ONLY: zwy => ua ! ua used as workspace250 !251 245 INTEGER , INTENT(in ) :: kt ! ocean time-step index 252 246 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) … … 259 253 INTEGER :: ji, jj, jk, jn ! dummy loop indices 260 254 REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk ! local scalars 261 REAL(wp), POINTER, DIMENSION(:,:,:) :: z fu, zfc, zfd255 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwy, zfu, zfc, zfd 262 256 !---------------------------------------------------------------------- 263 257 ! 264 CALL wrk_alloc( jpi, jpj, jpk, z fu, zfc, zfd )258 CALL wrk_alloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd ) 265 259 ! 266 260 ! ! =========== … … 359 353 END DO 360 354 ! ! trend diagnostics (contribution of upstream fluxes) 361 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) )355 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 362 356 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 363 357 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN … … 368 362 END DO 369 363 ! 370 CALL wrk_dealloc( jpi, jpj, jpk, z fu, zfc, zfd )364 CALL wrk_dealloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd ) 371 365 ! 372 366 END SUBROUTINE tra_adv_qck_j … … 378 372 !! 379 373 !!---------------------------------------------------------------------- 380 USE oce, ONLY: zwz => ua ! ua used as workspace381 !382 374 INTEGER , INTENT(in ) :: kt ! ocean time-step index 383 375 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) … … 389 381 INTEGER :: ji, jj, jk, jn ! dummy loop indices 390 382 REAL(wp) :: zbtr , ztra ! local scalars 391 !!---------------------------------------------------------------------- 392 383 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz 384 !!---------------------------------------------------------------------- 385 ! 386 CALL wrk_alloc( jpi, jpj, jpk, zwz ) 393 387 ! ! =========== 394 388 DO jn = 1, kjpt ! tracer loop … … 422 416 END DO 423 417 ! ! Save the vertical advective trends for diagnostic 424 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_ trd_zad, zwz, pwn, ptn(:,:,:,jn) )418 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 425 419 ! 426 420 END DO 421 ! 422 CALL wrk_dealloc( jpi, jpj, jpk, zwz ) 427 423 ! 428 424 END SUBROUTINE tra_adv_cen2_k -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r4499 r4896 22 22 USE oce ! ocean dynamics and active tracers 23 23 USE dom_oce ! ocean space and time domain 24 USE trdmod_oce ! tracers trends 24 USE trc_oce ! share passive tracers/Ocean variables 25 USE trd_oce ! trends: ocean variables 25 26 USE trdtra ! tracers trends 26 USE in_out_manager ! I/O manager27 27 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 28 USE diaptr ! poleward transport diagnostics 29 ! 28 30 USE lib_mpp ! MPP library 29 31 USE lbclnk ! ocean lateral boundary condition (or mpp link) 30 USE diaptr ! poleward transport diagnostics 31 USE trc_oce ! share passive tracers/Ocean variables 32 USE in_out_manager ! I/O manager 32 33 USE wrk_nemo ! Memory Allocation 33 34 USE timing ! Timing … … 93 94 IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype 94 95 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 96 ! 97 l_trd = .FALSE. 98 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 95 99 ENDIF 96 !97 l_trd = .FALSE.98 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.99 100 ! 100 101 IF( l_trd ) THEN … … 228 229 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 229 230 230 CALL trd_tra( kt, cdtype, jn, jptra_ trd_xad, ztrdx, pun, ptn(:,:,:,jn) )231 CALL trd_tra( kt, cdtype, jn, jptra_ trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )232 CALL trd_tra( kt, cdtype, jn, jptra_ trd_zad, ztrdz, pwn, ptn(:,:,:,jn) )231 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 232 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 233 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 233 234 END IF 234 235 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) … … 261 262 !! in-space based differencing for fluid 262 263 !!---------------------------------------------------------------------- 263 !264 !!----------------------------------------------------------------------265 264 REAL(wp), DIMENSION(jpk) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 266 265 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pbef, paft ! before & after field 267 266 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions 268 267 ! 269 INTEGER :: ji, jj, jk ! dummy loop indices270 INTEGER :: ikm1 ! local integer268 INTEGER :: ji, jj, jk ! dummy loop indices 269 INTEGER :: ikm1 ! local integer 271 270 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt ! local scalars 272 271 REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - … … 278 277 CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 279 278 ! 280 281 279 zbig = 1.e+40_wp 282 280 zrtrn = 1.e-15_wp 283 281 zbetup(:,:,jpk) = 0._wp ; zbetdo(:,:,jpk) = 0._wp 284 282 285 286 283 ! Search local extrema 287 284 ! -------------------- 288 285 ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land 289 zbup = MAX( pbef * tmask - zbig * ( 1. e0- tmask ), &290 & paft * tmask - zbig * ( 1. e0- tmask ) )291 zbdo = MIN( pbef * tmask + zbig * ( 1. e0- tmask ), &292 & paft * tmask + zbig * ( 1. e0- tmask ) )286 zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ), & 287 & paft * tmask - zbig * ( 1._wp - tmask ) ) 288 zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ), & 289 & paft * tmask + zbig * ( 1._wp - tmask ) ) 293 290 294 291 DO jk = 1, jpkm1 … … 334 331 DO jj = 2, jpjm1 335 332 DO ji = fs_2, fs_jpim1 ! vector opt. 336 zau = MIN( 1. e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )337 zbu = MIN( 1. e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )333 zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 334 zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 338 335 zcu = ( 0.5 + SIGN( 0.5 , paa(ji,jj,jk) ) ) 339 paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1. e0- zcu) * zbu )340 341 zav = MIN( 1. e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )342 zbv = MIN( 1. e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )336 paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu ) 337 338 zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 339 zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 343 340 zcv = ( 0.5 + SIGN( 0.5 , pbb(ji,jj,jk) ) ) 344 pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1. e0- zcv) * zbv )341 pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv ) 345 342 346 343 ! monotonic flux in the k direction, i.e. pcc … … 349 346 zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) ) 350 347 zc = ( 0.5 + SIGN( 0.5 , pcc(ji,jj,jk+1) ) ) 351 pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1. e0- zc) * zb )348 pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 352 349 END DO 353 350 END DO -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r4499 r4896 14 14 USE oce ! ocean dynamics and active tracers 15 15 USE dom_oce ! ocean space and time domain 16 USE trdmod_oce ! ocean space and time domain 17 USE trdtra 18 USE lib_mpp 16 USE trc_oce ! share passive tracers/Ocean variables 17 USE trd_oce ! trends: ocean variables 18 USE trdtra ! trends manager: tracers 19 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 20 USE diaptr ! poleward transport diagnostics 21 ! 22 USE lib_mpp ! I/O library 19 23 USE lbclnk ! ocean lateral boundary condition (or mpp link) 20 24 USE in_out_manager ! I/O manager 21 USE diaptr ! poleward transport diagnostics22 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient23 USE trc_oce ! share passive tracers/Ocean variables24 25 USE wrk_nemo ! Memory Allocation 25 26 USE timing ! Timing … … 51 52 !! and add it to the general trend of passive tracer equations. 52 53 !! 53 !! ** Method : The upstream biased 3rd order scheme (UBS) is based on an54 !! ** Method : The upstream biased scheme (UBS) is based on a 3rd order 54 55 !! upstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005) 55 56 !! It is only used in the horizontal direction. 56 57 !! For example the i-component of the advective fluxes are given by : 57 58 !! ! e2u e3u un ( mi(Tn) - zltu(i ) ) if un(i) >= 0 58 !! z wx= ! or59 !! ztu = ! or 59 60 !! ! e2u e3u un ( mi(Tn) - zltu(i+1) ) if un(i) < 0 60 61 !! where zltu is the second derivative of the before temperature field: … … 76 77 !! Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741. 77 78 !!---------------------------------------------------------------------- 78 USE oce , ONLY: zwx => ua , zwy => va ! (ua,va) used as workspace79 !80 79 INTEGER , INTENT(in ) :: kt ! ocean time-step index 81 80 INTEGER , INTENT(in ) :: kit000 ! first time step index … … 98 97 CALL wrk_alloc( jpi, jpj, jpk, ztu, ztv, zltu, zltv, zti, ztw ) 99 98 ! 100 101 99 IF( kt == kit000 ) THEN 102 100 IF(lwp) WRITE(numout,*) … … 151 149 zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn) ) 152 150 ! UBS advective fluxes 153 z wx(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) )154 z wy(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) )151 ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) ) 152 ztv(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) ) 155 153 END DO 156 154 END DO … … 159 157 zltu(:,:,:) = pta(:,:,:,jn) ! store pta trends 160 158 161 ! Horizontal advective trends 162 DO jk = 1, jpkm1 163 ! Tracer flux divergence at t-point added to the general trend 159 DO jk = 1, jpkm1 ! Horizontal advective trends 164 160 DO jj = 2, jpjm1 165 161 DO ji = fs_2, fs_jpim1 ! vector opt. 166 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 167 ! horizontal advective 168 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk) & 169 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk) ) 170 ! add it to the general tracer trends 171 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 162 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) & 163 & - ( ztu(ji,jj,jk) - ztu(ji-1,jj ,jk) & 164 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 172 165 END DO 173 166 END DO … … 178 171 zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:) 179 172 180 ! 3. Save the horizontal advective trends for diagnostic 181 ! ------------------------------------------------------ 182 ! ! trend diagnostics (contribution of upstream fluxes) 183 IF( l_trd ) THEN 184 CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) ) 185 CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 173 ! 174 IF( l_trd ) THEN ! trend diagnostics 175 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pun, ptn(:,:,:,jn) ) 176 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pvn, ptn(:,:,:,jn) ) 186 177 END IF 187 178 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 188 179 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 189 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( z wy(:,:,:) )190 IF( jn == jp_sal ) str_adv(:) = ptr_vj( z wy(:,:,:) )180 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( ztv(:,:,:) ) 181 IF( jn == jp_sal ) str_adv(:) = ptr_vj( ztv(:,:,:) ) 191 182 ENDIF 192 183 … … 265 256 END DO 266 257 END DO 267 CALL trd_tra( kt, cdtype, jn, jptra_ trd_zad, zltv )258 CALL trd_tra( kt, cdtype, jn, jptra_zad, zltv ) 268 259 ENDIF 269 260 ! 270 END DO261 END DO 271 262 ! 272 263 CALL wrk_dealloc( jpi, jpj, jpk, ztu, ztv, zltu, zltv, zti, ztw ) … … 290 281 !! in-space based differencing for fluid 291 282 !!---------------------------------------------------------------------- 292 !293 283 REAL(wp), INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 294 284 REAL(wp), DIMENSION (jpi,jpj,jpk) :: pbef ! before field … … 306 296 CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo ) 307 297 ! 308 309 298 zbig = 1.e+40_wp 310 299 zrtrn = 1.e-15_wp -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r4147 r4896 18 18 USE dom_oce ! domain: ocean 19 19 USE phycst ! physical constants 20 USE trd mod_oce ! trends: ocean variables21 USE trdtra ! trends : activetracers20 USE trd_oce ! trends: ocean variables 21 USE trdtra ! trends manager: tracers 22 22 USE in_out_manager ! I/O manager 23 23 USE prtctl ! Print control … … 84 84 ! 85 85 ! ! Add the geothermal heat flux trend on temperature 86 #if defined key_vectopt_loop87 DO jj = 1, 188 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)89 #else90 86 DO jj = 2, jpjm1 91 87 DO ji = 2, jpim1 92 #endif93 88 ik = mbkt(ji,jj) 94 89 zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik) … … 99 94 IF( l_trdtra ) THEN ! Save the geothermal heat flux trend for diagnostics 100 95 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 101 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_bbc, ztrdt )96 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 102 97 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt ) 103 98 ENDIF … … 130 125 INTEGER :: inum ! temporary logical unit 131 126 INTEGER :: ios ! Local integer output status for namelist read 132 ! !127 ! 133 128 NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst 134 129 !!---------------------------------------------------------------------- -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r4292 r4896 12 12 !! - ! 2010-06 (C. Ethe, G. Madec) merge TRA-TRC 13 13 !! - ! 2010-11 (G. Madec) add mbk. arrays associated to the deepest ocean level 14 !! - ! 2013-04 (F. Roquet, G. Madec) use of eosbn2 instead of local hard coded alpha and beta 14 15 !!---------------------------------------------------------------------- 15 16 #if defined key_trabbl || defined key_esopa … … 28 29 USE phycst ! physical constant 29 30 USE eosbn2 ! equation of state 30 USE trd mod_oce ! trends: ocean variables31 USE trd_oce ! trends: ocean variables 31 32 USE trdtra ! trends: active tracers 32 USE iom ! IOM server 33 ! 34 USE iom ! IOM library 33 35 USE in_out_manager ! I/O manager 34 36 USE lbclnk ! ocean lateral boundary conditions … … 36 38 USE wrk_nemo ! Memory Allocation 37 39 USE timing ! Timing 38 40 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 39 41 40 42 IMPLICIT NONE … … 57 59 REAL(wp), PUBLIC :: rn_gambbl !: lateral coeff. for bottom boundary layer scheme [s] 58 60 59 LOGICAL , PUBLIC :: l_bbl 61 LOGICAL , PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 60 62 61 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: utr_bbl , vtr_bbl ! u- (v-) transport in the bottom boundary layer … … 84 86 & vtr_bbl (jpi,jpj) , ahv_bbl (jpi,jpj) , mbkv_d (jpi,jpj) , mgrhv(jpi,jpj) , & 85 87 & ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) , & 86 & e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , STAT= tra_bbl_alloc)88 & e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , STAT=tra_bbl_alloc ) 87 89 ! 88 90 IF( lk_mpp ) CALL mpp_sum ( tra_bbl_alloc ) … … 104 106 !!---------------------------------------------------------------------- 105 107 INTEGER, INTENT( in ) :: kt ! ocean time-step 106 ! !108 ! 107 109 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds 108 110 !!---------------------------------------------------------------------- … … 110 112 IF( nn_timing == 1 ) CALL timing_start( 'tra_bbl') 111 113 ! 112 IF( l_trdtra ) THEN !* Save ta and sa trends114 IF( l_trdtra ) THEN !* Save ta and sa trends 113 115 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 114 116 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) … … 116 118 ENDIF 117 119 118 IF( l_bbl ) CALL bbl( kt, nit000, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl)119 120 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl120 IF( l_bbl ) CALL bbl( kt, nit000, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl) 121 122 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl 121 123 ! 122 124 CALL tra_bbl_dif( tsb, tsa, jpts ) 123 125 IF( ln_ctl ) & 124 126 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 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 126 128 ! lateral boundary conditions ; just need for outputs 127 129 CALL lbc_lnk( ahu_bbl, 'U', 1. ) ; CALL lbc_lnk( ahv_bbl, 'V', 1. ) … … 131 133 END IF 132 134 133 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl135 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl 134 136 ! 135 137 CALL tra_bbl_adv( tsb, tsa, jpts ) 136 138 IF(ln_ctl) & 137 139 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv - Ta: ', mask1=tmask, & 138 &tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )140 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 139 141 ! lateral boundary conditions ; just need for outputs 140 142 CALL lbc_lnk( utr_bbl, 'U', 1. ) ; CALL lbc_lnk( vtr_bbl, 'V', 1. ) … … 147 149 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 148 150 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 149 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_bbl, ztrdt )150 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ trd_bbl, ztrds )151 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 152 CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 151 153 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 152 154 ENDIF … … 164 166 !! advection terms. 165 167 !! 166 !! ** Method : 167 !! * diffusive bbl (nn_bbl_ldf=1) : 168 !! ** Method : * diffusive bbl only (nn_bbl_ldf=1) : 168 169 !! When the product grad( rho) * grad(h) < 0 (where grad is an 169 170 !! along bottom slope gradient) an additional lateral 2nd order … … 179 180 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 180 181 !!---------------------------------------------------------------------- 181 !182 182 INTEGER , INTENT(in ) :: kjpt ! number of tracers 183 183 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields … … 196 196 DO jn = 1, kjpt ! tracer loop 197 197 ! ! =========== 198 # if defined key_vectopt_loop199 DO jj = 1, 1 ! vector opt. (forced unrolling)200 DO ji = 1, jpij201 #else202 198 DO jj = 1, jpj 203 199 DO ji = 1, jpi 204 #endif 205 ik = mbkt(ji,jj) ! bottom T-level index 206 zptb(ji,jj) = ptb(ji,jj,ik,jn) ! bottom before T and S 200 zptb(ji,jj) = ptb(ji,jj,mbkt(ji,jj),jn) ! bottom before T and S 207 201 END DO 208 202 END DO 209 ! ! Compute the trend 210 # if defined key_vectopt_loop 211 DO jj = 1, 1 ! vector opt. (forced unrolling) 212 DO ji = jpi+1, jpij-jpi-1 213 # else 214 DO jj = 2, jpjm1 203 ! 204 DO jj = 2, jpjm1 ! Compute the trend 215 205 DO ji = 2, jpim1 216 # endif 217 ik = mbkt(ji,jj) ! bottom T-level index 206 ik = mbkt(ji,jj) ! bottom T-level index 218 207 zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,ik) 219 208 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn) & … … 264 253 DO jn = 1, kjpt ! tracer loop 265 254 ! ! =========== 266 # if defined key_vectopt_loop267 DO jj = 1, 1268 DO ji = 1, jpij-jpi-1 ! vector opt. (forced unrolling)269 # else270 255 DO jj = 1, jpjm1 271 256 DO ji = 1, jpim1 ! CAUTION start from i=1 to update i=2 when cyclic east-west 272 # endif273 257 IF( utr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero i-direction bbl advection 274 258 ! down-slope i/k-indices (deep) & up-slope i/k indices (shelf) … … 333 317 !! advection terms. 334 318 !! 335 !! ** Method : 336 !! * diffusive bbl (nn_bbl_ldf=1) : 319 !! ** Method : * diffusive bbl (nn_bbl_ldf=1) : 337 320 !! When the product grad( rho) * grad(h) < 0 (where grad is an 338 321 !! along bottom slope gradient) an additional lateral 2nd order … … 342 325 !! a downslope velocity of 20 cm/s if the condition for slope 343 326 !! convection is satified) 344 !! * advective bbl (nn_bbl_adv=1 or 2) :327 !! * advective bbl (nn_bbl_adv=1 or 2) : 345 328 !! nn_bbl_adv = 1 use of the ocean velocity as bbl velocity 346 329 !! nn_bbl_adv = 2 follow Campin and Goosse (1999) implentation … … 353 336 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 354 337 !!---------------------------------------------------------------------- 355 !356 338 INTEGER , INTENT(in ) :: kt ! ocean time-step index 357 INTEGER , INTENT(in ) :: kit000 339 INTEGER , INTENT(in ) :: kit000 ! first time step index 358 340 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 359 341 !! 360 342 INTEGER :: ji, jj ! dummy loop indices 361 343 INTEGER :: ik ! local integers 362 INTEGER :: iis , iid , ijs , ijd ! - - 363 INTEGER :: ikus, ikud, ikvs, ikvd ! - - 364 REAL(wp) :: zsign, zsigna, zgbbl ! local scalars 365 REAL(wp) :: zgdrho, zt, zs, zh ! - - 366 !! 367 REAL(wp) :: fsalbt, fsbeta, pft, pfs, pfh ! statement function 368 REAL(wp), POINTER, DIMENSION(:,:) :: zub, zvb, ztb, zsb, zdep 369 !!----------------------- zv_bbl----------------------------------------------- 370 ! ratio alpha/beta = fsalbt : ratio of thermal over saline expension coefficients 371 ! ================ pft : potential temperature in degrees celcius 372 ! pfs : salinity anomaly (s-35) in psu 373 ! pfh : depth in meters 374 ! nn_eos = 0 (Jackett and McDougall 1994 formulation) 375 fsalbt( pft, pfs, pfh ) = & ! alpha/beta 376 ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft & 377 - 0.203814e-03 ) * pft & 378 + 0.170907e-01 ) * pft & 379 + 0.665157e-01 & 380 +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs & 381 + ( ( - 0.302285e-13 * pfh & 382 - 0.251520e-11 * pfs & 383 + 0.512857e-12 * pft * pft ) * pfh & 384 - 0.164759e-06 * pfs & 385 +( 0.791325e-08 * pft - 0.933746e-06 ) * pft & 386 + 0.380374e-04 ) * pfh 387 fsbeta( pft, pfs, pfh ) = & ! beta 388 ( ( -0.415613e-09 * pft + 0.555579e-07 ) * pft & 389 - 0.301985e-05 ) * pft & 390 + 0.785567e-03 & 391 + ( 0.515032e-08 * pfs & 392 + 0.788212e-08 * pft - 0.356603e-06 ) * pfs & 393 +( ( 0.121551e-17 * pfh & 394 - 0.602281e-15 * pfs & 395 - 0.175379e-14 * pft + 0.176621e-12 ) * pfh & 396 + 0.408195e-10 * pfs & 397 + ( - 0.213127e-11 * pft + 0.192867e-09 ) * pft & 398 - 0.121555e-07 ) * pfh 399 !!---------------------------------------------------------------------- 400 344 INTEGER :: iis, iid, ikus, ikud ! - - 345 INTEGER :: ijs, ijd, ikvs, ikvd ! - - 346 REAL(wp) :: za, zb, zgdrho ! local scalars 347 REAL(wp) :: zsign, zsigna, zgbbl ! - - 348 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts, zab ! 3D workspace 349 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb, zdep ! 2D workspace 350 !!---------------------------------------------------------------------- 401 351 ! 402 352 IF( nn_timing == 1 ) CALL timing_start( 'bbl') 403 353 ! 404 CALL wrk_alloc( jpi, jpj, zub, zvb, ztb, zsb, zdep )405 !406 407 354 IF( kt == kit000 ) THEN 408 355 IF(lwp) WRITE(numout,*) … … 410 357 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 411 358 ENDIF 412 413 ! !* bottom temperature, salinity, velocity and depth 414 #if defined key_vectopt_loop 415 DO jj = 1, 1 ! vector opt. (forced unrolling) 416 DO ji = 1, jpij 417 #else 359 ! !* bottom variables (T, S, alpha, beta, depth, velocity) 418 360 DO jj = 1, jpj 419 361 DO ji = 1, jpi 420 #endif 421 ik = mbkt(ji,jj) ! bottom T-level index 422 ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) * tmask(ji,jj,1) ! bottom before T and S 423 zsb (ji,jj) = tsb(ji,jj,ik,jp_sal) * tmask(ji,jj,1) 424 zdep(ji,jj) = gdept_0(ji,jj,ik) ! bottom T-level reference depth 362 ik = mbkt(ji,jj) ! bottom T-level index 363 zts (ji,jj,jp_tem) = tsb(ji,jj,ik,jp_tem) ! bottom before T and S 364 zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal) 425 365 ! 426 zub(ji,jj) = un(ji,jj,mbku(ji,jj)) ! bottom velocity 427 zvb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 366 zdep(ji,jj) = fsdept(ji,jj,ik) ! bottom T-level reference depth 367 zub (ji,jj) = un(ji,jj,mbku(ji,jj)) ! bottom velocity 368 zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj)) 428 369 END DO 429 370 END DO 430 371 ! 372 CALL eos_rab( zts, zdep, zab ) 373 ! 431 374 ! !-------------------! 432 375 IF( nn_bbl_ldf == 1 ) THEN ! diffusive bbl ! 433 376 ! !-------------------! 434 377 DO jj = 1, jpjm1 ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 435 DO ji = 1, jpim1 436 ! ! i-direction 437 zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) ) ! T, S anomalie, and depth 438 zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0 439 zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 440 ! ! masked bbl i-gradient of density 441 zgdrho = ( fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) ) & 442 & - ( zsb(ji+1,jj) - zsb(ji,jj) ) ) * umask(ji,jj,1) 378 DO ji = 1, fs_jpim1 ! vector opt. 379 ! ! i-direction 380 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point 381 zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 382 ! ! 2*masked bottom density gradient 383 zgdrho = ( za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) ) & 384 & - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) ) ) * umask(ji,jj,1) 443 385 ! 444 zsign = SIGN( 0.5, -zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of ( i-gradient * i-slope )445 ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj) 386 zsign = SIGN( 0.5, -zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of ( i-gradient * i-slope ) 387 ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj) ! masked diffusive flux coeff. 446 388 ! 447 ! ! j-direction 448 zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) ) ! T, S anomalie, and depth 449 zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0 450 zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 451 ! ! masked bbl j-gradient of density 452 zgdrho = ( fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) ) & 453 & - ( zsb(ji,jj+1) - zsb(ji,jj) ) ) * vmask(ji,jj,1) 389 ! ! j-direction 390 za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at v-point 391 zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 392 ! ! 2*masked bottom density gradient 393 zgdrho = ( za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) ) & 394 & - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) ) ) * vmask(ji,jj,1) 454 395 ! 455 zsign 396 zsign = SIGN( 0.5, -zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of ( j-gradient * j-slope ) 456 397 ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 457 !458 398 END DO 459 399 END DO … … 469 409 DO jj = 1, jpjm1 ! criteria: grad(rho).grad(h)<0 and grad(rho).grad(h)<0 470 410 DO ji = 1, fs_jpim1 ! vector opt. 471 ! ! i-direction 472 zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) ) ! T, S anomalie, and depth 473 zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0 474 zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 475 ! ! masked bbl i-gradient of density 476 zgdrho = ( fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) ) & 477 & - ( zsb(ji+1,jj) - zsb(ji,jj) ) ) * umask(ji,jj,1) 478 ! 479 zsign = SIGN( 0.5, - zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of i-gradient * i-slope 480 zsigna= SIGN( 0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) ) ) ! sign of u * i-slope 481 ! 482 ! ! bbl velocity 411 ! ! i-direction 412 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point 413 zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 414 ! ! 2*masked bottom density gradient 415 zgdrho = ( za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) ) & 416 - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) ) ) * umask(ji,jj,1) 417 ! 418 zsign = SIGN( 0.5, - zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of i-gradient * i-slope 419 zsigna= SIGN( 0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) ) ) ! sign of u * i-slope 420 ! 421 ! ! bbl velocity 483 422 utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj) 484 423 ! 485 ! ! j-direction 486 zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) ) ! T, S anomalie, and depth 487 zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0 488 zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 489 ! ! masked bbl j-gradient of density 490 zgdrho = ( fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) ) & 491 & - ( zsb(ji,jj+1) - zsb(ji,jj) ) ) * vmask(ji,jj,1) 492 zsign = SIGN( 0.5, - zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of j-gradient * j-slope 493 zsigna= SIGN( 0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) ) ) ! sign of u * i-slope 494 ! 495 ! ! bbl velocity 424 ! ! j-direction 425 za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at v-point 426 zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 427 ! ! 2*masked bottom density gradient 428 zgdrho = ( za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) ) & 429 & - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) ) ) * vmask(ji,jj,1) 430 zsign = SIGN( 0.5, - zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of j-gradient * j-slope 431 zsigna= SIGN( 0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) ) ) ! sign of u * i-slope 432 ! 433 ! ! bbl transport 496 434 vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj) 497 435 END DO … … 502 440 DO jj = 1, jpjm1 ! criteria: rho_up > rho_down 503 441 DO ji = 1, fs_jpim1 ! vector opt. 504 ! ! i-direction442 ! ! i-direction 505 443 ! down-slope T-point i/k-index (deep) & up-slope T-point i/k-index (shelf) 506 iid = ji + MAX( 0, mgrhu(ji,jj) ) ; iis = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 507 ikud = mbku_d(ji,jj) ; ikus = mbku(ji,jj) 508 ! 509 ! ! mid-depth density anomalie (up-slope minus down-slope) 510 zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) ) ! mid slope depth of T, S, and depth 511 zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0 512 zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 513 zgdrho = fsbeta( zt, zs, zh ) & 514 & * ( fsalbt( zt, zs, zh ) * ( ztb(iid,jj) - ztb(iis,jj) ) & 515 & - ( zsb(iid,jj) - zsb(iis,jj) ) ) * umask(ji,jj,1) 516 zgdrho = MAX( 0.e0, zgdrho ) ! only if shelf is denser than deep 517 ! 518 ! ! bbl transport (down-slope direction) 444 iid = ji + MAX( 0, mgrhu(ji,jj) ) 445 iis = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 446 ! 447 ikud = mbku_d(ji,jj) 448 ikus = mbku(ji,jj) 449 ! 450 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point 451 zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 452 ! ! masked bottom density gradient 453 zgdrho = 0.5 * ( za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) ) & 454 & - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) ) ) * umask(ji,jj,1) 455 zgdrho = MAX( 0.e0, zgdrho ) ! only if shelf is denser than deep 456 ! 457 ! ! bbl transport (down-slope direction) 519 458 utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) ) 520 459 ! 521 ! ! j-direction460 ! ! j-direction 522 461 ! down-slope T-point j/k-index (deep) & of the up -slope T-point j/k-index (shelf) 523 ijd = jj + MAX( 0, mgrhv(ji,jj) ) ; ijs = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 524 ikvd = mbkv_d(ji,jj) ; ikvs = mbkv(ji,jj) 525 ! 526 ! ! mid-depth density anomalie (up-slope minus down-slope) 527 zt = 0.5 * ( ztb (ji,jj) + ztb (ji,jj+1) ) ! mid slope depth of T, S, and depth 528 zs = 0.5 * ( zsb (ji,jj) + zsb (ji,jj+1) ) - 35.0 529 zh = 0.5 * ( zdep(ji,jj) + zdep(ji,jj+1) ) 530 zgdrho = fsbeta( zt, zs, zh ) & 531 & * ( fsalbt( zt, zs, zh ) * ( ztb(ji,ijd) - ztb(ji,ijs) ) & 532 & - ( zsb(ji,ijd) - zsb(ji,ijs) ) ) * vmask(ji,jj,1) 533 zgdrho = MAX( 0.e0, zgdrho ) ! only if shelf is denser than deep 534 ! 535 ! ! bbl transport (down-slope direction) 462 ijd = jj + MAX( 0, mgrhv(ji,jj) ) 463 ijs = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 464 ! 465 ikvd = mbkv_d(ji,jj) 466 ikvs = mbkv(ji,jj) 467 ! 468 za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at v-point 469 zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 470 ! ! masked bottom density gradient 471 zgdrho = 0.5 * ( za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) ) & 472 & - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) ) ) * vmask(ji,jj,1) 473 zgdrho = MAX( 0.e0, zgdrho ) ! only if shelf is denser than deep 474 ! 475 ! ! bbl transport (down-slope direction) 536 476 vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) ) 537 477 END DO … … 541 481 ENDIF 542 482 ! 543 CALL wrk_dealloc( jpi, jpj, zub, zvb, ztb, zsb, zdep )544 !545 483 IF( nn_timing == 1 ) CALL timing_stop( 'bbl') 546 484 ! … … 558 496 !!---------------------------------------------------------------------- 559 497 INTEGER :: ji, jj ! dummy loop indices 560 INTEGER :: ii0, ii1, ij0, ij1 ! temporaryinteger561 INTEGER :: ios ! Local integer output status for namelist read498 INTEGER :: ii0, ii1, ij0, ij1 ! local integer 499 INTEGER :: ios ! - - 562 500 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 563 501 !! … … 598 536 IF( nn_bbl_adv == 2 ) WRITE(numout,*) ' * Advective BBL using velocity = F( delta rho)' 599 537 600 IF( nn_eos /= 0 ) CALL ctl_stop ( ' bbl parameterisation requires eos = 0. We stop.' )601 602 538 ! !* vertical index of "deep" bottom u- and v-points 603 539 DO jj = 1, jpjm1 ! (the "shelf" bottom k-indices are mbku and mbkv) … … 607 543 END DO 608 544 END DO 609 ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk545 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 610 546 zmbk(:,:) = REAL( mbku_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'U',1.) ; mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 611 547 zmbk(:,:) = REAL( mbkv_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 612 548 613 !* sign of grad(H) at u- and v-points614 mgrhu(jpi,:) = 0 . ; mgrhu(:,jpj) = 0. ; mgrhv(jpi,:) = 0. ; mgrhv(:,jpj) = 0.549 !* sign of grad(H) at u- and v-points 550 mgrhu(jpi,:) = 0 ; mgrhu(:,jpj) = 0 ; mgrhv(jpi,:) = 0 ; mgrhv(:,jpj) = 0 615 551 DO jj = 1, jpjm1 616 552 DO ji = 1, jpim1 … … 621 557 622 558 DO jj = 1, jpjm1 !* bbl thickness at u- (v-) point 623 DO ji = 1, jpim1 ! minimum of top & bottom e3u_0 (e3v_0)559 DO ji = 1, jpim1 ! minimum of top & bottom e3u_0 (e3v_0) 624 560 e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj )), e3u_0(ji,jj,mbkt(ji,jj)) ) 625 561 e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r4292 r4896 28 28 USE dom_oce ! ocean: domain variables 29 29 USE c1d ! 1D vertical configuration 30 USE trd mod_oce ! ocean: trendvariables31 USE trdtra ! active tracers: trends30 USE trd_oce ! trends: ocean variables 31 USE trdtra ! trends manager: tracers 32 32 USE zdf_oce ! ocean: vertical physics 33 33 USE phycst ! physical constants … … 48 48 PUBLIC dtacof_zoom ! routine called by tradmp.F90, trcdmp.F90 and dyndmp.F90 49 49 50 !!gm why all namelist variable public???? only ln_tradmp should be sufficient 51 50 52 ! !!* Namelist namtra_dmp : T & S newtonian damping * 51 53 LOGICAL , PUBLIC :: ln_tradmp !: internal damping flag … … 112 114 ! 113 115 CALL wrk_alloc( jpi, jpj, jpk, jpts, zts_dta ) 116 ! 114 117 ! !== input T-S data at kt ==! 115 118 CALL dta_tsd( kt, zts_dta ) ! read and interpolates T-S data at kt … … 172 175 ! 173 176 IF( l_trdtra ) THEN ! trend diagnostic 174 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_dmp, ttrdmp )175 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ trd_dmp, strdmp )177 CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ttrdmp ) 178 CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, strdmp ) 176 179 ENDIF 177 180 ! ! Control print … … 194 197 !! ** Method : read the namtra_dmp namelist and check the parameters 195 198 !!---------------------------------------------------------------------- 199 INTEGER :: ios ! Local integer output status for namelist read 200 !! 196 201 NAMELIST/namtra_dmp/ ln_tradmp, nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file 197 INTEGER :: ios ! Local integer output status for namelist read 198 !!---------------------------------------------------------------------- 199 202 !!---------------------------------------------------------------------- 203 ! 200 204 REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : Temperature and salinity damping term 201 205 READ ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901) 202 206 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp ) 203 207 ! 204 208 REWIND( numnam_cfg ) ! Namelist namtra_dmp in configuration namelist : Temperature and salinity damping term 205 209 READ ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 ) … … 228 232 IF( tra_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 229 233 ! 234 !!gm I don't understand the specificities of c1d case...... 235 !!gm to be check with the autor of these lines 236 230 237 #if ! defined key_c1d 231 238 SELECT CASE ( nn_hdmp ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r4488 r4896 23 23 USE traldf_iso_grif ! lateral mixing (tra_ldf_iso_grif routine) 24 24 USE traldf_lap ! lateral mixing (tra_ldf_lap routine) 25 USE trdmod_oce ! ocean space and time domain 26 USE trdtra ! ocean active tracers trends 25 USE trd_oce ! trends: ocean variables 26 USE trdtra ! trends manager: tracers 27 ! 27 28 USE prtctl ! Print control 28 29 USE in_out_manager ! I/O manager … … 35 36 PRIVATE 36 37 37 PUBLIC tra_ldf 38 PUBLIC tra_ldf_init 38 PUBLIC tra_ldf ! called by step.F90 39 PUBLIC tra_ldf_init ! called by opa.F90 39 40 ! 40 41 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) … … 112 113 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 113 114 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 114 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_ldf, ztrdt )115 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ trd_ldf, ztrds )115 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 116 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 116 117 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 117 118 ENDIF … … 174 175 IF ( ln_traldf_iso ) nldf = 1 ! isoneutral ( rotation) 175 176 ENDIF 176 IF ( ln_zps ) THEN ! z -coordinate177 IF ( ln_zps ) THEN ! zps-coordinate 177 178 IF ( ln_traldf_level ) ierr = 1 ! iso-level not allowed 178 179 IF ( ln_traldf_hor ) nldf = 0 ! horizontal (no rotation) 179 180 IF ( ln_traldf_iso ) nldf = 1 ! isoneutral ( rotation) 180 181 ENDIF 181 IF ( ln_sco ) THEN ! z-coordinate182 IF ( ln_sco ) THEN ! s-coordinate 182 183 IF ( ln_traldf_level ) nldf = 0 ! iso-level (no rotation) 183 184 IF ( ln_traldf_hor ) nldf = 1 ! horizontal ( rotation) … … 192 193 IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) 193 194 ENDIF 194 IF ( ln_zps ) THEN ! z -coordinate195 IF ( ln_zps ) THEN ! zps-coordinate 195 196 IF ( ln_traldf_level ) ierr = 1 ! iso-level not allowed 196 197 IF ( ln_traldf_hor ) nldf = 2 ! horizontal (no rotation) 197 198 IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) 198 199 ENDIF 199 IF ( ln_sco ) THEN ! z-coordinate200 IF ( ln_sco ) THEN ! s-coordinate 200 201 IF ( ln_traldf_level ) nldf = 2 ! iso-level (no rotation) 201 202 IF ( ln_traldf_hor ) nldf = 3 ! horizontal ( rotation) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r3632 r4896 252 252 END DO 253 253 IF( ln_zps.and.l_grad_zps ) THEN ! partial steps: correction at the last level 254 # if defined key_vectopt_loop255 DO jj = 1, 1256 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)257 # else258 254 DO jj = 1, jpjm1 259 255 DO ji = 1, jpim1 260 # endif261 256 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 262 257 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
r4313 r4896 2 2 !!============================================================================== 3 3 !! *** MODULE tranpc *** 4 !! Ocean active tracers: non penetrative convecti onscheme4 !! Ocean active tracers: non penetrative convective adjustment scheme 5 5 !!============================================================================== 6 6 !! History : 1.0 ! 1990-09 (G. Madec) Original code … … 9 9 !! 3.0 ! 2008-06 (G. Madec) applied on ta, sa and called before tranxt in step.F90 10 10 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 11 !! 3.7 ! 2014-06 (L. Brodeau) new algorithm based on local Brunt-Vaisala freq. 11 12 !!---------------------------------------------------------------------- 12 13 … … 14 15 !! tra_npc : apply the non penetrative convection scheme 15 16 !!---------------------------------------------------------------------- 16 USE oce ! ocean dynamics and active tracers 17 USE oce ! ocean dynamics and active tracers 17 18 USE dom_oce ! ocean space and time domain 19 USE phycst ! physical constants 18 20 USE zdf_oce ! ocean vertical physics 19 USE trd mod_oce! ocean active tracer trends21 USE trd_oce ! ocean active tracer trends 20 22 USE trdtra ! ocean active tracer trends 21 USE eosbn2 ! equation of state (eos routine) 23 USE eosbn2 ! equation of state (eos routine) 24 ! 22 25 USE lbclnk ! lateral boundary conditions (or mpp link) 23 26 USE in_out_manager ! I/O manager … … 29 32 PRIVATE 30 33 31 PUBLIC tra_npc 34 PUBLIC tra_npc ! routine called by step.F90 32 35 33 36 !! * Substitutions 34 37 # include "domzgr_substitute.h90" 35 !!---------------------------------------------------------------------- 36 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 37 !! $Id$ 38 # include "vectopt_loop_substitute.h90" 39 !!---------------------------------------------------------------------- 40 !! NEMO/OPA 3.6 , NEMO Consortium (2014) 41 !! $Id$ 38 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 39 43 !!---------------------------------------------------------------------- … … 44 48 !! *** ROUTINE tranpc *** 45 49 !! 46 !! ** Purpose : Non penetrative convective adjustment scheme. solve50 !! ** Purpose : Non-penetrative convective adjustment scheme. solve 47 51 !! the static instability of the water column on after fields 48 52 !! while conserving heat and salt contents. 49 53 !! 50 !! ** Method : The algorithm used converges in a maximium of jpk 51 !! iterations. instabilities are treated when the vertical density 52 !! gradient is less than 1.e-5. 53 !! l_trdtra=T: the trend associated with this algorithm is saved. 54 !! ** Method : updated algorithm able to deal with non-linear equation of state 55 !! (i.e. static stability computed locally) 54 56 !! 55 57 !! ** Action : - (ta,sa) after the application od the npc scheme 56 !! - s ave the associated trends (ttrd,strd) ('key_trdtra')58 !! - send the associated trends for on-line diagnostics (l_trdtra=T) 57 59 !! 58 !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371.60 !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 59 61 !!---------------------------------------------------------------------- 60 !61 62 INTEGER, INTENT(in) :: kt ! ocean time-step index 62 63 ! 63 64 INTEGER :: ji, jj, jk ! dummy loop indices 64 65 INTEGER :: inpcc ! number of statically instable water column 65 INTEGER :: inpci ! number of iteration for npc scheme 66 INTEGER :: jiter, jkdown, jkp ! ??? 67 INTEGER :: ikbot, ik, ikup, ikdown ! ??? 68 REAL(wp) :: ze3tot, zta, zsa, zraua, ze3dwn 69 REAL(wp), POINTER, DIMENSION(:,: ) :: zwx, zwy, zwz 70 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds, zrhop 66 INTEGER :: jiter, ikbot, ik, ikup, ikdown, ilayer, ikm ! local integers 67 LOGICAL :: l_bottom_reached, l_column_treated 68 REAL(wp) :: zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 69 REAL(wp) :: zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt 70 REAL(wp), POINTER, DIMENSION(:) :: zvn2 ! vertical profile of N2 at 1 given point... 71 REAL(wp), POINTER, DIMENSION(:,:) :: zvts ! vertical profile of T and S at 1 given point... 72 REAL(wp), POINTER, DIMENSION(:,:) :: zvab ! vertical profile of alpha and beta 73 REAL(wp), POINTER, DIMENSION(:,:,:) :: zn2 ! N^2 74 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zab ! alpha and beta 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 76 ! 77 !!LB debug: 78 LOGICAL, PARAMETER :: l_LB_debug = .FALSE. 79 INTEGER :: ilc1, jlc1, klc1, nncpu 80 LOGICAL :: lp_monitor_point = .FALSE. 81 !!LB debug. 71 82 !!---------------------------------------------------------------------- 72 83 ! 73 84 IF( nn_timing == 1 ) CALL timing_start('tra_npc') 74 85 ! 75 CALL wrk_alloc(jpi, jpj, jpk, zrhop )76 CALL wrk_alloc(jpi, jpk, zwx, zwy, zwz )77 !78 86 IF( MOD( kt, nn_npc ) == 0 ) THEN 79 80 inpcc = 081 inpci = 082 83 CALL eos( tsa, rhd, zrhop, fsdept_n(:,:,:) ) ! Potential density84 85 IF( l_trdtra ) THEN !* Save ta and sa trends87 ! 88 CALL wrk_alloc( jpi, jpj, jpk, zn2 ) ! N2 89 CALL wrk_alloc( jpi, jpj, jpk, 2, zab ) ! Alpha and Beta 90 CALL wrk_alloc( jpk, 2, zvts, zvab ) ! 1D column vector at point ji,jj 91 CALL wrk_alloc( jpk, zvn2 ) ! 1D column vector at point ji,jj 92 93 IF( l_trdtra ) THEN !* Save initial after fields 86 94 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 87 95 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) … … 89 97 ENDIF 90 98 91 ! ! =============== 92 DO jj = 1, jpj ! Vertical slab 93 ! ! =============== 94 ! Static instability pointer 95 ! ---------------------------- 96 DO jk = 1, jpkm1 97 DO ji = 1, jpi 98 zwx(ji,jk) = ( zrhop(ji,jj,jk) - zrhop(ji,jj,jk+1) ) * tmask(ji,jj,jk+1) 99 END DO 100 END DO 101 102 ! 1.1 do not consider the boundary points 103 104 ! even if east-west cyclic b. c. do not considere ji=1 or jpi 105 DO jk = 1, jpkm1 106 zwx( 1 ,jk) = 0.e0 107 zwx(jpi,jk) = 0.e0 108 END DO 109 ! even if south-symmetric b. c. used, do not considere jj=1 110 IF( jj == 1 ) zwx(:,:) = 0.e0 111 112 DO jk = 1, jpkm1 113 DO ji = 1, jpi 114 zwx(ji,jk) = 1. 115 IF( zwx(ji,jk) < 1.e-5 ) zwx(ji,jk) = 0.e0 116 END DO 117 END DO 118 119 zwy(:,1) = 0.e0 120 DO ji = 1, jpi 121 DO jk = 1, jpkm1 122 zwy(ji,1) = zwy(ji,1) + zwx(ji,jk) 123 END DO 124 END DO 125 126 zwz(1,1) = 0.e0 127 DO ji = 1, jpi 128 zwz(1,1) = zwz(1,1) + zwy(ji,1) 129 END DO 130 131 inpcc = inpcc + NINT( zwz(1,1) ) 132 133 134 ! 2. Vertical mixing for each instable portion of the density profil 135 ! ------------------------------------------------------------------ 136 137 IF( zwz(1,1) /= 0.e0 ) THEN ! -->> the density profil is statically instable : 138 DO ji = 1, jpi 139 IF( zwy(ji,1) /= 0.e0 ) THEN 99 !LB debug: 100 IF( lwp .AND. l_LB_debug ) THEN 101 WRITE(numout,*) 102 WRITE(numout,*) 'LOLO: entering tra_npc, kt, narea =', kt, narea 103 ENDIF 104 !LBdebug: Monitoring of 1 column subject to convection... 105 IF( l_LB_debug ) THEN 106 ! Location of 1 known convection spot to follow what's happening in the water column 107 ilc1 = 54 ; jlc1 = 15 ; ! Labrador ORCA1 4x4 cpus: 108 nncpu = 15 ; ! the CPU domain contains the convection spot 109 !ilc1 = 14 ; jlc1 = 13 ; ! Labrador ORCA1 8x8 cpus: 110 !nncpu = 54 ; ! the CPU domain contains the convection spot 111 klc1 = mbkt(ilc1,jlc1) ! bottom of the ocean for debug point... 112 ENDIF 113 !LBdebug. 114 115 CALL eos_rab( tsa, zab ) ! after alpha and beta 116 CALL bn2 ( tsa, zab, zn2 ) ! after Brunt-Vaisala 117 118 inpcc = 0 119 120 DO jj = 2, jpjm1 ! interior column only 121 DO ji = fs_2, fs_jpim1 122 ! 123 IF( tmask(ji,jj,2) == 1 ) THEN ! At least 2 ocean points 124 ! ! consider one ocean column 125 zvts(:,jp_tem) = tsa(ji,jj,:,jp_tem) ! temperature 126 zvts(:,jp_sal) = tsa(ji,jj,:,jp_sal) ! salinity 127 128 zvab(:,jp_tem) = zab(ji,jj,:,jp_tem) ! Alpha 129 zvab(:,jp_sal) = zab(ji,jj,:,jp_sal) ! Beta 130 zvn2(:) = zn2(ji,jj,:) ! N^2 131 132 IF( l_LB_debug ) THEN !LB debug: 133 lp_monitor_point = .FALSE. 134 IF( ( ji == ilc1 ).AND.( jj == jlc1 ) ) lp_monitor_point = .TRUE. 135 ! writing only if on CPU domain where conv region is: 136 lp_monitor_point = (narea == nncpu).AND.lp_monitor_point 137 138 IF(lp_monitor_point) THEN 139 WRITE(numout,*) '' ;WRITE(numout,*) '' ; 140 WRITE(numout,'("Time step = ",i6.6," !!!")') kt 141 WRITE(numout,'(" *** BEFORE anything, N^2 for point ",i3,",",i3,":" )') , ji,jj 142 DO jk = 1, klc1 143 WRITE(numout,*) jk, zvn2(jk) 144 END DO 145 WRITE(numout,*) ' ' 146 ENDIF 147 ENDIF !LB debug end 148 149 ikbot = mbkt(ji,jj) ! ikbot: ocean bottom T-level 150 ik = 1 ! because N2 is irrelevant at the surface level (will start at ik=2) 151 ilayer = 0 152 jiter = 0 153 l_column_treated = .FALSE. 154 155 DO WHILE ( .NOT. l_column_treated ) 140 156 ! 141 ikbot = mbkt(ji,jj) ! ikbot: ocean bottom T-level 157 jiter = jiter + 1 158 159 IF( jiter >= 400 ) EXIT 160 161 l_bottom_reached = .FALSE. 162 163 DO WHILE ( .NOT. l_bottom_reached ) 164 165 ik = ik + 1 166 167 !! Checking level ik for instability 168 !! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 169 170 IF( zvn2(ik) < 0. ) THEN ! Instability found! 171 172 ikm = ik ! first level whith negative N2 173 ilayer = ilayer + 1 ! yet another layer found.... 174 IF(jiter == 1) inpcc = inpcc + 1 175 176 IF(l_LB_debug .AND. lp_monitor_point) & 177 & WRITE(numout,*) 'Negative N2 at ik =', ikm, ' layer nb.', ilayer, & 178 & ' inpcc =', inpcc 179 180 !! Case we mix with upper regions where N2==0: 181 !! All the points above ikup where N2 == 0 must also be mixed => we go 182 !! upward to find a new ikup, where the layer doesn't have N2==0 183 ikup = ikm 184 DO jk = ikm, 2, -1 185 ikup = ikup - 1 186 IF( (zvn2(jk-1) > 0.).OR.(ikup == 1) ) EXIT 187 END DO 188 189 ! adjusting ikup if the upper part of the unstable column was neutral (N2=0) 190 IF((zvn2(ikup+1) == 0.).AND.(ikup /= 1)) ikup = ikup+1 ; 191 192 193 IF( lp_monitor_point ) WRITE(numout,*) ' => ikup is =', ikup, ' layer nb.', ilayer 194 195 zsum_temp = 0._wp 196 zsum_sali = 0._wp 197 zsum_alfa = 0._wp 198 zsum_beta = 0._wp 199 zsum_z = 0._wp 200 201 DO jk = ikup, ikbot+1 ! Inside the instable (and overlying neutral) portion of the column 202 ! 203 IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) ' -> summing for jk =', jk 204 ! 205 zdz = fse3t(ji,jj,jk) 206 zsum_temp = zsum_temp + zvts(jk,jp_tem)*zdz 207 zsum_sali = zsum_sali + zvts(jk,jp_sal)*zdz 208 zsum_alfa = zsum_alfa + zvab(jk,jp_tem)*zdz 209 zsum_beta = zsum_beta + zvab(jk,jp_sal)*zdz 210 zsum_z = zsum_z + zdz 211 ! 212 !! EXIT if we found the bottom of the unstable portion of the water column 213 IF( (zvn2(jk+1) > 0.).OR.(jk == ikbot ).OR.((jk==ikm).AND.(zvn2(jk+1) == 0.)) ) EXIT 214 END DO 215 216 !ik = jk !LB remove? 217 ikdown = jk ! for the current unstable layer, ikdown is the deepest point with a negative N2 218 219 IF(l_LB_debug .AND. lp_monitor_point) & 220 & WRITE(numout,*) ' => ikdown =', ikdown, ' layer nb.', ilayer 221 222 ! Mixing Temperature and salinity between ikup and ikdown: 223 zta = zsum_temp/zsum_z 224 zsa = zsum_sali/zsum_z 225 zalfa = zsum_alfa/zsum_z 226 zbeta = zsum_beta/zsum_z 227 228 IF(l_LB_debug .AND. lp_monitor_point) THEN 229 WRITE(numout,*) ' => Mean temp. in that portion =', zta 230 WRITE(numout,*) ' => Mean sali. in that portion =', zsa 231 WRITE(numout,*) ' => Mean Alpha in that portion =', zalfa 232 WRITE(numout,*) ' => Mean Beta in that portion =', zbeta 233 ENDIF 234 235 !! Homogenaizing the temperature, salinity, alpha and beta in this portion of the column 236 DO jk = ikup, ikdown 237 zvts(jk,jp_tem) = zta 238 zvts(jk,jp_sal) = zsa 239 zvab(jk,jp_tem) = zalfa 240 zvab(jk,jp_sal) = zbeta 241 END DO 242 ! 243 !! Before updating N2, it is possible that another unstable 244 !! layer exists underneath the one we just homogeneized! 245 ik = ikdown 246 ! 247 ENDIF ! IF( zvn2(ik+1) < 0. ) THEN 248 ! 249 IF( ik == ikbot ) l_bottom_reached = .TRUE. 250 ! 251 END DO ! DO WHILE ( .NOT. l_bottom_reached ) 252 253 IF( ik /= ikbot ) STOP 'ERROR: tranpc.F90 => PROBLEM #1' 254 255 ! ******* At this stage ik == ikbot ! ******* 256 257 IF( ilayer > 0 ) THEN 258 !! least an unstable layer has been found 259 !! Temperature, Salinity, Alpha and Beta have been homogenized in the unstable portion 260 !! => Need to re-compute N2! will use Alpha and Beta! 261 ! 262 DO jk = ikup+1, ikdown+1 ! we must go 1 point deeper than ikdown! 263 !! Doing exactly as in eosbn2.F90: 264 !! * Except that we only are interested in the sign of N2 !!! 265 !! => just considering the vertical gradient of density 266 zrw = (fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk)) & 267 & / (fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk)) 268 zaw = zvab(jk,jp_tem) * (1._wp - zrw) + zvab(jk-1,jp_tem) * zrw 269 zbw = zvab(jk,jp_sal) * (1._wp - zrw) + zvab(jk-1,jp_sal) * zrw 270 271 !zvn2(jk) = grav*( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) ) & 272 ! & - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) ) ) & 273 ! & / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 274 zvn2(jk) = ( zaw * ( zvts(jk-1,jp_tem) - zvts(jk,jp_tem) ) & 275 & - zbw * ( zvts(jk-1,jp_sal) - zvts(jk,jp_sal) ) ) 276 END DO 277 278 IF(l_LB_debug .AND. lp_monitor_point) THEN 279 WRITE(numout, '(" *** After iteration #",i3.3,", N^2 for point ",i3,",",i3,":" )') & 280 & jiter, ji,jj 281 DO jk = 1, klc1 282 WRITE(numout,*) jk, zvn2(jk) 283 END DO 284 WRITE(numout,*) ' ' 285 ENDIF 286 287 ik = 1 ! starting again at the surface for the next iteration 288 ilayer = 0 289 ENDIF 142 290 ! 143 DO jiter = 1, jpk ! vertical iteration 144 ! 145 ! search of ikup : the first static instability from the sea surface 146 ! 147 ik = 0 148 220 CONTINUE 149 ik = ik + 1 150 IF( ik >= ikbot ) GO TO 200 151 zwx(ji,ik) = zrhop(ji,jj,ik) - zrhop(ji,jj,ik+1) 152 IF( zwx(ji,ik) <= 0.e0 ) GO TO 220 153 ikup = ik 154 ! the density profil is instable below ikup 155 ! ikdown : bottom of the instable portion of the density profil 156 ! search of ikdown and vertical mixing from ikup to ikdown 157 ! 158 ze3tot= fse3t(ji,jj,ikup) 159 zta = tsa (ji,jj,ikup,jp_tem) 160 zsa = tsa (ji,jj,ikup,jp_sal) 161 zraua = zrhop(ji,jj,ikup) 162 ! 163 DO jkdown = ikup+1, ikbot-1 164 IF( zraua <= zrhop(ji,jj,jkdown) ) THEN 165 ikdown = jkdown 166 GO TO 240 167 ENDIF 168 ze3dwn = fse3t(ji,jj,jkdown) 169 ze3tot = ze3tot + ze3dwn 170 zta = ( zta*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_tem)*ze3dwn )/ze3tot 171 zsa = ( zsa*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_sal)*ze3dwn )/ze3tot 172 zraua = ( zraua*(ze3tot-ze3dwn) + zrhop(ji,jj,jkdown)*ze3dwn )/ze3tot 173 inpci = inpci+1 174 END DO 175 ikdown = ikbot-1 176 240 CONTINUE 177 ! 178 DO jkp = ikup, ikdown-1 179 tsa (ji,jj,jkp,jp_tem) = zta 180 tsa (ji,jj,jkp,jp_sal) = zsa 181 zrhop(ji,jj,jkp ) = zraua 182 END DO 183 IF (ikdown == ikbot-1 .AND. zraua >= zrhop(ji,jj,ikdown) ) THEN 184 tsa (ji,jj,jkp,jp_tem) = zta 185 tsa (ji,jj,jkp,jp_sal) = zsa 186 zrhop(ji,jj,ikdown ) = zraua 187 ENDIF 188 END DO 189 ENDIF 190 200 CONTINUE 191 END DO 192 ! <<-- no more static instability on slab jj 193 ENDIF 194 ! ! =============== 195 END DO ! End of slab 196 ! ! =============== 197 ! 198 IF( l_trdtra ) THEN ! save the Non penetrative mixing trends for diagnostic 199 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 200 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 201 CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_npc, ztrdt ) 202 CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_npc, ztrds ) 291 IF( ik >= ikbot ) THEN 292 IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) ' --- exiting jiter loop ---' 293 l_column_treated = .TRUE. 294 ENDIF 295 ! 296 END DO ! DO WHILE ( .NOT. l_column_treated ) 297 298 !! Updating tsa: 299 tsa(ji,jj,:,jp_tem) = zvts(:,jp_tem) 300 tsa(ji,jj,:,jp_sal) = zvts(:,jp_sal) 301 302 !! lolo: Should we update something else???? 303 !! => like alpha and beta? 304 305 IF(l_LB_debug .AND. lp_monitor_point) WRITE(numout,*) '' 306 307 ENDIF ! IF( tmask(ji,jj,3) == 1 ) THEN 308 309 END DO ! ji 310 END DO ! jj 311 ! 312 IF( l_trdtra ) THEN ! send the Non penetrative mixing trends for diagnostic 313 z1_r2dt = 1._wp / (2._wp * rdt) 314 ztrdt(:,:,:) = ( tsa(:,:,:,jp_tem) - ztrdt(:,:,:) ) * z1_r2dt 315 ztrds(:,:,:) = ( tsa(:,:,:,jp_sal) - ztrds(:,:,:) ) * z1_r2dt 316 CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt ) 317 CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds ) 203 318 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 204 319 ENDIF 205 206 ! Lateral boundary conditions on ( ta, sa ) ( Unchanged sign) 207 ! ------------------------------============ 320 ! 208 321 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 209 210 211 ! 2. non penetrative convective scheme statistics212 ! -----------------------------------------------213 IF( nn_npcp /= 0 .AND. MOD( kt, nn_npcp ) == 0 ) THEN214 IF(lwp) WRITE(numout,*)' kt=',kt, ' number of statically instable', &215 & ' water column : ',inpcc, ' number of iteration : ',inpci216 ENDIF217 !218 ENDIF219 !220 CALL wrk_dealloc(jpi, jpj, jpk, zrhop )221 CALL wrk_dealloc(jpi, jpk, zwx, zwy, zwz )322 ! 323 IF(lwp) THEN 324 WRITE(numout,*) 'LOLO: exiting tra_npc, kt =', kt 325 WRITE(numout,*)' => number of statically instable water column : ',inpcc 326 WRITE(numout,*) '' ; WRITE(numout,*) '' 327 ENDIF 328 ! 329 CALL wrk_dealloc(jpi, jpj, jpk, zn2 ) 330 CALL wrk_dealloc(jpi, jpj, jpk, 2, zab ) 331 CALL wrk_dealloc(jpk, zvn2 ) 332 CALL wrk_dealloc(jpk, 2, zvts, zvab ) 333 ! 334 ENDIF ! IF( MOD( kt, nn_npc ) == 0 ) THEN 222 335 ! 223 336 IF( nn_timing == 1 ) CALL timing_stop('tra_npc') -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r4328 r4896 27 27 USE dom_oce ! ocean space and time domain variables 28 28 USE sbc_oce ! surface boundary condition: ocean 29 USE zdf_oce ! ???29 USE zdf_oce ! ocean vertical mixing 30 30 USE domvvl ! variable volume 31 31 USE dynspg_oce ! surface pressure gradient variables 32 32 USE dynhpg ! hydrostatic pressure gradient 33 USE trdmod_oce ! ocean space and time domain variables 34 USE trdtra ! ocean active tracers trends 35 USE phycst 36 USE bdy_oce 33 USE trd_oce ! trends: ocean variables 34 USE trdtra ! trends manager: tracers 35 USE traqsr ! penetrative solar radiation (needed for nksr) 36 USE phycst ! physical constant 37 USE ldftra_oce ! lateral physics on tracers 38 USE bdy_oce ! BDY open boundary condition variables 37 39 USE bdytra ! open boundary condition (bdy_tra routine) 40 ! 38 41 USE in_out_manager ! I/O manager 39 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 40 43 USE prtctl ! Print control 41 USE traqsr ! penetrative solar radiation (needed for nksr) 44 USE wrk_nemo ! Memory allocation 45 USE timing ! Timing 42 46 #if defined key_agrif 43 47 USE agrif_opa_update 44 48 USE agrif_opa_interp 45 49 #endif 46 USE wrk_nemo ! Memory allocation47 USE timing ! Timing48 50 49 51 IMPLICIT NONE … … 80 82 !! at the local domain boundaries through lbc_lnk call, 81 83 !! at the one-way open boundaries (lk_bdy=T), 82 !! at the AGRIF zoom 84 !! at the AGRIF zoom boundaries (lk_agrif=T) 83 85 !! 84 86 !! - Update lateral boundary conditions on AGRIF children … … 127 129 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 128 130 ztrds(:,:,:) = tsn(:,:,:,jp_sal) 131 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 132 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 133 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds ) 134 ENDIF 129 135 ENDIF 130 136 … … 150 156 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 151 157 DO jk = 1, jpkm1 152 zfact = 1. e0_wp / r2dtra(jk)158 zfact = 1._wp / r2dtra(jk) 153 159 ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 154 160 ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 155 161 END DO 156 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_atf, ztrdt )157 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ trd_atf, ztrds )162 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 163 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 158 164 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 159 165 END IF … … 163 169 & tab3d_2=tsn(:,:,:,jp_sal), clinfo2= ' Sn: ', mask2=tmask ) 164 170 ! 165 ! 166 IF( nn_timing == 1 ) CALL timing_stop('tra_nxt') 171 IF( nn_timing == 1 ) CALL timing_stop('tra_nxt') 167 172 ! 168 173 END SUBROUTINE tra_nxt -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r4333 r4896 10 10 !! - ! 2005-11 (G. Madec) zco, zps, sco coordinate 11 11 !! 3.2 ! 2009-04 (G. Madec & NEMO team) 12 !! 4.0! 2012-05 (C. Rousset) store attenuation coef for use in ice model12 !! 3.6 ! 2012-05 (C. Rousset) store attenuation coef for use in ice model 13 13 !!---------------------------------------------------------------------- 14 14 … … 17 17 !! tra_qsr_init : solar radiation penetration initialization 18 18 !!---------------------------------------------------------------------- 19 USE oce ! ocean dynamics and active tracers 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce ! surface boundary condition: ocean 22 USE trc_oce ! share SMS/Ocean variables 23 USE trdmod_oce ! ocean variables trends 24 USE trdtra ! ocean active tracers trends 25 USE in_out_manager ! I/O manager 26 USE phycst ! physical constants 27 USE prtctl ! Print control 28 USE iom ! I/O manager 29 USE fldread ! read input fields 30 USE restart ! ocean restart 31 USE lib_mpp ! MPP library 19 USE oce ! ocean dynamics and active tracers 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce ! surface boundary condition: ocean 22 USE trc_oce ! share SMS/Ocean variables 23 USE trd_oce ! trends: ocean variables 24 USE trdtra ! trends manager: tracers 25 USE phycst ! physical constants 26 USE sbc_ice, ONLY : lk_lim3 27 ! 28 USE in_out_manager ! I/O manager 29 USE prtctl ! Print control 30 USE iom ! I/O manager 31 USE fldread ! read input fields 32 USE lib_mpp ! MPP library 32 33 USE wrk_nemo ! Memory Allocation 33 34 USE timing ! Timing 34 USE sbc_ice, ONLY : lk_lim335 35 36 36 IMPLICIT NONE … … 51 51 REAL(wp), PUBLIC :: rn_si1 !: deepest depth of extinction (water type I) (2 bands) 52 52 53 ! Module variables 54 REAL(wp) :: xsi0r !: inverse of rn_si0 55 REAL(wp) :: xsi1r !: inverse of rn_si1 53 INTEGER , PUBLIC :: nksr !: levels below which the light cannot penetrate ( depth larger than 391 m) 54 55 REAL(wp) :: xsi0r, xsi1r ! inverse of rn_si0 and rn_si1, resp. 56 REAL(wp), DIMENSION(3,61) :: rkrgb ! tabulated attenuation coefficients for RGB absorption 56 57 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read) 57 INTEGER, PUBLIC :: nksr ! levels below which the light cannot penetrate ( depth larger than 391 m)58 REAL(wp), DIMENSION(3,61) :: rkrgb !: tabulated attenuation coefficients for RGB absorption59 58 60 59 !! * Substitutions … … 90 89 !! 91 90 !! ** Action : - update ta with the penetrative solar radiation trend 92 !! - s ave the trend in ttrd ('key_trdtra')91 !! - send the trend to trdtra (l_trdtra=T) 93 92 !! 94 93 !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 95 94 !! Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516. 96 95 !!---------------------------------------------------------------------- 97 !98 96 INTEGER, INTENT(in) :: kt ! ocean time-step 99 97 ! … … 120 118 ENDIF 121 119 122 IF( l_trdtra ) THEN ! Save t a and satrends120 IF( l_trdtra ) THEN ! Save temperature trends 123 121 CALL wrk_alloc( jpi, jpj, jpk, ztrdt ) 124 122 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) … … 145 143 ! Compute now qsr tracer content field 146 144 ! ************************************ 147 148 145 ! ! ============================================== ! 149 146 IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN ! bio-model fluxes : all vertical coordinates ! … … 183 180 IF( nn_chldta == 1 .OR. lk_vvl ) THEN !* Variable Chlorophyll or ocean volume 184 181 ! 185 IF( nn_chldta == 1 ) THEN ! *Variable Chlorophyll182 IF( nn_chldta == 1 ) THEN !- Variable Chlorophyll 186 183 ! 187 184 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step … … 199 196 END DO 200 197 END DO 201 ELSE !Variable ocean volume but constant chrlorophyll202 zchl = 0.05 ! constant chlorophyll198 ELSE !- Variable ocean volume but constant chrlorophyll 199 zchl = 0.05 ! constant chlorophyll 203 200 irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 ) 204 zekb(:,:) = rkrgb(1,irgb) ! Separation in R-G-B depending of the chlorophyll201 zekb(:,:) = rkrgb(1,irgb) ! Separation in R-G-B depending of the chlorophyll 205 202 zekg(:,:) = rkrgb(2,irgb) 206 203 zekr(:,:) = rkrgb(3,irgb) 207 204 ENDIF 208 205 ! 209 zcoef = ( 1. - rn_abs ) / 3.e0 !equi-partition in R-G-B210 ze0(:,:,1) = rn_abs 211 ze1(:,:,1) = zcoef * qsr(:,:)212 ze2(:,:,1) = zcoef * qsr(:,:)213 ze3(:,:,1) = zcoef * qsr(:,:)214 zea(:,:,1) = qsr(:,:)206 zcoef = ( 1. - rn_abs ) / 3.e0 !- equi-partition in R-G-B 207 ze0(:,:,1) = rn_abs * qsr(:,:) 208 ze1(:,:,1) = zcoef * qsr(:,:) 209 ze2(:,:,1) = zcoef * qsr(:,:) 210 ze3(:,:,1) = zcoef * qsr(:,:) 211 zea(:,:,1) = qsr(:,:) 215 212 ! 216 213 DO jk = 2, nksr+1 … … 257 254 ! clem: store attenuation coefficient of the first ocean level 258 255 IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 256 257 !!gm BUG ?????? ? ? ? 259 258 oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 260 259 iatte(:,:) = oatte(:,:) … … 332 331 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 333 332 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 334 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_qsr, ztrdt )333 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 335 334 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt ) 336 335 ENDIF … … 363 362 !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 364 363 !!---------------------------------------------------------------------- 365 !366 364 INTEGER :: ji, jj, jk ! dummy loop indices 367 365 INTEGER :: irgb, ierror, ioptio, nqsr ! local integer -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r3764 r4896 18 18 USE dom_oce ! ocean space domain variables 19 19 USE phycst ! physical constant 20 USE sbcmod ! ln_rnf 21 USE sbcrnf ! River runoff 20 22 USE traqsr ! solar radiation penetration 21 USE trdmod_oce ! ocean trends 22 USE trdtra ! ocean trends 23 USE trd_oce ! trends: ocean variables 24 USE trdtra ! trends manager: tracers 25 ! 23 26 USE in_out_manager ! I/O manager 24 27 USE prtctl ! Print control 25 USE sbcrnf ! River runoff 26 USE sbcmod ! ln_rnf 27 USE iom 28 USE iom ! I/O library 28 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 30 USE wrk_nemo ! Memory Allocation … … 39 40 # include "vectopt_loop_substitute.h90" 40 41 !!---------------------------------------------------------------------- 41 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)42 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 42 43 !! $Id$ 43 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 91 92 !! where emp, the surface freshwater budget (evaporation minus 92 93 !! precipitation minus runoff) given in kg/m2/s is divided 93 !! by rau0 = 1020 kg/m3(density of sea water) to obtain m/s.94 !! by rau0 (density of sea water) to obtain m/s. 94 95 !! Note: even though Fwe does not appear explicitly for 95 96 !! temperature in this routine, the heat carried by the water … … 107 108 !! ** Action : - Update the 1st level of (ta,sa) with the trend associated 108 109 !! with the tracer surface boundary condition 109 !! - s ave the trend it in ttrd ('key_trdtra')110 !! - send trends to trdtra module (l_trdtra=T) 110 111 !!---------------------------------------------------------------------- 111 112 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 124 125 ENDIF 125 126 126 IF( l_trdtra ) 127 IF( l_trdtra ) THEN !* Save ta and sa trends 127 128 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 128 129 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) … … 137 138 138 139 !---------------------------------------- 139 ! EMP, EMPSand QNS effects140 ! EMP, SFX and QNS effects 140 141 !---------------------------------------- 141 142 ! Set before sbc tracer content fields … … 146 147 & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 147 148 IF(lwp) WRITE(numout,*) ' nit000-1 surface tracer content forcing fields red in the restart file' 148 zfact = 0.5 e0149 zfact = 0.5_wp 149 150 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend 150 151 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend 151 152 ELSE ! No restart or restart not found: Euler forward time stepping 152 zfact = 1. e0153 sbc_tsc_b(:,:,:) = 0. e0153 zfact = 1._wp 154 sbc_tsc_b(:,:,:) = 0._wp 154 155 ENDIF 155 156 ELSE ! Swap of forcing fields 156 157 ! ! ---------------------- 157 zfact = 0.5 e0158 zfact = 0.5_wp 158 159 sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 159 160 ENDIF … … 226 227 ENDIF 227 228 228 IF( l_trdtra ) THEN ! s ave the horizontal diffusivetrends for further diagnostics229 IF( l_trdtra ) THEN ! send trends for further diagnostics 229 230 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 230 231 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 231 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_nsr, ztrdt )232 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ trd_nsr, ztrds )232 CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 233 CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 233 234 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 234 235 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r3294 r4896 19 19 USE sbc_oce ! surface boundary condition: ocean 20 20 USE dynspg_oce 21 22 21 USE trazdf_exp ! vertical diffusion: explicit (tra_zdf_exp routine) 23 22 USE trazdf_imp ! vertical diffusion: implicit (tra_zdf_imp routine) 24 25 23 USE ldftra_oce ! ocean active tracers: lateral physics 26 USE trdmod_oce ! ocean active tracers: lateral physics 27 USE trdtra ! ocean tracers trends 24 USE trd_oce ! trends: ocean variables 25 USE trdtra ! trends manager: tracers 26 ! 28 27 USE in_out_manager ! I/O manager 29 28 USE prtctl ! Print control … … 32 31 USE wrk_nemo ! Memory allocation 33 32 USE timing ! Timing 34 35 33 36 34 IMPLICIT NONE … … 47 45 # include "vectopt_loop_substitute.h90" 48 46 !!---------------------------------------------------------------------- 49 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)47 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 50 48 !! $Id$ 51 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 96 94 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk) 97 95 END DO 98 CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt ) 99 CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_zdf, ztrds ) 96 CALL lbc_lnk( ztrdt, 'T', 1. ) 97 CALL lbc_lnk( ztrds, 'T', 1. ) 98 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) 99 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds ) 100 100 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 101 101 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r3294 r4896 74 74 !! Idem for di(s) and dj(s) 75 75 !! 76 !! For rho, we call eos _insitu_2d which will compute rd~(t~,s~) at77 !! the good depth zh from interpolated T and S for the different78 !! formulationof the equation of state (eos).76 !! For rho, we call eos which will compute rd~(t~,s~) at the right 77 !! depth zh from interpolated T and S for the different formulations 78 !! of the equation of state (eos). 79 79 !! Gradient formulation for rho : 80 !! di(rho) = rd~ - rd(i,j,k) orrd(i+1,j,k) - rd~80 !! di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ 81 81 !! 82 82 !! ** Action : - pgtu, pgtv: horizontal gradient of tracer at u- & v-points 83 83 !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 84 84 !!---------------------------------------------------------------------- 85 !86 85 INTEGER , INTENT(in ) :: kt ! ocean time-step index 87 86 INTEGER , INTENT(in ) :: kjpt ! number of tracers 88 87 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 89 88 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 90 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields91 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad. of prd at u- & v-pts89 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 90 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad. of prd at u- & v-pts 92 91 ! 93 92 INTEGER :: ji, jj, jn ! Dummy loop indices 94 93 INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points 95 94 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 96 REAL(wp), POINTER, DIMENSION(:,: ) :: zri, zrj, zhi, zhj97 REAL(wp), POINTER, DIMENSION(:,:,:) :: zti, ztj ! interpolated value of tracer95 REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos 96 REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! 98 97 !!---------------------------------------------------------------------- 99 98 ! 100 99 IF( nn_timing == 1 ) CALL timing_start( 'zps_hde') 101 100 ! 102 CALL wrk_alloc( jpi, jpj, zri, zrj, zhi, zhj )103 CALL wrk_alloc( jpi, jpj, kjpt, zti, ztj )104 !105 101 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 106 102 ! 107 # if defined key_vectopt_loop108 jj = 1109 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled)110 # else111 103 DO jj = 1, jpjm1 112 104 DO ji = 1, jpim1 113 # endif114 105 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 115 106 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 … … 121 112 zmaxu = ze3wu / fse3w(ji+1,jj,iku) 122 113 ! interpolated values of tracers 123 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )114 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 124 115 ! gradient of tracers 125 116 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) … … 127 118 zmaxu = -ze3wu / fse3w(ji,jj,iku) 128 119 ! interpolated values of tracers 129 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )120 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 130 121 ! gradient of tracers 131 122 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) … … 136 127 zmaxv = ze3wv / fse3w(ji,jj+1,ikv) 137 128 ! interpolated values of tracers 138 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )129 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 139 130 ! gradient of tracers 140 131 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) … … 142 133 zmaxv = -ze3wv / fse3w(ji,jj,ikv) 143 134 ! interpolated values of tracers 144 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )135 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 145 136 ! gradient of tracers 146 137 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 147 138 ENDIF 148 # if ! defined key_vectopt_loop149 139 END DO 150 # endif151 140 END DO 152 141 CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond. … … 156 145 ! horizontal derivative of density anomalies (rd) 157 146 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 158 # if defined key_vectopt_loop159 jj = 1160 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled)161 # else162 147 DO jj = 1, jpjm1 163 148 DO ji = 1, jpim1 164 # endif165 149 iku = mbku(ji,jj) 166 150 ikv = mbkv(ji,jj) … … 173 157 ELSE ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) ! - - case 2 174 158 ENDIF 175 # if ! defined key_vectopt_loop176 159 END DO 177 # endif178 160 END DO 179 161 … … 184 166 185 167 ! Gradient of density at the last level 186 # if defined key_vectopt_loop187 jj = 1188 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled)189 # else190 168 DO jj = 1, jpjm1 191 169 DO ji = 1, jpim1 192 # endif193 170 iku = mbku(ji,jj) 194 171 ikv = mbkv(ji,jj) 195 172 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 196 173 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 197 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1198 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2174 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 175 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 199 176 ENDIF 200 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1201 ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2177 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 178 ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 202 179 ENDIF 203 # if ! defined key_vectopt_loop204 180 END DO 205 # endif206 181 END DO 207 182 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions 208 183 ! 209 184 END IF 210 !211 CALL wrk_dealloc( jpi, jpj, zri, zrj, zhi, zhj )212 CALL wrk_dealloc( jpi, jpj, kjpt, zti, ztj )213 185 ! 214 186 IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde') -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r3632 r4896 2 2 !!====================================================================== 3 3 !! *** MODULE trdtra *** 4 !! Ocean diagnostics: ocean tracers trends 4 !! Ocean diagnostics: ocean tracers trends pre-processing 5 5 !!===================================================================== 6 !! History : 1.0 ! 2004-08 (C. Talandier) Original code 7 !! 2.0 ! 2005-04 (C. Deltel) Add Asselin trend in the ML budget 8 !! 3.3 ! 2010-06 (C. Ethe) merge TRA-TRC 9 !!---------------------------------------------------------------------- 10 #if defined key_trdtra || defined key_trdtrc || defined key_trdmld || defined key_trdmld_trc 11 !!---------------------------------------------------------------------- 12 !! trd_tra : Call the trend to be computed 13 !!---------------------------------------------------------------------- 14 USE dom_oce ! ocean domain 15 USE trdmod_oce ! ocean active mixed layer tracers trends 16 USE trdmod ! ocean active mixed layer tracers trends 17 USE trdmod_trc ! ocean passive mixed layer tracers trends 18 USE in_out_manager ! I/O manager 19 USE lib_mpp ! MPP library 20 USE wrk_nemo ! Memory allocation 21 6 !! History : 3.3 ! 2010-06 (C. Ethe) creation for the TRA/TRC merge 7 !! 3.5 ! 2012-02 (G. Madec) update the comments 8 !!---------------------------------------------------------------------- 9 10 !!---------------------------------------------------------------------- 11 !! trd_tra : pre-process the tracer trends 12 !! trd_tra_adv : transform a div(U.T) trend into a U.grad(T) trend 13 !! trd_tra_mng : tracer trend manager: dispatch to the diagnostic modules 14 !! trd_tra_iom : output 3D tracer trends using IOM 15 !!---------------------------------------------------------------------- 16 USE oce ! ocean dynamics and tracers variables 17 USE dom_oce ! ocean domain 18 USE sbc_oce ! surface boundary condition: ocean 19 USE zdf_oce ! ocean vertical physics 20 USE trd_oce ! trends: ocean variables 21 USE trdtrc ! ocean passive mixed layer tracers trends 22 USE trdglo ! trends: global domain averaged 23 USE trdpen ! trends: Potential ENergy 24 USE trdmxl ! ocean active mixed layer tracers trends 25 USE ldftra_oce ! ocean active tracers lateral physics 26 USE zdfddm ! vertical physics: double diffusion 27 USE phycst ! physical constants 28 USE in_out_manager ! I/O manager 29 USE iom ! I/O manager library 30 USE lib_mpp ! MPP library 31 USE wrk_nemo ! Memory allocation 22 32 23 33 IMPLICIT NONE 24 34 PRIVATE 25 35 26 PUBLIC trd_tra ! called by all traXX modules 27 28 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt !: 36 PUBLIC trd_tra ! called by all tra_... modules 37 38 REAL(wp) :: r2dt ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 39 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt ! use to store the temperature trends 29 41 30 42 !! * Substitutions 31 43 # include "domzgr_substitute.h90" 44 # include "zdfddm_substitute.h90" 32 45 # include "vectopt_loop_substitute.h90" 33 46 !!---------------------------------------------------------------------- 34 !! NEMO/OPA 4.0 , NEMO Consortium (2011)47 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 35 48 !! $Id$ 36 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 39 52 40 53 INTEGER FUNCTION trd_tra_alloc() 41 !!--------------------------------------------------------------------- -------54 !!--------------------------------------------------------------------- 42 55 !! *** FUNCTION trd_tra_alloc *** 43 !!--------------------------------------------------------------------- -------56 !!--------------------------------------------------------------------- 44 57 ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc ) 45 58 ! … … 53 66 !! *** ROUTINE trd_tra *** 54 67 !! 55 !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or 56 !! integral constraints 68 !! ** Purpose : pre-process tracer trends 57 69 !! 58 !! ** Method /usage : For the mixed-layer trend, the control surface can be either59 !! a mixed layer depth (time varying) or a fixed surface (jk level or bowl).60 !! Choose control surface with nn_ctls in namelist NAMTRD :61 !! nn_ctls = 0 : use mixed layer with density criterion62 !! nn_ctls = 1 : read index from file 'ctlsurf_idx'63 !! nn_ctls > 1 : use fixed level surface jk = nn_ctls64 !!---------------------------------------------------------------------- 65 !66 INTEGER , INTENT(in) :: kt ! time step67 CHARACTER(len=3) , INTENT(in) :: ctype ! tracers trends type 'TRA'/'TRC'68 INTEGER , INTENT(in) :: ktra ! tracerindex69 INTEGER , INTENT(in) :: ktrd ! tracer trend index70 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrd ! tracer trend or flux71 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pun ! velocity72 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! Tracer variablea73 !74 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrds75 !!---------------------------------------------------------------------- 76 70 !! ** Method : - mask the trend 71 !! - advection (ptra present) converte the incoming flux (U.T) 72 !! into trend (U.T => -U.grat(T)=div(U.T)-T.div(U)) through a 73 !! call to trd_tra_adv 74 !! - 'TRA' case : regroup T & S trends 75 !! - send the trends to trd_tra_mng (trdtrc) for further processing 76 !!---------------------------------------------------------------------- 77 INTEGER , INTENT(in) :: kt ! time step 78 CHARACTER(len=3) , INTENT(in) :: ctype ! tracers trends type 'TRA'/'TRC' 79 INTEGER , INTENT(in) :: ktra ! tracer index 80 INTEGER , INTENT(in) :: ktrd ! tracer trend index 81 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrd ! tracer trend or flux 82 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pun ! now velocity 83 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable 84 ! 85 INTEGER :: jk ! loop indices 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwt, zws, ztrdt, ztrds ! 3D workspace 87 !!---------------------------------------------------------------------- 88 ! 77 89 CALL wrk_alloc( jpi, jpj, jpk, ztrds ) 78 79 IF( .NOT. ALLOCATED( trdtx ) ) THEN 90 ! 91 IF( .NOT. ALLOCATED( trdtx ) ) THEN ! allocate trdtra arrays 80 92 IF( trd_tra_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 81 93 ENDIF 82 83 ! Control of optional arguments 84 IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN 85 IF( PRESENT( ptra ) ) THEN 86 SELECT CASE( ktrd ) ! shift depending on the direction 87 CASE( jptra_trd_xad ) ; CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 88 CASE( jptra_trd_yad ) ; CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 89 CASE( jptra_trd_zad ) ; CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt ) 90 END SELECT 91 ELSE 92 trdt(:,:,:) = ptrd(:,:,:) 93 IF( ktrd == jptra_trd_bbc .OR. ktrd == jptra_trd_qsr ) THEN 94 ztrds(:,:,:) = 0. 95 CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) 96 END IF 97 END IF 98 END IF 99 100 IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN 101 IF( PRESENT( ptra ) ) THEN 102 SELECT CASE( ktrd ) ! shift depending on the direction 103 CASE( jptra_trd_xad ) 104 CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 105 CALL trd_mod( trdtx, ztrds, ktrd, ctype, kt ) 106 CASE( jptra_trd_yad ) 107 CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 108 CALL trd_mod( trdty, ztrds, ktrd, ctype, kt ) 109 CASE( jptra_trd_zad ) 110 CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 111 CALL trd_mod( trdt , ztrds, ktrd, ctype, kt ) 112 END SELECT 113 ELSE 114 ztrds(:,:,:) = ptrd(:,:,:) 115 CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) 116 END IF 117 END IF 118 119 IF( ctype == 'TRC' ) THEN 120 ! 121 IF( PRESENT( ptra ) ) THEN 122 SELECT CASE( ktrd ) ! shift depending on the direction 123 CASE( jptra_trd_xad ) 124 CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 125 CALL trd_mod_trc( ztrds, ktra, ktrd, kt ) 126 CASE( jptra_trd_yad ) 127 CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 128 CALL trd_mod_trc( ztrds, ktra, ktrd, kt ) 129 CASE( jptra_trd_zad ) 130 CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 131 CALL trd_mod_trc( ztrds, ktra, ktrd, kt ) 132 END SELECT 133 ELSE 134 ztrds(:,:,:) = ptrd(:,:,:) 135 CALL trd_mod_trc( ztrds, ktra, ktrd, kt ) 136 END IF 94 95 IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN !== Temperature trend ==! 96 ! 97 SELECT CASE( ktrd ) 98 ! ! advection: transform the advective flux into a trend 99 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 100 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 101 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt ) 102 CASE( jptra_bbc, & ! qsr, bbc: on temperature only, send to trd_tra_mng 103 & jptra_qsr ) ; trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 104 ztrds(:,:,:) = 0._wp 105 CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 106 CASE DEFAULT ! other trends: masked trends 107 trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) ! mask & store 108 END SELECT 109 ! 110 ENDIF 111 112 IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN !== Salinity trends ==! 113 ! 114 SELECT CASE( ktrd ) 115 ! ! advection: transform the advective flux into a trend 116 ! ! and send T & S trends to trd_tra_mng 117 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'X' , ztrds ) 118 CALL trd_tra_mng( trdtx, ztrds, ktrd, kt ) 119 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'Y' , ztrds ) 120 CALL trd_tra_mng( trdty, ztrds, ktrd, kt ) 121 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'Z' , ztrds ) 122 CALL trd_tra_mng( trdt , ztrds, ktrd, kt ) 123 CASE( jptra_zdfp ) ! diagnose the "PURE" Kz trend (here: just before the swap) 124 ! ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" 125 CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 126 ! 127 zwt(:,:, 1 ) = 0._wp ; zws(:,:, 1 ) = 0._wp ! vertical diffusive fluxes 128 zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp 129 DO jk = 2, jpk 130 zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 131 zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 132 END DO 133 ! 134 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 135 DO jk = 1, jpkm1 136 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 137 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk) 138 END DO 139 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt ) 140 ! 141 CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 142 ! 143 CASE DEFAULT ! other trends: mask and send T & S trends to trd_tra_mng 144 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 145 CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 146 END SELECT 147 ENDIF 148 149 IF( ctype == 'TRC' ) THEN !== passive tracer trend ==! 150 ! 151 SELECT CASE( ktrd ) 152 ! ! advection: transform the advective flux into a masked trend 153 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'X', ztrds ) 154 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds ) 155 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds ) 156 CASE DEFAULT ! other trends: just masked 157 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 158 END SELECT 159 ! ! send trend to trd_trc 160 CALL trd_trc( ztrds, ktra, ktrd, kt ) 137 161 ! 138 162 ENDIF … … 147 171 !! *** ROUTINE trd_tra_adv *** 148 172 !! 149 !! ** Purpose : transformed the i-, j- or k-advective flux into thes 150 !! i-, j- or k-advective trends, resp. 151 !! ** Method : i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] ) 152 !! k-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] ) 153 !! k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] ) 154 !!---------------------------------------------------------------------- 155 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pf ! advective flux in one direction 156 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun ! now velocity in one direction 157 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: ptn ! now or before tracer 158 CHARACTER(len=1), INTENT(in ) :: cdir ! X/Y/Z direction 159 REAL(wp) , INTENT(out), DIMENSION(jpi,jpj,jpk) :: ptrd ! advective trend in one direction 173 !! ** Purpose : transformed a advective flux into a masked advective trends 174 !! 175 !! ** Method : use the following transformation: -div(U.T) = - U grad(T) + T.div(U) 176 !! i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] ) 177 !! j-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] ) 178 !! k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] ) 179 !! where fi is the incoming advective flux. 180 !!---------------------------------------------------------------------- 181 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pf ! advective flux in one direction 182 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pun ! now velocity in one direction 183 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: ptn ! now or before tracer 184 CHARACTER(len=1) , INTENT(in ) :: cdir ! X/Y/Z direction 185 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: ptrd ! advective trend in one direction 160 186 ! 161 187 INTEGER :: ji, jj, jk ! dummy loop indices 162 INTEGER :: ii, ij, ik ! index shift function of the direction 163 REAL(wp) :: zbtr ! local scalar 164 !!---------------------------------------------------------------------- 165 166 SELECT CASE( cdir ) ! shift depending on the direction 167 CASE( 'X' ) ; ii = 1 ; ij = 0 ; ik = 0 ! i-advective trend 168 CASE( 'Y' ) ; ii = 0 ; ij = 1 ; ik = 0 ! j-advective trend 169 CASE( 'Z' ) ; ii = 0 ; ij = 0 ; ik =-1 ! k-advective trend 188 INTEGER :: ii, ij, ik ! index shift as function of the direction 189 !!---------------------------------------------------------------------- 190 ! 191 SELECT CASE( cdir ) ! shift depending on the direction 192 CASE( 'X' ) ; ii = 1 ; ij = 0 ; ik = 0 ! i-trend 193 CASE( 'Y' ) ; ii = 0 ; ij = 1 ; ik = 0 ! j-trend 194 CASE( 'Z' ) ; ii = 0 ; ij = 0 ; ik =-1 ! k-trend 170 195 END SELECT 171 172 ! ! set to zero uncomputed values 173 ptrd(jpi,:,:) = 0.e0 ; ptrd(1,:,:) = 0.e0 174 ptrd(:,jpj,:) = 0.e0 ; ptrd(:,1,:) = 0.e0 175 ptrd(:,:,jpk) = 0.e0 176 ! 177 ! 178 DO jk = 1, jpkm1 196 ! 197 ! ! set to zero uncomputed values 198 ptrd(jpi,:,:) = 0._wp ; ptrd(1,:,:) = 0._wp 199 ptrd(:,jpj,:) = 0._wp ; ptrd(:,1,:) = 0._wp 200 ptrd(:,:,jpk) = 0._wp 201 ! 202 DO jk = 1, jpkm1 ! advective trend 179 203 DO jj = 2, jpjm1 180 204 DO ji = fs_2, fs_jpim1 ! vector opt. 181 zbtr = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )182 ptrd(ji,jj,jk) = - zbtr * ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)&183 & - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk))205 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 206 & - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk) ) & 207 & / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) 184 208 END DO 185 209 END DO … … 188 212 END SUBROUTINE trd_tra_adv 189 213 190 # else 191 !!---------------------------------------------------------------------- 192 !! Default case : Dummy module No trend diagnostics 193 !!---------------------------------------------------------------------- 194 USE par_oce ! ocean variables trends 195 CONTAINS 196 SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra ) 197 !!---------------------------------------------------------------------- 198 INTEGER , INTENT(in) :: kt ! time step 199 CHARACTER(len=3) , INTENT(in) :: ctype ! tracers trends type 'TRA'/'TRC' 200 INTEGER , INTENT(in) :: ktra ! tracer index 201 INTEGER , INTENT(in) :: ktrd ! tracer trend index 202 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrd ! tracer trend 203 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu ! velocity 204 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! Tracer variable 205 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1), & 206 & ktrd, ktra, ctype, kt 207 END SUBROUTINE trd_tra 208 # endif 214 215 SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt ) 216 !!--------------------------------------------------------------------- 217 !! *** ROUTINE trd_tra_mng *** 218 !! 219 !! ** Purpose : Dispatch all tracer trends computation, e.g. 3D output, 220 !! integral constraints, potential energy, and/or 221 !! mixed layer budget. 222 !!---------------------------------------------------------------------- 223 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend 224 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend 225 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 226 INTEGER , INTENT(in ) :: kt ! time step 227 !!---------------------------------------------------------------------- 228 229 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restart with Euler time stepping) 230 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdttra (leapfrog) 231 ENDIF 232 233 ! ! 3D output of tracers trends using IOM interface 234 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt ) 235 236 ! ! Integral Constraints Properties for tracers trends !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 237 IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt ) 238 239 ! ! Potential ENergy trends 240 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt ) 241 242 ! ! Mixed layer trends for active tracers 243 IF( ln_tra_mxl ) THEN 244 !----------------------------------------------------------------------------------------------- 245 ! W.A.R.N.I.N.G : 246 ! jptra_ldf : called by traldf.F90 247 ! at this stage we store: 248 ! - the lateral geopotential diffusion (here, lateral = horizontal) 249 ! - and the iso-neutral diffusion if activated 250 ! jptra_zdf : called by trazdf.F90 251 ! * in case of iso-neutral diffusion we store the vertical diffusion component in the 252 ! lateral trend including the K_z contrib, which will be removed later (see trd_mxl) 253 !----------------------------------------------------------------------------------------------- 254 255 SELECT CASE ( ktrd ) 256 CASE ( jptra_xad ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_xad, '3D' ) ! zonal advection 257 CASE ( jptra_yad ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_yad, '3D' ) ! merid. advection 258 CASE ( jptra_zad ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_zad, '3D' ) ! vertical advection 259 CASE ( jptra_ldf ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_ldf, '3D' ) ! lateral diffusion 260 CASE ( jptra_bbl ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_bbl, '3D' ) ! bottom boundary layer 261 CASE ( jptra_zdf ) 262 IF( ln_traldf_iso ) THEN ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_ldf, '3D' ) ! lateral diffusion (K_z) 263 ELSE ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_zdf, '3D' ) ! vertical diffusion (K_z) 264 ENDIF 265 CASE ( jptra_dmp ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_dmp, '3D' ) ! internal 3D restoring (tradmp) 266 CASE ( jptra_qsr ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_for, '3D' ) ! air-sea : penetrative sol radiat 267 CASE ( jptra_nsr ) ; ptrdx(:,:,2:jpk) = 0._wp ; ptrdy(:,:,2:jpk) = 0._wp 268 CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_for, '2D' ) ! air-sea : non penetr sol radiation 269 CASE ( jptra_bbc ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_bbc, '3D' ) ! bottom bound cond (geoth flux) 270 CASE ( jptra_npc ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_npc, '3D' ) ! non penetr convect adjustment 271 CASE ( jptra_atf ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_atf, '3D' ) ! asselin time filter (last trend) 272 ! 273 CALL trd_mxl( kt, r2dt ) ! trends: Mixed-layer (output) 274 END SELECT 275 ! 276 ENDIF 277 ! 278 END SUBROUTINE trd_tra_mng 279 280 281 SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt ) 282 !!--------------------------------------------------------------------- 283 !! *** ROUTINE trd_tra_iom *** 284 !! 285 !! ** Purpose : output 3D tracer trends using IOM 286 !!---------------------------------------------------------------------- 287 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend 288 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend 289 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 290 INTEGER , INTENT(in ) :: kt ! time step 291 !! 292 INTEGER :: ji, jj, jk ! dummy loop indices 293 INTEGER :: ikbu, ikbv ! local integers 294 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace 295 !!---------------------------------------------------------------------- 296 ! 297 !!gm Rq: mask the trends already masked in trd_tra, but lbc_lnk should probably be added 298 ! 299 SELECT CASE( ktrd ) 300 CASE( jptra_xad ) ; CALL iom_put( "ttrd_xad" , ptrdx ) ! x- horizontal advection 301 CALL iom_put( "strd_xad" , ptrdy ) 302 CASE( jptra_yad ) ; CALL iom_put( "ttrd_yad" , ptrdx ) ! y- horizontal advection 303 CALL iom_put( "strd_yad" , ptrdy ) 304 CASE( jptra_zad ) ; CALL iom_put( "ttrd_zad" , ptrdx ) ! z- vertical advection 305 CALL iom_put( "strd_zad" , ptrdy ) 306 IF( .NOT. lk_vvl ) THEN ! cst volume : adv flux through z=0 surface 307 CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 308 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 309 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 310 CALL iom_put( "ttrd_sad", z2dx ) 311 CALL iom_put( "strd_sad", z2dy ) 312 CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 313 ENDIF 314 CASE( jptra_ldf ) ; CALL iom_put( "ttrd_ldf" , ptrdx ) ! lateral diffusion 315 CALL iom_put( "strd_ldf" , ptrdy ) 316 CASE( jptra_zdf ) ; CALL iom_put( "ttrd_zdf" , ptrdx ) ! vertical diffusion (including Kz contribution) 317 CALL iom_put( "strd_zdf" , ptrdy ) 318 CASE( jptra_zdfp ) ; CALL iom_put( "ttrd_zdfp", ptrdx ) ! PURE vertical diffusion (no isoneutral contribution) 319 CALL iom_put( "strd_zdfp", ptrdy ) 320 CASE( jptra_dmp ) ; CALL iom_put( "ttrd_dmp" , ptrdx ) ! internal restoring (damping) 321 CALL iom_put( "strd_dmp" , ptrdy ) 322 CASE( jptra_bbl ) ; CALL iom_put( "ttrd_bbl" , ptrdx ) ! bottom boundary layer 323 CALL iom_put( "strd_bbl" , ptrdy ) 324 CASE( jptra_npc ) ; CALL iom_put( "ttrd_npc" , ptrdx ) ! static instability mixing 325 CALL iom_put( "strd_npc" , ptrdy ) 326 CASE( jptra_nsr ) ; CALL iom_put( "ttrd_qns" , ptrdx ) ! surface forcing + runoff (ln_rnf=T) 327 CALL iom_put( "strd_cdt" , ptrdy ) 328 CASE( jptra_qsr ) ; CALL iom_put( "ttrd_qsr" , ptrdx ) ! penetrative solar radiat. (only on temperature) 329 CASE( jptra_bbc ) ; CALL iom_put( "ttrd_bbc" , ptrdx ) ! geothermal heating (only on temperature) 330 CASE( jptra_atf ) ; CALL iom_put( "ttrd_atf" , ptrdx ) ! asselin time Filter 331 CALL iom_put( "strd_atf" , ptrdy ) 332 END SELECT 333 ! 334 END SUBROUTINE trd_tra_iom 335 209 336 !!====================================================================== 210 337 END MODULE trdtra -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
r3294 r4896 4 4 !! Ocean diagnostics: momentum trends 5 5 !!===================================================================== 6 !! History : 1.0 ! 04-2006 (L. Brunier, A-M. Treguier) Original code 7 !! 2.0 ! 04-2008 (C. Talandier) New trends organization 6 !! History : 1.0 ! 2006-01 (L. Brunier, A-M. Treguier) Original code 7 !! 2.0 ! 2008-04 (C. Talandier) New trends organization 8 !! 3.5 ! 2012-02 (G. Madec) regroup beta.V computation with pvo trend 8 9 !!---------------------------------------------------------------------- 9 #if defined key_trdvor || defined key_esopa 10 !!---------------------------------------------------------------------- 11 !! 'key_trdvor' : momentum trend diagnostics 10 12 11 !!---------------------------------------------------------------------- 13 12 !! trd_vor : momentum trends averaged over the depth … … 17 16 USE oce ! ocean dynamics and tracers variables 18 17 USE dom_oce ! ocean space and time domain variables 19 USE trd mod_oce ! ocean variables trends18 USE trd_oce ! trends: ocean variables 20 19 USE zdf_oce ! ocean vertical physics 21 USE in_out_manager ! I/O manager20 USE sbc_oce ! surface boundary condition: ocean 22 21 USE phycst ! Define parameters for the routines 23 22 USE ldfdyn_oce ! ocean active tracers: lateral physics 24 23 USE dianam ! build the name of file (routine) 25 24 USE zdfmxl ! mixed layer depth 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE in_out_manager ! I/O manager 26 27 USE ioipsl ! NetCDF library 27 USE lbclnk ! ocean lateral boundary conditions (or mpp link)28 28 USE lib_mpp ! MPP library 29 29 USE wrk_nemo ! Memory allocation 30 31 30 32 31 IMPLICIT NONE … … 37 36 END INTERFACE 38 37 39 PUBLIC trd_vor ! routine called by step.F90 40 PUBLIC trd_vor_zint ! routine called by dynamics routines 38 PUBLIC trd_vor ! routine called by trddyn.F90 41 39 PUBLIC trd_vor_init ! routine called by opa.F90 42 40 PUBLIC trd_vor_alloc ! routine called by nemogcm.F90 … … 80 78 IF( trd_vor_alloc /= 0 ) CALL ctl_warn('trd_vor_alloc: failed to allocate arrays') 81 79 END FUNCTION trd_vor_alloc 80 81 82 SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt ) 83 !!---------------------------------------------------------------------- 84 !! *** ROUTINE trd_vor *** 85 !! 86 !! ** Purpose : computation of cumulated trends over analysis period 87 !! and make outputs (NetCDF or DIMG format) 88 !!---------------------------------------------------------------------- 89 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends 90 INTEGER , INTENT(in ) :: ktrd ! trend index 91 INTEGER , INTENT(in ) :: kt ! time step 92 ! 93 INTEGER :: ji, jj ! dummy loop indices 94 REAL(wp), POINTER, DIMENSION(:,:) :: ztswu, ztswv ! 2D workspace 95 !!---------------------------------------------------------------------- 96 97 CALL wrk_alloc( jpi, jpj, ztswu, ztswv ) 98 99 SELECT CASE( ktrd ) 100 CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg ) ! Hydrostatique Pressure Gradient 101 CASE( jpdyn_keg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_keg ) ! KE Gradient 102 CASE( jpdyn_rvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo ) ! Relative Vorticity 103 CASE( jpdyn_pvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo ) ! Planetary Vorticity Term 104 CASE( jpdyn_ldf ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf ) ! Horizontal Diffusion 105 CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad ) ! Vertical Advection 106 CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg ) ! Surface Pressure Grad. 107 CASE( jpdyn_zdf ) ! Vertical Diffusion 108 ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0 109 DO jj = 2, jpjm1 ! wind stress trends 110 DO ji = fs_2, fs_jpim1 ! vector opt. 111 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 ) 112 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 ) 113 END DO 114 END DO 115 ! 116 CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf ) ! zdf trend including surf./bot. stresses 117 CALL trd_vor_zint( ztswu, ztswv, jpvor_swf ) ! surface wind stress 118 CASE( jpdyn_bfr ) 119 CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr ) ! Bottom stress 120 ! 121 CASE( jpdyn_atf ) ! last trends: perform the output of 2D vorticity trends 122 CALL trd_vor_iom( kt ) 123 END SELECT 124 ! 125 CALL wrk_dealloc( jpi, jpj, ztswu, ztswv ) 126 ! 127 END SUBROUTINE trd_vor 82 128 83 129 … … 109 155 !! trends output in netCDF format using ioipsl 110 156 !!---------------------------------------------------------------------- 111 !112 157 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 113 158 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: putrdvor ! u vorticity trend … … 131 176 ! ===================================== 132 177 133 SELECT CASE (ktrd)134 ! 135 CASE (jpvor_bfr) ! bottom friction178 SELECT CASE( ktrd ) 179 ! 180 CASE( jpvor_bfr ) ! bottom friction 136 181 DO jj = 2, jpjm1 137 182 DO ji = fs_2, fs_jpim1 … … 143 188 END DO 144 189 ! 145 CASE (jpvor_swf) ! wind stress190 CASE( jpvor_swf ) ! wind stress 146 191 zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1) 147 192 zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1) … … 154 199 155 200 ! Curl 156 DO ji =1,jpim1157 DO jj =1,jpjm1201 DO ji = 1, jpim1 202 DO jj = 1, jpjm1 158 203 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 159 204 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) … … 229 274 END DO 230 275 231 ! Save Beta.V term to avoid average before Curl232 ! Beta.V : intergration, noaverage233 IF( ktrd == jpvor_ bev) THEN276 ! Planetary vorticity: 2nd computation (Beta.V term) store the vertical sum 277 ! as Beta.V term need intergration, not average 278 IF( ktrd == jpvor_pvo ) THEN 234 279 zubet(:,:) = zudpvor(:,:) 235 280 zvbet(:,:) = zvdpvor(:,:) 236 ENDIF 237 238 ! Average except for Beta.V 281 DO ji = 1, jpim1 282 DO jj = 1, jpjm1 283 vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) & 284 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 285 END DO 286 END DO 287 ! Average of the Curl and Surface mask 288 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) * fmask(:,:,1) 289 ENDIF 290 ! 291 ! Average 239 292 zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 240 293 zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 241 294 ! 242 295 ! Curl 243 296 DO ji=1,jpim1 … … 247 300 END DO 248 301 END DO 249 250 302 ! Surface mask 251 303 vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) 252 253 ! Special treatement for the Beta.V term254 ! Compute the Curl of the Beta.V term which is not averaged255 IF( ktrd == jpvor_bev ) THEN256 DO ji=1,jpim1257 DO jj=1,jpjm1258 vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) &259 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) )260 END DO261 END DO262 263 ! Average on the Curl264 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:)265 266 ! Surface mask267 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * fmask(:,:,1)268 ENDIF269 304 270 305 IF( ndebug /= 0 ) THEN … … 278 313 279 314 280 SUBROUTINE trd_vor ( kt )315 SUBROUTINE trd_vor_iom( kt ) 281 316 !!---------------------------------------------------------------------- 282 317 !! *** ROUTINE trd_vor *** … … 285 320 !! and make outputs (NetCDF or DIMG format) 286 321 !!---------------------------------------------------------------------- 287 ! 288 INTEGER, INTENT(in) :: kt ! ocean time-step index 322 INTEGER , INTENT(in ) :: kt ! time step 289 323 ! 290 324 INTEGER :: ji, jj, jk, jl ! dummy loop indices … … 305 339 306 340 IF( kt > nit000 ) vor_avrb(:,:) = vor_avr(:,:) 307 308 IF( ndebug /= 0 ) THEN309 WRITE(numout,*) ' debuging trd_vor: I.1 done '310 CALL FLUSH(numout)311 ENDIF312 341 313 342 ! I.2 vertically integrated vorticity … … 330 359 331 360 ! Curl 332 DO ji =1,jpim1333 DO jj =1,jpjm1361 DO ji = 1, jpim1 362 DO jj = 1, jpjm1 334 363 vor_avr(ji,jj) = ( ( zvn(ji+1,jj) - zvn(ji,jj) ) & 335 364 & - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) … … 337 366 END DO 338 367 339 IF( ndebug /= 0 ) THEN340 WRITE(numout,*) ' debuging trd_vor: I.2 done'341 CALL FLUSH(numout)342 ENDIF343 344 368 ! ================================= 345 369 ! II. Cumulated trends … … 351 375 vor_avrbb(:,:) = vor_avrb(:,:) 352 376 vor_avrbn(:,:) = vor_avr (:,:) 353 ENDIF354 355 IF( ndebug /= 0 ) THEN356 WRITE(numout,*) ' debuging trd_vor: I1.1 done'357 CALL FLUSH(numout)358 377 ENDIF 359 378 … … 371 390 ENDIF 372 391 373 IF( ndebug /= 0 ) THEN374 WRITE(numout,*) ' debuging trd_vor: II.2 done'375 CALL FLUSH(numout)376 ENDIF377 378 392 ! ============================================= 379 393 ! III. Output in netCDF + residual computation … … 391 405 vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean 392 406 393 IF( ndebug /= 0 ) THEN394 WRITE(numout,*) ' zmean = ',zmean395 WRITE(numout,*) ' debuging trd_vor: III.1 done'396 CALL FLUSH(numout)397 ENDIF398 407 399 408 ! III.2 compute residual … … 406 415 CALL lbc_lnk( vor_avrres, 'F', 1. ) 407 416 408 IF( ndebug /= 0 ) THEN409 WRITE(numout,*) ' debuging trd_vor: III.2 done'410 CALL FLUSH(numout)411 ENDIF412 417 413 418 ! III.3 time evolution array swap … … 415 420 vor_avrbb(:,:) = vor_avrb(:,:) 416 421 vor_avrbn(:,:) = vor_avr (:,:) 417 418 IF( ndebug /= 0 ) THEN419 WRITE(numout,*) ' debuging trd_vor: III.3 done'420 CALL FLUSH(numout)421 ENDIF422 422 ! 423 423 nmoydpvor = 0 … … 463 463 CALL wrk_dealloc( jpi, jpj, zun, zvn ) 464 464 ! 465 END SUBROUTINE trd_vor 465 END SUBROUTINE trd_vor_iom 466 466 467 467 … … 587 587 END SUBROUTINE trd_vor_init 588 588 589 #else590 !!----------------------------------------------------------------------591 !! Default option : Empty module592 !!----------------------------------------------------------------------593 INTERFACE trd_vor_zint594 MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d595 END INTERFACE596 CONTAINS597 SUBROUTINE trd_vor( kt ) ! Empty routine598 WRITE(*,*) 'trd_vor: You should not have seen this print! error?', kt599 END SUBROUTINE trd_vor600 SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )601 REAL, DIMENSION(:,:), INTENT( inout ) :: putrdvor, pvtrdvor602 INTEGER, INTENT( in ) :: ktrd ! ocean trend index603 WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1), pvtrdvor(1,1), ktrd604 END SUBROUTINE trd_vor_zint_2d605 SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )606 REAL, DIMENSION(:,:,:), INTENT( inout ) :: putrdvor, pvtrdvor607 INTEGER, INTENT( in ) :: ktrd ! ocean trend index608 WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1), pvtrdvor(1,1,1), ktrd609 END SUBROUTINE trd_vor_zint_3d610 SUBROUTINE trd_vor_init ! Empty routine611 WRITE(*,*) 'trd_vor_init: You should not have seen this print! error?'612 END SUBROUTINE trd_vor_init613 #endif614 589 !!====================================================================== 615 590 END MODULE trdvor -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90
r2715 r4896 4 4 !! Ocean trends : set vorticity trend variables 5 5 !!====================================================================== 6 !! History : 9.0 ! 04-2006 (L. Brunier, A-M. Treguier) Original code6 !! History : 1.0 ! 04-2006 (L. Brunier, A-M. Treguier) Original code 7 7 !!---------------------------------------------------------------------- 8 9 !!---------------------------------------------------------------------- 8 10 9 USE par_oce ! ocean parameters 11 10 … … 13 12 PRIVATE 14 13 15 #if defined key_trdvor16 LOGICAL, PUBLIC, PARAMETER :: lk_trdvor = .TRUE. !: momentum trend flag17 #else18 LOGICAL, PUBLIC, PARAMETER :: lk_trdvor = .FALSE. !: momentum trend flag19 #endif20 14 ! !!* vorticity trends index 21 15 INTEGER, PUBLIC, PARAMETER :: jpltot_vor = 11 !: Number of vorticity trend terms -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r4381 r4896 105 105 IF ( ln_loglayer.AND.lk_vvl ) THEN ! "log layer" bottom friction coefficient 106 106 107 # if defined key_vectopt_loop108 DO jj = 1, 1109 !CDIR NOVERRCHK110 DO ji = 1, jpij ! vector opt. (forced unrolling)111 # else112 !CDIR NOVERRCHK113 107 DO jj = 1, jpj 114 !CDIR NOVERRCHK115 108 DO ji = 1, jpi 116 # endif117 109 ikbt = mbkt(ji,jj) 118 ! JC: possible WAD implementation should modify line below if layers vanish110 !! JC: possible WAD implementation should modify line below if layers vanish 119 111 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 120 112 zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp) … … 127 119 ENDIF 128 120 129 # if defined key_vectopt_loop130 DO jj = 1, 1131 !CDIR NOVERRCHK132 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)133 # else134 !CDIR NOVERRCHK135 121 DO jj = 2, jpjm1 136 !CDIR NOVERRCHK137 122 DO ji = 2, jpim1 138 # endif139 123 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 140 124 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) … … 152 136 END DO 153 137 END DO 154 155 138 ! 156 139 CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition … … 265 248 ! 266 249 IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all 267 # if defined key_vectopt_loop268 DO jj = 1, 1269 !CDIR NOVERRCHK270 DO ji = 1, jpij ! vector opt. (forced unrolling)271 # else272 !CDIR NOVERRCHK273 250 DO jj = 1, jpj 274 !CDIR NOVERRCHK275 251 DO ji = 1, jpi 276 # endif277 252 ikbt = mbkt(ji,jj) 278 253 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp … … 309 284 zmaxbfr = -1.e10_wp ! initialise tracker for maximum of bottom friction coefficient 310 285 ! 311 # if defined key_vectopt_loop312 DO jj = 1, 1313 !CDIR NOVERRCHK314 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)315 # else316 !CDIR NOVERRCHK317 286 DO jj = 2, jpjm1 318 !CDIR NOVERRCHK319 287 DO ji = 2, jpim1 320 # endif321 288 ikbu = mbku(ji,jj) ! deepest ocean level at u- and v-points 322 289 ikbv = mbkv(ji,jj) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r4147 r4896 6 6 !! History : OPA ! 2000-08 (G. Madec) double diffusive mixing 7 7 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 8 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 8 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 9 !! 3.6 ! 2013-04 (G. Madec, F. Roquet) zrau compute locally using interpolation of alpha & beta 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_zdfddm || defined key_esopa … … 18 19 USE dom_oce ! ocean space and time domain variables 19 20 USE zdf_oce ! ocean vertical physics variables 21 USE eosbn2 ! equation of state 22 ! 20 23 USE in_out_manager ! I/O manager 21 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 34 37 LOGICAL , PUBLIC, PARAMETER :: lk_zdfddm = .TRUE. !: double diffusive mixing flag 35 38 36 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avs !: salinity vertical diffusivity coeff. at w-point 37 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: rrau !: heat/salt buoyancy flux ratio 38 39 ! !!* Namelist namzdf_ddm : double diffusive mixing * 40 REAL(wp) :: rn_avts ! maximum value of avs for salt fingering 41 REAL(wp) :: rn_hsbfr ! heat/salt buoyancy flux ratio 39 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avs !: salinity vertical diffusivity coeff. at w-point 40 41 ! !!* Namelist namzdf_ddm : double diffusive mixing * 42 REAL(wp) :: rn_avts ! maximum value of avs for salt fingering 43 REAL(wp) :: rn_hsbfr ! heat/salt buoyancy flux ratio 42 44 43 45 !! * Substitutions 46 # include "domzgr_substitute.h90" 44 47 # include "vectopt_loop_substitute.h90" 45 48 !!---------------------------------------------------------------------- 46 !! NEMO/OPA 4.0 , NEMO Consortium (2011)49 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 47 50 !! $Id$ 48 51 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 54 57 !! *** ROUTINE zdf_ddm_alloc *** 55 58 !!---------------------------------------------------------------------- 56 ALLOCATE( avs(jpi,jpj,jpk), rrau(jpi,jpj,jpk), STAT= zdf_ddm_alloc ) 57 ! 59 ALLOCATE( avs(jpi,jpj,jpk) , STAT= zdf_ddm_alloc ) 58 60 IF( lk_mpp ) CALL mpp_sum ( zdf_ddm_alloc ) 59 61 IF( zdf_ddm_alloc /= 0 ) CALL ctl_warn('zdf_ddm_alloc: failed to allocate arrays') … … 71 73 !! diffusive mixing (i.e. salt fingering and diffusive layering) 72 74 !! following Merryfield et al. (1999). The rate of double diffusive 73 !! mixing depend on the buoyancy ratio: Rrau=alpha/beta dk[T]/dk[S] 74 !! which is computed in rn2.F 75 !! mixing depend on the buoyancy ratio (R=alpha/beta dk[T]/dk[S]): 75 76 !! * salt fingering (Schmitt 1981): 76 !! for R rau > 1 and rn2 > 0 : zavfs = rn_avts / ( 1 + (Rrau/rn_hsbfr)^6 )77 !! for R rau> 1 and rn2 > 0 : zavfs = O78 !! otherwise : zavft = 0.7 zavs / R rau77 !! for R > 1 and rn2 > 0 : zavfs = rn_avts / ( 1 + (R/rn_hsbfr)^6 ) 78 !! for R > 1 and rn2 > 0 : zavfs = O 79 !! otherwise : zavft = 0.7 zavs / R 79 80 !! * diffusive layering (Federov 1988): 80 !! for 0< Rrau < 1 and rn2 > 0 : zavdt = 1.3635e-6 81 !! * exp( 4.6 exp(-0.54 (1/Rrau-1) ) ) 81 !! for 0< R < 1 and N^2 > 0 : zavdt = 1.3635e-6 * exp( 4.6 exp(-0.54 (1/R-1) ) ) 82 82 !! otherwise : zavdt = 0 83 !! for .5 < R rau < 1 and rn2 > 0 : zavds = zavdt (1.885 Rrau-0.85)84 !! for 0 < R rau <.5 and rn2 > 0 : zavds = zavdt 0.15 Rrau83 !! for .5 < R < 1 and N^2 > 0 : zavds = zavdt (1.885 R -0.85) 84 !! for 0 < R <.5 and N^2 > 0 : zavds = zavdt 0.15 R 85 85 !! otherwise : zavds = 0 86 86 !! * update the eddy diffusivity: … … 96 96 ! 97 97 INTEGER :: ji, jj , jk ! dummy loop indices 98 REAL(wp) :: zinr, zrr ! temporary scalars 99 REAL(wp) :: zavft, zavfs ! - - 100 REAL(wp) :: zavdt, zavds ! - - 101 REAL(wp), POINTER, DIMENSION(:,:) :: zmsks, zmskf, zmskd1, zmskd2, zmskd3 98 REAL(wp) :: zaw, zbw, zrw ! local scalars 99 REAL(wp) :: zdt, zds 100 REAL(wp) :: zinr, zrr ! - - 101 REAL(wp) :: zavft, zavfs ! - - 102 REAL(wp) :: zavdt, zavds ! - - 103 REAL(wp), POINTER, DIMENSION(:,:) :: zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 102 104 !!---------------------------------------------------------------------- 103 105 ! 104 106 IF( nn_timing == 1 ) CALL timing_start('zdf_ddm') 105 107 ! 106 CALL wrk_alloc( jpi,jpj, z msks, zmskf, zmskd1, zmskd2, zmskd3 )107 108 CALL wrk_alloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 ) 109 ! 108 110 ! ! =============== 109 111 DO jk = 2, jpkm1 ! Horizontal slab … … 111 113 ! Define the mask 112 114 ! --------------- 113 rrau(:,:,jk) = MAX( 1.e-20, rrau(:,:,jk) ) ! only retains positive value of rrau 115 DO jj = 1, jpj ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 116 DO ji = 1, jpi 117 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) & 118 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 119 ! 120 zaw = ( rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw ) * tmask(ji,jj,jk) 121 zbw = ( rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw ) * tmask(ji,jj,jk) 122 ! 123 zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) 124 zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 125 IF( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 126 zrau(ji,jj) = MAX( 1.e-20, zdt / zds ) ! only retains positive value of zrau 127 END DO 128 END DO 114 129 115 130 DO jj = 1, jpj ! indicators: … … 119 134 ELSE ; zmsks(ji,jj) = 1._wp 120 135 ENDIF 121 ! salt fingering indicator: msksf=1 if rrau>1; 0 elsewhere122 IF( rrau(ji,jj,jk) <= 1.) THEN ; zmskf(ji,jj) = 0._wp136 ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere 137 IF( zrau(ji,jj) <= 1. ) THEN ; zmskf(ji,jj) = 0._wp 123 138 ELSE ; zmskf(ji,jj) = 1._wp 124 139 ENDIF 125 140 ! diffusive layering indicators: 126 ! ! mskdl1=1 if 0< rrau<1; 0 elsewhere127 IF( rrau(ji,jj,jk) >= 1.) THEN ; zmskd1(ji,jj) = 0._wp141 ! ! mskdl1=1 if 0< R <1; 0 elsewhere 142 IF( zrau(ji,jj) >= 1. ) THEN ; zmskd1(ji,jj) = 0._wp 128 143 ELSE ; zmskd1(ji,jj) = 1._wp 129 144 ENDIF 130 ! ! mskdl2=1 if 0< rrau<0.5; 0 elsewhere131 IF( rrau(ji,jj,jk) >= 0.5) THEN ; zmskd2(ji,jj) = 0._wp145 ! ! mskdl2=1 if 0< R <0.5; 0 elsewhere 146 IF( zrau(ji,jj) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0._wp 132 147 ELSE ; zmskd2(ji,jj) = 1._wp 133 148 ENDIF 134 ! mskdl3=1 if 0.5< rrau<1; 0 elsewhere135 IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN ; zmskd3(ji,jj) = 0._wp136 ELSE 149 ! mskdl3=1 if 0.5< R <1; 0 elsewhere 150 IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN ; zmskd3(ji,jj) = 0._wp 151 ELSE ; zmskd3(ji,jj) = 1._wp 137 152 ENDIF 138 153 END DO … … 149 164 !CDIR NOVERRCHK 150 165 DO ji = 1, jpi 151 zinr = 1. /rrau(ji,jj,jk)166 zinr = 1._wp / zrau(ji,jj) 152 167 ! salt fingering 153 zrr = rrau(ji,jj,jk)/rn_hsbfr168 zrr = zrau(ji,jj) / rn_hsbfr 154 169 zrr = zrr * zrr 155 170 zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) … … 157 172 ! diffusive layering 158 173 zavdt = 1.3635e-6 * EXP( 4.6 * EXP( -0.54*(zinr-1.) ) ) * zmsks(ji,jj) * zmskd1(ji,jj) 159 zavds = zavdt * zmsks(ji,jj) * ( ( 1.85 * rrau(ji,jj,jk) - 0.85 ) * zmskd3(ji,jj) &160 & + 0.15 * rrau(ji,jj,jk) * zmskd2(ji,jj) )174 zavds = zavdt * zmsks(ji,jj) * ( ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj) & 175 & + 0.15 * zrau(ji,jj) * zmskd2(ji,jj) ) 161 176 ! add to the eddy viscosity coef. previously computed 162 177 avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds … … 212 227 !! called by zdf_ddm at the first timestep (nit000) 213 228 !!---------------------------------------------------------------------- 229 INTEGER :: ios ! local integer 230 !! 214 231 NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr 215 INTEGER :: ios ! Local integer output status for namelist read216 232 !!---------------------------------------------------------------------- 217 233 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r3294 r4896 78 78 ! 79 79 DO jk = 1, jpkm1 80 #if defined key_vectopt_loop81 DO jj = 1, 1 ! big loop forced82 DO ji = jpi+2, jpij83 #else84 80 DO jj = 2, jpj ! no vector opt. 85 81 DO ji = 2, jpi 86 #endif87 82 #if defined key_zdfkpp 88 83 ! no evd mixing in the boundary layer with KPP … … 110 105 DO jk = 1, jpkm1 111 106 !!! WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd ! agissant sur T SEUL! 112 #if defined key_vectopt_loop113 DO jj = 1, 1 ! big loop forced114 DO ji = 1, jpij115 #else116 107 DO jj = 1, jpj ! loop over the whole domain (no lbc_lnk call) 117 108 DO ji = 1, jpi 118 #endif119 109 #if defined key_zdfkpp 120 110 ! no evd mixing in the boundary layer with KPP -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r4147 r4896 26 26 USE phycst ! physical constants 27 27 USE eosbn2 ! equation of state 28 USE zdfddm ! double diffusion mixing 28 USE zdfddm ! double diffusion mixing (avs array) 29 USE lib_mpp ! MPP library 30 USE trd_oce ! ocean trends definition 31 USE trdtra ! tracers trends 32 ! 29 33 USE in_out_manager ! I/O manager 30 USE lib_mpp ! MPP library31 USE wrk_nemo ! work arrays32 34 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 35 USE prtctl ! Print control 34 USE trdmod_oce ! ocean trends definition 35 USE trdtra ! tracers trends 36 USE wrk_nemo ! work arrays 36 37 USE timing ! Timing 37 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 38 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 38 39 39 40 IMPLICIT NONE … … 246 247 REAL(wp) :: zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 247 248 #if defined key_zdfddm 248 REAL(wp) :: zrrau, zds, zavdds, zavddt,zinr ! double diffusion mixing 249 REAL(wp), POINTER, DIMENSION(:,:) :: zdifs 249 REAL(wp) :: zrw, zkm1s ! local scalars 250 REAL(wp) :: zrrau, zdt, zds, zavdds, zavddt, zinr ! double diffusion mixing 251 REAL(wp), POINTER, DIMENSION(:,:) :: zdifs 250 252 REAL(wp), POINTER, DIMENSION(:) :: za2s, za3s, zkmps 251 REAL(wp) :: zkm1s252 253 REAL(wp), POINTER, DIMENSION(:,:) :: zblcs 253 254 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdiffus … … 274 275 #endif 275 276 276 zviscos(:,:,:) = 0. 277 zblcm (:,: ) = 0. 278 zdiffut(:,:,:) = 0. 279 zblct (:,: ) = 0. 277 zviscos(:,:,:) = 0._wp 278 zblcm (:,: ) = 0._wp 279 zdiffut(:,:,:) = 0._wp 280 zblct (:,: ) = 0._wp 280 281 #if defined key_zdfddm 281 zdiffus(:,:,:) = 0. 282 zblcs (:,: ) = 0. 283 #endif 284 ghats(:,:,:) = 0. 285 286 zBo (:,:) = 0. 287 zBosol(:,:) = 0. 288 zustar(:,:) = 0. 289 290 282 zdiffus(:,:,:) = 0._wp 283 zblcs (:,: ) = 0._wp 284 #endif 285 ghats (:,:,:) = 0._wp 286 zBo (:,: ) = 0._wp 287 zBosol (:,: ) = 0._wp 288 zustar (:,: ) = 0._wp 289 ! 291 290 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 292 291 ! I. Interior diffusivity and viscosity at w points ( T interfaces) … … 332 331 avt (ji,jj,jk) = avt (ji,jj,jk) + rn_difri * zfri 333 332 ENDIF 333 ! 334 334 #if defined key_zdfddm 335 avs (ji,jj,jk) = avt (ji,jj,jk)335 ! 336 336 ! Double diffusion mixing ; NOT IN ROUTINE ZDFDDM.F90 337 ! ------------------------------------------------------------------ 338 ! only retains positive value of rrau 339 zrrau = MAX( rrau(ji,jj,jk), epsln ) 340 zds = tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) 341 IF( zrrau > 1. .AND. zds > 0.) THEN 342 ! 343 ! Salt fingering case. 344 !--------------------- 345 ! Compute interior diffusivity for double diffusive mixing of 346 ! salinity. Upper bound "zrrau" by "Rrho0"; (Rrho0=1.9, difcoefnuf=0.001). 347 ! After that set interior diffusivity for double diffusive mixing 348 ! of temperature 337 ! ------------------------- 338 avs (ji,jj,jk) = avt (ji,jj,jk) 339 340 ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 341 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) & 342 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 343 ! 344 zaw = ( rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw ) * tmask(ji,jj,jk) 345 zbw = ( rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw ) * tmask(ji,jj,jk) 346 ! 347 zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) 348 zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 349 IF( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 350 zrrau = MAX( epsln , zdt / zds ) ! only retains positive value of zrau 351 ! 352 IF( zrrau > 1. .AND. zds > 0.) THEN ! Salt fingering case. 353 ! !--------------------- 354 ! Compute interior diffusivity for double diffusive mixing of salinity. 355 ! Upper bound "zrrau" by "Rrho0"; (Rrho0=1.9, difcoefnuf=0.001). 356 ! After that set interior diffusivity for double diffusive mixing of temperature 349 357 zavdds = MIN( zrrau, Rrho0 ) 350 358 zavdds = ( zavdds - 1.0 ) / ( Rrho0 - 1.0 ) … … 353 361 zavdds = difssf * zavdds 354 362 zavddt = 0.7 * zavdds 355 ELSEIF( zrrau < 1. .AND. zrrau > 0. .AND. zds < 0.) THEN356 363 ! 357 ! Diffusive convection case. 358 !--------------------------- 359 ! Compute interior diffusivity for double diffusive mixing of 360 ! temperature (Marmorino and Caldwell, 1976); 364 ELSEIF( zrrau < 1. .AND. zrrau > 0. .AND. zds < 0.) THEN ! Diffusive convection case. 365 ! !--------------------------- 366 ! Compute interior diffusivity for double diffusive mixing of temperature (Marmorino and Caldwell, 1976); 361 367 ! Compute interior diffusivity for double diffusive mixing of salinity 362 368 zinr = 1. / zrrau 363 369 zavddt = 0.909 * EXP( 4.6 * EXP( -0.54* ( zinr - 1. ) ) ) 364 370 zavddt = difsdc * zavddt 365 IF( zrrau < 0.5) THEN 366 zavdds = zavddt * 0.15 * zrrau 367 ELSE 368 zavdds = zavddt * (1.85 * zrrau - 0.85 ) 371 IF( zrrau < 0.5) THEN ; zavdds = zavddt * 0.15 * zrrau 372 ELSE ; zavdds = zavddt * (1.85 * zrrau - 0.85 ) 369 373 ENDIF 370 374 ELSE … … 385 389 !--------------------------------------------------------------------- 386 390 DO jj = 2, jpjm1 387 DO ji = fs_2, fs_jpim1 388 IF( nn_eos < 1) THEN 389 zt = tsn(ji,jj,1,jp_tem) 390 zs = tsn(ji,jj,1,jp_sal) - 35.0 391 zh = fsdept(ji,jj,1) 392 ! potential volumic mass 393 zrhos = rhop(ji,jj,1) 394 zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt & ! ratio alpha/beta 395 & - 0.203814e-03 ) * zt & 396 & + 0.170907e-01 ) * zt & 397 & + 0.665157e-01 & 398 & + ( - 0.678662e-05 * zs & 399 & - 0.846960e-04 * zt + 0.378110e-02 ) * zs & 400 & + ( ( - 0.302285e-13 * zh & 401 & - 0.251520e-11 * zs & 402 & + 0.512857e-12 * zt * zt ) * zh & 403 & - 0.164759e-06 * zs & 404 & +( 0.791325e-08 * zt - 0.933746e-06 ) * zt & 405 & + 0.380374e-04 ) * zh 406 407 zbeta = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt & ! beta 408 & - 0.301985e-05 ) * zt & 409 & + 0.785567e-03 & 410 & + ( 0.515032e-08 * zs & 411 & + 0.788212e-08 * zt - 0.356603e-06 ) * zs & 412 & +( ( 0.121551e-17 * zh & 413 & - 0.602281e-15 * zs & 414 & - 0.175379e-14 * zt + 0.176621e-12 ) * zh & 415 & + 0.408195e-10 * zs & 416 & + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt & 417 & - 0.121555e-07 ) * zh 418 419 zthermal = zbeta * zalbet / ( rcp * zrhos + epsln ) 420 zhalin = zbeta * tsn(ji,jj,1,jp_sal) * rcs 421 ELSE 422 zrhos = rhop(ji,jj,1) + rau0 * ( 1. - tmask(ji,jj,1) ) 423 zthermal = rn_alpha / ( rcp * zrhos + epsln ) 424 zhalin = rn_beta * tsn(ji,jj,1,jp_sal) * rcs 425 zbeta = rn_beta 426 ENDIF 391 DO ji = fs_2, fs_jpim1 392 zrhos = rau0 * ( 1._wp + rhd(ji,jj,1) ) * tmask(ji,jj,1) 393 zthermal = rab_n(ji,jj,1,jp_tem) / ( rcp * zrhos + epsln ) 394 zbeta = rab_n(ji,jj,1,jp_sal) 395 zhalin = zbeta * tsn(ji,jj,1,jp_sal) * rcs 396 ! 427 397 ! Radiative surface buoyancy force 428 398 zBosol(ji,jj) = grav * zthermal * qsr(ji,jj) … … 435 405 ws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) & 436 406 & + sfx(ji,jj) ) * rcs * tmask(ji,jj,1) 437 END DO438 END DO407 END DO 408 END DO 439 409 440 410 zflageos = 0.5 + SIGN( 0.5, nn_eos - 1. ) … … 447 417 ! Friction velocity (zustar), at T-point : LMD94 eq. 2 448 418 zustar(ji,jj) = SQRT( taum(ji,jj) / ( zrhos + epsln ) ) 449 END DO450 END DO419 END DO 420 END DO 451 421 452 422 !CDIR NOVERRCHK … … 1270 1240 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 1271 1241 !!bug gm jpttdzdf ==> jpttkpp 1272 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_zdf, ztrdt )1273 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ trd_zdf, ztrds )1242 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) 1243 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds ) 1274 1244 DEALLOCATE( ztrdt ) ; DEALLOCATE( ztrds ) 1275 1245 ENDIF … … 1340 1310 IF( l_trdtrc ) THEN ! save the non-local tracer flux trends for diagnostic 1341 1311 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 1342 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_zdf, ztrtrd(:,:,:) )1312 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:) ) 1343 1313 ENDIF 1344 1314 ! … … 1375 1345 !!---------------------------------------------------------------------- 1376 1346 INTEGER :: ji, jj, jk ! dummy loop indices 1347 INTEGER :: ios ! local integer 1377 1348 #if ! defined key_kppcustom 1378 1349 INTEGER :: jm ! dummy loop indices … … 1382 1353 REAL(wp) :: zustar, zucube, zustvk, zeta, zehat ! tempory scalars 1383 1354 #endif 1384 INTEGER :: ios ! Local integer output status for namelist read1385 1355 REAL(wp) :: zhbf ! tempory scalars 1386 1356 LOGICAL :: ll_kppcustom ! 1st ocean level taken as surface layer -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r4245 r4896 6 6 !! History : 1.0 ! 2003-08 (G. Madec) original code 7 7 !! 3.2 ! 2009-07 (S. Masson, G. Madec) IOM + merge of DO-loop 8 !! 3.7 ! 2012-03 (G. Madec) make public the density criteria for trdmxl 9 !! - ! 2014-02 (F. Roquet) mixed layer depth calculated using N2 instead of rhop 8 10 !!---------------------------------------------------------------------- 9 11 !! zdf_mxl : Compute the turbocline and mixed layer depths. … … 14 16 USE in_out_manager ! I/O manager 15 17 USE prtctl ! Print control 18 USE phycst ! physical constants 16 19 USE iom ! I/O library 17 20 USE lib_mpp ! MPP library … … 25 28 PUBLIC zdf_mxl ! called by step.F90 26 29 27 REAL(wp), PUBLIC :: rho_c = 0.01_wp ! density criterion for mixed layer depth28 REAL(wp), PUBLIC :: avt_c = 5.e-4_wp ! Kz criterion for the turbocline depth29 30 30 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nmln !: number of level in the mixed layer (used by TOP) 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 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmlpt !: mixed layer depth at t-points [m] 34 35 REAL(wp), PUBLIC :: rho_c = 0.01_wp !: density criterion for mixed layer depth 36 REAL(wp) :: avt_c = 5.e-4_wp ! Kz criterion for the turbocline depth 34 37 35 38 !! * Substitutions … … 70 73 !! eddy diffusivity coefficient (resulting from the vertical physics 71 74 !! alone, not the isopycnal part, see trazdf.F) fall below a given 72 !! value defined locally (avt_c here taken equal to 5 cm/s2 )75 !! value defined locally (avt_c here taken equal to 5 cm/s2 by default) 73 76 !! 74 77 !! ** Action : nmln, hmld, hmlp, hmlpt 75 78 !!---------------------------------------------------------------------- 76 79 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 !! 78 INTEGER :: ji, jj, jk ! dummy loop indices 79 INTEGER :: iikn, iiki ! temporary integer within a do loop 80 INTEGER, POINTER, DIMENSION(:,:) :: imld ! temporary workspace 80 ! 81 INTEGER :: ji, jj, jk ! dummy loop indices 82 INTEGER :: iikn, iiki ! local integer 83 REAL(wp) :: zN2_c ! local scalar 84 INTEGER, POINTER, DIMENSION(:,:) :: imld ! 2D workspace 81 85 !!---------------------------------------------------------------------- 82 86 ! … … 94 98 95 99 ! w-level of the mixing and mixed layers 96 nmln(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point 97 imld(:,:) = mbkt(:,:) + 1 98 DO jk = jpkm1, nlb10, -1 ! from the bottom to nlb10 100 nmln(:,:) = nlb10 ! Initialization to the number of w ocean point 101 hmlp(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 102 zN2_c = grav * rho_c * r1_rau0 ! convert density criteria into N^2 criteria 103 DO jk = nlb10, jpkm1 104 DO jj = 1, jpj ! Mixed layer level: w-level 105 DO ji = 1, jpi 106 hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * fse3w(ji,jj,jk) 107 IF( hmlp(ji,jj) < zN2_c ) nmln(ji,jj) = MIN( jk , mbkt(ji,jj) ) + 1 ! Mixed layer level 108 END DO 109 END DO 110 END DO 111 ! 112 ! w-level of the turbocline 113 imld(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point 114 DO jk = jpkm1, nlb10, -1 ! from the bottom to nlb10 99 115 DO jj = 1, jpj 100 116 DO ji = 1, jpi 101 IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rho_c ) nmln(ji,jj) = jk ! Mixed layer 102 IF( avt (ji,jj,jk) < avt_c ) imld(ji,jj) = jk ! Turbocline 117 IF( avt (ji,jj,jk) < avt_c ) imld(ji,jj) = jk ! Turbocline 103 118 END DO 104 119 END DO -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r4147 r4896 291 291 END DO 292 292 ! ! finite LC depth 293 # if defined key_vectopt_loop294 DO jj = 1, 1295 DO ji = 1, jpij ! vector opt. (forced unrolling)296 # else297 293 DO jj = 1, jpj 298 294 DO ji = 1, jpi 299 # endif300 295 zhlc(ji,jj) = fsdepw(ji,jj,imlc(ji,jj)) 301 296 END DO 302 297 END DO 303 298 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 304 !CDIR NOVERRCHK305 299 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 306 !CDIR NOVERRCHK 307 DO jj = 2, jpjm1 308 !CDIR NOVERRCHK 300 DO jj = 2, jpjm1 309 301 DO ji = fs_2, fs_jpim1 ! vector opt. 310 302 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4354 r4896 51 51 #endif 52 52 USE tideini ! tidal components initialization (tide_ini routine) 53 USE bdyini ! open boundary cond. initialization(bdy_init routine)54 USE bdydta ! open boundary cond. initialization(bdy_dta_init routine)55 USE bdytides ! open boundary cond. initialization(bdytide_init routine)53 USE bdyini ! open boundary cond. setting (bdy_init routine) 54 USE bdydta ! open boundary cond. setting (bdy_dta_init routine) 55 USE bdytides ! open boundary cond. setting (bdytide_init routine) 56 56 USE istate ! initial state setting (istate_init routine) 57 57 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) … … 59 59 USE zdfini ! vertical physics setting (zdf_init routine) 60 60 USE phycst ! physical constant (par_cst routine) 61 USE trd mod ! momentum/tracers trends (trd_mod_init routine)61 USE trdini ! dyn/tra trends initialization (trd_init routine) 62 62 USE asminc ! assimilation increments 63 63 USE asmbkg ! writing out state trajectory … … 121 121 !!---------------------------------------------------------------------- 122 122 ! 123 124 123 #if defined key_agrif 125 124 CALL Agrif_Init_Grids() ! AGRIF: set the meshes … … 139 138 # endif 140 139 #endif 141 142 140 ! check that all process are still there... If some process have an error, 143 141 ! they will never enter in step and other processes will wait until the end of the cpu time! … … 166 164 167 165 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 168 169 166 #if defined key_agrif 170 167 CALL Agrif_Step( stp ) ! AGRIF: time stepping … … 172 169 CALL stp( istp ) ! standard time stepping 173 170 #endif 174 175 171 istp = istp + 1 176 172 IF( lk_mpp ) CALL mpp_max( nstop ) … … 227 223 INTEGER :: ios 228 224 CHARACTER(len=80), DIMENSION(16) :: cltxt 229 ! !230 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, &225 ! 226 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 231 227 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & 232 228 & nn_bench, nn_timing … … 385 381 IF( lk_tide ) CALL tide_init( nit000 ) ! Initialisation of the tidal harmonics 386 382 387 IF( lk_bdy ) CALL bdy_init! Open boundaries initialisation388 IF( lk_bdy ) CALL bdy_dta_init! Open boundaries initialisation of external data arrays383 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 384 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays 389 385 IF( lk_bdy .AND. lk_tide ) & 390 & CALL bdytide_init! Open boundaries initialisation of tidal harmonic forcing386 & CALL bdytide_init ! Open boundaries initialisation of tidal harmonic forcing 391 387 392 388 CALL dyn_nept_init ! simplified form of Neptune effect … … 398 394 CALL sbc_init ! Forcings : surface module 399 395 ! ! Vertical physics 400 401 396 CALL zdf_init ! namelist read 402 403 397 CALL zdf_bfr_init ! bottom friction 404 405 398 IF( lk_zdfric ) CALL zdf_ric_init ! Richardson number dependent Kz 406 399 IF( lk_zdftke ) CALL zdf_tke_init ! TKE closure scheme … … 441 434 CALL trc_init 442 435 #endif 443 ! 444 445 ! Diagnostics 436 ! ! Diagnostics 446 437 IF( lk_floats ) CALL flo_init ! drifting Floats 447 438 IF( lk_diaar5 ) CALL dia_ar5_init ! ar5 diag … … 449 440 IF( lk_diadct ) CALL dia_dct_init ! Sections tranports 450 441 CALL dia_hsb_init ! heat content, salt content and volume budgets 451 CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends442 CALL trd_init ! Mixed-layer/Vorticity/Integral constraints trends 452 443 IF( lk_diaobs ) THEN ! Observation & model comparison 453 444 CALL dia_obs_init ! Initialize observational data 454 445 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 455 446 ENDIF 447 456 448 ! ! Assimilation increments 457 449 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments … … 655 647 !! ** Method : 656 648 !!---------------------------------------------------------------------- 657 INTEGER, INTENT(in) :: num_pes! The number of MPI processes we have649 INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 658 650 ! 659 651 INTEGER, PARAMETER :: nfactmax = 20 … … 664 656 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 665 657 !!---------------------------------------------------------------------- 666 658 ! 667 659 ierr = 0 668 660 ! 669 661 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 670 662 ! 671 663 IF( nfact <= 1 ) THEN 672 664 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' … … 710 702 INTEGER, PARAMETER :: ntest = 14 711 703 INTEGER :: ilfax(ntest) 712 704 ! 713 705 ! lfax contains the set of allowed factors. 714 706 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & … … 761 753 762 754 #if defined key_mpp_mpi 755 763 756 SUBROUTINE nemo_northcomms 764 757 !!====================================================================== … … 823 816 END SUBROUTINE nemo_northcomms 824 817 #endif 818 825 819 !!====================================================================== 826 820 END MODULE nemogcm -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/oce.F90
r4354 r4896 20 20 !! dynamics and tracer fields ! before ! now ! after ! the after trends becomes the fields 21 21 !! -------------------------- ! fields ! fields ! trends ! only after tra_zdf and dyn_spg 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ub , un , ua !: i-horizontal velocity [m/s] 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vb , vn , va !: j-horizontal velocity [m/s] 24 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ua_sv, va_sv !: Saved trends (time spliting) [m/s2] 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wn !: vertical velocity [m/s] 26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rotb , rotn !: relative vorticity [s-1] 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivb, hdivn !: horizontal divergence [s-1] 28 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsb , tsn !: 4D T-S fields [Celcius,psu] 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rn2b , rn2 !: brunt-vaisala frequency**2 [s-2] 30 ! 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsa !: 4D T-S trends fields & work array 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ub , un , ua !: i-horizontal velocity [m/s] 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vb , vn , va !: j-horizontal velocity [m/s] 24 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ua_sv, va_sv !: Saved trends (time spliting) [m/s2] 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wn !: vertical velocity [m/s] 26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rotb , rotn !: relative vorticity [s-1] 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivb, hdivn !: horizontal divergence [s-1] 28 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsb , tsn , tsa !: 4D T-S fields [Celcius,psu] 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: rab_b, rab_n !: thermal/haline expansion coef. [Celcius-1,psu-1] 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rn2b , rn2 !: brunt-vaisala frequency**2 [s-2] 32 31 ! 33 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 [no units] … … 81 80 & hdivb(jpi,jpj,jpk) , hdivn(jpi,jpj,jpk) , & 82 81 & tsb (jpi,jpj,jpk,jpts) , tsn (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) , & 82 & rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) , & 83 83 & rn2b (jpi,jpj,jpk) , rn2 (jpi,jpj,jpk) , STAT=ierr(1) ) 84 84 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
r4205 r4896 94 94 #endif 95 95 96 #if defined key_vectopt_loop97 LOGICAL, PUBLIC, PARAMETER :: lk_vopt_loop = .TRUE. !: vector optimization flag98 #else99 LOGICAL, PUBLIC, PARAMETER :: lk_vopt_loop = .FALSE. !: vector optimization flag100 #endif101 102 96 !!---------------------------------------------------------------------- 103 97 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/step.F90
r4491 r4896 24 24 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 25 25 !! 3.4 ! 2011-04 (G. Madec, C. Ethe) Merge of dtatem and dtasal 26 !! ! 2012-07 (J. Simeon, G. Madec. C. Ethe) Online coarsening of outputs 26 !! ! 2012-07 (J. Simeon, G. Madec, C. Ethe) Online coarsening of outputs 27 !! 3.7 ! 2014-04 (F. Roquet, G. Madec) New equations of state 27 28 !!---------------------------------------------------------------------- 28 29 … … 39 40 !! * Substitutions 40 41 # include "domzgr_substitute.h90" 41 # include "zdfddm_substitute.h90"42 !!---------------------------------------------------------------------- 43 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)42 !!gm # include "zdfddm_substitute.h90" 43 !!---------------------------------------------------------------------- 44 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 44 45 !! $Id$ 45 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 106 107 ! Ocean physics update (ua, va, tsa used as workspace) 107 108 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 108 CALL bn2( tsb, rn2b ) ! before Brunt-Vaisala frequency 109 CALL bn2( tsn, rn2 ) ! now Brunt-Vaisala frequency 109 ! THERMODYNAMICS 110 CALL eos_rab( tsb, rab_b ) ! before local thermal/haline expension ratio at T-points 111 CALL eos_rab( tsn, rab_n ) ! now local thermal/haline expension ratio at T-points 112 CALL bn2 ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency 113 CALL bn2 ( tsn, rab_n, rn2 ) ! now Brunt-Vaisala frequency 110 114 ! 111 115 ! VERTICAL PHYSICS … … 220 224 #endif 221 225 226 222 227 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 223 228 ! Active tracers (ua, va used as workspace) … … 319 324 320 325 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 321 ! Trends (ua, va, tsa used as workspace)322 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<323 IF( nstop == 0 ) THEN324 IF( lk_trddyn ) CALL trd_dwr( kstp ) ! trends: dynamics325 IF( lk_trdtra ) CALL trd_twr( kstp ) ! trends: active tracers326 IF( lk_trdmld ) CALL trd_mld( kstp ) ! trends: Mixed-layer327 IF( lk_trdvor ) CALL trd_vor( kstp ) ! trends: vorticity budget328 ENDIF329 330 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>331 326 ! Coupled mode 332 327 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r4328 r4896 84 84 85 85 USE diawri ! Standard run outputs (dia_wri routine) 86 USE trdicp ! Ocean momentum/tracers trends (trd_wri routine)87 USE trdmld ! mixed-layer trends (trd_mld routine)88 USE trdmld_rst ! restart for mixed-layer trends89 USE trdmod_oce ! ocean momentum/tracers trends90 USE trdmod ! momentum/tracers trends91 USE trdvor ! vorticity budget (trd_vor routine)92 86 USE diaptr ! poleward transports (dia_ptr routine) 93 87 USE diadct ! sections transports (dia_dct routine) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90
r2528 r4896 2 2 !! *** vectopt_loop_substitute *** 3 3 !!---------------------------------------------------------------------- 4 !! ** purpose : substitute the inner loop start ing and inding indices5 !! to allow unrolling of do-loop using CPP macro.4 !! ** purpose : substitute the inner loop start/end indices with CPP macro 5 !! allow unrolling of do-loop (useful with vector processors) 6 6 !!---------------------------------------------------------------------- 7 7 !!---------------------------------------------------------------------- 8 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)8 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 9 9 !! $Id$ 10 10 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 11 11 !!---------------------------------------------------------------------- 12 12 #if defined key_vectopt_loop 13 # define fs_2114 # define fs_jpim1jpi13 # define fs_2 1 14 # define fs_jpim1 jpi 15 15 #else 16 # define fs_2217 # define fs_jpim1jpim116 # define fs_2 2 17 # define fs_jpim1 jpim1 18 18 #endif -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r3680 r4896 18 18 USE par_trc ! TOP parameters 19 19 USE trc ! TOP variables 20 USE trd mod_oce21 USE trd mod_trc20 USE trd_oce 21 USE trdtrc 22 22 USE iom ! I/O library 23 23 … … 302 302 ENDIF 303 303 304 IF( l_trdtrc ) CALL trd_ mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt ) ! save trends304 IF( l_trdtrc ) CALL trd_trc( tra(:,:,:,jpc14), jpc14, jptra_sms, kt ) ! save trends 305 305 306 306 CALL wrk_dealloc( jpi, jpj, zatmbc14 ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r3680 r4896 18 18 USE par_trc ! TOP parameters 19 19 USE trc ! TOP variables 20 USE trd mod_oce21 USE trd mod_trc20 USE trd_oce 21 USE trdtrc 22 22 USE iom ! I/O library 23 23 … … 201 201 IF( l_trdtrc ) THEN 202 202 DO jn = jp_cfc0, jp_cfc1 203 CALL trd_ mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt ) ! save trends203 CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends 204 204 END DO 205 205 END IF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r3680 r4896 16 16 USE oce_trc ! Ocean variables 17 17 USE trc ! TOP variables 18 USE trd mod_oce19 USE trd mod_trc18 USE trd_oce 19 USE trdtrc 20 20 21 21 IMPLICIT NONE … … 65 65 DO jn = jp_myt0, jp_myt1 66 66 ztrmyt(:,:,:) = tra(:,:,:,jn) 67 CALL trd_ mod_trc( ztrmyt, jn, jptra_trd_sms, kt ) ! save trends67 CALL trd_trc( ztrmyt, jn, jptra_sms, kt ) ! save trends 68 68 END DO 69 69 CALL wrk_dealloc( jpi, jpj, jpk, ztrmyt ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r4147 r4896 21 21 USE lbclnk ! 22 22 USE prtctl_trc ! Print control for debbuging 23 USE trd mod_oce24 USE trd mod_trc23 USE trd_oce 24 USE trdtrc 25 25 USE iom 26 26 … … 457 457 IF( l_trdtrc ) THEN 458 458 DO jl = jp_pcs0_trd, jp_pcs1_trd 459 CALL trd_ mod_trc( trbio(:,:,:,jl), jl, kt ) ! handle the trend459 CALL trd_trc( trbio(:,:,:,jl), jl, kt ) ! handle the trend 460 460 END DO 461 461 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
r3446 r4896 22 22 USE lbclnk 23 23 USE prtctl_trc ! Print control for debbuging 24 USE trd mod_oce25 USE trd mod_trc24 USE trd_oce 25 USE trdtrc 26 26 USE iom 27 27 … … 164 164 ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:) 165 165 jl = jp_pcs0_trd + 16 166 CALL trd_ mod_trc( ztrbio, jl, kt ) ! handle the trend166 CALL trd_trc( ztrbio, jl, kt ) ! handle the trend 167 167 CALL wrk_dealloc( jpi, jpj, jpk, ztrbio ) ! temporary save of trends 168 168 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
r4147 r4896 128 128 IF( etot(ji,jj,jk) >= zpar100(ji,jj) ) neln(ji,jj) = jk + 1 129 129 ! ! nb. this is to ensure compatibility with 130 ! ! nmld_trc definition in trd_m ld_trc_zint130 ! ! nmld_trc definition in trd_mxl_trc_zint 131 131 END DO 132 132 END DO -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
r4609 r4896 18 18 USE sms_pisces 19 19 USE lbclnk 20 USE trd mod_oce21 USE trd mod_trc20 USE trd_oce 21 USE trdtrc 22 22 USE iom 23 23 USE prtctl_trc ! Print control for debbuging … … 128 128 ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:) 129 129 jl = jp_pcs0_trd + 7 130 CALL trd_ mod_trc( ztrbio, jl, kt ) ! handle the trend130 CALL trd_trc( ztrbio, jl, kt ) ! handle the trend 131 131 CALL wrk_dealloc( jpi, jpj, jpk, ztrbio ) 132 132 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
r4147 r4896 20 20 USE p2zsed 21 21 USE p2zexp 22 USE trd mod_oce23 USE trd mod_trc_oce24 USE trd mod_trc25 USE trdm ld_trc22 USE trd_oce 23 USE trdtrc_oce 24 USE trdtrc 25 USE trdmxl_trc 26 26 27 27 IMPLICIT NONE … … 61 61 IF( l_trdtrc ) THEN 62 62 DO jn = jp_pcs0, jp_pcs1 63 CALL trd_ mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt ) ! save trends63 CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends 64 64 END DO 65 65 END IF 66 66 67 IF( lk_trdm ld_trc ) CALL trd_mld_bio( kt ) ! trends: Mixed-layer67 IF( lk_trdmxl_trc ) CALL trd_mxl_bio( kt ) ! trends: Mixed-layer 68 68 ! 69 69 IF ( kt == nittrc000 ) CALL FLUSH ( numonp ) ! flush output namelist PISCES -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r4361 r4896 205 205 IF( etot(ji,jj,jk) * tmask(ji,jj,jk) >= 0.0043 * qsr(ji,jj) ) THEN 206 206 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 207 ! ! nb: ensure the compatibility with nmld_trc definition in trd_m ld_trc_zint207 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mxl_trc_zint 208 208 heup(ji,jj) = fsdepw(ji,jj,jk+1) ! Euphotic layer depth 209 209 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r4162 r4896 11 11 !! 'key_pisces' PISCES bio-model 12 12 !!---------------------------------------------------------------------- 13 !! p4zsms : Time loop of passive tracers sms13 !! p4zsms : Time loop of passive tracers sms 14 14 !!---------------------------------------------------------------------- 15 15 USE oce_trc ! shared variables between ocean and passive tracers … … 25 25 USE p4zint ! time interpolation 26 26 USE iom ! I/O manager 27 USE trd mod_oce! Ocean trends variables28 USE trd mod_trc! TOP trends variables27 USE trd_oce ! Ocean trends variables 28 USE trdtrc ! TOP trends variables 29 29 USE sedmodel ! Sediment model 30 30 USE prtctl_trc ! print control for debugging … … 33 33 PRIVATE 34 34 35 PUBLIC p4z_sms_init 36 PUBLIC p4z_sms ! called in p4zsms.F9035 PUBLIC p4z_sms_init ! called in p4zsms.F90 36 PUBLIC p4z_sms ! called in p4zsms.F90 37 37 38 38 REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget … … 146 146 jl = jn + jp_pcs0 - 1 147 147 ztrdpis(:,:,:,jn) = ztrdpis(:,:,:,jn) + tra(:,:,:,jl) 148 CALL trd_ mod_trc( ztrdpis(:,:,:,jn), jn, jptra_trd_sms, kt ) ! save trends148 CALL trd_trc( ztrdpis(:,:,:,jn), jn, jptra_sms, kt ) ! save trends 149 149 END DO 150 150 CALL wrk_dealloc( jpi, jpj, jpk, jp_pisces, ztrdpis ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90
r4319 r4896 19 19 USE trc ! TOP variables 20 20 USE sms_pisces ! sms trends 21 USE trd mod_trc_oce21 USE trdtrc_oce 22 22 USE iom ! I/O manager 23 23 … … 123 123 #if defined key_pisces_reduced 124 124 125 IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdm ld_trc ) THEN125 IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdmxl_trc ) THEN 126 126 ! 127 127 ! Namelist nampisdbi -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r4513 r4896 25 25 USE trabbl ! 26 26 USE prtctl_trc ! Print control for debbuging 27 USE trd mod_oce27 USE trd_oce 28 28 USE trdtra 29 29 … … 93 93 DO jn = 1, jptra 94 94 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 95 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_bbl, ztrtrd(:,:,:,jn) )95 CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 96 96 END DO 97 97 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r4359 r4896 23 23 USE prtctl_trc ! Print control for debbuging 24 24 USE trdtra 25 USE trd mod_oce25 USE trd_oce 26 26 27 27 IMPLICIT NONE … … 75 75 !! ** Action : - update the tracer trends tra with the newtonian 76 76 !! damping trends. 77 !! - save the trends ('key_trdm ld_trc')77 !! - save the trends ('key_trdmxl_trc') 78 78 !!---------------------------------------------------------------------- 79 79 !! … … 151 151 IF( l_trdtrc ) THEN 152 152 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 153 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_dmp, ztrtrd )153 CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd ) 154 154 END IF 155 155 ! ! =========== -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r3294 r4896 25 25 USE traldf_iso_grif ! lateral mixing (tra_ldf_iso_grif routine) 26 26 USE traldf_lap ! lateral mixing (tra_ldf_lap routine) 27 USE trd mod_oce27 USE trd_oce 28 28 USE trdtra 29 29 USE prtctl_trc ! Print control … … 105 105 DO jn = 1, jptra 106 106 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 107 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_ldf, ztrtrd(:,:,:,jn) )107 CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 108 108 END DO 109 109 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r4611 r4896 30 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 31 USE prtctl_trc ! Print control for debbuging 32 USE trd mod_oce32 USE trd_oce 33 33 USE trdtra 34 34 USE tranxt … … 148 148 zfact = 1.e0 / r2dt(jk) 149 149 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 150 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_atf, ztrdt )150 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 151 151 END DO 152 152 END DO -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r3680 r4896 15 15 USE oce_trc ! ocean dynamics and tracers variables 16 16 USE trc ! ocean passive tracers variables 17 USE trd mod_oce17 USE trd_oce 18 18 USE trdtra 19 19 USE prtctl_trc ! Print control for debbuging … … 156 156 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 157 157 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 158 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radb, ztrtrdb ) ! Asselin-like trend handling159 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radn, ztrtrdn ) ! standard trend handling158 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 159 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 160 160 ! 161 161 ENDIF … … 187 187 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 188 188 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 189 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radb, ztrtrdb ) ! Asselin-like trend handling190 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radn, ztrtrdn ) ! standard trend handling189 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 190 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 191 191 ! 192 192 ENDIF -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r3719 r4896 19 19 USE trc ! ocean passive tracers variables 20 20 USE prtctl_trc ! Print control for debbuging 21 USE trd mod_oce21 USE trd_oce 22 22 USE trdtra 23 23 … … 104 104 IF( l_trdtrc ) THEN 105 105 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 106 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_nsr, ztrtrd )106 CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 107 107 END IF 108 108 ! ! =========== -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r3680 r4896 19 19 USE trazdf_exp ! vertical diffusion: explicit (tra_zdf_exp routine) 20 20 USE trazdf_imp ! vertical diffusion: implicit (tra_zdf_imp routine) 21 USE trd mod_oce21 USE trd_oce 22 22 USE trdtra 23 23 USE prtctl_trc ! Print control … … 106 106 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn) 107 107 END DO 108 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_zdf, ztrtrd(:,:,:,jn) )108 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 109 109 END DO 110 110 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r4610 r4896 66 66 USE oce , ONLY : rhop => rhop !: potential volumic mass (kg m-3) 67 67 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 68 #if defined key_offline 69 USE oce , ONLY : rab_n => rab_n !: local thermal/haline expension ratio at T-points 70 #endif 68 71 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s) 69 72 USE oce , ONLY : rotn => rotn !: relative vorticity [s-1] -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r4607 r4896 192 192 USE trcnxt , ONLY: trc_nxt_alloc 193 193 USE trczdf , ONLY: trc_zdf_alloc 194 USE trd mod_trc_oce, ONLY: trd_mod_trc_oce_alloc195 #if defined key_trdm ld_trc196 USE trdm ld_trc , ONLY: trd_mld_trc_alloc194 USE trdtrc_oce , ONLY: trd_trc_oce_alloc 195 #if defined key_trdmxl_trc 196 USE trdmxl_trc , ONLY: trd_mxl_trc_alloc 197 197 #endif 198 198 ! … … 204 204 ierr = ierr + trc_nxt_alloc() 205 205 ierr = ierr + trc_zdf_alloc() 206 ierr = ierr + trd_ mod_trc_oce_alloc()207 #if defined key_trdm ld_trc208 ierr = ierr + trd_m ld_trc_alloc()206 ierr = ierr + trd_trc_oce_alloc() 207 #if defined key_trdmxl_trc 208 ierr = ierr + trd_mxl_trc_alloc() 209 209 #endif 210 210 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r4319 r4896 25 25 USE trcnam_c14b ! C14 SMS namelist 26 26 USE trcnam_my_trc ! MY_TRC SMS namelist 27 USE trd mod_oce28 USE trd mod_trc_oce27 USE trd_oce 28 USE trdtrc_oce 29 29 USE iom ! I/O manager 30 30 … … 119 119 120 120 121 #if defined key_trdm ld_trc || defined key_trdtrc121 #if defined key_trdmxl_trc || defined key_trdtrc 122 122 123 123 REWIND( numnat_ref ) ! Namelist namtrc_trd in reference namelist : Passive tracer trends … … 132 132 IF(lwp) THEN 133 133 WRITE(numout,*) 134 WRITE(numout,*) ' trd_m ld_trc_init : read namelist namtrc_trd '134 WRITE(numout,*) ' trd_mxl_trc_init : read namelist namtrc_trd ' 135 135 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 136 136 WRITE(numout,*) ' * frequency of trends diagnostics nn_trd_trc = ', nn_trd_trc 137 137 WRITE(numout,*) ' * control surface type nn_ctls_trc = ', nn_ctls_trc 138 WRITE(numout,*) ' * restart for ML diagnostics ln_trdm ld_trc_restart = ', ln_trdmld_trc_restart138 WRITE(numout,*) ' * restart for ML diagnostics ln_trdmxl_trc_restart = ', ln_trdmxl_trc_restart 139 139 WRITE(numout,*) ' * flag to diagnose trends of ' 140 WRITE(numout,*) ' instantantaneous or mean ML T/S ln_trdm ld_trc_instant = ', ln_trdmld_trc_instant140 WRITE(numout,*) ' instantantaneous or mean ML T/S ln_trdmxl_trc_instant = ', ln_trdmxl_trc_instant 141 141 WRITE(numout,*) ' * unit conversion factor rn_ucf_trc = ', rn_ucf_trc 142 142 DO jn = 1, jptra … … 266 266 !!--------------------------------------------------------------------- 267 267 INTEGER :: ierr 268 #if defined key_trdm ld_trc || defined key_trdtrc268 #if defined key_trdmxl_trc || defined key_trdtrc 269 269 NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 270 & ln_trdm ld_trc_restart, ln_trdmld_trc_instant, &270 & ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 271 271 & cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 272 272 #endif -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r4152 r4896 137 137 CALL trc_rst_stat ! statistics 138 138 CALL iom_close( numrtw ) ! close the restart file (only at last time step) 139 #if ! defined key_trdm ld_trc139 #if ! defined key_trdmxl_trc 140 140 lrst_trc = .FALSE. 141 141 #endif -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r4306 r4896 19 19 USE trcwri 20 20 USE trcrst 21 USE trd mod_trc_oce22 USE trdm ld_trc21 USE trdtrc_oce 22 USE trdmxl_trc 23 23 USE iom 24 24 USE in_out_manager … … 59 59 IF( nn_timing == 1 ) CALL timing_start('trc_stp') 60 60 ! 61 IF( kt == nittrc000 .AND. lk_trdm ld_trc ) CALL trd_mld_trc_init ! trends: Mixed-layer61 IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer 62 62 ! 63 63 IF( lk_vvl ) THEN ! update ocean volume due to ssh temporal evolution … … 100 100 ENDIF 101 101 IF( lrst_trc ) CALL trc_rst_wri ( kt ) ! write tracer restart file 102 IF( lk_trdm ld_trc ) CALL trd_mld_trc ( kt ) ! trends: Mixed-layer102 IF( lk_trdmxl_trc ) CALL trd_mxl_trc ( kt ) ! trends: Mixed-layer 103 103 ! 104 104 IF( nn_dttrc /= 1 ) CALL trc_sub_reset( kt ) ! resetting physical variables when sub-stepping
Note: See TracChangeset
for help on using the changeset viewer.