- Timestamp:
- 2014-04-08T11:23:42+02:00 (10 years ago)
- Location:
- branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM
- Files:
-
- 9 added
- 7 deleted
- 71 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
r4370 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm
r4230 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/CONFIG/SHARED/field_def.xml
r4565 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/CONFIG/SHARED/namelist_ref
r4384 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r4313 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
r4367 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r4292 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r4570 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r4370 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r3625 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r3294 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r4153 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r3294 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r4292 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r3294 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r4522 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
r3634 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r4488 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r4488 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
r3294 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r4370 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r4496 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r4328 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r4328 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4496 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r4601 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r3294 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r3294 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r4370 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r4334 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
r3294 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r4488 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r4333 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r4161 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r4333 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r4306 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r4292 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r4147 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r4292 r4619 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-02 (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 ! EOS parameters 83 REAL(wp) :: EOS111 , EOS211 , EOS311 , EOS411 , EOS511 , EOS611 , EOS711 84 REAL(wp) :: EOS121 , EOS221 , EOS321 , EOS421 , EOS521 , EOS621 85 REAL(wp) :: EOS131 , EOS231 , EOS331 , EOS431 , EOS531 86 REAL(wp) :: EOS141 , EOS241 , EOS341 , EOS441 87 REAL(wp) :: EOS151 , EOS251 , EOS351 88 REAL(wp) :: EOS161 , EOS261 89 REAL(wp) :: EOS171 90 REAL(wp) :: EOS112 , EOS212 , EOS312 , EOS412 , EOS512 91 REAL(wp) :: EOS122 , EOS222 , EOS322 , EOS422 92 REAL(wp) :: EOS132 , EOS232 , EOS332 93 REAL(wp) :: EOS142 , EOS242 94 REAL(wp) :: EOS152 95 REAL(wp) :: EOS113 , EOS213 , EOS313 96 REAL(wp) :: EOS123 , EOS223 97 REAL(wp) :: EOS133 98 99 ! ALPHA parameters 100 REAL(wp) :: ALP111 , ALP211 , ALP311 , ALP411 , ALP511 , ALP611 101 REAL(wp) :: ALP121 , ALP221 , ALP321 , ALP421 , ALP521 102 REAL(wp) :: ALP131 , ALP231 , ALP331 , ALP431 103 REAL(wp) :: ALP141 , ALP241 , ALP341 104 REAL(wp) :: ALP151 , ALP251 105 REAL(wp) :: ALP161 106 REAL(wp) :: ALP112 , ALP212 , ALP312 , ALP412 107 REAL(wp) :: ALP122 , ALP222 , ALP322 108 REAL(wp) :: ALP132 , ALP232 109 REAL(wp) :: ALP142 110 REAL(wp) :: ALP113 , ALP213 111 REAL(wp) :: ALP123 112 113 ! BETA parameters 114 REAL(wp) :: BET111 , BET211 , BET311 , BET411 , BET511 , BET611 115 REAL(wp) :: BET121 , BET221 , BET321 , BET421 , BET521 116 REAL(wp) :: BET131 , BET231 , BET331 , BET431 117 REAL(wp) :: BET141 , BET241 , BET341 118 REAL(wp) :: BET151 , BET251 119 REAL(wp) :: BET161 120 REAL(wp) :: BET112 , BET212 , BET312 , BET412 121 REAL(wp) :: BET122 , BET222 , BET322 122 REAL(wp) :: BET132 , BET232 123 REAL(wp) :: BET142 124 REAL(wp) :: BET113 , BET213 125 REAL(wp) :: BET123 126 127 ! PEN parameters 128 REAL(wp) :: PEN112 , PEN212 , PEN312 , PEN412 , PEN512 129 REAL(wp) :: PEN122 , PEN222 , PEN322 , PEN422 130 REAL(wp) :: PEN132 , PEN232 , PEN332 131 REAL(wp) :: PEN142 , PEN242 132 REAL(wp) :: PEN152 133 REAL(wp) :: PEN113 , PEN213 , PEN313 134 REAL(wp) :: PEN123 , PEN223 135 REAL(wp) :: PEN133 136 137 ! ALPHA_PEN parameters 138 REAL(wp) :: APE112 , APE212 , APE312 , APE412 139 REAL(wp) :: APE122 , APE222 , APE322 140 REAL(wp) :: APE132 , APE232 141 REAL(wp) :: APE142 142 REAL(wp) :: APE113 , APE213 143 REAL(wp) :: APE123 144 145 ! BETA_PEN parameters 146 REAL(wp) :: BPE112 , BPE212 , BPE312 , BPE412 147 REAL(wp) :: BPE122 , BPE222 , BPE322 148 REAL(wp) :: BPE132 , BPE232 149 REAL(wp) :: BPE142 150 REAL(wp) :: BPE113 , BPE213 151 REAL(wp) :: BPE123 65 152 66 153 !! * Substitutions … … 68 155 # include "vectopt_loop_substitute.h90" 69 156 !!---------------------------------------------------------------------- 70 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)157 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 71 158 !! $Id$ 72 159 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 82 169 !! defined through the namelist parameter nn_eos. 83 170 !! 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. 171 !! ** Method : prd(t,s,z) = ( rho(t,s,z) - rau0 ) / rau0 172 !! with prd in situ density anomalie no units 173 !! t potential temperature Celsius 174 !! s salinity psu 175 !! z depth meters 176 !! rho in situ density kg/m^3 177 !! rau0 reference density kg/m^3 178 !! 179 !! nn_eos = -1 : polynomial TEOS-10 equation of state is used for rho(t,s,z). 180 !! Check value: rho = 1028.21583 kg/m^3 for p=3000 dbar, t=3 Celcius, s=35.5 psu 181 !! 182 !! nn_eos = 0 : Jackett and McDougall (1995) equation of state is used for rho(t,s,z) 183 !! where the density anomaly of a water parcel at t=4, s=35 moved adiabatically to surface 184 !! has been removed: rho = rho_JM95 - ( rho_JM95(4,35,z) - rho_JM95(4,35,0) ) 185 !! Check value: rho = 1028.34976 kg/m^3 for p=3000 dbar, t=3 Celcius, s=35.5 psu 186 !! Check value: rho_JM95 = 1041.83267 kg/m^3 for p=3000 dbar, t=3 Celcius, s=35.5 psu 187 !! 188 !! nn_eos = 1 : simplified equation of state 189 !! prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rau0 190 !! linear case function of T only: rn_alpha<>0, other coefficients = 0 191 !! linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0 192 !! Vallis like equation: use default values of coefficients 107 193 !! 108 194 !! ** Action : compute prd , the in situ density (no units) 109 195 !! 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 ) 196 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1995 197 !! Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006 198 !! TEOS-10 Manual, 2010 199 !! Roquet, Ocean Modelling, in preparation (2013) 200 !!---------------------------------------------------------------------- 201 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 202 ! ! 2 : salinity [psu] 203 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 204 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 205 ! 206 INTEGER :: ji, jj, jk ! dummy loop indices 207 REAL(wp) :: zt , zh , zs , zsr, ztm ! local scalars 208 REAL(wp) :: zn , zn0, zn1, zn2 ! - - 209 !!---------------------------------------------------------------------- 210 ! 211 IF( nn_timing == 1 ) CALL timing_start('eos') 131 212 ! 132 213 SELECT CASE( nn_eos ) 133 214 ! 134 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 135 !CDIR NOVERRCHK 136 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 215 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 137 216 ! 138 217 DO jk = 1, jpkm1 139 218 DO jj = 1, jpj 140 219 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) 220 ! 221 zh = pdep(ji,jj,jk) ! depth 222 zt = pts (ji,jj,jk,jp_tem) ! temperature 223 zsr = SQRT( MAX( pts(ji,jj,jk,jp_sal) , 0.1_wp ) ) ! square root salinity 224 ztm = tmask(ji,jj,jk) ! tmask 225 ! 226 zn2 = ( EOS133*zsr + EOS223*zt + EOS123 )*zsr + ( EOS313*zt + EOS213 )*zt + EOS113 227 ! 228 zn1 = ( ( ( EOS152*zsr & 229 & + EOS242*zt + EOS142 )*zsr & 230 & + ( EOS332*zt + EOS232 )*zt + EOS132 )*zsr & 231 & + ( ( EOS422*zt + EOS322 )*zt + EOS222 )*zt + EOS122 )*zsr & 232 & + ( ( ( EOS512*zt + EOS412 )*zt + EOS312 )*zt + EOS212 )*zt + EOS112 233 ! 234 zn0 = ( ( ( ( ( EOS171*zsr & 235 & + EOS261*zt + EOS161 )*zsr & 236 & + ( EOS351*zt + EOS251 )*zt + EOS151 )*zsr & 237 & + ( ( EOS441*zt + EOS341 )*zt + EOS241 )*zt + EOS141 )*zsr & 238 & + ( ( ( EOS531*zt + EOS431 )*zt + EOS331 )*zt + EOS231 )*zt + EOS131 )*zsr & 239 & + ( ( ( ( EOS621*zt + EOS521 )*zt + EOS421 )*zt + EOS321 )*zt + EOS221 )*zt + EOS121 )*zsr & 240 & + ( ( ( ( ( EOS711*zt + EOS611 )*zt + EOS511 )*zt + EOS411 )*zt + EOS311 )*zt + EOS211 )*zt + EOS111 241 ! 242 zn = ( zn2 * zh + zn1 ) * zh + zn0 243 ! 244 prd(ji,jj,jk) = ( zn * r1_rau0 - 1._wp ) * ztm ! density anomaly (masked) 176 245 END DO 177 246 END DO 178 247 END DO 179 248 ! 180 CASE( 1 ) !== Linear formulation function of temperature only ==! 249 CASE( 1 ) !== simplified EOS ==! 250 ! 181 251 DO jk = 1, jpkm1 182 prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 252 DO jj = 1, jpj 253 DO ji = 1, jpi 254 zt = pts (ji,jj,jk,jp_tem) - 10._wp 255 zs = pts (ji,jj,jk,jp_sal) - 35._wp 256 zh = pdep (ji,jj,jk) 257 ztm = tmask(ji,jj,jk) 258 ! 259 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 260 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 261 & - rn_nu * zt * zs 262 ! 263 prd(ji,jj,jk) = zn * r1_rau0 * ztm ! density anomaly (masked) 264 END DO 265 END DO 183 266 END DO 184 267 ! 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 268 END SELECT 191 269 ! 192 270 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos : ', ovlap=1, kdim=jpk ) 193 271 ! 194 CALL wrk_dealloc( jpi, jpj, jpk, zws ) 195 ! 196 IF( nn_timing == 1 ) CALL timing_stop('eos') 272 IF( nn_timing == 1 ) CALL timing_stop('eos') 197 273 ! 198 274 END SUBROUTINE eos_insitu … … 208 284 !! namelist parameter nn_eos. 209 285 !! 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 286 !! ** Action : - prd , the in situ density (no units) 242 287 !! - prhop, the potential volumic mass (Kg/m3) 243 288 !! 244 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 245 !! Brown and Campana, Mon. Weather Rev., 1978 246 !!---------------------------------------------------------------------- 247 !! 289 !!---------------------------------------------------------------------- 248 290 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 249 291 ! ! 2 : salinity [psu] … … 252 294 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 253 295 ! 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 ) 296 INTEGER :: ji, jj, jk ! dummy loop indices 297 REAL(wp) :: zt , zh , zs , zsr, ztm ! local scalars 298 REAL(wp) :: zn , zn0, zn1, zn2 ! - - 299 !!---------------------------------------------------------------------- 300 ! 301 IF( nn_timing == 1 ) CALL timing_start('eos-p') 263 302 ! 264 303 SELECT CASE ( nn_eos ) 265 304 ! 266 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 267 !CDIR NOVERRCHK 268 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 305 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 269 306 ! 270 307 DO jk = 1, jpkm1 271 308 DO jj = 1, jpj 272 309 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) 310 ! 311 zh = pdep (ji,jj,jk) ! depth 312 zt = pts (ji,jj,jk,jp_tem) ! conservative temperature 313 zsr = SQRT( MAX( pts(ji,jj,jk,jp_sal) , 0.1_wp ) ) ! square root salinity 314 ztm = tmask(ji,jj,jk) ! tmask 315 ! 316 zn2 = ( EOS133*zsr + EOS223*zt + EOS123 )*zsr + ( EOS313*zt + EOS213 )*zt + EOS113 317 ! 318 zn1 = ( ( ( EOS152*zsr & 319 & + EOS242*zt + EOS142 )*zsr & 320 & + ( EOS332*zt + EOS232 )*zt + EOS132 )*zsr & 321 & + ( ( EOS422*zt + EOS322 )*zt + EOS222 )*zt + EOS122 )*zsr & 322 & + ( ( ( EOS512*zt + EOS412 )*zt + EOS312 )*zt + EOS212 )*zt + EOS112 323 ! 324 zn0 = ( ( ( ( ( EOS171*zsr & 325 & + EOS261*zt + EOS161 )*zsr & 326 & + ( EOS351*zt + EOS251 )*zt + EOS151 )*zsr & 327 & + ( ( EOS441*zt + EOS341 )*zt + EOS241 )*zt + EOS141 )*zsr & 328 & + ( ( ( EOS531*zt + EOS431 )*zt + EOS331 )*zt + EOS231 )*zt + EOS131 )*zsr & 329 & + ( ( ( ( EOS621*zt + EOS521 )*zt + EOS421 )*zt + EOS321 )*zt + EOS221 )*zt + EOS121 )*zsr & 330 & + ( ( ( ( ( EOS711*zt + EOS611 )*zt + EOS511 )*zt + EOS411 )*zt + EOS311 )*zt + EOS211 )*zt + EOS111 331 ! 332 zn = ( zn2 * zh + zn1 ) * zh + zn0 333 ! 334 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 335 ! 336 prd(ji,jj,jk) = ( zn * r1_rau0 - 1._wp ) * ztm ! density anomaly (masked) 311 337 END DO 312 338 END DO 313 339 END DO 314 340 ! 315 CASE( 1 ) !== Linear formulation = F( temperature ) ==! 341 CASE( 1 ) !== simplified EOS ==! 342 ! 316 343 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) 344 DO jj = 1, jpj 345 DO ji = 1, jpi 346 zt = pts (ji,jj,jk,jp_tem) - 10._wp 347 zs = pts (ji,jj,jk,jp_sal) - 35._wp 348 zh = pdep (ji,jj,jk) 349 ztm = tmask(ji,jj,jk) 350 ! ! potential density referenced at the surface 351 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 352 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 353 & - rn_nu * zt * zs 354 prhop(ji,jj,jk) = ( rau0 + zn ) * ztm 355 ! ! density anomaly (masked) 356 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 357 prd(ji,jj,jk) = zn * r1_rau0 * ztm 358 ! 359 END DO 360 END DO 319 361 END DO 320 362 ! 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 363 END SELECT 328 364 ! 329 365 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 330 366 ! 331 CALL wrk_dealloc( jpi, jpj, jpk, zws ) 332 ! 333 IF( nn_timing == 1 ) CALL timing_stop('eos-p') 367 IF( nn_timing == 1 ) CALL timing_stop('eos-p') 334 368 ! 335 369 END SUBROUTINE eos_insitu_pot … … 344 378 !! defined through the namelist parameter nn_eos. * 2D field case 345 379 !! 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 !! 380 !! ** Action : - prd , the in situ density (no units) (unmasked) 381 !! 382 !!---------------------------------------------------------------------- 375 383 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 376 384 ! ! 2 : salinity [psu] 377 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m]385 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 378 386 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 387 ! 388 INTEGER :: ji, jj, jk ! dummy loop indices 389 REAL(wp) :: zt , zh , zs , zsr, ztm ! local scalars 390 REAL(wp) :: zn , zn0, zn1, zn2 ! - - 391 !!---------------------------------------------------------------------- 392 ! 393 IF( nn_timing == 1 ) CALL timing_start('eos2d') 394 ! 391 395 prd(:,:) = 0._wp 392 396 ! 393 397 SELECT CASE( nn_eos ) 394 398 ! 395 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 396 ! 397 !CDIR NOVERRCHK 399 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 400 ! 398 401 DO jj = 1, jpjm1 399 !CDIR NOVERRCHK400 402 DO ji = 1, fs_jpim1 ! vector opt. 401 zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) ) 403 ! 404 zt = pts (ji,jj,jp_tem) ! interpolated T 405 zsr = SQRT( MAX( pts(ji,jj,jp_sal) , 0.1_wp ) ) ! square root salinity 406 zh = pdep (ji,jj) ! depth at the partial step level 407 ! 408 ! 409 zn2 = ( EOS133*zsr + EOS223*zt + EOS123 )*zsr + ( EOS313*zt + EOS213 )*zt + EOS113 410 ! 411 zn1 = ( ( ( EOS152*zsr & 412 & + EOS242*zt + EOS142 )*zsr & 413 & + ( EOS332*zt + EOS232 )*zt + EOS132 )*zsr & 414 & + ( ( EOS422*zt + EOS322 )*zt + EOS222 )*zt + EOS122 )*zsr & 415 & + ( ( ( EOS512*zt + EOS412 )*zt + EOS312 )*zt + EOS212 )*zt + EOS112 416 ! 417 zn0 = ( ( ( ( ( EOS171*zsr & 418 & + EOS261*zt + EOS161 )*zsr & 419 & + ( EOS351*zt + EOS251 )*zt + EOS151 )*zsr & 420 & + ( ( EOS441*zt + EOS341 )*zt + EOS241 )*zt + EOS141 )*zsr & 421 & + ( ( ( EOS531*zt + EOS431 )*zt + EOS331 )*zt + EOS231 )*zt + EOS131 )*zsr & 422 & + ( ( ( ( EOS621*zt + EOS521 )*zt + EOS421 )*zt + EOS321 )*zt + EOS221 )*zt + EOS121 )*zsr & 423 & + ( ( ( ( ( EOS711*zt + EOS611 )*zt + EOS511 )*zt + EOS411 )*zt + EOS311 )*zt + EOS211 )*zt + EOS111 424 ! 425 zn = ( zn2 * zh + zn1 ) * zh + zn0 426 ! 427 prd(ji,jj) = zn * r1_rau0 - 1._wp ! unmasked in situ density anomaly 428 ! 402 429 END DO 403 430 END DO 431 ! 432 CASE( 1 ) !== simplified EOS ==! 433 ! 404 434 DO jj = 1, jpjm1 405 435 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 436 ! 437 zt = pts (ji,jj,jp_tem) - 10._wp 438 zs = pts (ji,jj,jp_sal) - 35._wp 439 zh = pdep (ji,jj) ! depth at the partial step level 440 ! 441 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 442 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 443 & - rn_nu * zt * zs 444 ! 445 prd(ji,jj) = zn * r1_rau0 ! unmasked in situ density anomaly 446 ! 442 447 END DO 443 448 END DO 444 449 ! 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 450 END SELECT 460 451 ! 461 452 IF(ln_ctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 462 453 ! 463 CALL wrk_dealloc( jpi, jpj, zws ) 464 ! 465 IF( nn_timing == 1 ) CALL timing_stop('eos2d') 454 IF( nn_timing == 1 ) CALL timing_stop('eos2d') 466 455 ! 467 456 END SUBROUTINE eos_insitu_2d 468 457 469 458 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 ] ) 459 SUBROUTINE rab_3d( pts, pab ) 460 !!---------------------------------------------------------------------- 461 !! *** ROUTINE rab_3d *** 462 !! 463 !! ** Purpose : Calculates thermal/haline expansion ratio at T-points 464 !! 465 !! ** Method : calculates alpha / beta at T-points 466 !! * nn_eos = 0 : polynomial approximation of McDougall (1987) 467 !! The alpha/beta is returned as 4-D array pab using the exact expression 468 !! based on the JM95 equation of state. 485 469 !! * nn_eos = 1 : linear equation of state (temperature only) 486 !! N^2 = grav * rn_alpha * dk[ t ]/e3w470 !! We return alpha and beta=0 487 471 !! * 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 472 !! We return alpha0 and beta0 473 !! 474 !! ** Action : - pab : thermal/haline expansion ratio at T-points 475 !!---------------------------------------------------------------------- 476 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 477 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab ! thermal/haline expansion ratio 478 ! 479 INTEGER :: ji, jj, jk ! dummy loop indices 480 REAL(wp) :: zt , zh , zs , zsr, ztm ! local scalars 481 REAL(wp) :: zn , zn0, zn1, zn2 ! - - 482 !!---------------------------------------------------------------------- 483 ! 484 IF( nn_timing == 1 ) CALL timing_start('rab_3d') 485 ! 486 SELECT CASE ( nn_eos ) 487 ! 488 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 489 ! 490 DO jk = 1, jpkm1 521 491 DO jj = 1, jpj 522 492 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 493 ! 494 zh = fsdept(ji,jj,jk) ! depth 495 zt = pts (ji,jj,jk,jp_tem) ! conservative temperature 496 zsr = SQRT( MAX( pts(ji,jj,jk,jp_sal) , 0.1_wp ) ) ! square root salinity 497 ztm = tmask(ji,jj,jk) ! tmask 498 ! 499 zn2 = ALP123*zsr + ALP213*zt + ALP113 500 ! 501 zn1 = ( ( ALP142*zsr & 502 & + ALP232*zt + ALP132 )*zsr & 503 & + ( ALP322*zt + ALP222 )*zt + ALP122 )*zsr & 504 & + ( ( ALP412*zt + ALP312 )*zt + ALP212 )*zt + ALP112 505 ! 506 zn0 = ( ( ( ( ALP161*zsr & 507 & + ALP251*zt + ALP151 )*zsr & 508 & + ( ALP341*zt + ALP241 )*zt + ALP141 )*zsr & 509 & + ( ( ALP431*zt + ALP331 )*zt + ALP231 )*zt + ALP131 )*zsr & 510 & + ( ( ( ALP521*zt + ALP421 )*zt + ALP321 )*zt + ALP221 )*zt + ALP121 )*zsr & 511 & + ( ( ( ( ALP611*zt + ALP511 )*zt + ALP411 )*zt + ALP311 )*zt + ALP211 )*zt + ALP111 540 512 ! 541 z beta = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt & ! beta542 & - 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 ) * zh513 zn = ( zn2 * zh + zn1 ) * zh + zn0 514 ! 515 pab(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm 516 ! 517 ! 518 zn2 = BET123*zsr + BET213*zt + BET113 519 ! 520 zn1 = ( ( BET142*zsr & 521 & + BET232*zt + BET132 )*zsr & 522 & + ( BET322*zt + BET222 )*zt + BET122 )*zsr & 523 & + ( ( BET412*zt + BET312 )*zt + BET212 )*zt + BET112 552 524 ! 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 525 zn0 = ( ( ( ( BET161*zsr & 526 & + BET251*zt + BET151 )*zsr & 527 & + ( BET341*zt + BET241 )*zt + BET141 )*zsr & 528 & + ( ( BET431*zt + BET331 )*zt + BET231 )*zt + BET131 )*zsr & 529 & + ( ( ( BET521*zt + BET421 )*zt + BET321 )*zt + BET221 )*zt + BET121 )*zsr & 530 & + ( ( ( ( BET611*zt + BET511 )*zt + BET411 )*zt + BET311 )*zt + BET211 )*zt + BET111 531 ! 532 zn = ( zn2 * zh + zn1 ) * zh + zn0 533 ! 534 pab(ji,jj,jk,jp_sal) = zn / zsr * r1_rau0 * ztm 535 ! 562 536 END DO 563 537 END DO 564 538 END DO 565 539 ! 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]) 540 CASE( 1 ) !== simplified EOS ==! 541 ! 542 DO jk = 1, jpkm1 579 543 DO jj = 1, jpj 580 544 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 545 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 546 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 547 zh = fsdept(ji,jj,jk) ! depth in meters at t-point 548 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 549 ! ! alpha 550 pab(ji,jj,jk,jp_tem) = ( rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs ) * r1_rau0 * ztm ! alpha 551 pab(ji,jj,jk,jp_sal) = ( rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt ) * r1_rau0 * ztm ! beta ! beta 584 552 END DO 585 553 END DO 586 554 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 555 ! 667 556 CASE DEFAULT … … 672 561 END SELECT 673 562 ! 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 ) 563 IF( nn_timing == 1 ) CALL timing_stop('rab_3d') 564 ! 565 END SUBROUTINE rab_3d 566 567 568 SUBROUTINE rab_2d( pts, pdep, pab ) 569 !!---------------------------------------------------------------------- 570 !! *** ROUTINE rab_2d *** 571 !! 572 !! ** Purpose : Calculates thermal/haline expansion ratio for a 2d field (unmasked) 573 !! 574 !! ** Action : - pab : thermal/haline expansion ratio at T-points 575 !!---------------------------------------------------------------------- 576 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT(in ) :: pts ! pot. temperature & salinity 577 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 578 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT( out) :: pab ! thermal/haline expansion ratio 579 ! 580 INTEGER :: ji, jj, jk ! dummy loop indices 581 REAL(wp) :: zt , zh , zs , zsr, ztm ! local scalars 582 REAL(wp) :: zn , zn0, zn1, zn2 ! - - 583 !!---------------------------------------------------------------------- 584 ! 585 IF( nn_timing == 1 ) CALL timing_start('rab_2d') 586 ! 587 pab(:,:,:) = 0._wp 588 ! 589 SELECT CASE ( nn_eos ) 590 ! 591 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 592 ! 593 DO jj = 1, jpjm1 594 DO ji = 1, fs_jpim1 ! vector opt. 595 ! 596 zt = pts (ji,jj,jp_tem) ! interpolated T 597 zsr = SQRT( MAX( pts(ji,jj,jp_sal) , 0.1_wp ) ) ! square root salinity 598 zh = pdep (ji,jj) ! depth at the partial step level 599 ! 600 ! 601 zn2 = ALP123*zsr + ALP213*zt + ALP113 602 ! 603 zn1 = ( ( ALP142*zsr & 604 & + ALP232*zt + ALP132 )*zsr & 605 & + ( ALP322*zt + ALP222 )*zt + ALP122 )*zsr & 606 & + ( ( ALP412*zt + ALP312 )*zt + ALP212 )*zt + ALP112 607 ! 608 zn0 = ( ( ( ( ALP161*zsr & 609 & + ALP251*zt + ALP151 )*zsr & 610 & + ( ALP341*zt + ALP241 )*zt + ALP141 )*zsr & 611 & + ( ( ALP431*zt + ALP331 )*zt + ALP231 )*zt + ALP131 )*zsr & 612 & + ( ( ( ALP521*zt + ALP421 )*zt + ALP321 )*zt + ALP221 )*zt + ALP121 )*zsr & 613 & + ( ( ( ( ALP611*zt + ALP511 )*zt + ALP411 )*zt + ALP311 )*zt + ALP211 )*zt + ALP111 614 ! 615 zn = ( zn2 * zh + zn1 ) * zh + zn0 616 ! 617 pab(ji,jj,jp_tem) = zn * r1_rau0 618 ! 619 ! 620 zn2 = BET123*zsr + BET213*zt + BET113 621 ! 622 zn1 = ( ( BET142*zsr & 623 & + BET232*zt + BET132 )*zsr & 624 & + ( BET322*zt + BET222 )*zt + BET122 )*zsr & 625 & + ( ( BET412*zt + BET312 )*zt + BET212 )*zt + BET112 626 ! 627 zn0 = ( ( ( ( BET161*zsr & 628 & + BET251*zt + BET151 )*zsr & 629 & + ( BET341*zt + BET241 )*zt + BET141 )*zsr & 630 & + ( ( BET431*zt + BET331 )*zt + BET231 )*zt + BET131 )*zsr & 631 & + ( ( ( BET521*zt + BET421 )*zt + BET321 )*zt + BET221 )*zt + BET121 )*zsr & 632 & + ( ( ( ( BET611*zt + BET511 )*zt + BET411 )*zt + BET311 )*zt + BET211 )*zt + BET111 633 ! 634 zn = ( zn2 * zh + zn1 ) * zh + zn0 635 ! 636 pab(ji,jj,jp_sal) = zn / zsr * r1_rau0 637 ! 638 ! 639 END DO 640 END DO 641 ! 642 CASE( 1 ) !== simplified EOS ==! 643 ! 644 DO jj = 1, jpjm1 645 DO ji = 1, fs_jpim1 ! vector opt. 646 ! 647 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 648 zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 649 zh = pdep (ji,jj) ! depth at the partial step level 650 ! 651 ! ! alpha 652 pab(ji,jj,jp_tem) = ( rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs ) * r1_rau0 ! alpha 653 pab(ji,jj,jp_sal) = ( rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt ) * r1_rau0 ! beta ! beta 654 ! 655 END DO 656 END DO 657 ! 658 CASE DEFAULT 659 IF(lwp) WRITE(numout,cform_err) 660 IF(lwp) WRITE(numout,*) ' bad flag value for nn_eos = ', nn_eos 661 nstop = nstop + 1 662 ! 663 END SELECT 664 ! 665 IF( nn_timing == 1 ) CALL timing_stop('rab_2d') 666 ! 667 END SUBROUTINE rab_2d 668 669 670 SUBROUTINE bn2( pts, pab, pn2 ) 671 !!---------------------------------------------------------------------- 672 !! *** ROUTINE bn2 *** 673 !! 674 !! ** Purpose : Compute the local Brunt-Vaisala frequency at the 675 !! time-step of the input arguments 676 !! 677 !! ** Method : pn2 = grav * (alpha dk[T] + beta dk[S] ) / e3w 678 !! where alpha and beta are given in pab, and computed on T-points. 679 !! N.B. N^2 is set one for all to zero at jk=1 in istate module. 680 !! 681 !! ** Action : pn2 : square of the brunt-vaisala frequency at w-point 682 !! 683 !! References : Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006 684 !! Jackett and McDougall, J. Atmos. Ocean. Tech., 1995 685 !! McDougall, J. Phys. Oceano., 1987 686 !!---------------------------------------------------------------------- 687 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celcius,psu] 688 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celcius-1,psu-1] 689 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 690 ! 691 INTEGER :: ji, jj, jk ! dummy loop indices 692 REAL(wp) :: zaw, zbw, zrw ! local scalars 693 !!---------------------------------------------------------------------- 694 ! 695 IF( nn_timing == 1 ) CALL timing_start('bn2') 696 ! 697 DO jk = 2, jpkm1 ! interior points only (2=< jk =< jpkm1 ) 698 DO jj = 1, jpj ! surface and bottom value set to zero one for all in istate.F90 699 DO ji = 1, jpi 700 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) & 701 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 702 ! 703 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 704 zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 705 ! 706 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 707 & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 708 & / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 709 END DO 710 END DO 711 END DO 712 ! 713 IF(ln_ctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ', ovlap=1, kdim=jpk ) 714 ! 715 IF( nn_timing == 1 ) CALL timing_stop('bn2') 716 ! 717 END SUBROUTINE bn2 718 719 720 FUNCTION eos_pt_from_ct( ctmp, psal ) RESULT( ptmp ) 721 !!---------------------------------------------------------------------- 722 !! *** ROUTINE eos_pt_from_ct *** 723 !! 724 !! ** Purpose : Compute pot.temp. from cons. temp. [Celcius] 725 !! 726 !! ** Method : rational approximation (5/3th order) of TEOS-10 algorithm 727 !! checkvalue: pt=20.0239165517474 Celsius for s=35.7psu, t=20degC 728 !! 729 !! Reference : TEOS-10, UNESCO 730 !! Rational fit, see Roquet (2013) 731 !!---------------------------------------------------------------------- 732 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celcius] 733 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 734 ! Leave result array automatic rather than making explicitly allocated 735 REAL(wp), DIMENSION(jpi,jpj) :: ptmp ! potential temperature [Celcius] 736 ! 737 INTEGER :: ji, jj ! dummy loop indices 738 REAL(wp) :: zt , zsr, ztm ! local scalars 739 REAL(wp) :: zn , zd ! local scalars 740 !!---------------------------------------------------------------------- 741 ! 742 IF ( nn_timing == 1 ) CALL timing_start('eos_pt_from_ct') 743 ! 744 DO jj = 1, jpj 745 DO ji = 1, jpi 746 zt = ctmp (ji,jj) 747 zsr = SQRT( MAX( psal(ji,jj) , 0.1_wp ) ) ! square root salinity 748 ztm = tmask(ji,jj,1) ! tmask 749 ! 750 zn = ( ( ( ( -1.960202285944569e-04_wp*zsr & 751 & - 6.698743070819174e-05_wp*zt + 4.456449354084589e-03_wp )*zsr & 752 & + ( 1.424140773841990e-05_wp*zt - 1.961306826357777e-04_wp )*zt & 753 & - 1.535458707717669e-02_wp )*zsr & 754 & + ( ( 2.814957335530553e-06_wp*zt + 1.534287192323960e-04_wp )*zt & 755 & + 2.701363554476190e-02_wp )*zt - 1.869037589289360e-02_wp )*zsr & 756 & + ( ( ( -1.646758381788031e-08_wp*zt + 4.568111226988701e-07_wp )*zt & 757 & - 7.853794523448087e-04_wp )*zt - 8.000001510387515e-03_wp )*zt & 758 & - 1.132820958753811e-03_wp )*zsr & 759 & + ( ( ( ( -3.885399051933490e-09_wp*zt + 6.608853649947305e-07_wp )*zt & 760 & - 1.507746029483144e-04_wp )*zt - 3.457378558412451e-03_wp )*zt & 761 & - 7.616362942562558e-01_wp )*zt - 2.067472332529282e-01_wp 762 ! 763 zd = ( ( 8.421053090759674e-04_wp*zsr & 764 & - 8.267668312138185e-04_wp*zt - 6.920238162292441e-02_wp )*zsr & 765 & + ( 5.063023899703211e-05_wp*zt + 1.488626985392304e-02_wp )*zt & 766 & + 1.541411683853927e-01_wp )*zsr & 767 & + ( ( 6.537389208598346e-07_wp*zt + 1.856814792031252e-03_wp )*zt & 768 & + 1.592477436776734e-01_wp )*zt + 1.406742653394891e+01_wp 769 ! 770 ptmp(ji,jj) = ( zt + zn / zd ) * ztm 771 ! 772 END DO 773 END DO 774 ! 775 IF( nn_timing == 1 ) CALL timing_stop('eos_pt_from_ct') 776 ! 777 END FUNCTION eos_pt_from_ct 778 779 780 FUNCTION eos_fzp( psal, pdep ) RESULT( ptf ) 781 !!---------------------------------------------------------------------- 782 !! *** ROUTINE eos_fzp *** 783 !! 784 !! ** Purpose : Compute the freezing point temperature [Celcius] 785 !! 786 !! ** Method : UNESCO freezing point (ptf) in Celcius is given by 787 !! ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 788 !! checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m 789 !! 790 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978 791 !!---------------------------------------------------------------------- 792 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 793 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 794 ! Leave result array automatic rather than making explicitly allocated 795 REAL(wp), DIMENSION(jpi,jpj) :: ptf ! freezing temperature [Celcius] 796 ! 797 INTEGER :: ji, jj ! dummy loop indices 798 REAL(wp) :: zt , zsr ! local scalars 799 !!---------------------------------------------------------------------- 800 ! 801 SELECT CASE ( nn_eos ) 802 ! 803 CASE ( -1, 1 ) !== CT,SA (TEOS-10 formulation) ==! 804 ! 805 DO jj = 1, jpj 806 DO ji = 1, jpi 807 zsr= SQRT( ABS( psal(ji,jj) ) ) * 0.1_wp ! square root salinity x 0.1 808 ptf(ji,jj) = 0.017947064327968_wp & 809 & + zsr*zsr*(-6.07609909992982_wp + zsr*(4.883198653547851_wp & 810 & + zsr*(-11.8808160123054_wp + zsr*(13.34658511480257_wp & 811 & + zsr*(-8.722761043208607_wp + 2.082038908808201_wp*zsr))))) 812 END DO 813 END DO 814 ! 815 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.69e-4 * pdep(:,:) 816 ! 817 CASE ( 0 ) !== PT,SP (UNESCO formulation) ==! 818 ! 819 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) & 820 & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:) 821 ! 822 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 823 ! 824 CASE DEFAULT 825 IF(lwp) WRITE(numout,cform_err) 826 IF(lwp) WRITE(numout,*) ' bad flag value for nn_eos = ', nn_eos 827 nstop = nstop + 1 828 ! 829 END SELECT 830 ! 831 END FUNCTION eos_fzp 832 833 834 SUBROUTINE eos_pen( pts, pab_pe, ppen ) 835 !!---------------------------------------------------------------------- 836 !! *** ROUTINE eos_pen *** 837 !! 838 !! ** Purpose : Calculates nonlinear anomalies of alpha_PE, beta_PE and PE at T-points 839 !! 840 !! ** Method : PE is defined analytically as the vertical 841 !! primitive of EOS times -g integrated between 0 and z>0. 842 !! pen is the nonlinear PE anomaly: ppen = ( PE - rau0 gz ) / rau0 gz - rd 843 !! = 1/z * /int_0^z rd dz - rd 844 !! where rd is the density anomaly (see eos_rhd function) 845 !! ab_pe are partial derivatives of PE anomaly with respect to T and S: 846 !! ab_pe(1) = - 1/(rau0 gz) * dPE/dT + drd/dT = - d(pen)/dT 847 !! ab_pe(2) = 1/(rau0 gz) * dPE/dS + drd/dS = d(pen)/dS 848 !! 849 !! * nn_eos = -1 : polynomial TEOS-10 850 !! * nn_eos = 0 : Jackett and McDougall (1995) (should not be used, using polynomial TEOS-10 formulation) 851 !! * nn_eos = 1 : Vallis equation of state (Vallis 2006) 852 !! 853 !! ** Action : - pen : PE anomaly given at T-points 854 !! : - pab_pe : given at T-points 855 !! pab_pe(:,:,:,jp_tem) is alpha_pe 856 !! pab_pe(:,:,:,jp_sal) is beta_pe 857 !!---------------------------------------------------------------------- 858 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 859 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab_pe ! alpha_pe and beta_pe 860 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: ppen ! potential energy anomaly 861 ! 862 INTEGER :: ji, jj, jk ! dummy loop indices 863 REAL(wp) :: zt , zh , zsr, ztm , zs ! local scalars 864 REAL(wp) :: zn 865 !!---------------------------------------------------------------------- 866 ! 867 IF ( nn_timing == 1 ) CALL timing_start('eos_pen') 868 ! 869 SELECT CASE ( nn_eos ) 870 ! 871 CASE ( -1 , 0 ) ! polyTEOS10 (used also for JM95 case as an approximation) 872 ! 873 DO jk = 1, jpkm1 874 DO jj = 1, jpj 875 DO ji = 1, jpi 876 zt = pts (ji,jj,jk,jp_tem) 877 zh = fsdept(ji,jj,jk) ! depth 878 zsr = SQRT( MAX( pts(ji,jj,jk,jp_sal) , 0.1_wp ) ) ! square root salinity 879 ztm = tmask(ji,jj,jk) ! tmask 880 ! 881 ! 882 zn = ( ( ( PEN133*zsr & 883 & + PEN223*zt + PEN123 )*zsr & 884 & + ( PEN313*zt + PEN213 )*zt + PEN113 )*zh & 885 & + ( ( ( PEN152*zsr & 886 & + PEN242*zt + PEN142 )*zsr & 887 & + ( PEN332*zt + PEN232 )*zt + PEN132 )*zsr & 888 & + ( ( PEN422*zt + PEN322 )*zt + PEN222 )*zt + PEN122 )*zsr & 889 & + ( ( ( PEN512*zt + PEN412 )*zt + PEN312 )*zt + PEN212 )*zt + PEN112 )*zh 890 ! 891 ! ! potential energy non-linear anomaly 892 ppen(ji,jj,jk) = zn * r1_rau0 * ztm 893 ! 894 ! 895 zn = ( ( ( APE123 )*zsr & 896 & + APE213*zt + APE113 )*zh & 897 & + ( ( ( APE142 )*zsr & 898 & + APE232*zt + APE132 )*zsr & 899 & + ( APE322*zt + APE222 )*zt + APE122 )*zsr & 900 & + ( ( APE412*zt + APE312 )*zt + APE212 )*zt + APE112 )*zh 901 ! 902 ! ! alphaPE non-linear anomaly 903 pab_pe(ji,jj,jk,jp_tem) = zn * r1_rau0 * ztm 904 ! 905 ! 906 zn = ( ( ( BPE123 )*zsr & 907 & + BPE213*zt + BPE113 )*zh & 908 & + ( ( ( BPE142 )*zsr & 909 & + BPE232*zt + BPE132 )*zsr & 910 & + ( BPE322*zt + BPE222 )*zt + BPE122 )*zsr & 911 & + ( ( BPE412*zt + BPE312 )*zt + BPE212 )*zt + BPE112 )*zh 912 ! 913 ! ! betaPE non-linear anomaly 914 pab_pe(ji,jj,jk,jp_sal) = zn / zsr * r1_rau0 * ztm 915 ! 916 END DO 917 END DO 918 END DO 919 ! 920 CASE( 1 ) !== Vallis (2006) simplified EOS ==! 921 ! 922 DO jk = 1, jpkm1 923 DO jj = 1, jpj 924 DO ji = 1, jpi 925 zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0) 926 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 927 zh = fsdept(ji,jj,jk) ! depth in meters at t-point 928 ztm = tmask(ji,jj,jk) ! tmask 929 zn = 0.5_wp * zh * r1_rau0 * ztm 930 ! ! Potential Energy 931 ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 932 ! ! alphaPE 933 pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 934 pab_pe(ji,jj,jk,jp_sal) = rn_b0 * rn_mu2 * zn 935 ! 936 END DO 937 END DO 938 END DO 939 ! 940 CASE DEFAULT 941 IF(lwp) WRITE(numout,cform_err) 942 IF(lwp) WRITE(numout,*) ' bad flag value for nn_eos = ', nn_eos 943 nstop = nstop + 1 944 ! 945 END SELECT 946 ! 947 IF( nn_timing == 1 ) CALL timing_stop('eos_pen') 948 ! 949 END SUBROUTINE eos_pen 950 951 952 SUBROUTINE eos_init 680 953 !!---------------------------------------------------------------------- 681 954 !! *** ROUTINE eos_init *** 682 955 !! 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 956 !! ** Purpose : initializations for the equation of state 711 957 !! 712 958 !! ** Method : Read the namelist nameos and control the parameters 713 959 !!---------------------------------------------------------------------- 714 NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta 715 !!---------------------------------------------------------------------- 716 INTEGER :: ios 960 INTEGER :: ios ! local integer 961 !! 962 NAMELIST/nameos/ nn_eos, ln_useCT, rn_a0, rn_b0, rn_lambda1, rn_mu1, & 963 & rn_lambda2, rn_mu2, rn_nu 964 !!---------------------------------------------------------------------- 717 965 ! 718 966 REWIND( numnam_ref ) ! Namelist nameos in reference namelist : equation of state 719 967 READ ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 720 968 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist', lwp ) 721 969 ! 722 970 REWIND( numnam_cfg ) ! Namelist nameos in configuration namelist : equation of state 723 971 READ ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 724 972 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist', lwp ) 725 973 WRITE( numond, nameos ) 974 ! 975 rau0 = 1026._wp !: volumic mass of reference [kg/m3] 976 rcp = 3992._wp !: heat capacity [J/K] 726 977 ! 727 978 IF(lwp) THEN ! Control print … … 731 982 WRITE(numout,*) ' Namelist nameos : set eos parameters' 732 983 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 984 IF( ln_useCT ) THEN 985 WRITE(numout,*) ' model uses Conservative Temperature' 986 WRITE(numout,*) ' Important: model must be initialized with CT and SA fields' 987 ENDIF 735 988 ENDIF 736 989 ! 737 990 SELECT CASE( nn_eos ) ! check option 738 991 ! 739 CASE( 0 ) !== Jackett and McDougall (1994) formulation==!992 CASE( -1 ) !== polynomial TEOS-10 ==! 740 993 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 ) ==! 994 IF(lwp) WRITE(numout,*) ' use of TEOS-10 equation of state (cons. temp. and abs. salinity)' 995 ! 996 EOS111 = 9.9984112007e+02_wp 997 EOS211 = 6.4904564681e-02_wp 998 EOS311 = -8.1866708294e-03_wp 999 EOS411 = 8.4327846386e-05_wp 1000 EOS511 = -9.9853850905e-07_wp 1001 EOS611 = 9.5342506671e-09_wp 1002 EOS711 = -5.5942725501e-11_wp 1003 EOS121 = 4.8745609554e-04_wp 1004 EOS221 = -7.9137653036e-04_wp 1005 EOS321 = 1.1241300058e-04_wp 1006 EOS421 = -4.2658318975e-06_wp 1007 EOS521 = 2.7589924936e-08_wp 1008 EOS621 = 5.6573234128e-10_wp 1009 EOS131 = 8.2409990767e-01_wp 1010 EOS231 = -3.6746935996e-03_wp 1011 EOS331 = 2.8088034997e-05_wp 1012 EOS431 = 3.9432934562e-07_wp 1013 EOS531 = -8.6081969467e-09_wp 1014 EOS141 = -8.5860758561e-03_wp 1015 EOS241 = 1.0048170774e-04_wp 1016 EOS341 = -1.1219591564e-06_wp 1017 EOS441 = -1.4550322467e-09_wp 1018 EOS151 = 1.2633903654e-03_wp 1019 EOS251 = -7.2707200365e-06_wp 1020 EOS351 = 2.6241351559e-08_wp 1021 EOS161 = -7.4242043203e-05_wp 1022 EOS261 = 3.8374457797e-07_wp 1023 EOS171 = 1.2722088050e-06_wp 1024 EOS112 = 4.3845092294e-04_wp 1025 EOS212 = -3.5237528758e-05_wp 1026 EOS312 = 5.7586626030e-07_wp 1027 EOS412 = -6.3139238271e-09_wp 1028 EOS512 = 3.9434377793e-11_wp 1029 EOS122 = -7.6672754907e-06_wp 1030 EOS222 = 9.0194877799e-08_wp 1031 EOS322 = -1.6940551903e-09_wp 1032 EOS422 = 3.1783762285e-11_wp 1033 EOS132 = -5.9870305749e-06_wp 1034 EOS232 = 1.0325176608e-07_wp 1035 EOS332 = -8.0185331501e-10_wp 1036 EOS142 = -5.6324524012e-07_wp 1037 EOS242 = 6.6221210305e-10_wp 1038 EOS152 = 3.9558159454e-08_wp 1039 EOS113 = -1.6847693220e-09_wp 1040 EOS213 = 5.3653075114e-10_wp 1041 EOS313 = -1.0864160933e-11_wp 1042 EOS123 = -1.6883150438e-09_wp 1043 EOS223 = 6.5982407189e-12_wp 1044 EOS133 = 2.7370939782e-10_wp 1045 ! 1046 ALP111 = -6.4904564681e-02_wp 1047 ALP211 = 1.6373341659e-02_wp 1048 ALP311 = -2.5298353916e-04_wp 1049 ALP411 = 3.9941540362e-06_wp 1050 ALP511 = -4.7671253336e-08_wp 1051 ALP611 = 3.3565635301e-10_wp 1052 ALP121 = 7.9137653036e-04_wp 1053 ALP221 = -2.2482600117e-04_wp 1054 ALP321 = 1.2797495693e-05_wp 1055 ALP421 = -1.1035969974e-07_wp 1056 ALP521 = -2.8286617064e-09_wp 1057 ALP131 = 3.6746935996e-03_wp 1058 ALP231 = -5.6176069994e-05_wp 1059 ALP331 = -1.1829880369e-06_wp 1060 ALP431 = 3.4432787787e-08_wp 1061 ALP141 = -1.0048170774e-04_wp 1062 ALP241 = 2.2439183129e-06_wp 1063 ALP341 = 4.3650967401e-09_wp 1064 ALP151 = 7.2707200365e-06_wp 1065 ALP251 = -5.2482703118e-08_wp 1066 ALP161 = -3.8374457797e-07_wp 1067 ALP112 = 3.5237528758e-05_wp 1068 ALP212 = -1.1517325206e-06_wp 1069 ALP312 = 1.8941771481e-08_wp 1070 ALP412 = -1.5773751117e-10_wp 1071 ALP122 = -9.0194877799e-08_wp 1072 ALP222 = 3.3881103805e-09_wp 1073 ALP322 = -9.5351286854e-11_wp 1074 ALP132 = -1.0325176608e-07_wp 1075 ALP232 = 1.6037066300e-09_wp 1076 ALP142 = -6.6221210305e-10_wp 1077 ALP113 = -5.3653075114e-10_wp 1078 ALP213 = 2.1728321866e-11_wp 1079 ALP123 = -6.5982407189e-12_wp 1080 ! 1081 BET111 = 2.4372804777e-04_wp 1082 BET211 = -3.9568826518e-04_wp 1083 BET311 = 5.6206500292e-05_wp 1084 BET411 = -2.1329159488e-06_wp 1085 BET511 = 1.3794962468e-08_wp 1086 BET611 = 2.8286617064e-10_wp 1087 BET121 = 8.2409990767e-01_wp 1088 BET221 = -3.6746935996e-03_wp 1089 BET321 = 2.8088034997e-05_wp 1090 BET421 = 3.9432934562e-07_wp 1091 BET521 = -8.6081969467e-09_wp 1092 BET131 = -1.2879113784e-02_wp 1093 BET231 = 1.5072256162e-04_wp 1094 BET331 = -1.6829387347e-06_wp 1095 BET431 = -2.1825483700e-09_wp 1096 BET141 = 2.5267807308e-03_wp 1097 BET241 = -1.4541440073e-05_wp 1098 BET341 = 5.2482703118e-08_wp 1099 BET151 = -1.8560510801e-04_wp 1100 BET251 = 9.5936144494e-07_wp 1101 BET161 = 3.8166264151e-06_wp 1102 BET112 = -3.8336377454e-06_wp 1103 BET212 = 4.5097438900e-08_wp 1104 BET312 = -8.4702759513e-10_wp 1105 BET412 = 1.5891881142e-11_wp 1106 BET122 = -5.9870305749e-06_wp 1107 BET222 = 1.0325176608e-07_wp 1108 BET322 = -8.0185331501e-10_wp 1109 BET132 = -8.4486786018e-07_wp 1110 BET232 = 9.9331815458e-10_wp 1111 BET142 = 7.9116318907e-08_wp 1112 BET113 = -8.4415752190e-10_wp 1113 BET213 = 3.2991203594e-12_wp 1114 BET123 = 2.7370939782e-10_wp 1115 ! 1116 PEN112 = -2.1922546147e-04_wp 1117 PEN212 = 1.7618764379e-05_wp 1118 PEN312 = -2.8793313015e-07_wp 1119 PEN412 = 3.1569619136e-09_wp 1120 PEN512 = -1.9717188896e-11_wp 1121 PEN122 = 3.8336377454e-06_wp 1122 PEN222 = -4.5097438900e-08_wp 1123 PEN322 = 8.4702759513e-10_wp 1124 PEN422 = -1.5891881142e-11_wp 1125 PEN132 = 2.9935152875e-06_wp 1126 PEN232 = -5.1625883042e-08_wp 1127 PEN332 = 4.0092665751e-10_wp 1128 PEN142 = 2.8162262006e-07_wp 1129 PEN242 = -3.3110605153e-10_wp 1130 PEN152 = -1.9779079727e-08_wp 1131 PEN113 = 1.1231795480e-09_wp 1132 PEN213 = -3.5768716743e-10_wp 1133 PEN313 = 7.2427739554e-12_wp 1134 PEN123 = 1.1255433625e-09_wp 1135 PEN223 = -4.3988271459e-12_wp 1136 PEN133 = -1.8247293188e-10_wp 1137 ! 1138 APE112 = -1.7618764379e-05_wp 1139 APE212 = 5.7586626030e-07_wp 1140 APE312 = -9.4708857407e-09_wp 1141 APE412 = 7.8868755586e-11_wp 1142 APE122 = 4.5097438900e-08_wp 1143 APE222 = -1.6940551903e-09_wp 1144 APE322 = 4.7675643427e-11_wp 1145 APE132 = 5.1625883042e-08_wp 1146 APE232 = -8.0185331501e-10_wp 1147 APE142 = 3.3110605153e-10_wp 1148 APE113 = 3.5768716743e-10_wp 1149 APE213 = -1.4485547911e-11_wp 1150 APE123 = 4.3988271459e-12_wp 1151 ! 1152 BPE112 = 1.9168188727e-06_wp 1153 BPE212 = -2.2548719450e-08_wp 1154 BPE312 = 4.2351379756e-10_wp 1155 BPE412 = -7.9459405711e-12_wp 1156 BPE122 = 2.9935152875e-06_wp 1157 BPE222 = -5.1625883042e-08_wp 1158 BPE322 = 4.0092665751e-10_wp 1159 BPE132 = 4.2243393009e-07_wp 1160 BPE232 = -4.9665907729e-10_wp 1161 BPE142 = -3.9558159454e-08_wp 1162 BPE113 = 5.6277168127e-10_wp 1163 BPE213 = -2.1994135730e-12_wp 1164 BPE123 = -1.8247293188e-10_wp 1165 ! 1166 CASE( 0 ) !== polynomial EOS-80 formulation ==! 1167 ! 745 1168 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 )' 1169 IF(lwp) WRITE(numout,*) ' use of EOS-80 equation of state (pot. temp. and pract. salinity)' 1170 ! 1171 EOS111 = 9.9984240021e+02_wp 1172 EOS211 = 6.8051135248e-02_wp 1173 EOS311 = -9.0991456041e-03_wp 1174 EOS411 = 9.9238754931e-05_wp 1175 EOS511 = -1.0602210389e-06_wp 1176 EOS611 = 5.1296071368e-09_wp 1177 EOS711 = 1.1887242136e-11_wp 1178 EOS121 = -1.9799119661e-04_wp 1179 EOS221 = -1.6676932531e-05_wp 1180 EOS321 = 3.2084304200e-06_wp 1181 EOS421 = -4.8983568948e-08_wp 1182 EOS521 = -1.5610111448e-09_wp 1183 EOS621 = 2.8366680541e-11_wp 1184 EOS131 = 8.2448582544e-01_wp 1185 EOS231 = -4.0764319966e-03_wp 1186 EOS331 = 7.4898579574e-05_wp 1187 EOS431 = -7.7884546946e-07_wp 1188 EOS531 = 5.0405569756e-09_wp 1189 EOS141 = -5.7150204345e-03_wp 1190 EOS241 = 1.0157923923e-04_wp 1191 EOS341 = -1.6325795501e-06_wp 1192 EOS441 = -1.6144820180e-09_wp 1193 EOS151 = 4.8005813592e-04_wp 1194 EOS251 = 1.6199868493e-07_wp 1195 EOS351 = 7.8805435082e-09_wp 1196 EOS161 = 1.9978872493e-07_wp 1197 EOS261 = -3.1437087783e-08_wp 1198 EOS171 = 2.5463113215e-08_wp 1199 EOS112 = 4.3756680685e-04_wp 1200 EOS212 = -3.7298355935e-05_wp 1201 EOS312 = 6.5348660941e-07_wp 1202 EOS412 = -7.2558835910e-09_wp 1203 EOS512 = 3.8273323221e-11_wp 1204 EOS122 = 1.4369434305e-06_wp 1205 EOS222 = 5.6521871685e-08_wp 1206 EOS322 = -1.2136936896e-08_wp 1207 EOS422 = 2.1030996727e-10_wp 1208 EOS132 = -1.0262750144e-05_wp 1209 EOS232 = 2.0858571138e-07_wp 1210 EOS332 = -1.4826357415e-09_wp 1211 EOS142 = 8.5860757162e-08_wp 1212 EOS242 = -5.2140945761e-09_wp 1213 EOS152 = 8.2162682979e-09_wp 1214 EOS113 = -5.5011801985e-09_wp 1215 EOS213 = 5.7020541017e-10_wp 1216 EOS313 = -1.0193603551e-11_wp 1217 EOS123 = -1.0893703284e-10_wp 1218 EOS223 = -4.1944954508e-12_wp 1219 EOS133 = 1.1857534169e-10_wp 1220 ! 1221 ALP111 = -6.8051135248e-02_wp 1222 ALP211 = 1.8198291208e-02_wp 1223 ALP311 = -2.9771626479e-04_wp 1224 ALP411 = 4.2408841556e-06_wp 1225 ALP511 = -2.5648035684e-08_wp 1226 ALP611 = -7.1323452819e-11_wp 1227 ALP121 = 1.6676932531e-05_wp 1228 ALP221 = -6.4168608399e-06_wp 1229 ALP321 = 1.4695070684e-07_wp 1230 ALP421 = 6.2440445791e-09_wp 1231 ALP521 = -1.4183340270e-10_wp 1232 ALP131 = 4.0764319966e-03_wp 1233 ALP231 = -1.4979715915e-04_wp 1234 ALP331 = 2.3365364084e-06_wp 1235 ALP431 = -2.0162227903e-08_wp 1236 ALP141 = -1.0157923923e-04_wp 1237 ALP241 = 3.2651591003e-06_wp 1238 ALP341 = 4.8434460540e-09_wp 1239 ALP151 = -1.6199868493e-07_wp 1240 ALP251 = -1.5761087016e-08_wp 1241 ALP161 = 3.1437087783e-08_wp 1242 ALP112 = 3.7298355935e-05_wp 1243 ALP212 = -1.3069732188e-06_wp 1244 ALP312 = 2.1767650773e-08_wp 1245 ALP412 = -1.5309329288e-10_wp 1246 ALP122 = -5.6521871685e-08_wp 1247 ALP222 = 2.4273873792e-08_wp 1248 ALP322 = -6.3092990180e-10_wp 1249 ALP132 = -2.0858571138e-07_wp 1250 ALP232 = 2.9652714830e-09_wp 1251 ALP142 = 5.2140945761e-09_wp 1252 ALP113 = -5.7020541017e-10_wp 1253 ALP213 = 2.0387207103e-11_wp 1254 ALP123 = 4.1944954508e-12_wp 1255 ! 1256 BET111 = -9.8995598303e-05_wp 1257 BET211 = -8.3384662657e-06_wp 1258 BET311 = 1.6042152100e-06_wp 1259 BET411 = -2.4491784474e-08_wp 1260 BET511 = -7.8050557238e-10_wp 1261 BET611 = 1.4183340270e-11_wp 1262 BET121 = 8.2448582544e-01_wp 1263 BET221 = -4.0764319966e-03_wp 1264 BET321 = 7.4898579574e-05_wp 1265 BET421 = -7.7884546946e-07_wp 1266 BET521 = 5.0405569756e-09_wp 1267 BET131 = -8.5725306517e-03_wp 1268 BET231 = 1.5236885884e-04_wp 1269 BET331 = -2.4488693252e-06_wp 1270 BET431 = -2.4217230270e-09_wp 1271 BET141 = 9.6011627184e-04_wp 1272 BET241 = 3.2399736986e-07_wp 1273 BET341 = 1.5761087016e-08_wp 1274 BET151 = 4.9947181231e-07_wp 1275 BET251 = -7.8592719459e-08_wp 1276 BET161 = 7.6389339644e-08_wp 1277 BET112 = 7.1847171523e-07_wp 1278 BET212 = 2.8260935842e-08_wp 1279 BET312 = -6.0684684481e-09_wp 1280 BET412 = 1.0515498363e-10_wp 1281 BET122 = -1.0262750144e-05_wp 1282 BET222 = 2.0858571138e-07_wp 1283 BET322 = -1.4826357415e-09_wp 1284 BET132 = 1.2879113574e-07_wp 1285 BET232 = -7.8211418642e-09_wp 1286 BET142 = 1.6432536596e-08_wp 1287 BET113 = -5.4468516419e-11_wp 1288 BET213 = -2.0972477254e-12_wp 1289 BET123 = 1.1857534169e-10_wp 1290 ! 1291 PEN112 = -2.1878340343e-04_wp 1292 PEN212 = 1.8649177967e-05_wp 1293 PEN312 = -3.2674330470e-07_wp 1294 PEN412 = 3.6279417955e-09_wp 1295 PEN512 = -1.9136661610e-11_wp 1296 PEN122 = -7.1847171523e-07_wp 1297 PEN222 = -2.8260935842e-08_wp 1298 PEN322 = 6.0684684481e-09_wp 1299 PEN422 = -1.0515498363e-10_wp 1300 PEN132 = 5.1313750720e-06_wp 1301 PEN232 = -1.0429285569e-07_wp 1302 PEN332 = 7.4131787075e-10_wp 1303 PEN142 = -4.2930378581e-08_wp 1304 PEN242 = 2.6070472881e-09_wp 1305 PEN152 = -4.1081341490e-09_wp 1306 PEN113 = 3.6674534657e-09_wp 1307 PEN213 = -3.8013694011e-10_wp 1308 PEN313 = 6.7957357010e-12_wp 1309 PEN123 = 7.2624688558e-11_wp 1310 PEN223 = 2.7963303006e-12_wp 1311 PEN133 = -7.9050227794e-11_wp 1312 ! 1313 APE112 = -1.8649177967e-05_wp 1314 APE212 = 6.5348660941e-07_wp 1315 APE312 = -1.0883825386e-08_wp 1316 APE412 = 7.6546646441e-11_wp 1317 APE122 = 2.8260935842e-08_wp 1318 APE222 = -1.2136936896e-08_wp 1319 APE322 = 3.1546495090e-10_wp 1320 APE132 = 1.0429285569e-07_wp 1321 APE232 = -1.4826357415e-09_wp 1322 APE142 = -2.6070472881e-09_wp 1323 APE113 = 3.8013694011e-10_wp 1324 APE213 = -1.3591471402e-11_wp 1325 APE123 = -2.7963303006e-12_wp 1326 ! 1327 BPE112 = -3.5923585761e-07_wp 1328 BPE212 = -1.4130467921e-08_wp 1329 BPE312 = 3.0342342240e-09_wp 1330 BPE412 = -5.2577491816e-11_wp 1331 BPE122 = 5.1313750720e-06_wp 1332 BPE222 = -1.0429285569e-07_wp 1333 BPE322 = 7.4131787075e-10_wp 1334 BPE132 = -6.4395567871e-08_wp 1335 BPE232 = 3.9105709321e-09_wp 1336 BPE142 = -8.2162682979e-09_wp 1337 BPE113 = 3.6312344279e-11_wp 1338 BPE213 = 1.3981651503e-12_wp 1339 BPE123 = -7.9050227794e-11_wp 1340 ! 1341 CASE( 1 ) !== Simplified EOS ==! 1342 IF(lwp) THEN 1343 WRITE(numout,*) 1344 WRITE(numout,*) ' use of simplified eos: rhd(dT=T-10,dS=S-35,Z) = ' 1345 WRITE(numout,*) ' [-a0*(1+lambda1/2*dT+mu1*Z)*dT + b0*(1+lambda2/2*dT+mu2*Z)*dS - nu*dT*dS]/rau0' 1346 WRITE(numout,*) 1347 WRITE(numout,*) ' thermal exp. coef. rn_a0 = ', rn_a0 1348 WRITE(numout,*) ' saline cont. coef. rn_b0 = ', rn_b0 1349 WRITE(numout,*) ' cabbeling coef. rn_lambda1 = ', rn_lambda1 1350 WRITE(numout,*) ' cabbeling coef. rn_lambda2 = ', rn_lambda2 1351 WRITE(numout,*) ' thermobar. coef. rn_mu1 = ', rn_mu1 1352 WRITE(numout,*) ' thermobar. coef. rn_mu2 = ', rn_mu2 1353 WRITE(numout,*) ' 2nd cabbel. coef. rn_nu = ', rn_nu 1354 WRITE(numout,*) ' Caution: rn_beta0=0 incompatible with ddm parameterization ' 1355 ENDIF 754 1356 ! 755 1357 CASE DEFAULT !== ERROR in nn_eos ==! … … 759 1361 END SELECT 760 1362 ! 1363 r1_rau0 = 1._wp / rau0 1364 r1_rcp = 1._wp / rcp 1365 r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 1366 ! 1367 IF(lwp) WRITE(numout,*) 1368 IF(lwp) WRITE(numout,*) ' volumic mass of reference rau0 = ', rau0 , ' kg/m^3' 1369 IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0 = ', r1_rau0, ' m^3/kg' 1370 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin' 1371 IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp 1372 ! 761 1373 END SUBROUTINE eos_init 762 1374 -
branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r4499 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r4499 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r4499 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r4499 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r4499 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r4499 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r4147 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r4292 r4619 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 617 mgrhu(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) )618 mgrhv(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) )553 mgrhu(ji,jj) = INT( SIGN( 1.e0, fsdept_0(ji+1,jj,mbkt(ji+1,jj)) - fsdept_0(ji,jj,mbkt(ji,jj)) ) ) 554 mgrhv(ji,jj) = INT( SIGN( 1.e0, fsdept_0(ji,jj+1,mbkt(ji,jj+1)) - fsdept_0(ji,jj,mbkt(ji,jj)) ) ) 619 555 END DO 620 556 END DO 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)624 e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj )),e3u_0(ji,jj,mbkt(ji,jj)) )625 e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji ,jj+1)),e3v_0(ji,jj,mbkt(ji,jj)) )559 DO ji = 1, jpim1 ! minimum of top & bottom e3u_0 (e3v_0) 560 e3u_bbl_0(ji,jj) = MIN( fse3u_0(ji,jj,mbkt(ji+1,jj )), fse3u_0(ji,jj,mbkt(ji,jj)) ) 561 e3v_bbl_0(ji,jj) = MIN( fse3v_0(ji,jj,mbkt(ji ,jj+1)), fse3v_0(ji,jj,mbkt(ji,jj)) ) 626 562 END DO 627 563 END DO -
branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r4292 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r4488 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r3632 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
r4313 r4619 17 17 USE dom_oce ! ocean space and time domain 18 18 USE zdf_oce ! ocean vertical physics 19 USE trd mod_oce! ocean active tracer trends19 USE trd_oce ! ocean active tracer trends 20 20 USE trdtra ! ocean active tracer trends 21 21 USE eosbn2 ! equation of state (eos routine) … … 199 199 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 200 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 )201 CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt ) 202 CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds ) 203 203 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 204 204 ENDIF -
branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r4328 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r4333 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r3764 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r3294 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r3294 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r3632 r4619 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 trdmod_trc ! 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 (trdmod_trc) 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_mod_trc 160 CALL trd_mod_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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
r3294 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90
r2715 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r4381 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r4147 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r3294 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r4147 r4619 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 … … 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r4245 r4619 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. … … 25 27 PUBLIC zdf_mxl ! called by step.F90 26 28 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 29 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nmln !: number of level in the mixed layer (used by TOP) 31 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmld !: mixing layer depth (turbocline) [m] 32 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmlp !: mixed layer depth (rho=rho0+zdcrit) [m] 33 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmlpt !: mixed layer depth at t-points [m] 33 34 REAL(wp), PUBLIC :: rho_c = 0.01_wp !: density criterion for mixed layer depth 35 REAL(wp) :: avt_c = 5.e-4_wp ! Kz criterion for the turbocline depth 34 36 35 37 !! * Substitutions … … 70 72 !! eddy diffusivity coefficient (resulting from the vertical physics 71 73 !! 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 )74 !! value defined locally (avt_c here taken equal to 5 cm/s2 by default) 73 75 !! 74 76 !! ** Action : nmln, hmld, hmlp, hmlpt 75 77 !!---------------------------------------------------------------------- 76 78 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 79 ! 80 INTEGER :: ji, jj, jk ! dummy loop indices 81 INTEGER :: iikn, iiki ! local integer 82 REAL(wp) :: zmult ! local scalar 83 INTEGER, POINTER, DIMENSION(:,:) :: imld ! 2D workspace 81 84 !!---------------------------------------------------------------------- 82 85 ! … … 94 97 95 98 ! w-level of the mixing and mixed layers 96 nmln(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point 97 imld(:,:) = mbkt(:,:) + 1 99 nmln (:,:) = nlb10 ! Initialization to the number of w ocean point 100 hmlp (:,:) = 0._wp ! used as a dummy variable, integrating vertically N2 101 zmult = rho_c * r1_rau0 * grav 102 DO jk = nlb10, jpkm1 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 hmlp(ji,jj) = hmlp(ji,jj) + rn2b(ji,jj,jk) * fse3w(ji,jj,jk) 106 IF( hmlp(ji,jj) < zmult ) nmln(ji,jj) = jk + 1 ! Mixed layer 107 END DO 108 END DO 109 END DO 110 ! 111 DO jj = 1, jpj ! bottom k-index of u- (v-) level 112 DO ji = 1, jpi 113 nmln(ji,jj) = MIN( nmln(ji,jj) , mbkt(ji,jj) + 1 ) 114 END DO 115 END DO 116 !! end fabien 117 ! w-level of the turbocline 118 imld(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point 98 119 DO jk = jpkm1, nlb10, -1 ! from the bottom to nlb10 99 120 DO jj = 1, jpj 100 121 DO ji = 1, jpi 101 IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rho_c ) nmln(ji,jj) = jk ! Mixed layer102 122 IF( avt (ji,jj,jk) < avt_c ) imld(ji,jj) = jk ! Turbocline 103 123 END DO -
branches/2014/dev_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r4147 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4354 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/oce.F90
r4354 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
r4205 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/step.F90
r4491 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r4328 r4619 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_CNRS1_10_TEOS10_Ediag/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90
r2528 r4619 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
Note: See TracChangeset
for help on using the changeset viewer.