- Timestamp:
- 2014-03-26T12:02:30+01:00 (10 years ago)
- Location:
- branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM
- Files:
-
- 3 added
- 17 deleted
- 46 edited
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
r4370 r4596 82 82 !----------------------------------------------------------------------- 83 83 nn_fsbc = 1 ! frequency of surface boundary condition computation 84 84 ! ! (also = the frequency of sea-ice model call) 85 85 ln_ana = .true. ! analytical formulation (T => fill namsbc_ana ) 86 86 ln_blk_core = .false. ! CORE bulk formulation (T => fill namsbc_core) … … 212 212 &namtra_ldf ! lateral diffusion scheme for tracers 213 213 !---------------------------------------------------------------------------------- 214 rn_aeiv_0 = 0. ! eddy induced velocity coefficient [m2/s] 215 rn_aht_0 = 1000. ! horizontal eddy diffusivity for tracers [m2/s] 214 ! ! Operator type: 215 ln_traldf_lap = .true. ! laplacian operator 216 ln_traldf_blp = .false. ! bilaplacian operator 217 ! ! Direction of action: 218 ln_traldf_lev = .false. ! iso-level 219 ln_traldf_hor = .false. ! horizontal (geopotential) 220 ln_traldf_iso = .false. ! iso-neutral 221 ln_traldf_triad = .true. ! iso-neutral with Griffies triads 222 ! 223 ! ! iso-neutral options 224 ln_traldf_msc = .true. ! Method of Stabilizing Correction (both operator) 225 rn_slpmax = 0.01 ! slope limit (both operator) 226 ln_triad_iso = .false. ! pure horizontal mixing in ML (triad only) 227 ln_botmix_triad = .false. ! lateral mixing on bottom (triad only) 228 ! 229 ! ! Coefficients 230 nn_aht_ijk_t = 0 ! space/time variation of eddy coef 231 ! ! =0 constant ; =10 F(k) ; =20 F(i,j)=F(grid spacing) ; =30 F(i,j,k) 232 ! ! =21 F(i,jt)=Treguier et al. JPO 1997 formulation 233 ! ! =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 234 rn_aht_0 = 1000. ! lateral eddy diffusivity (lap. operator) [m2/s] 235 rn_bht_0 = 5.e+11 ! lateral eddy diffusivity (bilap. operator) [m4/s] 236 / 237 !---------------------------------------------------------------------------------- 238 &namtra_ldfeiv ! eddy induced velocity param. 239 !---------------------------------------------------------------------------------- 240 ln_ldfeiv =.false. ! use eddy induced velocity parameterization 241 ln_ldfeiv_dia =.false. ! diagnose eiv stream function and velocities 242 rn_aeiv_0 = 1000. ! eddy induced velocity coefficient [m2/s] 243 nn_aei_ijk_t = 0 ! space/time variation of the eiv coeficient 244 ! ! =0 constant ; =10 F(k) ; =20 F(i,j) = F(grid spacing) ; =30 F(i,j,k) 245 ! ! =21 F(i,jt)=Treguier et al. JPO 1997 formulation 246 ! ! =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 216 247 / 217 248 !----------------------------------------------------------------------- … … 242 273 !namdyn_spg ! surface pressure gradient (CPP key only) 243 274 !----------------------------------------------------------------------- 275 244 276 !----------------------------------------------------------------------- 245 277 &namdyn_ldf ! lateral diffusion on momentum 246 278 !----------------------------------------------------------------------- 247 rn_ahm_0_lap = 100000. ! horizontal laplacian eddy viscosity [m2/s] 279 ! ! Type of the operator : 280 ln_dynldf_lap = .true. ! laplacian operator 281 ln_dynldf_blp = .false. ! bilaplacian operator 282 ! ! Direction of action : 283 ln_dynldf_lev = .false. ! iso-level 284 ln_dynldf_hor = .true. ! horizontal (geopotential) 285 ln_dynldf_iso = .false. ! iso-neutral 286 ! ! Coefficient 287 nn_ahm_ijk_t = 0 ! space/time variation of eddy coef 288 ! ! =0 constant ; =10 F(k) ; =20 F(i,j)=F(grid spacing) ; =30 F(i,j,k) 289 ! ! =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 290 rn_ahm_0 = 100000. ! horizontal laplacian eddy viscosity [m2/s] 291 rn_ahm_b = 0. ! background eddy viscosity for ldf_iso [m2/s] 292 rn_bhm_0 = 1.e+12 ! horizontal bilaplacian eddy viscosity [m4/s] 248 293 / 249 294 !----------------------------------------------------------------------- -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm
r4230 r4596 1 bld::tool::fppkeys key_dynspg_flt key_ ldfslp key_zdftke key_iomput key_mpp_mpi1 bld::tool::fppkeys key_dynspg_flt key_zdftke key_iomput key_mpp_mpi -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/CONFIG/SHARED/field_def.xml
r4341 r4596 144 144 <field id="precip" long_name="Total precipitation" unit="kg/m2/s" /> 145 145 146 147 146 <field id="qt" long_name="Net Downward Heat Flux" unit="W/m2" /> 148 147 <field id="qns" long_name="non solar Downward Heat Flux" unit="W/m2" /> … … 274 273 <field id="uocet" long_name="ocean transport along i-axis times temperature" unit="degC.m/s" grid_ref="grid_U_3D" /> 275 274 <field id="uoces" long_name="ocean transport along i-axis times salinity" unit="psu.m/s" grid_ref="grid_U_3D" /> 275 <!-- u-eddy coefficients (ldftra, ldfdyn) --> 276 <field id="aeiu_2d" long_name=" surface u-EIV coefficient" unit="m2/s" /> 277 <field id="aeiu_3d" long_name=" 3D u-EIV coefficient" unit="m2/s" grid_ref="grid_U_3D"/> 278 <field id="ahtu_2d" long_name=" surface u-eddy diffusivity coefficient" unit="m2/s or m4/s" /> 279 <field id="ahtu_3d" long_name=" 3D u-EIV coefficient" unit="m2/s or m4/s" grid_ref="grid_U_3D"/> 276 280 <!-- variables available with MLE --> 277 281 <field id="psiu_mle" long_name="MLE streamfunction along i-axis" unit="m3/s" grid_ref="grid_U_3D" /> … … 279 283 <field id="uoce_eiv" long_name="EIV ocean current along i-axis" unit="m/s" grid_ref="grid_U_3D" /> 280 284 <!-- uoce_eiv: available with key_trabbl --> 281 <field id="uoce_bbl" long_name="BBL ocean current along i-axis"unit="m/s" grid_ref="grid_U_3D" />282 <field id="ahu_bbl" long_name="BBL diffusive flux along i-axis" unit="m3/s" />285 <field id="uoce_bbl" long_name="BBL ocean current along i-axis" unit="m/s" grid_ref="grid_U_3D" /> 286 <field id="ahu_bbl" long_name="BBL diffusive flux along i-axis" unit="m3/s" /> 283 287 <!-- variables available with key_diaar5 --> 284 288 <field id="u_masstr" long_name="ocean eulerian mass transport along i-axis" unit="kg/s" grid_ref="grid_U_3D" /> … … 297 301 <field id="vocet" long_name="ocean transport along j-axis times temperature" unit="degC.m/s" grid_ref="grid_V_3D" /> 298 302 <field id="voces" long_name="ocean transport along j-axis times salinity" unit="psu.m/s" grid_ref="grid_V_3D" /> 303 <!-- v-eddy coefficients (ldftra, ldfdyn) --> 304 <field id="aeiv_2d" long_name=" surface v-EIV coefficient" unit="m2/s" /> 305 <field id="aeiv_3d" long_name=" 3D v-EIV coefficient" unit="m2/s" grid_ref="grid_V_3D" /> 306 <field id="ahtv_2d" long_name=" surface v-eddy diffusivity coefficient" unit="m2/s or (m4/s)^1/2" /> 307 <field id="ahtv_3d" long_name=" 3D v-eddy diffusivity coefficient" unit="m2/s or (m4/s)^1/2" grid_ref="grid_V_3D"/> 299 308 <!-- variables available with MLE --> 300 309 <field id="psiv_mle" long_name="MLE streamfunction along j-axis" unit="m3/s" grid_ref="grid_V_3D" /> -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/CONFIG/SHARED/namelist_ref
r4384 r4596 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! NEMO/OPA : 1 - run manager (namrun , namcfg)3 !! namelists 2 - Domain (nam zgr, namzgr_sco, namdom, namtsd)4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, namsbc_sas5 !! namsbc_cpl, namtra_qsr, namsbc_rnf,6 !! namsbc_apr, namsbc_ssr, namsbc_alb)2 !! NEMO/OPA : 1 - run manager (namrun) 3 !! namelists 2 - Domain (namcfg, namzgr, nam_vvl, namzgr_sco, namdom, namtsd) 4 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, 5 !! namsbc_sas, namsbc_cpl, namtra_qsr , namsbc_rnf , 6 !! namsbc_apr, namsbc_ssr, namsbc_alb) 7 7 !! 4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide) 8 8 !! 5 - bottom boundary (nambfr, nambbc, nambbl) 9 !! 6 - Tracer (nameos, namtra_adv, namtra_ldf, namtra_ dmp)9 !! 6 - Tracer (nameos, namtra_adv, namtra_ldf, namtra_ldfeiv, namtra_dmp) 10 10 !! 7 - dynamics (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf) 11 11 !! 8 - Verical physics (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx) … … 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 … … 46 46 nn_chunksz = 0 ! chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 47 47 / 48 !!====================================================================== 49 !! *** Domain namelists *** 50 !!====================================================================== 51 !! namcfg parameters of the configuration 52 !! namzgr vertical coordinate 53 !! nam_vvl vertical coordinate options (z-star, z-tilde) 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 !!====================================================================== 48 58 ! 49 59 !----------------------------------------------------------------------- 50 &namcfg ! defaultparameters of the configuration60 &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 … … 82 83 ln_zps = .true. ! z-coordinate - partial steps (T/F) 83 84 ln_sco = .false. ! s- or hybrid z-s-coordinate (T/F) 85 / 86 !----------------------------------------------------------------------- 87 &nam_vvl ! vertical coordinate options 88 !----------------------------------------------------------------------- 89 ln_vvl_zstar = .true. ! zstar vertical coordinate 90 ln_vvl_ztilde = .false. ! ztilde vertical coordinate: only high frequency variations 91 ln_vvl_layer = .false. ! full layer vertical coordinate 92 ln_vvl_ztilde_as_zstar = .false. ! ztilde vertical coordinate emulating zstar 93 ln_vvl_zstar_at_eqtor = .false. ! ztilde near the equator 94 rn_ahe3 = 0.0e0 ! thickness diffusion coefficient 95 rn_rst_e3t = 30.e0 ! ztilde to zstar restoration timescale [days] 96 rn_lf_cutoff = 5.0e0 ! cutoff frequency for low-pass filter [days] 97 rn_zdef_max = 0.9e0 ! maximum fractional e3t deformation 98 ln_vvl_dbg = .true. ! debug prints (T/F) 84 99 / 85 100 !----------------------------------------------------------------------- … … 205 220 !! namsbc_mfs MFS bulk formulae formulation 206 221 !! namsbc_cpl CouPLed formulation ("key_coupled") 207 !! namsbc_sas St Andalone Surface module222 !! namsbc_sas Stand Alone Surface module 208 223 !! namtra_qsr penetrative solar radiation 209 224 !! namsbc_rnf river runoffs … … 633 648 !! Tracer (T & S ) namelists 634 649 !!====================================================================== 635 !! nameos equation of state 636 !! namtra_adv advection scheme 637 !! namtra_ldf lateral diffusion scheme 638 !! namtra_dmp T & S newtonian damping 650 !! nameos equation of state 651 !! namtra_adv advection scheme 652 !! namtra_adv_mle mixed layer eddy param. (Fox-Kemper param.) 653 !! namtra_ldf lateral diffusion scheme 654 !! namtra_ldfeiv eddy induced velocity param. 655 !! namtra_dmp T & S newtonian damping 639 656 !!====================================================================== 640 657 ! … … 661 678 / 662 679 !----------------------------------------------------------------------- 663 &namtra_adv_mle ! mixed layer eddy param etrisation (Fox-Kemper param)680 &namtra_adv_mle ! mixed layer eddy param. (Fox-Kemper param.) 664 681 !----------------------------------------------------------------------- 665 682 ln_mle = .true. ! (T) use the Mixed Layer Eddy (MLE) parameterisation … … 677 694 !---------------------------------------------------------------------------------- 678 695 ! ! Operator type: 679 ln_traldf_lap = .true. !laplacian operator680 ln_traldf_b ilap= .false. ! bilaplacian operator696 ln_traldf_lap = .true. ! laplacian operator 697 ln_traldf_blp = .false. ! bilaplacian operator 681 698 ! ! Direction of action: 682 ln_traldf_level = .false. ! iso-level 683 ln_traldf_hor = .false. ! horizontal (geopotential) (needs "key_ldfslp" when ln_sco=T) 684 ln_traldf_iso = .true. ! iso-neutral (needs "key_ldfslp") 685 ! ! Griffies parameters (all need "key_ldfslp") 686 ln_traldf_grif = .false. ! use griffies triads 687 ln_traldf_gdia = .false. ! output griffies eddy velocities 688 ln_triad_iso = .false. ! pure lateral mixing in ML 689 ln_botmix_grif = .false. ! lateral mixing on bottom 690 ! ! Coefficients 691 ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv" 692 ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv 693 ! (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05) 694 rn_aeiv_0 = 2000. ! eddy induced velocity coefficient [m2/s] 695 rn_aht_0 = 2000. ! horizontal eddy diffusivity for tracers [m2/s] 696 rn_ahtb_0 = 0. ! background eddy diffusivity for ldf_iso [m2/s] 697 ! (normally=0; not used with Griffies) 698 rn_slpmax = 0.01 ! slope limit 699 rn_chsmag = 1. ! multiplicative factor in Smagorinsky diffusivity 700 rn_smsh = 1. ! Smagorinsky diffusivity: = 0 - use only sheer 701 rn_aht_m = 2000. ! upper limit or stability criteria for lateral eddy diffusivity (m2/s) 699 ln_traldf_lev = .false. ! iso-level 700 ln_traldf_hor = .false. ! horizontal (geopotential) 701 ln_traldf_iso = .true. ! iso-neutral 702 ln_traldf_triad = .false. ! iso-neutral using Griffies triads 703 ! 704 ! ! iso-neutral options: 705 ln_traldf_msc = .true. ! Method of Stabilizing Correction (both operators) 706 rn_slpmax = 0.01 ! slope limit (both operators) 707 ln_triad_iso = .false. ! pure horizontal mixing in ML (triad only) 708 ln_botmix_triad = .false. ! lateral mixing on bottom (triad only) 709 ! 710 ! ! Coefficients: 711 nn_aht_ijk_t = 21 ! space/time variation of eddy coef 712 ! ! =0 constant ; =10 F(k) ; =20 F(i,j)=F(grid spacing) ; =30 F(i,j,k) 713 ! ! =21 F(i,jt)=Treguier et al. JPO 1997 formulation 714 ! ! =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 715 rn_aht_0 = 2000. ! lateral eddy diffusivity (lap. operator) [m2/s] 716 rn_bht_0 = 1.e+12 ! lateral eddy diffusivity (bilap. operator) [m4/s] 717 718 !!gm rn_chsmag = 1. ! multiplicative factor in Smagorinsky diffusivity 719 !!gm rn_smsh = 1. ! Smagorinsky diffusivity: = 0 - use only sheer 720 / 721 !---------------------------------------------------------------------------------- 722 &namtra_ldfeiv ! eddy induced velocity param. 723 !---------------------------------------------------------------------------------- 724 ln_ldfeiv =.true. ! use eddy induced velocity parameterization 725 ln_ldfeiv_dia =.true. ! diagnose eiv stream function and velocities 726 rn_aeiv_0 = 2000. ! eddy induced velocity coefficient [m2/s] 727 nn_aei_ijk_t = 21 ! space/time variation of the eiv coeficient 728 ! ! =0 constant ; =10 F(k) ; =20 F(i,j) = F(grid spacing) ; =30 F(i,j,k) 729 ! ! =21 F(i,jt)=Treguier et al. JPO 1997 formulation 730 ! ! =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 702 731 / 703 732 !----------------------------------------------------------------------- … … 735 764 / 736 765 !----------------------------------------------------------------------- 737 &nam_vvl ! vertical coordinate options738 !-----------------------------------------------------------------------739 ln_vvl_zstar = .true. ! zstar vertical coordinate740 ln_vvl_ztilde = .false. ! ztilde vertical coordinate: only high frequency variations741 ln_vvl_layer = .false. ! full layer vertical coordinate742 ln_vvl_ztilde_as_zstar = .false. ! ztilde vertical coordinate emulating zstar743 ln_vvl_zstar_at_eqtor = .false. ! ztilde near the equator744 rn_ahe3 = 0.0e0 ! thickness diffusion coefficient745 rn_rst_e3t = 30.e0 ! ztilde to zstar restoration timescale [days]746 rn_lf_cutoff = 5.0e0 ! cutoff frequency for low-pass filter [days]747 rn_zdef_max = 0.9e0 ! maximum fractional e3t deformation748 ln_vvl_dbg = .true. ! debug prints (T/F)749 /750 !-----------------------------------------------------------------------751 766 &namdyn_vor ! option of physics/algorithm (not control by CPP keys) 752 767 !----------------------------------------------------------------------- … … 778 793 !----------------------------------------------------------------------- 779 794 ! ! Type of the operator : 780 ln_dynldf_lap = .true.! laplacian operator781 ln_dynldf_b ilap = .false.! bilaplacian operator795 ln_dynldf_lap = .true. ! laplacian operator 796 ln_dynldf_blp = .false. ! bilaplacian operator 782 797 ! ! Direction of action : 783 ln_dynldf_lev el = .false.! iso-level784 ln_dynldf_hor = .true. ! horizontal (geopotential) (require "key_ldfslp" in s-coord.)785 ln_dynldf_iso = .false. ! iso-neutral (require "key_ldfslp")798 ln_dynldf_lev = .false. ! iso-level 799 ln_dynldf_hor = .true. ! horizontal (geopotential) 800 ln_dynldf_iso = .false. ! iso-neutral 786 801 ! ! Coefficient 787 rn_ahm_0_lap = 40000. ! horizontal laplacian eddy viscosity [m2/s] 788 rn_ahmb_0 = 0. ! background eddy viscosity for ldf_iso [m2/s] 789 rn_ahm_0_blp = 0. ! horizontal bilaplacian eddy viscosity [m4/s] 790 rn_cmsmag_1 = 3. ! constant in laplacian Smagorinsky viscosity 791 rn_cmsmag_2 = 3 ! constant in bilaplacian Smagorinsky viscosity 792 rn_cmsh = 1. ! 1 or 0 , if 0 -use only shear for Smagorinsky viscosity 793 rn_ahm_m_blp = -1.e12 ! upper limit for bilap abs(ahm) < min( dx^4/128rdt, rn_ahm_m_blp) 794 rn_ahm_m_lap = 40000. ! upper limit for lap ahm < min(dx^2/16rdt, rn_ahm_m_lap) 802 nn_ahm_ijk_t = 0 ! space/time variation of eddy coef 803 ! ! =0 constant ; =10 F(k) ; =20 F(i,j)=F(grid spacing) ; =30 F(i,j,k) 804 ! ! =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 805 rn_ahm_0 = 40000. ! horizontal laplacian eddy viscosity [m2/s] 806 rn_ahm_b = 0. ! background eddy viscosity for ldf_iso [m2/s] 807 rn_bhm_0 = 1.e+12 ! horizontal bilaplacian eddy viscosity [m4/s] 808 809 810 !!gm rn_cmsmag_1 = 3. ! constant in laplacian Smagorinsky viscosity 811 !!gm rn_cmsmag_2 = 3 ! constant in bilaplacian Smagorinsky viscosity 812 !!gm rn_cmsh = 1. ! 1 or 0 , if 0 -use only shear for Smagorinsky viscosity 795 813 / 796 814 … … 914 932 !! *** Miscellaneous namelists *** 915 933 !!====================================================================== 934 !! namsol elliptic solver / island / free surface 916 935 !! nammpp Massively Parallel Processing ("key_mpp_mpi) 917 936 !! namctl Control prints & Benchmark 918 !! namsol elliptic solver / island / free surface 937 !! namc1d 1D configuration options ("key_c1d") 938 !! namc1d_uvd data: U & V currents ("key_c1d") 939 !! namc1d_dyndmp U & V newtonian damping ("key_c1d") 919 940 !!====================================================================== 920 941 ! … … 981 1002 ln_dyndmp = .false. ! add a damping term (T) or not (F) 982 1003 / 1004 983 1005 !!====================================================================== 984 1006 !! *** Diagnostics namelists *** … … 989 1011 !! namptr Poleward Transport Diagnostics 990 1012 !! namhsb Heat and salt budgets 1013 !! nam_diaharm Harmonic analysis of tidal constituents ('key_diaharm') 1014 !! namdct transports through sections 991 1015 !!====================================================================== 992 1016 ! … … 1068 1092 !! namobs observation and model comparison ('key_diaobs') 1069 1093 !! nam_asminc assimilation increments ('key_asminc') 1094 !! namsbc_wave External fields from wave model 1095 !! namdyn_nept Neptune effect 1070 1096 !!====================================================================== 1071 1097 ! -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
r3764 r4596 18 18 19 19 !!---------------------------------------------------------------------- 20 !! 'key_asminc' : Switch on the assimilation increment interface21 !!----------------------------------------------------------------------22 20 !! asm_bkg_wri : Write out the background state 23 21 !! asm_trj_wri : Write out the model state trajectory (used with 4D-Var) … … 27 25 USE zdf_oce ! Vertical mixing variables 28 26 USE zdfddm ! Double diffusion mixing parameterization 29 USE ldftra _oce ! Lateral tracer mixing coefficientdefined in memory30 USE ldfslp ! Slopes of neutral surfaces27 USE ldftra ! Lateral diffusion: eddy diffusivity coeff. defined in memory 28 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 31 29 USE tradmp ! Tracer damping 32 30 #if defined key_zdftke … … 41 39 USE asmpar ! Parameters for the assmilation interface 42 40 USE zdfmxl ! mixed layer depth 43 #if defined key_traldf_c2d44 USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine)45 #endif46 41 #if defined key_lim2 47 42 USE ice_2 -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r4313 r4596 14 14 15 15 !!---------------------------------------------------------------------- 16 !! 'key_asminc' 16 !! 'key_asminc' : Switch on the assimilation increment interface 17 17 !!---------------------------------------------------------------------- 18 !! asm_inc_init 19 !! calc_date 20 !! tra_asm_inc 21 !! dyn_asm_inc 22 !! ssh_asm_inc 23 !! seaice_asm_inc : Apply the seaice increment18 !! asm_inc_init : Initialize the increment arrays and IAU weights 19 !! calc_date : Compute the calendar date YYYYMMDD on a given step 20 !! tra_asm_inc : Apply the tracer (T and S) increments 21 !! dyn_asm_inc : Apply the dynamic (u and v) increments 22 !! ssh_asm_inc : Apply the SSH increment 23 !! seaice_asm_inc : Apply the seaice increment 24 24 !!---------------------------------------------------------------------- 25 25 USE wrk_nemo ! Memory Allocation … … 28 28 USE domvvl ! domain: variable volume level 29 29 USE oce ! Dynamics and active tracers defined in memory 30 USE ldfdyn _oce ! ocean dynamics: lateral physics30 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 31 31 USE eosbn2 ! Equation of state - in situ and potential density 32 32 USE zpshde ! Partial step : Horizontal Derivative … … 90 90 !! * Substitutions 91 91 # include "domzgr_substitute.h90" 92 # include "ldfdyn_substitute.h90"93 92 # include "vectopt_loop_substitute.h90" 94 93 !!---------------------------------------------------------------------- … … 109 108 !! ** Action : 110 109 !!---------------------------------------------------------------------- 111 INTEGER :: ji, jj, jk 112 INTEGER :: jt 113 INTEGER :: imid 114 INTEGER :: inum 115 INTEGER :: iiauper ! Number of time steps in the IAU period 116 INTEGER :: icycper ! Number of time steps in the cycle 117 INTEGER :: iitend_date ! Date YYYYMMDD of final time step 118 INTEGER :: iitbkg_date ! Date YYYYMMDD of background time step for Jb term 119 INTEGER :: iitdin_date ! Date YYYYMMDD of background time step for DI 120 INTEGER :: iitiaustr_date ! Date YYYYMMDD of IAU interval start time step 121 INTEGER :: iitiaufin_date ! Date YYYYMMDD of IAU interval final time step 122 INTEGER :: ios ! Local integer output status for namelist read 123 124 REAL(wp) :: znorm ! Normalization factor for IAU weights 125 REAL(wp) :: ztotwgt ! Value of time-integrated IAU weights 126 ! (should be equal to one) 127 REAL(wp) :: z_inc_dateb ! Start date of interval on which increment is valid 128 REAL(wp) :: z_inc_datef ! End date of interval on which increment is valid 129 REAL(wp) :: zdate_bkg ! Date in background state file for DI 130 REAL(wp) :: zdate_inc ! Time axis in increments file 131 110 INTEGER :: ji, jj, jk, jt 111 INTEGER :: imid, inum 112 INTEGER :: iiauper ! Number of time steps in the IAU period 113 INTEGER :: icycper ! Number of time steps in the cycle 114 INTEGER :: iitend_date ! Date YYYYMMDD of final time step 115 INTEGER :: iitbkg_date ! Date YYYYMMDD of background time step for Jb term 116 INTEGER :: iitdin_date ! Date YYYYMMDD of background time step for DI 117 INTEGER :: iitiaustr_date ! Date YYYYMMDD of IAU interval start time step 118 INTEGER :: iitiaufin_date ! Date YYYYMMDD of IAU interval final time step 119 INTEGER :: ios ! Local integer output status for namelist read 120 ! 121 REAL(wp) :: znorm ! Normalization factor for IAU weights 122 REAL(wp) :: ztotwgt ! Value of time-integrated IAU weights 123 ! ! (should be equal to one) 124 REAL(wp) :: z_inc_dateb ! Start date of interval on which increment is valid 125 REAL(wp) :: z_inc_datef ! End date of interval on which increment is valid 126 REAL(wp) :: zdate_bkg ! Date in background state file for DI 127 REAL(wp) :: zdate_inc ! Time axis in increments file 128 ! 132 129 REAL(wp), POINTER, DIMENSION(:,:) :: hdiv 133 130 !! … … 143 140 ! Read Namelist nam_asminc : assimilation increment interface 144 141 !----------------------------------------------------------------------- 145 146 ln_seaiceinc = .FALSE. 142 ln_seaiceinc = .FALSE. 147 143 ln_temnofreeze = .FALSE. 148 144 … … 449 445 CALL wrk_alloc(jpi,jpj,hdiv) 450 446 451 DO 452 447 DO jt = 1, nn_divdmp 448 ! 453 449 DO jk = 1, jpkm1 454 455 450 hdiv(:,:) = 0._wp 456 457 451 DO jj = 2, jpjm1 458 452 DO ji = fs_2, fs_jpim1 ! vector opt. … … 462 456 + e1v(ji ,jj ) * fse3v(ji ,jj ,jk) * v_bkginc(ji ,jj ,jk) & 463 457 - e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) * v_bkginc(ji ,jj-1,jk) ) & 464 / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )458 / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 465 459 END DO 466 460 END DO 467 468 461 CALL lbc_lnk( hdiv, 'T', 1. ) ! lateral boundary cond. (no sign change) 469 462 ! 470 463 DO jj = 2, jpjm1 471 464 DO ji = fs_2, fs_jpim1 ! vector opt. 472 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1 t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj) &473 - e1t(ji ,jj)*e2t(ji ,jj) * hdiv(ji ,jj) ) &474 475 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1 t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1) &476 - e1t(ji,jj )*e2t(ji,jj ) * hdiv(ji,jj ) ) &477 465 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj) & 466 & - e1e2t(ji ,jj) * hdiv(ji ,jj) ) & 467 & / e1u(ji,jj) * umask(ji,jj,jk) 468 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1) & 469 & - e1e2t(ji,jj ) * hdiv(ji,jj ) ) & 470 & / e2v(ji,jj) * vmask(ji,jj,jk) 478 471 END DO 479 472 END DO 480 481 473 END DO 482 474 ! 483 475 END DO 484 476 ! 485 477 CALL wrk_dealloc(jpi,jpj,hdiv) 486 478 ! 487 479 ENDIF 488 489 490 480 491 481 !----------------------------------------------------------------------- … … 677 667 DO jk=1, jpkm1 678 668 fzptnz (:,:,jk) = tfreez( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) ) 679 END DO680 681 IF 669 END DO 670 671 IF( ln_asmiau ) THEN 682 672 683 673 !-------------------------------------------------------------------- … … 950 940 !! 951 941 !!---------------------------------------------------------------------- 952 IMPLICIT NONE 953 ! 954 INTEGER, INTENT(in) :: kt ! Current time step 942 INTEGER, INTENT(in) :: kt ! Current time step 955 943 INTEGER, INTENT(in), OPTIONAL :: kindic ! flag for disabling the deallocation 956 944 ! … … 1021 1009 1022 1010 #if defined key_cice && defined key_asminc 1023 ! Sea-ice : CICE case. Zero ice increment tendency into CICE 1024 ndaice_da(:,:) = 0.0_wp 1011 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 1025 1012 #endif 1026 1013 -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
r2287 r4596 6 6 7 7 IMPLICIT NONE 8 9 !! * Routine accessibility10 8 PRIVATE 11 9 12 !! * Shared Modules variables 13 CHARACTER (LEN=40), PUBLIC, PARAMETER :: & 14 & c_asmbkg = 'assim_background_state_Jb', & !: Filename for storing the 15 !: background state for use 16 !: in the Jb term 17 & c_asmdin = 'assim_background_state_DI', & !: Filename for storing the 18 !: background state for direct 19 !: initialization 20 & c_asmtrj = 'assim_trj', & !: Filename for storing the 21 !: reference trajectory 22 & c_asminc = 'assim_background_increments' !: Filename for storing the 23 !: increments to the background 24 !: state 10 CHARACTER(LEN=40), PUBLIC, PARAMETER :: c_asmbkg = 'assim_background_state_Jb' !: Filename for storing the background state 11 ! ! for use in the Jb term 12 CHARACTER(LEN=40), PUBLIC, PARAMETER :: c_asmdin = 'assim_background_state_DI' !: Filename for storing the background state 13 ! ! for direct initialization 14 CHARACTER(LEN=40), PUBLIC, PARAMETER :: c_asmtrj = 'assim_trj' !: Filename for storing the reference trajectory 15 CHARACTER(LEN=40), PUBLIC, PARAMETER :: c_asminc = 'assim_background_increments' !: Filename for storing the increments 16 ! ! to the background state 25 17 26 INTEGER, PUBLIC :: nitbkg_r !: Background time step referenced to nit00027 INTEGER, PUBLIC :: nitdin_r !: Direct Initialization time step referenced to nit00028 INTEGER, PUBLIC :: nitiaustr_r !: IAU starting time step referenced to nit00029 INTEGER, PUBLIC :: nitiaufin_r !: IAU final time step referenced to nit00030 INTEGER, PUBLIC :: nittrjfrq !: Frequency of trajectory output for 4D-VAR18 INTEGER, PUBLIC :: nitbkg_r !: Background time step referenced to nit000 19 INTEGER, PUBLIC :: nitdin_r !: Direct Initialization time step referenced to nit000 20 INTEGER, PUBLIC :: nitiaustr_r !: IAU starting time step referenced to nit000 21 INTEGER, PUBLIC :: nitiaufin_r !: IAU final time step referenced to nit000 22 INTEGER, PUBLIC :: nittrjfrq !: Frequency of trajectory output for 4D-VAR 31 23 32 24 !!---------------------------------------------------------------------- … … 34 26 !! $Id$ 35 27 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 !!---------------------------------------------------------------------- 37 28 !!====================================================================== 38 29 END MODULE asmpar -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r4149 r4596 11 11 !! other variables needed to be passed to TOP 12 12 !!---------------------------------------------------------------------- 13 USE crs 14 USE crsdom 15 USE crslbclnk 13 16 USE oce ! ocean dynamics and tracers 14 17 USE dom_oce ! ocean space and time domain 15 USE ldftra _oce! ocean active tracers: lateral physics18 USE ldftra ! ocean active tracers: lateral physics 16 19 USE sbc_oce ! Surface boundary condition: ocean fields 17 20 USE zdf_oce ! vertical physics: ocean fields 18 21 USE zdfddm ! vertical physics: double diffusion 22 ! 23 USE in_out_manager ! I/O manager 24 USE iom ! 19 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 USE in_out_manager ! I/O manager21 26 USE timing ! preformance summary 22 27 USE wrk_nemo ! working array 23 USE crs24 USE crsdom25 USE crslbclnk26 USE iom27 28 28 29 IMPLICIT NONE … … 30 31 31 32 PUBLIC crs_fld ! routines called by step.F90 32 33 33 34 34 !! * Substitutions … … 56 56 !! ** Method : 57 57 !!---------------------------------------------------------------------- 58 !!59 60 58 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 ! !59 ! 62 60 INTEGER :: ji, jj, jk ! dummy loop indices 63 61 !! … … 66 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 67 65 REAL(wp) :: z2dcrsu, z2dcrsv 68 !! 69 !!---------------------------------------------------------------------- 66 !!---------------------------------------------------------------------- 70 67 ! 71 72 68 IF( nn_timing == 1 ) CALL timing_start('crs_fld') 73 69 -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r4292 r4596 11 11 12 12 !!---------------------------------------------------------------------- 13 !! dia_ptr : Poleward Transport Diagnostics module14 !! dia_ptr_init : Initialization, namelist read15 !! dia_ptr_wri : Output of poleward fluxes16 !! ptr_vjk : "zonal" sum computation of a "meridional" flux array17 !! ptr_tjk : "zonal" mean computation of a tracer field18 !! ptr_vj : "zonal" and vertical sum computation of a "meridional" flux array19 !! (Generic interface to ptr_vj_3d, ptr_vj_2d)13 !! dia_ptr : Poleward Transport Diagnostics module 14 !! dia_ptr_init : Initialization, namelist read 15 !! dia_ptr_wri : Output of poleward fluxes 16 !! ptr_vjk : "zonal" sum computation of a "meridional" flux array 17 !! ptr_tjk : "zonal" mean computation of a tracer field 18 !! ptr_vj : "zonal" and vertical sum computation of a "meridional" flux array 19 !! (Generic interface to ptr_vj_3d, ptr_vj_2d) 20 20 !!---------------------------------------------------------------------- 21 USE oce ! ocean dynamics and active tracers 22 USE dom_oce ! ocean space and time domain 23 USE phycst ! physical constants 24 USE ldftra_oce ! ocean active tracers: lateral physics 25 USE dianam ! 26 USE iom ! IOM library 27 USE ioipsl ! IO-IPSL library 28 USE in_out_manager ! I/O manager 21 USE oce ! ocean dynamics and active tracers 22 USE dom_oce ! ocean space and time domain 23 USE phycst ! physical constants 24 USE ldftra ! lateral physics: eddy diffusivity & EIV coeff. 25 ! 26 USE dianam ! 27 USE iom ! IOM library 28 USE ioipsl ! IO-IPSL library 29 USE in_out_manager ! I/O manager 29 30 USE lib_mpp ! MPP library 30 31 USE lbclnk ! lateral boundary condition - processor exchanges … … 363 364 END DO 364 365 #if defined key_diaeiv 365 DO jn = 1, nptr ! bolus velocity366 v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) ) ! here no btm30 for MSFeiv367 END DO368 ! ! add bolus stream-function to the eulerian one369 v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:)366 !!gm DO jn = 1, nptr ! bolus velocity 367 !! v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) ) ! here no btm30 for MSFeiv 368 !! END DO 369 !! ! ! add bolus stream-function to the eulerian one 370 !!gm v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:) 370 371 #endif 371 372 ! … … 376 377 DO jj = 2, jpj 377 378 DO ji = 1, jpi 378 #if defined key_diaeiv379 zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + v_eiv(ji,jj,jk) + v_eiv(ji,jj-1,jk) ) * 0.5_wp380 #else379 !!gm#if defined key_diaeiv 380 !!gm zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + v_eiv(ji,jj,jk) + v_eiv(ji,jj-1,jk) ) * 0.5_wp 381 !!gm#else 381 382 zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 382 #endif383 !!gm#endif 383 384 vt(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_tem) 384 385 vs(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_sal) … … 408 409 409 410 #if defined key_diaeiv 410 DO jn = 1, nptr ! Bolus component411 htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt ! SUM over jk412 str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram ! SUM over jk413 END DO411 !!gm DO jn = 1, nptr ! Bolus component 412 !!gm htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt ! SUM over jk 413 !!gm str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram ! SUM over jk 414 !!gm END DO 414 415 #endif 415 416 ! ! "Meridional" Stream-Function … … 418 419 v_msf (:,jk,jn) = v_msf (:,jk-1,jn) + v_msf (:,jk,jn) ! Eulerian j-Stream-Function 419 420 #if defined key_diaeiv 420 v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn) ! Bolus j-Stream-Function421 421 !!gm v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn) ! Bolus j-Stream-Function 422 !!gm 422 423 #endif 423 424 END DO … … 425 426 v_msf (:,:,:) = v_msf (:,:,:) * rc_sv ! converte in Sverdrups 426 427 #if defined key_diaeiv 427 v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv428 !!gm v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv 428 429 #endif 429 430 ENDIF … … 554 555 !! ** Method : NetCDF file 555 556 !!---------------------------------------------------------------------- 556 !!557 557 INTEGER, INTENT(in) :: kt ! ocean time-step index 558 ! !558 ! 559 559 INTEGER, SAVE :: nhoridz, ndepidzt, ndepidzw 560 560 INTEGER, SAVE :: ndim , ndim_atl , ndim_pac , ndim_ind , ndim_ipc 561 561 INTEGER, SAVE :: ndim_atl_30 , ndim_pac_30 , ndim_ind_30 , ndim_ipc_30 562 562 INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30 563 ! !563 ! 564 564 CHARACTER (len=40) :: clhstnam, clop, clop_once, cl_comment ! temporary names 565 565 INTEGER :: iline, it, itmod, ji, jj, jk ! … … 568 568 #endif 569 569 REAL(wp) :: zsto, zout, zdt, zjulian ! temporary scalars 570 ! !570 ! 571 571 REAL(wp), POINTER, DIMENSION(:) :: zphi, zfoo ! 1D workspace 572 572 REAL(wp), POINTER, DIMENSION(:,:) :: z_1 ! 2D workspace -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r4492 r4596 17 17 !! ! 2005-11 (V. Garnier) Surface pressure gradient organization 18 18 !! 3.2 ! 2008-11 (B. Lemaire) creation from old diawri 19 !! 3.7 ! 2014-01 (G. Madec) remove eddy induced velocity from no-IOM output 20 !! ! change name of output variabls in dia_wri_state 19 21 !!---------------------------------------------------------------------- 20 22 … … 27 29 USE dynadv, ONLY: ln_dynadv_vec 28 30 USE zdf_oce ! ocean vertical physics 29 USE ldftra_oce ! ocean active tracers: lateral physics 30 USE ldfdyn_oce ! ocean dynamics: lateral physics 31 USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv 31 USE ldftra ! lateral physics: eddy diffusivity coef. 32 32 USE sol_oce ! solver variables 33 33 USE sbc_oce ! Surface boundary condition: ocean fields … … 45 45 USE diadimg ! dimg direct access file format output 46 46 USE diaar5, ONLY : lk_diaar5 47 USE dynadv, ONLY : ln_dynadv_vec48 47 USE iom 49 48 USE ioipsl … … 250 249 !! Each nwrite time step, output the instantaneous or mean fields 251 250 !!---------------------------------------------------------------------- 252 !!253 251 INTEGER, INTENT( in ) :: kt ! ocean time-step index 254 ! !252 ! 255 253 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout 256 254 CHARACTER (len=40) :: clhstnam, clop, clmx ! local names … … 261 259 INTEGER :: jn, ierror ! local integers 262 260 REAL(wp) :: zsto, zout, zmax, zjulian, zdt ! local scalars 263 ! !261 ! 264 262 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d ! 2D workspace 265 263 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d ! 3D workspace … … 268 266 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 269 267 ! 270 CALL wrk_alloc( jpi , jpj, zw2d )271 IF ( ln_traldf_gdia .OR. lk_vvl ) callwrk_alloc( jpi , jpj , jpk , zw3d )268 CALL wrk_alloc( jpi , jpj , zw2d ) 269 IF( lk_vvl ) CALL wrk_alloc( jpi , jpj , jpk , zw3d ) 272 270 ! 273 271 ! Output the initial state and forcings … … 531 529 # endif 532 530 #endif 533 534 531 CALL histend( nid_T, snc4chunks=snc4set ) 535 532 … … 537 534 CALL histdef( nid_U, "vozocrtx", "Zonal Current" , "m/s" , & ! un 538 535 & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 539 IF( ln_traldf_gdia ) THEN540 CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current" , "m/s" , & ! u_eiv541 & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )542 ELSE543 #if defined key_diaeiv544 CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current" , "m/s" , & ! u_eiv545 & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )546 #endif547 END IF548 536 ! !!! nid_U : 2D 549 537 CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis" , "N/m2" , & ! utau … … 555 543 CALL histdef( nid_V, "vomecrty", "Meridional Current" , "m/s" , & ! vn 556 544 & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 557 IF( ln_traldf_gdia ) THEN558 CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current" , "m/s" , & ! v_eiv559 & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )560 ELSE561 #if defined key_diaeiv562 CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current" , "m/s" , & ! v_eiv563 & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )564 #endif565 END IF566 545 ! !!! nid_V : 2D 567 546 CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis" , "N/m2" , & ! vtau … … 573 552 CALL histdef( nid_W, "vovecrtz", "Vertical Velocity" , "m/s" , & ! wn 574 553 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 575 IF( ln_traldf_gdia ) THEN576 CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity" , "m/s" , & ! w_eiv577 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )578 ELSE579 #if defined key_diaeiv580 CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity" , "m/s" , & ! w_eiv581 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )582 #endif583 END IF584 554 CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity" , "m2/s" , & ! avt 585 555 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) … … 592 562 ENDIF 593 563 ! !!! nid_W : 2D 594 #if defined key_traldf_c2d595 CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity" , "m2/s" , & ! ahtw596 & jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout )597 # if defined key_traldf_eiv598 CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s", & ! aeiw599 & jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout )600 # endif601 #endif602 603 564 CALL histend( nid_W, snc4chunks=snc4set ) 604 565 … … 716 677 ! Write fields on U grid 717 678 CALL histwrite( nid_U, "vozocrtx", it, un , ndim_U , ndex_U ) ! i-current 718 IF( ln_traldf_gdia ) THEN719 IF (.not. ALLOCATED(psix_eiv))THEN720 ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )721 IF( lk_mpp ) CALL mpp_sum ( ierr )722 IF( ierr > 0 ) CALL ctl_stop('STOP', 'diawri: unable to allocate psi{x,y}_eiv')723 psix_eiv(:,:,:) = 0.0_wp724 psiy_eiv(:,:,:) = 0.0_wp725 ENDIF726 DO jk=1,jpkm1727 zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk) ! u_eiv = -dpsix/dz728 END DO729 zw3d(:,:,jpk) = 0._wp730 CALL histwrite( nid_U, "vozoeivu", it, zw3d, ndim_U , ndex_U ) ! i-eiv current731 ELSE732 #if defined key_diaeiv733 CALL histwrite( nid_U, "vozoeivu", it, u_eiv, ndim_U , ndex_U ) ! i-eiv current734 #endif735 ENDIF736 679 CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress 737 680 738 681 ! Write fields on V grid 739 682 CALL histwrite( nid_V, "vomecrty", it, vn , ndim_V , ndex_V ) ! j-current 740 IF( ln_traldf_gdia ) THEN741 DO jk=1,jpk-1742 zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz743 END DO744 zw3d(:,:,jpk) = 0._wp745 CALL histwrite( nid_V, "vomeeivv", it, zw3d, ndim_V , ndex_V ) ! j-eiv current746 ELSE747 #if defined key_diaeiv748 CALL histwrite( nid_V, "vomeeivv", it, v_eiv, ndim_V , ndex_V ) ! j-eiv current749 #endif750 ENDIF751 683 CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress 752 684 753 685 ! Write fields on W grid 754 686 CALL histwrite( nid_W, "vovecrtz", it, wn , ndim_T, ndex_T ) ! vert. current 755 IF( ln_traldf_gdia ) THEN756 DO jk=1,jpk-1757 DO jj = 2, jpjm1758 DO ji = fs_2, fs_jpim1 ! vector opt.759 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2v(ji,jj) + &760 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx761 END DO762 END DO763 END DO764 zw3d(:,:,jpk) = 0._wp765 CALL histwrite( nid_W, "voveeivw", it, zw3d , ndim_T, ndex_T ) ! vert. eiv current766 ELSE767 # if defined key_diaeiv768 CALL histwrite( nid_W, "voveeivw", it, w_eiv , ndim_T, ndex_T ) ! vert. eiv current769 # endif770 ENDIF771 687 CALL histwrite( nid_W, "votkeavt", it, avt , ndim_T, ndex_T ) ! T vert. eddy diff. coef. 772 688 CALL histwrite( nid_W, "votkeavm", it, avmu , ndim_T, ndex_T ) ! T vert. eddy visc. coef. … … 774 690 CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T ) ! S vert. eddy diff. coef. 775 691 ENDIF 776 #if defined key_traldf_c2d777 CALL histwrite( nid_W, "soleahtw", it, ahtw , ndim_hT, ndex_hT ) ! lateral eddy diff. coef.778 # if defined key_traldf_eiv779 CALL histwrite( nid_W, "soleaeiw", it, aeiw , ndim_hT, ndex_hT ) ! EIV coefficient at w-point780 # endif781 #endif782 692 783 693 ! 3. Close all files … … 790 700 ENDIF 791 701 ! 792 CALL wrk_dealloc( jpi , jpj, zw2d )793 IF ( ln_traldf_gdia .OR. lk_vvl ) callwrk_dealloc( jpi , jpj , jpk , zw3d )702 CALL wrk_dealloc( jpi , jpj , zw2d ) 703 IF( lk_vvl ) CALL wrk_dealloc( jpi , jpj , jpk , zw3d ) 794 704 ! 795 705 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') … … 823 733 !!---------------------------------------------------------------------- 824 734 ! 825 ! IF( nn_timing == 1 ) CALL timing_start('dia_wri_state') ! not sure this works for routines not called in first timestep826 827 735 ! 0. Initialisation 828 736 ! ----------------- … … 883 791 CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth 884 792 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 885 END 793 ENDIF 886 794 887 795 #if defined key_lim2 … … 925 833 ENDIF 926 834 #endif 927 928 ! IF( nn_timing == 1 ) CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep929 835 ! 930 931 836 END SUBROUTINE dia_wri_state 837 932 838 !!====================================================================== 933 839 END MODULE diawri -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r4292 r4596 622 622 !! - update bathy : meter bathymetry (in meters) 623 623 !!---------------------------------------------------------------------- 624 !!625 624 INTEGER :: ji, jj, jl ! dummy loop indices 626 625 INTEGER :: icompt, ibtest, ikmax ! temporary integers 627 626 REAL(wp), POINTER, DIMENSION(:,:) :: zbathy 628 629 627 !!---------------------------------------------------------------------- 630 628 ! … … 1115 1113 !! 1116 1114 !!---------------------------------------------------------------------- 1117 !1118 1115 INTEGER :: ji, jj, jk, jl ! dummy loop argument 1119 INTEGER :: iip1, ijp1, iim1, ijm1 ! temporaryintegers1116 INTEGER :: iip1, ijp1, iim1, ijm1 ! local integers 1120 1117 INTEGER :: ios ! Local integer output status for namelist read 1121 REAL(wp) :: zrmax, ztaper ! temporary scalars 1122 REAL(wp) :: zrfact 1118 REAL(wp) :: zrmax, ztaper, zrfact ! local scalars 1123 1119 ! 1124 1120 REAL(wp), POINTER, DIMENSION(:,: ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 … … 1283 1279 DO jj = 1, jpj 1284 1280 DO ji = 1, jpi 1285 ztaper = EXP( -(gphit(ji,jj)/8._wp)**2 ._wp)1281 ztaper = EXP( -(gphit(ji,jj)/8._wp)**2 ) 1286 1282 hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper ) 1287 1283 END DO … … 1552 1548 END SUBROUTINE zgr_sco 1553 1549 1554 !!====================================================================== 1550 1555 1551 SUBROUTINE s_sh94() 1556 1557 1552 !!---------------------------------------------------------------------- 1558 1553 !! *** ROUTINE s_sh94 *** … … 1565 1560 !! Reference : Song and Haidvogel 1994. 1566 1561 !!---------------------------------------------------------------------- 1567 !1568 1562 INTEGER :: ji, jj, jk ! dummy loop argument 1569 1563 REAL(wp) :: zcoeft, zcoefw ! temporary scalars … … 1651 1645 END SUBROUTINE s_sh94 1652 1646 1647 1653 1648 SUBROUTINE s_sf12 1654 1655 1649 !!---------------------------------------------------------------------- 1656 1650 !! *** ROUTINE s_sf12 *** … … 1666 1660 !! 1667 1661 !! 1668 !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling). 1669 !!---------------------------------------------------------------------- 1670 ! 1662 !! Reference : Siddorn and Furner 2013 (Ocean modelling). 1663 !!---------------------------------------------------------------------- 1671 1664 INTEGER :: ji, jj, jk ! dummy loop argument 1672 1665 REAL(wp) :: zsmth ! smoothing around critical depth … … 1674 1667 ! 1675 1668 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 1676 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 1677 1669 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 1670 !!---------------------------------------------------------------------- 1678 1671 ! 1679 1672 CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3 ) … … 1744 1737 END DO 1745 1738 1746 END DO ! for all jj's1747 END DO ! for all ji's1739 END DO ! for all jj's 1740 END DO ! for all ji's 1748 1741 1749 1742 DO ji=1,jpi-1 … … 1773 1766 END DO 1774 1767 1775 END DO1776 END DO1768 END DO 1769 END DO 1777 1770 ! 1778 1771 CALL lbc_lnk(e3t_0 ,'T',1.) ; CALL lbc_lnk(e3u_0 ,'T',1.) … … 1788 1781 END SUBROUTINE s_sf12 1789 1782 1783 1790 1784 SUBROUTINE s_tanh() 1791 1792 1785 !!---------------------------------------------------------------------- 1793 1786 !! *** ROUTINE s_tanh*** … … 1799 1792 !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 1800 1793 !!---------------------------------------------------------------------- 1801 1802 1794 INTEGER :: ji, jj, jk ! dummy loop argument 1803 1795 REAL(wp) :: zcoeft, zcoefw ! temporary scalars 1804 1796 ! 1805 1797 REAL(wp), POINTER, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w 1806 1798 REAL(wp), POINTER, DIMENSION(:) :: z_esigt, z_esigw 1799 !!---------------------------------------------------------------------- 1807 1800 1808 1801 CALL wrk_alloc( jpk, z_gsigw, z_gsigt, z_gsi3w ) … … 1862 1855 END SUBROUTINE s_tanh 1863 1856 1857 1864 1858 FUNCTION fssig( pk ) RESULT( pf ) 1865 1859 !!---------------------------------------------------------------------- … … 1932 1926 REAL(wp), INTENT(in ) :: pk1(jpk) ! continuous "k" coordinate 1933 1927 REAL(wp) :: p_gamma(jpk) ! stretched coordinate 1934 REAL(wp), INTENT(in ) :: pzb ! Bottom box depth 1935 REAL(wp), INTENT(in ) :: pzs ! surface box depth 1936 REAL(wp), INTENT(in ) :: psmth ! Smoothing parameter 1928 REAL(wp), INTENT(in ) :: pzb ! Bottom box depth 1929 REAL(wp), INTENT(in ) :: pzs ! surface box depth 1930 REAL(wp), INTENT(in ) :: psmth ! Smoothing parameter 1931 ! 1932 INTEGER :: jk 1937 1933 REAL(wp) :: za1,za2,za3 ! local variables 1938 1934 REAL(wp) :: zn1,zn2 ! local variables 1939 1935 REAL(wp) :: za,zb,zx ! local variables 1940 integer :: jk 1941 !!---------------------------------------------------------------------- 1942 ! 1943 1936 !!---------------------------------------------------------------------- 1937 ! 1944 1938 zn1 = 1./(jpk-1.) 1945 1939 zn2 = 1. - zn1 1946 1940 ! 1947 1941 za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp) 1948 1942 za2 = (rn_alpha+2.0_wp)*zn2**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn2**(rn_alpha+2.0_wp) 1949 1943 za3 = (zn2**3.0_wp - za2)/( zn1**3.0_wp - za1) 1950 1944 ! 1951 1945 za = pzb - za3*(pzs-za1)-za2 1952 1946 za = za/( zn2-0.5_wp*(za2+zn2**2.0_wp) - za3*(zn1-0.5_wp*(za1+zn1**2.0_wp) ) ) 1953 1947 zb = (pzs - za1 - za*( zn1-0.5_wp*(za1+zn1**2.0_wp ) ) ) / (zn1**3.0_wp - za1) 1954 1948 zx = 1.0_wp-za/2.0_wp-zb 1955 1949 ! 1956 1950 DO jk = 1, jpk 1957 1951 p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp + & … … 1959 1953 & (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) ) 1960 1954 p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_wp-psmth) 1961 ENDDO 1962 1955 END DO 1963 1956 ! 1964 1957 END FUNCTION fgamma -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r4370 r4596 29 29 USE daymod ! calendar 30 30 USE eosbn2 ! eq. of state, Brunt Vaisala frequency (eos routine) 31 USE ldftra _oce ! ocean active tracers: lateral physics31 USE ldftra ! lateral physics: ocean active tracers 32 32 USE zdf_oce ! ocean vertical physics 33 33 USE phycst ! physical constants 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 … … 68 69 !! ** Purpose : Initialization of the dynamics and tracer fields. 69 70 !!---------------------------------------------------------------------- 70 ! - ML - needed for initialization of e3t_b 71 INTEGER :: ji,jj,jk ! dummy loop indices 72 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace 71 INTEGER :: ji, jj, jk ! dummy loop indices 72 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace 73 73 !!---------------------------------------------------------------------- 74 74 ! 75 75 IF( nn_timing == 1 ) CALL timing_start('istate_init') 76 76 ! 77 78 77 IF(lwp) WRITE(numout,*) 79 78 IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers' 80 79 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 81 80 82 CALL dta_tsd_init! Initialisation of T & S input data83 IF( lk_c1d ) CALL dta_uvd_init! Initialization of U & V input data84 85 rhd (:,:,: ) = 0. e086 rhop (:,:,: ) = 0. e087 rn2 (:,:,: ) = 0. e088 tsa (:,:,:,:) = 0. e081 CALL dta_tsd_init ! Initialisation of T & S input data 82 IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data 83 84 rhd (:,:,: ) = 0._wp 85 rhop (:,:,: ) = 0._wp 86 rn2 (:,:,: ) = 0._wp 87 tsa (:,:,:,:) = 0._wp 89 88 90 89 IF( ln_rstart ) THEN ! Restart from a file … … 103 102 ub (:,:,:) = 0._wp ; un (:,:,:) = 0._wp 104 103 vb (:,:,:) = 0._wp ; vn (:,:,:) = 0._wp 105 rotb (:,:,:) = 0._wp ; rotn (:,:,:) = 0._wp 106 hdivb(:,:,:) = 0._wp ; hdivn(:,:,:) = 0._wp 104 hdivn(:,:,:) = 0._wp 107 105 ! 108 106 IF( cp_cfg == 'eel' ) THEN … … 158 156 ! 159 157 ! 160 un_b(:,:) = 0._wp ;vn_b(:,:) = 0._wp161 ub_b(:,:) = 0._wp ;vb_b(:,:) = 0._wp158 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 159 ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 162 160 ! 163 161 DO jk = 1, jpkm1 164 #if defined key_vectopt_loop165 DO jj = 1, 1 !Vector opt. => forced unrolling166 DO ji = 1, jpij167 #else168 162 DO jj = 1, jpj 169 163 DO ji = 1, jpi 170 #endif171 164 un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 172 165 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) … … 188 181 ! 189 182 END SUBROUTINE istate_init 183 190 184 191 185 SUBROUTINE istate_t_s … … 201 195 !! References : Philander ??? 202 196 !!---------------------------------------------------------------------- 203 INTEGER :: ji, jj, jk204 REAL(wp) :: zsal = 35.50 197 INTEGER :: ji, jj, jk 198 REAL(wp) :: zsal = 35.50_wp 205 199 !!---------------------------------------------------------------------- 206 200 ! … … 218 212 ! 219 213 END SUBROUTINE istate_t_s 214 220 215 221 216 SUBROUTINE istate_eel … … 231 226 !! and relative vorticity fields 232 227 !!---------------------------------------------------------------------- 233 USE div cur ! hor. divergence & rel. vorticity (div_cur routine)228 USE divhor ! hor. divergence (div_hor routine) 234 229 USE iom 235 230 ! 236 231 INTEGER :: inum ! temporary logical unit 237 232 INTEGER :: ji, jj, jk ! dummy loop indices … … 280 275 tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 281 276 ! 282 ! set the dynamics: U,V, hdiv , rot(and ssh if necessary)277 ! set the dynamics: U,V, hdiv (and ssh if necessary) 283 278 ! ---------------- 284 279 ! Start EEL5 configuration with barotropic geostrophic velocities … … 316 311 ENDIF 317 312 ! 318 CALL div_ cur( nit000 ) ! horizontal divergence and relative vorticity (curl)313 CALL div_hor( nit000 ) ! horizontal divergence and relative vorticity (curl) 319 314 ! N.B. the vertical velocity will be computed from the horizontal divergence field 320 315 ! in istate by a call to wzv routine … … 369 364 !! 370 365 !! ** Method : - set temprature field 371 !! - set salinity field366 !! - set salinity field 372 367 !!---------------------------------------------------------------------- 373 368 INTEGER :: ji, jj, jk ! dummy loop indices … … 443 438 END SUBROUTINE istate_gyre 444 439 440 445 441 SUBROUTINE istate_uvg 446 442 !!---------------------------------------------------------------------- … … 455 451 !!---------------------------------------------------------------------- 456 452 USE dynspg ! surface pressure gradient (dyn_spg routine) 457 USE div cur ! hor. divergence & rel. vorticity (div_cur routine)453 USE divhor ! hor. divergence (div_hor routine) 458 454 USE lbclnk ! ocean lateral boundary condition (or mpp link) 459 455 ! 460 456 INTEGER :: ji, jj, jk ! dummy loop indices 461 457 INTEGER :: indic ! ??? … … 553 549 un(:,:,:) = ub(:,:,:) 554 550 vn(:,:,:) = vb(:,:,:) 555 556 ! Compute the divergence and curl 557 558 CALL div_cur( nit000 ) ! now horizontal divergence and curl 559 560 hdivb(:,:,:) = hdivn(:,:,:) ! set the before to the now value 561 rotb (:,:,:) = rotn (:,:,:) ! set the before to the now value 551 ! 552 !!gm Check here call to div_hor should not be necessary 553 !!gm div_hor call runoffs not sure they are defined at that level 554 CALL div_hor( nit000 ) ! now horizontal divergence 562 555 ! 563 556 CALL wrk_dealloc( jpi, jpj, jpk, zprn) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
r4557 r4596 1 MODULE div cur1 MODULE divhor 2 2 !!============================================================================== 3 !! *** MODULE div cur ***4 !! Ocean diagnostic variable : horizontal divergence and relative vorticity3 !! *** MODULE divhor *** 4 !! Ocean diagnostic variable : now horizontal divergence 5 5 !!============================================================================== 6 6 !! History : OPA ! 1987-06 (P. Andrich, D. L Hostis) Original code … … 17 17 !! 3.3 ! 2010-09 (D.Storkey and E.O'Dea) bug fixes for BDY module 18 18 !! - ! 2010-10 (R. Furner, G. Madec) runoff and cla added directly here 19 !! 3.7 ! 2014-01 (G. Madec) suppression of velocity curl from in-core memory 19 20 !!---------------------------------------------------------------------- 20 21 21 22 !!---------------------------------------------------------------------- 22 !! div_cur : Compute the horizontal divergence and relative 23 !! vorticity fields 23 !! div_hor : Compute the horizontal divergence field 24 24 !!---------------------------------------------------------------------- 25 25 USE oce ! ocean dynamics and tracers … … 28 28 USE sbcrnf ! river runoff 29 29 USE cla ! cross land advection (cla_div routine) 30 ! 30 31 USE in_out_manager ! I/O manager 31 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 37 38 PRIVATE 38 39 39 PUBLIC div_ cur ! routine called by step.F90 and istate.F9040 PUBLIC div_hor ! routine called by step.F90 and istate.F90 40 41 41 42 !! * Substitutions … … 43 44 # include "vectopt_loop_substitute.h90" 44 45 !!---------------------------------------------------------------------- 45 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)46 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 46 47 !! $Id$ 47 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 49 50 CONTAINS 50 51 51 #if defined key_noslip_accurate 52 !!---------------------------------------------------------------------- 53 !! 'key_noslip_accurate' 2nd order interior + 4th order at the coast 54 !!---------------------------------------------------------------------- 55 56 SUBROUTINE div_cur( kt ) 52 SUBROUTINE div_hor( kt ) 57 53 !!---------------------------------------------------------------------- 58 !! *** ROUTINE div_cur *** 54 !! *** ROUTINE div_hor *** 55 !! 56 !! ** Purpose : compute the horizontal divergence at now time-step 59 57 !! 60 !! ** Purpose : compute the horizontal divergence and the relative 61 !! vorticity at before and now time-step 58 !! ** Method : the now divergence is computed as : 59 !! hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 60 !! and correct with runoff inflow (div_rnf) and cross land flow (div_cla) 62 61 !! 63 !! ** Method : I. divergence : 64 !! - save the divergence computed at the previous time-step 65 !! (note that the Asselin filter has not been applied on hdivb) 66 !! - compute the now divergence given by : 67 !! hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 68 !! correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla) 69 !! II. vorticity : 70 !! - save the curl computed at the previous time-step 71 !! rotb = rotn 72 !! (note that the Asselin time filter has not been applied to rotb) 73 !! - compute the now curl in tensorial formalism: 74 !! rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] ) 75 !! - Coastal boundary condition: 'key_noslip_accurate' defined, 76 !! the no-slip boundary condition is computed using Schchepetkin 77 !! and O'Brien (1996) scheme (i.e. 4th order at the coast). 78 !! For example, along east coast, the one-sided finite difference 79 !! approximation used for di[v] is: 80 !! di[e2v vn] = 1/(e1f*e2f) * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) ) 81 !! 82 !! ** Action : - update hdivb, hdivn, the before & now hor. divergence 83 !! - update rotb , rotn , the before & now rel. vorticity 84 !!---------------------------------------------------------------------- 85 INTEGER, INTENT(in) :: kt ! ocean time-step index 86 ! 87 INTEGER :: ji, jj, jk, jl ! dummy loop indices 88 INTEGER :: ii, ij, ijt, iju, ierr ! local integer 89 REAL(wp) :: zraur, zdep ! local scalar 90 REAL(wp), POINTER, DIMENSION(:,:) :: zwu ! specific 2D workspace 91 REAL(wp), POINTER, DIMENSION(:,:) :: zwv ! specific 2D workspace 92 !!---------------------------------------------------------------------- 93 ! 94 IF( nn_timing == 1 ) CALL timing_start('div_cur') 95 ! 96 CALL wrk_alloc( jpi , jpj+2, zwu ) 97 CALL wrk_alloc( jpi+4, jpj , zwv, kjstart = -1 ) 98 ! 99 IF( kt == nit000 ) THEN 100 IF(lwp) WRITE(numout,*) 101 IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and relative vorticity' 102 IF(lwp) WRITE(numout,*) '~~~~~~~ NOT optimal for auto-tasking case' 103 ENDIF 104 105 ! ! =============== 106 DO jk = 1, jpkm1 ! Horizontal slab 107 ! ! =============== 108 ! 109 hdivb(:,:,jk) = hdivn(:,:,jk) ! time swap of div arrays 110 rotb (:,:,jk) = rotn (:,:,jk) ! time swap of rot arrays 111 ! 112 ! ! -------- 113 ! Horizontal divergence ! div 114 ! ! -------- 115 DO jj = 2, jpjm1 116 DO ji = fs_2, fs_jpim1 ! vector opt. 117 hdivn(ji,jj,jk) = & 118 ( e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj )*fse3u(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 119 + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji ,jj-1)*fse3v(ji ,jj-1,jk) * vn(ji ,jj-1,jk) ) & 120 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 121 END DO 122 END DO 123 124 IF( .NOT. AGRIF_Root() ) THEN 125 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , : ,jk) = 0.e0 ! east 126 IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2 , : ,jk) = 0.e0 ! west 127 IF ((nbondj == 1).OR.(nbondj == 2)) hdivn(: ,nlcj-1 ,jk) = 0.e0 ! north 128 IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(: ,2 ,jk) = 0.e0 ! south 129 ENDIF 130 131 ! ! -------- 132 ! relative vorticity ! rot 133 ! ! -------- 134 ! contravariant velocity (extended for lateral b.c.) 135 ! inside the model domain 136 DO jj = 1, jpj 137 DO ji = 1, jpi 138 zwu(ji,jj) = e1u(ji,jj) * un(ji,jj,jk) 139 zwv(ji,jj) = e2v(ji,jj) * vn(ji,jj,jk) 140 END DO 141 END DO 142 143 ! East-West boundary conditions 144 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 145 zwv( 0 ,:) = zwv(jpi-2,:) 146 zwv( -1 ,:) = zwv(jpi-3,:) 147 zwv(jpi+1,:) = zwv( 3 ,:) 148 zwv(jpi+2,:) = zwv( 4 ,:) 149 ELSE 150 zwv( 0 ,:) = 0.e0 151 zwv( -1 ,:) = 0.e0 152 zwv(jpi+1,:) = 0.e0 153 zwv(jpi+2,:) = 0.e0 154 ENDIF 155 156 ! North-South boundary conditions 157 IF( nperio == 3 .OR. nperio == 4 ) THEN 158 ! north fold ( Grid defined with a T-point pivot) ORCA 2 degre 159 zwu(jpi,jpj+1) = 0.e0 160 zwu(jpi,jpj+2) = 0.e0 161 DO ji = 1, jpi-1 162 iju = jpi - ji + 1 163 zwu(ji,jpj+1) = - zwu(iju,jpj-3) 164 zwu(ji,jpj+2) = - zwu(iju,jpj-4) 165 END DO 166 ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN 167 ! north fold ( Grid defined with a F-point pivot) ORCA 0.5 degre\ 168 zwu(jpi,jpj+1) = 0.e0 169 zwu(jpi,jpj+2) = 0.e0 170 DO ji = 1, jpi-1 171 iju = jpi - ji 172 zwu(ji,jpj ) = - zwu(iju,jpj-1) 173 zwu(ji,jpj+1) = - zwu(iju,jpj-2) 174 zwu(ji,jpj+2) = - zwu(iju,jpj-3) 175 END DO 176 DO ji = -1, jpi+2 177 ijt = jpi - ji + 1 178 zwv(ji,jpj) = - zwv(ijt,jpj-2) 179 END DO 180 DO ji = jpi/2+1, jpi+2 181 ijt = jpi - ji + 1 182 zwv(ji,jpjm1) = - zwv(ijt,jpjm1) 183 END DO 184 ELSE 185 ! closed 186 zwu(:,jpj+1) = 0.e0 187 zwu(:,jpj+2) = 0.e0 188 ENDIF 189 190 ! relative vorticity (vertical component of the velocity curl) 191 DO jj = 1, jpjm1 192 DO ji = 1, fs_jpim1 ! vector opt. 193 rotn(ji,jj,jk) = ( zwv(ji+1,jj ) - zwv(ji,jj) & 194 & - zwu(ji ,jj+1) + zwu(ji,jj) ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) ) 195 END DO 196 END DO 197 198 ! second order accurate scheme along straight coast 199 DO jl = 1, npcoa(1,jk) 200 ii = nicoa(jl,1,jk) 201 ij = njcoa(jl,1,jk) 202 rotn(ii,ij,jk) = 1. / ( e1f(ii,ij) * e2f(ii,ij) ) & 203 * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) ) 204 END DO 205 DO jl = 1, npcoa(2,jk) 206 ii = nicoa(jl,2,jk) 207 ij = njcoa(jl,2,jk) 208 rotn(ii,ij,jk) = 1./(e1f(ii,ij)*e2f(ii,ij)) & 209 *(-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij)) 210 END DO 211 DO jl = 1, npcoa(3,jk) 212 ii = nicoa(jl,3,jk) 213 ij = njcoa(jl,3,jk) 214 rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) ) & 215 * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) ) 216 END DO 217 DO jl = 1, npcoa(4,jk) 218 ii = nicoa(jl,4,jk) 219 ij = njcoa(jl,4,jk) 220 rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) ) & 221 * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) ) 222 END DO 223 ! ! =============== 224 END DO ! End of slab 225 ! ! =============== 226 227 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 228 IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 ) CALL cla_div ( kt ) ! Cross Land Advection (Update Hor. divergence) 229 230 ! 4. Lateral boundary conditions on hdivn and rotn 231 ! ---------------------------------=======---====== 232 CALL lbc_lnk( hdivn, 'T', 1. ) ; CALL lbc_lnk( rotn , 'F', 1. ) ! lateral boundary cond. (no sign change) 233 ! 234 CALL wrk_dealloc( jpi , jpj+2, zwu ) 235 CALL wrk_dealloc( jpi+4, jpj , zwv, kjstart = -1 ) 236 ! 237 IF( nn_timing == 1 ) CALL timing_stop('div_cur') 238 ! 239 END SUBROUTINE div_cur 240 241 #else 242 !!---------------------------------------------------------------------- 243 !! Default option 2nd order centered schemes 244 !!---------------------------------------------------------------------- 245 246 SUBROUTINE div_cur( kt ) 247 !!---------------------------------------------------------------------- 248 !! *** ROUTINE div_cur *** 249 !! 250 !! ** Purpose : compute the horizontal divergence and the relative 251 !! vorticity at before and now time-step 252 !! 253 !! ** Method : - Divergence: 254 !! - save the divergence computed at the previous time-step 255 !! (note that the Asselin filter has not been applied on hdivb) 256 !! - compute the now divergence given by : 257 !! hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 258 !! correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla) 259 !! - Relavtive Vorticity : 260 !! - save the curl computed at the previous time-step (rotb = rotn) 261 !! (note that the Asselin time filter has not been applied to rotb) 262 !! - compute the now curl in tensorial formalism: 263 !! rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] ) 264 !! Note: Coastal boundary condition: lateral friction set through 265 !! the value of fmask along the coast (see dommsk.F90) and shlat 266 !! (namelist parameter) 267 !! 268 !! ** Action : - update hdivb, hdivn, the before & now hor. divergence 269 !! - update rotb , rotn , the before & now rel. vorticity 62 !! ** Action : - update hdivn, the now horizontal divergence 270 63 !!---------------------------------------------------------------------- 271 64 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 275 68 !!---------------------------------------------------------------------- 276 69 ! 277 IF( nn_timing == 1 ) CALL timing_start('div_ cur')70 IF( nn_timing == 1 ) CALL timing_start('div_hor') 278 71 ! 279 72 IF( kt == nit000 ) THEN 280 73 IF(lwp) WRITE(numout,*) 281 IF(lwp) WRITE(numout,*) 'div_ cur : horizontal velocity divergence and'282 IF(lwp) WRITE(numout,*) '~~~~~~~ relative vorticity'74 IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence ' 75 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 283 76 ENDIF 284 285 ! ! =============== 286 DO jk = 1, jpkm1 ! Horizontal slab 287 ! ! =============== 288 ! 289 hdivb(:,:,jk) = hdivn(:,:,jk) ! time swap of div arrays 290 rotb (:,:,jk) = rotn (:,:,jk) ! time swap of rot arrays 291 ! 292 ! ! -------- 293 ! Horizontal divergence ! div 294 ! ! -------- 77 ! 78 DO jk = 1, jpkm1 !== Horizontal divergence ==! 295 79 DO jj = 2, jpjm1 296 80 DO ji = fs_2, fs_jpim1 ! vector opt. 297 hdivn(ji,jj,jk) = & 298 ( e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) & 299 + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk) ) & 300 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 81 hdivn(ji,jj,jk) = ( e2u(ji ,jj) * fse3u(ji ,jj,jk) * un(ji ,jj,jk) & 82 & - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) & 83 & + e1v(ji,jj ) * fse3v(ji,jj ,jk) * vn(ji,jj ,jk) & 84 & - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk) ) & 85 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 301 86 END DO 302 87 END DO 303 304 88 IF( .NOT. AGRIF_Root() ) THEN 305 IF ((nbondi == 1).OR.(nbondi == 2)) hdivn(nlci-1 , :,jk) = 0.e0 ! east306 IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2 , :,jk) = 0.e0 ! west307 IF ((nbondj == 1).OR.(nbondj == 2)) hdivn(: ,nlcj-1,jk) = 0.e0 ! north308 IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(: ,2,jk) = 0.e0 ! south89 IF( nbondi == 1 .OR. nbondi == 2 ) hdivn(nlci-1, : ,jk) = 0.e0 ! east 90 IF( nbondi == -1 .OR. nbondi == 2 ) hdivn( 2 , : ,jk) = 0.e0 ! west 91 IF( nbondj == 1 .OR. nbondj == 2 ) hdivn( : ,nlcj-1,jk) = 0.e0 ! north 92 IF( nbondj == -1 .OR. nbondj == 2 ) hdivn( : , 2 ,jk) = 0.e0 ! south 309 93 ENDIF 310 311 ! ! -------- 312 ! relative vorticity ! rot 313 ! ! -------- 314 DO jj = 1, jpjm1 315 DO ji = 1, fs_jpim1 ! vector opt. 316 rotn(ji,jj,jk) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 317 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 318 & * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) ) 319 END DO 320 END DO 321 ! ! =============== 322 END DO ! End of slab 323 ! ! =============== 324 325 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 326 IF( nn_cla == 1 ) CALL cla_div ( kt ) ! Cross Land Advection (update hdivn field) 94 END DO 327 95 ! 328 CALL lbc_lnk( hdivn, 'T', 1. ) ; CALL lbc_lnk( rotn , 'F', 1. ) ! lateral boundary cond. (no sign change)96 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) !== runoffs ==! (update hdivn field) 329 97 ! 330 IF( nn_ timing == 1 ) CALL timing_stop('div_cur')98 IF( nn_cla == 1 ) CALL cla_div ( kt ) !== Cross Land Advection ==! (update hdivn field) 331 99 ! 332 END SUBROUTINE div_cur 100 CALL lbc_lnk( hdivn, 'T', 1. ) !== lateral boundary cond. ==! (no sign change) 101 ! 102 IF( nn_timing == 1 ) CALL timing_stop('div_hor') 103 ! 104 END SUBROUTINE div_hor 333 105 334 #endif335 106 !!====================================================================== 336 END MODULE div cur107 END MODULE divhor -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r4292 r4596 124 124 INTEGER :: ios ! Local integer output status for namelist read 125 125 !! 126 NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco , &126 NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco , & 127 127 & ln_hpg_djc, ln_hpg_prj, ln_dynhpg_imp 128 128 !!---------------------------------------------------------------------- … … 434 434 END SUBROUTINE hpg_sco 435 435 436 436 437 SUBROUTINE hpg_djc( kt ) 437 438 !!--------------------------------------------------------------------- … … 580 581 581 582 !!bug gm : here also, simplification is possible 582 !!bug gm : optimisation: 1/10 and 1/12 the division should be done before the loop583 583 584 584 DO jk = 2, jpkm1 585 585 DO jj = 2, jpjm1 586 586 DO ji = fs_2, fs_jpim1 ! vector opt. 587 587 ! 588 588 rho_k(ji,jj,jk) = zcoef0 * ( rhd (ji,jj,jk) + rhd (ji,jj,jk-1) ) & 589 589 & * ( fsde3w(ji,jj,jk) - fsde3w(ji,jj,jk-1) ) & … … 594 594 & * ( rhd (ji,jj,jk) - rhd (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) ) & 595 595 & ) 596 596 ! 597 597 rho_i(ji,jj,jk) = zcoef0 * ( rhd (ji+1,jj,jk) + rhd (ji,jj,jk) ) & 598 598 & * ( fsde3w(ji+1,jj,jk) - fsde3w(ji,jj,jk) ) & … … 603 603 & * ( rhd (ji+1,jj,jk) - rhd (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) ) & 604 604 & ) 605 605 ! 606 606 rho_j(ji,jj,jk) = zcoef0 * ( rhd (ji,jj+1,jk) + rhd (ji,jj,jk) ) & 607 607 & * ( fsde3w(ji,jj+1,jk) - fsde3w(ji,jj,jk) ) & … … 612 612 & * ( rhd (ji,jj+1,jk) - rhd (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) ) & 613 613 & ) 614 615 614 END DO 616 615 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r4522 r4596 4 4 !! Ocean physics: lateral diffusivity trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 05-11 (G. Madec) Original code (new step architecture) 6 !! History : 2.0 ! 2005-11 (G. Madec) Original code (new step architecture) 7 !! 3.7 ! 2014-01 (F. Lemarie, G. Madec) restructuration/simplification of ahm specification, 8 !! ! add velocity dependent coefficient and optional read in file 7 9 !!---------------------------------------------------------------------- 8 10 … … 14 16 USE dom_oce ! ocean space and time domain 15 17 USE phycst ! physical constants 16 USE ldfdyn_oce ! ocean dynamics lateral physics 17 USE ldfslp ! lateral mixing: slopes of mixing orientation 18 USE dynldf_bilapg ! lateral mixing (dyn_ldf_bilapg routine) 19 USE dynldf_bilap ! lateral mixing (dyn_ldf_bilap routine) 20 USE dynldf_iso ! lateral mixing (dyn_ldf_iso routine) 21 USE dynldf_lap ! lateral mixing (dyn_ldf_lap routine) 22 USE ldftra_oce, ONLY: ln_traldf_hor ! ocean tracers lateral physics 18 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 19 USE ldfslp ! lateral diffusion: slopes of mixing orientation 20 USE dynldf_bilapg ! lateral mixing (dyn_ldf_blpg routine) 21 USE dynldf_iso ! lateral mixing (dyn_ldf_iso routine) 22 USE dynldf_lap ! lateral mixing (dyn_ldf_lap routine) 23 23 USE trdmod ! ocean dynamics and tracer trends 24 24 USE trdmod_oce ! ocean variables trends 25 ! 25 26 USE prtctl ! Print control 26 27 USE in_out_manager ! I/O manager 27 28 USE lib_mpp ! distribued memory computing library 28 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 USE wrk_nemo ! Memory Allocation 30 USE timing ! Timing 31 30 USE wrk_nemo ! Memory Allocation 31 USE timing ! Timing 32 32 33 33 IMPLICIT NONE … … 43 43 # include "vectopt_loop_substitute.h90" 44 44 !!---------------------------------------------------------------------- 45 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)45 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 46 46 !! $Id$ 47 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 55 55 !! ** Purpose : compute the lateral ocean dynamics physics. 56 56 !!---------------------------------------------------------------------- 57 !58 57 INTEGER, INTENT(in) :: kt ! ocean time-step index 59 58 ! … … 63 62 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf') 64 63 ! 65 IF( l_trddyn ) THEN ! temporary save of ta and satrends64 IF( l_trddyn ) THEN ! temporary save of momentum trends 66 65 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 67 66 ztrdu(:,:,:) = ua(:,:,:) … … 71 70 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 72 71 ! 73 CASE ( 0 ) ; CALL dyn_ldf_lap ( kt ) ! iso-level laplacian 74 CASE ( 1 ) ; CALL dyn_ldf_iso ( kt ) ! rotated laplacian (except dk[ dk[.] ] part) 75 CASE ( 2 ) ; CALL dyn_ldf_bilap ( kt ) ! iso-level bilaplacian 76 CASE ( 3 ) ; CALL dyn_ldf_bilapg ( kt ) ! s-coord. horizontal bilaplacian 77 CASE ( 4 ) ! iso-level laplacian + bilaplacian 78 CALL dyn_ldf_lap ( kt ) 79 CALL dyn_ldf_bilap ( kt ) 80 CASE ( 5 ) ! rotated laplacian + bilaplacian (s-coord) 81 CALL dyn_ldf_iso ( kt ) 82 CALL dyn_ldf_bilapg ( kt ) 72 CASE ( 0 ) ; CALL dyn_ldf_lap ( kt, ub, vb, ua, va, 1 ) ! iso-level laplacian 73 CASE ( 1 ) ; CALL dyn_ldf_iso ( kt ) ! rotated laplacian 74 CASE ( 2 ) ; CALL dyn_ldf_blp ( kt, ub, vb, ua, va ) ! iso-level bilaplacian 75 CASE ( 3 ) ; CALL dyn_ldf_blpg ( kt ) ! s-coord. horizontal bilaplacian 83 76 ! 84 77 CASE ( -1 ) ! esopa: test all possibility with control print 85 CALL dyn_ldf_lap ( kt)78 CALL dyn_ldf_lap ( kt , ub, vb, ua, va, 1 ) 86 79 CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf0 - Ua: ', mask1=umask, & 87 &tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )88 CALL dyn_ldf_iso 80 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 81 CALL dyn_ldf_iso ( kt ) 89 82 CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf1 - Ua: ', mask1=umask, & 90 &tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )91 CALL dyn_ldf_b ilap ( kt)83 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 84 CALL dyn_ldf_blp ( kt, ub, vb, ua, va ) 92 85 CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf2 - Ua: ', mask1=umask, & 93 &tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )94 CALL dyn_ldf_b ilapg( kt )86 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 87 CALL dyn_ldf_blpg( kt ) 95 88 CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask, & 96 &tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )97 !89 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 90 ! 98 91 CASE ( -2 ) ! neither laplacian nor bilaplacian schemes used 99 92 IF( kt == nit000 ) THEN … … 127 120 INTEGER :: ioptio, ierr ! temporary integers 128 121 !!---------------------------------------------------------------------- 129 122 ! 130 123 ! ! Namelist nam_dynldf: already read in ldfdyn module 131 124 ! 132 125 IF(lwp) THEN ! Namelist print 133 126 WRITE(numout,*) … … 135 128 WRITE(numout,*) '~~~~~~~~~~~' 136 129 WRITE(numout,*) ' Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)' 137 WRITE(numout,*) ' laplacian operator ln_dynldf_lap 138 WRITE(numout,*) ' bilaplacian operator ln_dynldf_b ilap = ', ln_dynldf_bilap139 WRITE(numout,*) ' iso-level ln_dynldf_lev el = ', ln_dynldf_level140 WRITE(numout,*) ' horizontal (geopotential) ln_dynldf_hor 141 WRITE(numout,*) ' iso-neutral ln_dynldf_iso 130 WRITE(numout,*) ' laplacian operator ln_dynldf_lap = ', ln_dynldf_lap 131 WRITE(numout,*) ' bilaplacian operator ln_dynldf_blp = ', ln_dynldf_blp 132 WRITE(numout,*) ' iso-level ln_dynldf_lev = ', ln_dynldf_lev 133 WRITE(numout,*) ' horizontal (geopotential) ln_dynldf_hor = ', ln_dynldf_hor 134 WRITE(numout,*) ' iso-neutral ln_dynldf_iso = ', ln_dynldf_iso 142 135 ENDIF 143 136 144 137 ! ! control the consistency 145 138 ioptio = 0 146 IF( ln_dynldf_lap 147 IF( ln_dynldf_b ilap ) ioptio = ioptio + 1139 IF( ln_dynldf_lap ) ioptio = ioptio + 1 140 IF( ln_dynldf_blp ) ioptio = ioptio + 1 148 141 IF( ioptio < 1 ) CALL ctl_warn( ' neither laplacian nor bilaplacian operator set for dynamics' ) 142 IF( ioptio == 2 ) CALL ctl_stop( ' you cannot use laplacian AND bilaplacian operator at the same time' ) 149 143 ioptio = 0 150 IF( ln_dynldf_lev el) ioptio = ioptio + 1151 IF( ln_dynldf_hor 152 IF( ln_dynldf_iso 144 IF( ln_dynldf_lev ) ioptio = ioptio + 1 145 IF( ln_dynldf_hor ) ioptio = ioptio + 1 146 IF( ln_dynldf_iso ) ioptio = ioptio + 1 153 147 IF( ioptio > 1 ) CALL ctl_stop( ' use only ONE direction (level/hor/iso)' ) 154 148 155 IF( ln_dynldf_iso .AND. ln_traldf_hor ) CALL ctl_stop&156 & ( 'Not sensible to use geopotential diffusion for tracers with isoneutral diffusion for dynamics' )149 !!gm IF( ln_dynldf_iso .AND. ln_traldf_hor ) CALL ctl_stop & 150 !!gm & ( 'Not sensible to use geopotential diffusion for tracers with isoneutral diffusion for dynamics' ) 157 151 158 152 ! ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals … … 160 154 IF ( ln_dynldf_lap ) THEN ! laplacian operator 161 155 IF ( ln_zco ) THEN ! z-coordinate 162 IF ( ln_dynldf_lev el) nldf = 0 ! iso-level (no rotation)163 IF ( ln_dynldf_hor 164 IF ( ln_dynldf_iso 165 ENDIF 166 IF ( ln_zps ) THEN ! z-coordinate 167 IF ( ln_dynldf_lev el) ierr = 1 ! iso-level not allowed168 IF ( ln_dynldf_hor 169 IF ( ln_dynldf_iso 156 IF ( ln_dynldf_lev ) nldf = 0 ! iso-level (no rotation) 157 IF ( ln_dynldf_hor ) nldf = 0 ! horizontal (no rotation) 158 IF ( ln_dynldf_iso ) nldf = 1 ! isoneutral ( rotation) 159 ENDIF 160 IF ( ln_zps ) THEN ! z-coordinate with partial step 161 IF ( ln_dynldf_lev ) ierr = 1 ! iso-level not allowed 162 IF ( ln_dynldf_hor ) nldf = 0 ! horizontal (no rotation) 163 IF ( ln_dynldf_iso ) nldf = 1 ! isoneutral ( rotation) 170 164 ENDIF 171 165 IF ( ln_sco ) THEN ! s-coordinate 172 IF ( ln_dynldf_lev el) nldf = 0 ! iso-level (no rotation)173 IF ( ln_dynldf_hor 174 IF ( ln_dynldf_iso 175 ENDIF 176 ENDIF 177 178 IF( ln_dynldf_b ilap ) THEN! bilaplacian operator166 IF ( ln_dynldf_lev ) nldf = 0 ! iso-level (no rotation) 167 IF ( ln_dynldf_hor ) nldf = 1 ! horizontal ( rotation) 168 IF ( ln_dynldf_iso ) nldf = 1 ! isoneutral ( rotation) 169 ENDIF 170 ENDIF 171 172 IF( ln_dynldf_blp ) THEN ! bilaplacian operator 179 173 IF ( ln_zco ) THEN ! z-coordinate 180 IF ( ln_dynldf_lev el) nldf = 2 ! iso-level (no rotation)181 IF ( ln_dynldf_hor 182 IF ( ln_dynldf_iso 183 ENDIF 184 IF ( ln_zps ) THEN ! z-coordinate 185 IF ( ln_dynldf_lev el) ierr = 1 ! iso-level not allowed186 IF ( ln_dynldf_hor 187 IF ( ln_dynldf_iso 174 IF ( ln_dynldf_lev ) nldf = 2 ! iso-level (no rotation) 175 IF ( ln_dynldf_hor ) nldf = 2 ! horizontal (no rotation) 176 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation) 177 ENDIF 178 IF ( ln_zps ) THEN ! z-coordinate with partial step 179 IF ( ln_dynldf_lev ) ierr = 1 ! iso-level not allowed 180 IF ( ln_dynldf_hor ) nldf = 2 ! horizontal (no rotation) 181 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation) 188 182 ENDIF 189 183 IF ( ln_sco ) THEN ! s-coordinate 190 IF ( ln_dynldf_lev el) nldf = 2 ! iso-level (no rotation)191 IF ( ln_dynldf_hor 192 IF ( ln_dynldf_iso 184 IF ( ln_dynldf_lev ) nldf = 2 ! iso-level (no rotation) 185 IF ( ln_dynldf_hor ) nldf = 3 ! horizontal ( rotation) 186 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation) 193 187 ENDIF 194 188 ENDIF 195 189 196 IF( ln_dynldf_lap .AND. ln_dynldf_b ilap ) THEN ! mixed laplacian and bilaplacian operators190 IF( ln_dynldf_lap .AND. ln_dynldf_blp ) THEN ! mixed laplacian and bilaplacian operators 197 191 IF ( ln_zco ) THEN ! z-coordinate 198 IF ( ln_dynldf_lev el) nldf = 4 ! iso-level (no rotation)199 IF ( ln_dynldf_hor 200 IF ( ln_dynldf_iso 201 ENDIF 202 IF ( ln_zps ) THEN ! z-coordinate 203 IF ( ln_dynldf_lev el) ierr = 1 ! iso-level not allowed204 IF ( ln_dynldf_hor 205 IF ( ln_dynldf_iso 192 IF ( ln_dynldf_lev ) nldf = 4 ! iso-level (no rotation) 193 IF ( ln_dynldf_hor ) nldf = 4 ! horizontal (no rotation) 194 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation) 195 ENDIF 196 IF ( ln_zps ) THEN ! z-coordinate with partial step 197 IF ( ln_dynldf_lev ) ierr = 1 ! iso-level not allowed 198 IF ( ln_dynldf_hor ) nldf = 4 ! horizontal (no rotation) 199 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation) 206 200 ENDIF 207 201 IF ( ln_sco ) THEN ! s-coordinate 208 IF ( ln_dynldf_lev el) nldf = 4 ! iso-level (no rotation)209 IF ( ln_dynldf_hor 210 IF ( ln_dynldf_iso 202 IF ( ln_dynldf_lev ) nldf = 4 ! iso-level (no rotation) 203 IF ( ln_dynldf_hor ) nldf = 5 ! horizontal ( rotation) 204 IF ( ln_dynldf_iso ) ierr = 2 ! isoneutral ( rotation) 211 205 ENDIF 212 206 ENDIF … … 216 210 IF( ierr == 1 ) CALL ctl_stop( 'iso-level in z-coordinate - partial step, not allowed' ) 217 211 IF( ierr == 2 ) CALL ctl_stop( 'isoneutral bilaplacian operator does not exist' ) 218 IF( nldf == 1 .OR. nldf == 3 ) THEN ! rotation 219 IF( .NOT.lk_ldfslp ) CALL ctl_stop( 'the rotation of the diffusive tensor require key_ldfslp' ) 220 ENDIF 212 IF( nldf == 1 .OR. nldf == 3 ) l_ldfslp = .TRUE. ! rotation require the computation of the slopes 221 213 222 214 IF(lwp) THEN -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r4488 r4596 7 7 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 8 8 !! 2.0 ! 2004-08 (C. Talandier) New trends organization 9 !! 3.7 ! 2014-01 (F. Lemarie, G. Madec) restructuration/simplification of ahm specification, 10 !! ! add velocity dependent coefficient and optional read in file 9 11 !!---------------------------------------------------------------------- 10 #if defined key_ldfslp || defined key_esopa 12 11 13 !!---------------------------------------------------------------------- 12 !! 'key_ldfslp' Rotation of mixing tensor 13 !!---------------------------------------------------------------------- 14 !! dyn_ldf_bilapg : update the momentum trend with the horizontal part 15 !! of the horizontal s-coord. bilaplacian diffusion 16 !! ldfguv : 14 !! dyn_ldf_blpg : update the momentum trend with the horizontal part 15 !! of the horizontal s-coord. bilaplacian diffusion 16 !! ldfguv : 17 17 !!---------------------------------------------------------------------- 18 18 USE oce ! ocean dynamics and tracers 19 19 USE dom_oce ! ocean space and time domain 20 USE ldfdyn_oce ! ocean dynamics lateral physics 21 USE ldftra_oce, ONLY: ln_traldf_iso 20 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 22 21 USE zdf_oce ! ocean vertical physics 23 22 USE trdmod ! ocean dynamics trends 24 23 USE trdmod_oce ! ocean variables trends 25 24 USE ldfslp ! iso-neutral slopes available 25 ! 26 26 USE in_out_manager ! I/O manager 27 27 USE lib_mpp ! MPP library … … 34 34 PRIVATE 35 35 36 PUBLIC dyn_ldf_b ilapg ! called by step.F9036 PUBLIC dyn_ldf_blpg ! called by step.F90 37 37 38 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zfvw , zdiu, zdiv ! 2D workspace (ldfguv) … … 41 41 !! * Substitutions 42 42 # include "domzgr_substitute.h90" 43 # include "ldfdyn_substitute.h90"44 43 !!---------------------------------------------------------------------- 45 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)44 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 46 45 !! $Id$ 47 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 49 48 CONTAINS 50 49 51 INTEGER FUNCTION dyn_ldf_b ilapg_alloc()52 !!---------------------------------------------------------------------- 53 !! *** ROUTINE dyn_ldf_b ilapg_alloc ***50 INTEGER FUNCTION dyn_ldf_blpg_alloc() 51 !!---------------------------------------------------------------------- 52 !! *** ROUTINE dyn_ldf_blpg_alloc *** 54 53 !!---------------------------------------------------------------------- 55 54 ALLOCATE( zfuw(jpi,jpk) , zfvw (jpi,jpk) , zdiu(jpi,jpk) , zdiv (jpi,jpk) , & 56 & zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_b ilapg_alloc )55 & zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_blpg_alloc ) 57 56 ! 58 IF( dyn_ldf_b ilapg_alloc /= 0 ) CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays')59 END FUNCTION dyn_ldf_b ilapg_alloc60 61 62 SUBROUTINE dyn_ldf_b ilapg( kt )63 !!---------------------------------------------------------------------- 64 !! *** ROUTINE dyn_ldf_b ilapg ***57 IF( dyn_ldf_blpg_alloc /= 0 ) CALL ctl_warn('dyn_ldf_blpg_alloc: failed to allocate arrays') 58 END FUNCTION dyn_ldf_blpg_alloc 59 60 61 SUBROUTINE dyn_ldf_blpg( kt ) 62 !!---------------------------------------------------------------------- 63 !! *** ROUTINE dyn_ldf_blpg *** 65 64 !! 66 65 !! ** Purpose : Compute the before trend of the horizontal momentum … … 93 92 !!---------------------------------------------------------------------- 94 93 ! 95 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_b ilapg')94 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_blpg') 96 95 ! 97 96 CALL wrk_alloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 ) … … 99 98 IF( kt == nit000 ) THEN 100 99 IF(lwp) WRITE(numout,*) 101 IF(lwp) WRITE(numout,*) 'dyn_ldf_b ilapg : horizontal biharmonic operator in s-coordinate'102 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ ~~'103 ! ! allocate dyn_ldf_b ilapg arrays104 IF( dyn_ldf_b ilapg_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_ldf_bilapg: failed to allocate arrays')100 IF(lwp) WRITE(numout,*) 'dyn_ldf_blpg : horizontal biharmonic operator in s-coordinate' 101 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 102 ! ! allocate dyn_ldf_blpg arrays 103 IF( dyn_ldf_blpg_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_ldf_blpg: failed to allocate arrays') 105 104 ENDIF 106 107 ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum 108 IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 109 ! 110 DO jk = 1, jpk ! set the slopes of iso-level 111 DO jj = 2, jpjm1 112 DO ji = 2, jpim1 113 uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 114 vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 115 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 116 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 117 END DO 118 END DO 119 END DO 120 ! Lateral boundary conditions on the slopes 121 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 122 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 123 124 !!bug 125 IF( kt == nit000 ) then 126 IF(lwp) WRITE(numout,*) ' max slop: u', SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)), & 127 & ' wi', sqrt(MAXVAL(wslpi)) , ' wj', sqrt(MAXVAL(wslpj)) 128 endif 129 !!end 130 ENDIF 131 105 ! 132 106 zwk1(:,:,:) = 0.e0 ; zwk3(:,:,:) = 0.e0 133 107 zwk2(:,:,:) = 0.e0 ; zwk4(:,:,:) = 0.e0 … … 157 131 CALL wrk_dealloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 ) 158 132 ! 159 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_b ilapg')160 ! 161 END SUBROUTINE dyn_ldf_b ilapg133 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_blpg') 134 ! 135 END SUBROUTINE dyn_ldf_blpg 162 136 163 137 … … 178 152 !! ========== pu as follows (idem on pv) 179 153 !! horizontal fluxes : 180 !! zftu = e2u*e3u/e1u di[ pu ] - e2u*uslp dk[ mi(mk(pu)) ]181 !! zftv = e1v*e3v/e2v dj[ pu ] - e1v*vslp dk[ mj(mk(pu)) ]154 !! zftu = ahmt ( e2u*e3u/e1u di[ pu ] - e2u*uslp dk[ mi(mk(pu)) ] ) 155 !! zftv = ahmf ( e1v*e3v/e2v dj[ pu ] - e1v*vslp dk[ mj(mk(pu)) ] ) 182 156 !! take the horizontal divergence of the fluxes (no divided by 183 157 !! the volume element : 184 !! plu = di-1[ zftu ] + 158 !! plu = di-1[ zftu ] + dj-1[ zftv ] 185 159 !! 186 160 !! Second step: vertical part of the operator. It is computed on 187 161 !! =========== pu as follows (idem on pv) 188 162 !! vertical fluxes : 189 !! zftw = e1t*e2t/e3w * ( wslpi^2+wslpj^2) dk-1[ pu ]190 !! - e2t * wslpidi[ mi(mk(pu)) ]191 !! - e1t * wslpjdj[ mj(mk(pu)) ]163 !! zftw = e1t*e2t/e3w * (ahm*wslpi^2+ahm*wslpj^2) dk-1[ pu ] 164 !! - e2t * ahm*wslpi di[ mi(mk(pu)) ] 165 !! - e1t * ahm*wslpj dj[ mj(mk(pu)) ] 192 166 !! take the vertical divergence of the fluxes add it to the hori- 193 !! zontal component, divide the result by the volume element and 194 !! if kahm=1, multiply by the eddy diffusivity coefficient: 195 !! plu = aht / (e1t*e2t*e3t) { plu + dk[ zftw ] } 196 !! else: 197 !! plu = 1 / (e1t*e2t*e3t) { plu + dk[ zftw ] } 167 !! zontal component, divide the result by the volume element : 168 !! plu = zsign / (e1t*e2t*e3t) { plu + dk[ zftw ] } 169 !! where zsign=+1 if kahm =1 (laplacian or 1st pass of bilaplacian) 170 !! =-1 if kahm =2 (2nd pass in case of bilaplacian) 198 171 !! 199 172 !! ** Action : … … 203 176 !! 'key_trddyn' defined: the trend is saved for diagnostics. 204 177 !!---------------------------------------------------------------------- 205 !! 206 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu , pv ! 1st call: before horizontal velocity 207 ! ! 2nd call: ahm x these fields 208 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: plu, plv ! partial harmonic operator applied to 178 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu , pv ! fields on which laplacian is applied 179 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: plu, plv ! partial laplacian operator applied to 209 180 ! ! pu and pv (all the components except 210 181 ! ! second order vertical derivative term) … … 213 184 INTEGER :: ji, jj, jk ! dummy loop indices 214 185 REAL(wp) :: zabe1 , zabe2 , zcof1 , zcof2 ! local scalar 215 REAL(wp) :: zcoef0, zcoef3, zcoef4 186 REAL(wp) :: zcoef0, zcoef3, zcoef4, zsign ! - - 216 187 REAL(wp) :: zbur, zbvr, zmkt, zmkf, zuav, zvav ! - - 217 188 REAL(wp) :: zuwslpi, zuwslpj, zvwslpi, zvwslpj ! - - 189 REAL(wp) :: zaht_uw, zahf_uw ! - - 190 REAL(wp) :: zaht_vw, zahf_vw ! - - 218 191 ! 219 192 REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v … … 223 196 ! 224 197 CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 198 ! 199 IF ( kahm == 1 ) THEN ; zsign = +1._wp 200 ELSEIF( kahm == 2 ) THEN ; zsign = -1._wp 201 ELSE 202 IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 203 IF(lwp)WRITE(numout,*) ' We stop' 204 STOP 'ldfguv' 205 ENDIF 225 206 ! 226 207 ! ! ********** ! ! =============== … … 252 233 DO ji = 2, jpi 253 234 zabe1 = e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj) 254 235 ! 255 236 zmkt = 1./MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & 256 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1. ) 257 258 zcof1 = -e2t(ji,jj) * zmkt & 259 * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 260 261 ziut(ji,jj) = tmask(ji,jj,jk) * & 262 ( zabe1 * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) ) & 263 + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & 264 +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) 237 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1. ) 238 ! 239 zcof1 = -e2t(ji,jj) * zmkt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 240 ! 241 ziut(ji,jj) = tmask(ji,jj,jk) * ahmt(ji,jj,jk) * & 242 & ( zabe1 * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) ) & 243 & + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & 244 & +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) 265 245 END DO 266 246 END DO … … 270 250 DO ji = 1, jpim1 271 251 zabe2 = e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) 272 252 ! 273 253 zmkf = 1./MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1) & 274 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk ), 1. ) 275 276 zcof2 = -e1f(ji,jj) * zmkf & 277 * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 278 279 zjuf(ji,jj) = fmask(ji,jj,jk) * & 280 ( zabe2 * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) ) & 281 + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj) & 282 +zdk1u(ji,jj+1) + zdku (ji,jj) ) ) 254 & + umask(ji,jj+1,jk+1)+umask(ji,jj,jk ), 1. ) 255 ! 256 zcof2 = -e1f(ji,jj) * zmkf * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 257 258 !!gm caution here fmask multiplication already done in the def of ahmf... 259 !!gm so in noslip.... with fmask value=2 at the coast !!!! 260 261 ! 262 zjuf(ji,jj) = fmask(ji,jj,jk) * ahmf(ji,jj,jk) * & 263 & ( zabe2 * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) ) & 264 & + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj) & 265 & +zdk1u(ji,jj+1) + zdku (ji,jj) ) ) 283 266 END DO 284 267 END DO … … 292 275 DO ji = 1, jpim1 293 276 zabe1 = e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj) 294 277 ! 295 278 zmkf = 1./MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & 296 + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. ) 297 298 zcof1 = -e2f(ji,jj) * zmkf & 299 * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 300 301 zivf(ji,jj) = fmask(ji,jj,jk) * & 302 ( zabe1 * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) ) & 303 + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj) & 304 +zdk1u(ji,jj) + zdku (ji+1,jj) ) ) 279 & + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. ) 280 ! 281 zcof1 = -e2f(ji,jj) * zmkf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 282 ! 283 zivf(ji,jj) = fmask(ji,jj,jk) * ahmf(ji,jj,jk) * & 284 & ( zabe1 * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) ) & 285 & + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj) & 286 & +zdk1u(ji,jj) + zdku (ji+1,jj) ) ) 305 287 END DO 306 288 END DO … … 310 292 DO ji = 1, jpim1 311 293 zabe2 = e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj) 312 294 ! 313 295 zmkt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 314 + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) 315 316 zcof2 = -e1t(ji,jj) * zmkt & 317 * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 318 319 zjvt(ji,jj) = tmask(ji,jj,jk) * & 320 ( zabe2 * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) ) & 321 + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj) & 322 +zdk1u(ji,jj-1) + zdku (ji,jj) ) ) 296 & + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) 297 ! 298 zcof2 = -e1t(ji,jj) * zmkt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 299 ! 300 zjvt(ji,jj) = tmask(ji,jj,jk) * ahmt(ji,jj,jk) * & 301 & ( zabe2 * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) ) & 302 & + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj) & 303 & +zdk1u(ji,jj-1) + zdku (ji,jj) ) ) 323 304 END DO 324 305 END DO … … 330 311 DO jj = 2, jpjm1 331 312 DO ji = 2, jpim1 332 plu(ji,jj,jk) = ziut (ji+1,jj) - ziut (ji,jj ) & 333 + zjuf (ji ,jj) - zjuf (ji,jj-1) 334 plv(ji,jj,jk) = zivf (ji,jj ) - zivf (ji-1,jj) & 335 + zjvt (ji,jj+1) - zjvt (ji,jj ) 336 END DO 337 END DO 338 313 plu(ji,jj,jk) = ziut (ji+1,jj) - ziut (ji,jj ) & 314 & + zjuf (ji ,jj) - zjuf (ji,jj-1) 315 plv(ji,jj,jk) = zivf (ji,jj ) - zivf (ji-1,jj) & 316 & + zjvt (ji,jj+1) - zjvt (ji,jj ) 317 END DO 318 END DO 339 319 ! ! =============== 340 320 END DO ! End of slab … … 352 332 DO jk = 1, jpk 353 333 DO ji = 2, jpi 354 ! i-gradient of u at jj 334 !!gm caution here fmask multiplication already done in the def of ahmf... 335 !!gm so in noslip.... with fmask value=2 at the coast !!!! 336 ! ! i-gradient of u at jj 355 337 zdiu (ji,jk) = tmask(ji,jj ,jk) * ( pu(ji,jj ,jk) - pu(ji-1,jj ,jk) ) 356 ! j-gradient of u and v at jj338 ! ! j-gradient of u and v at jj 357 339 zdju (ji,jk) = fmask(ji,jj ,jk) * ( pu(ji,jj+1,jk) - pu(ji ,jj ,jk) ) 358 340 zdjv (ji,jk) = tmask(ji,jj ,jk) * ( pv(ji,jj ,jk) - pv(ji ,jj-1,jk) ) 359 ! j-gradient of u and v at jj+1341 ! ! j-gradient of u and v at jj+1 360 342 zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( pu(ji,jj ,jk) - pu(ji ,jj-1,jk) ) 361 343 zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pv(ji,jj+1,jk) - pv(ji ,jj ,jk) ) … … 363 345 END DO 364 346 DO jk = 1, jpk 365 DO ji = 1, jpim1 366 ! i-gradient of v at jj 347 DO ji = 1, jpim1 ! i-gradient of v at jj 367 348 zdiv (ji,jk) = fmask(ji,jj ,jk) * ( pv(ji+1,jj,jk) - pv(ji ,jj ,jk) ) 368 349 END DO … … 375 356 ! Surface and bottom vertical fluxes set to zero 376 357 377 zfuw(:, 1 ) = 0. e0378 zfvw(:, 1 ) = 0. e0379 zfuw(:,jpk) = 0. e0380 zfvw(:,jpk) = 0. e0358 zfuw(:, 1 ) = 0._wp 359 zfvw(:, 1 ) = 0._wp 360 zfuw(:,jpk) = 0._wp 361 zfvw(:,jpk) = 0._wp 381 362 382 363 ! interior (2=<jk=<jpk-1) on pu field … … 389 370 ! coef. for the vertical dirative 390 371 zcoef0 = e1u(ji,jj) * e2u(ji,jj) / fse3u(ji,jj,jk) & 391 372 & * ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) 392 373 ! weights for the i-k, j-k averaging at t- and f-points, resp. 393 374 zmkt = 1./MAX( tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1) & 394 + tmask(ji,jj,jk )+tmask(ji+1,jj,jk ), 1. ) 375 & + tmask(ji,jj,jk )+tmask(ji+1,jj,jk ), 1. ) 376 !!gm caution here fmask multiplication already done in the def of ahmf... 377 !!gm so in noslip.... with fmask value=2 at the coast !!!! 395 378 zmkf = 1./MAX( fmask(ji,jj-1,jk-1)+fmask(ji,jj,jk-1) & 396 + fmask(ji,jj-1,jk )+fmask(ji,jj,jk ), 1. ) 379 & + fmask(ji,jj-1,jk )+fmask(ji,jj,jk ), 1. ) 380 zaht_uw = ( ahmt(ji,jj,jk-1) + ahmt(ji+1,jj,jk-1) & 381 & + ahmt(ji,jj,jk ) + ahmt(ji+1,jj,jk ) ) * zmkt 382 zahf_uw = ( ahmf(ji,jj-1,jk-1) + ahmf(ji,jj,jk-1) & 383 & + ahmf(ji,jj-1,jk ) + ahmf(ji,jj,jk ) ) * zmkf 397 384 ! coef. for the horitontal derivative 398 zcoef3 = - e2u(ji,jj) * z mkt* zuwslpi399 zcoef4 = - e1u(ji,jj) * z mkf* zuwslpj385 zcoef3 = - e2u(ji,jj) * zaht_uw * zuwslpi 386 zcoef4 = - e1u(ji,jj) * zahf_uw * zuwslpj 400 387 ! vertical flux on u field 401 388 zfuw(ji,jk) = umask(ji,jj,jk) * & 402 403 404 405 406 389 & ( zcoef0 * ( pu (ji,jj,jk-1) - pu (ji,jj,jk) ) & 390 & + zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1) & 391 & +zdiu (ji,jk ) + zdiu (ji+1,jk ) ) & 392 & + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji ,jk-1) & 393 & +zdj1u(ji,jk ) + zdju (ji ,jk ) ) ) 407 394 END DO 408 395 END DO … … 417 404 ! coef. for the vertical derivative 418 405 zcoef0 = e1v(ji,jj) * e2v(ji,jj) / fse3v(ji,jj,jk) & 419 * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) 406 & * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) 407 !!gm caution here fmask multiplication already done in the def of ahmf... 408 !!gm so in noslip.... with fmask value=2 at the coast !!!! 420 409 ! weights for the i-k, j-k averaging at f- and t-points, resp. 421 410 zmkf = 1./MAX( fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1) & 422 411 & + fmask(ji-1,jj,jk )+fmask(ji,jj,jk ), 1. ) 423 412 zmkt = 1./MAX( tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1) & 424 + tmask(ji,jj,jk )+tmask(ji,jj+1,jk ), 1. ) 413 & + tmask(ji,jj,jk )+tmask(ji,jj+1,jk ), 1. ) 414 zahf_vw = ( ahmf(ji-1,jj,jk-1) + ahmf(ji,jj,jk-1) & 415 & + ahmf(ji-1,jj,jk ) + ahmf(ji,jj,jk ) ) * zmkf 416 zaht_vw = ( ahmt(ji,jj,jk-1) + ahmt(ji,jj+1,jk-1) & 417 & + ahmt(ji,jj,jk ) + ahmt(ji,jj+1,jk ) ) * zmkt 425 418 ! coef. for the horizontal derivatives 426 zcoef3 = - e2v(ji,jj) * z mkf* zvwslpi427 zcoef4 = - e1v(ji,jj) * z mkt* zvwslpj419 zcoef3 = - e2v(ji,jj) * zahf_vw * zvwslpi 420 zcoef4 = - e1v(ji,jj) * zaht_vw * zvwslpj 428 421 ! vertical flux on pv field 429 422 zfvw(ji,jk) = vmask(ji,jj,jk) * & 430 431 432 433 434 423 & ( zcoef0 * ( pv (ji,jj,jk-1) - pv (ji,jj,jk) ) & 424 & + zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1) & 425 & +zdiv (ji,jk ) + zdiv (ji-1,jk ) ) & 426 & + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji ,jk-1) & 427 & +zdjv (ji,jk ) + zdj1v(ji ,jk ) ) ) 435 428 END DO 436 429 END DO … … 439 432 ! II.3 Divergence of vertical fluxes added to the horizontal divergence 440 433 ! --------------------------------------------------------------------- 441 IF( (kahm -nkahm_smag) ==1 ) THEN 442 ! multiply the laplacian by the eddy viscosity coefficient 443 DO jk = 1, jpkm1 444 DO ji = 2, jpim1 445 ! eddy coef. divided by the volume element 446 zbur = fsahmu(ji,jj,jk) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) 447 zbvr = fsahmv(ji,jj,jk) / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) 448 ! vertical divergence 449 zuav = zfuw(ji,jk) - zfuw(ji,jk+1) 450 zvav = zfvw(ji,jk) - zfvw(ji,jk+1) 451 ! harmonic operator applied to (pu,pv) and multiply by ahm 452 plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur 453 plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr 454 END DO 455 END DO 456 ELSEIF( (kahm +nkahm_smag ) == 2 ) THEN 457 ! second call, no multiplication 458 DO jk = 1, jpkm1 459 DO ji = 2, jpim1 460 ! inverse of the volume element 461 zbur = 1. / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) 462 zbvr = 1. / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) 463 ! vertical divergence 464 zuav = zfuw(ji,jk) - zfuw(ji,jk+1) 465 zvav = zfvw(ji,jk) - zfvw(ji,jk+1) 466 ! harmonic operator applied to (pu,pv) 467 plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur 468 plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr 469 END DO 470 END DO 471 ELSE 472 IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 473 IF(lwp)WRITE(numout,*) ' We stop' 474 STOP 'ldfguv' 475 ENDIF 434 435 DO jk = 1, jpkm1 436 DO ji = 2, jpim1 437 ! vertical divergence 438 zuav = zfuw(ji,jk) - zfuw(ji,jk+1) 439 zvav = zfvw(ji,jk) - zfvw(ji,jk+1) 440 ! harmonic operator applied to (pu,pv) and multiply by ahm 441 plu(ji,jj,jk) = zsign * ( plu(ji,jj,jk) + zuav ) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) 442 plv(ji,jj,jk) = zsign * ( plv(ji,jj,jk) + zvav ) / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) 443 END DO 444 END DO 476 445 ! ! =============== 477 446 END DO ! End of slab … … 484 453 END SUBROUTINE ldfguv 485 454 486 #else487 !!----------------------------------------------------------------------488 !! Dummy module : NO rotation of mixing tensor489 !!----------------------------------------------------------------------490 CONTAINS491 SUBROUTINE dyn_ldf_bilapg( kt ) ! Dummy routine492 INTEGER, INTENT(in) :: kt493 WRITE(*,*) 'dyn_ldf_bilapg: You should not have seen this print! error?', kt494 END SUBROUTINE dyn_ldf_bilapg495 #endif496 497 455 !!====================================================================== 498 456 END MODULE dynldf_bilapg -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r4488 r4596 8 8 !! - ! 2004-08 (C. Talandier) New trends organization 9 9 !! 2.0 ! 2005-11 (G. Madec) s-coordinate: horizontal diffusion 10 !! 3.7 ! 2014-01 (F. Lemarie, G. Madec) restructuration/simplification of ahm specification, 11 !! ! add velocity dependent coefficient and optional read in file 10 12 !!---------------------------------------------------------------------- 11 #if defined key_ldfslp || defined key_esopa 12 !!---------------------------------------------------------------------- 13 !! 'key_ldfslp' slopes of the direction of mixing 13 14 14 !!---------------------------------------------------------------------- 15 15 !! dyn_ldf_iso : update the momentum trend with the horizontal part … … 19 19 USE oce ! ocean dynamics and tracers 20 20 USE dom_oce ! ocean space and time domain 21 USE ldfdyn _oce ! ocean dynamics lateral physics22 USE ldftra _oce ! ocean tracer lateral physics21 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 22 USE ldftra ! lateral physics: eddy diffusivity 23 23 USE zdf_oce ! ocean vertical physics 24 24 USE trdmod ! ocean dynamics trends … … 43 43 !! * Substitutions 44 44 # include "domzgr_substitute.h90" 45 # include "ldfdyn_substitute.h90"46 45 # include "vectopt_loop_substitute.h90" 47 46 !!---------------------------------------------------------------------- … … 84 83 !! horizontal fluxes associated with the rotated lateral mixing: 85 84 !! u-component: 86 !! ziut = ( ahmt + ahmb0) e2t * e3t / e1t di[ ub ]87 !! - ahmte2t * mi-1(uslp) dk[ mi(mk(ub)) ]88 !! zjuf = ( ahmf + ahmb0) e1f * e3f / e2f dj[ ub ]89 !! - ahmfe1f * mi(vslp) dk[ mj(mk(ub)) ]85 !! ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t di[ ub ] 86 !! - ahmt e2t * mi-1(uslp) dk[ mi(mk(ub)) ] 87 !! zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f dj[ ub ] 88 !! - ahmf e1f * mi(vslp) dk[ mj(mk(ub)) ] 90 89 !! v-component: 91 !! zivf = ( ahmf + ahmb0) e2t * e3t / e1t di[ vb ]92 !! - ahmfe2t * mj(uslp) dk[ mi(mk(vb)) ]93 !! zjvt = ( ahmt + ahmb0) e1f * e3f / e2f dj[ ub ]94 !! - ahmte1f * mj-1(vslp) dk[ mj(mk(vb)) ]90 !! zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t di[ vb ] 91 !! - ahmf e2t * mj(uslp) dk[ mi(mk(vb)) ] 92 !! zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f dj[ ub ] 93 !! - ahmt e1f * mj-1(vslp) dk[ mj(mk(vb)) ] 95 94 !! take the horizontal divergence of the fluxes: 96 95 !! diffu = 1/(e1u*e2u*e3u) { di [ ziut ] + dj-1[ zjuf ] } … … 107 106 !! of the rotated operator in dynzdf module 108 107 !!---------------------------------------------------------------------- 109 !110 108 INTEGER, INTENT( in ) :: kt ! ocean time-step index 111 109 ! … … 131 129 ENDIF 132 130 133 ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum131 ! s-coordinate: Iso-level diffusion on momentum but not on tracer 134 132 IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 135 133 ! … … 185 183 DO jj = 2, jpjm1 186 184 DO ji = fs_2, jpi ! vector opt. 187 zabe1 = ( fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) / e1t(ji,jj)188 189 zmskt = 1. /MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1)&190 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1.)191 192 zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )185 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) / e1t(ji,jj) 186 187 zmskt = 1._wp / MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & 188 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ) , 1._wp ) 189 190 zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 193 191 192 ziut(ji,jj) = ( zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) ) & 193 & + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & 194 & +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) * tmask(ji,jj,jk) 195 END DO 196 END DO 197 ELSE ! other coordinate system (zco or sco) : e3t 198 DO jj = 2, jpjm1 199 DO ji = fs_2, jpi ! vector opt. 200 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj) 201 202 zmskt = 1._wp / MAX( umask(ji-1,jj,jk ) + umask(ji,jj,jk+1) & 203 & + umask(ji-1,jj,jk+1) + umask(ji,jj,jk ) , 1._wp ) 204 205 zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 206 194 207 ziut(ji,jj) = ( zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) ) & 195 208 & + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) & … … 197 210 END DO 198 211 END DO 199 ELSE ! other coordinate system (zco or sco) : e3t200 DO jj = 2, jpjm1201 DO ji = fs_2, jpi ! vector opt.202 zabe1 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)203 204 zmskt = 1./MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) &205 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1. )206 207 zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )208 209 ziut(ji,jj) = ( zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) ) &210 & + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) &211 & +zdk1u(ji,jj) + zdku (ji-1,jj) ) ) * tmask(ji,jj,jk)212 END DO213 END DO214 212 ENDIF 215 213 … … 217 215 DO jj = 1, jpjm1 218 216 DO ji = 1, fs_jpim1 ! vector opt. 219 zabe2 = ( fsahmf(ji,jj,jk) + ahmb0) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)220 221 zmskf = 1. /MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1)&222 & + umask(ji,jj+1,jk+1)+umask(ji,jj,jk ), 1.)223 224 zcof2 = - aht0 * e1f(ji,jj) * zmskf * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )217 zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) 218 219 zmskf = 1._wp / MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1) & 220 & + umask(ji,jj+1,jk+1)+umask(ji,jj,jk ) , 1._wp ) 221 222 zcof2 = - rn_aht_0 * e1f(ji,jj) * zmskf * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 225 223 226 224 zjuf(ji,jj) = ( zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) ) & … … 238 236 DO jj = 2, jpjm1 239 237 DO ji = 1, fs_jpim1 ! vector opt. 240 zabe1 = ( fsahmf(ji,jj,jk) + ahmb0) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)241 242 zmskf = 1. /MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1)&243 & + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1.)244 245 zcof1 = - aht0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )246 247 zivf(ji,jj) = ( zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) ) &248 & + zcof1 * ( zdkv (ji,jj) + zdk1v(ji+1,jj)&249 & + zdk1v(ji,jj) + zdkv (ji+1,jj) ) ) * fmask(ji,jj,jk)238 zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj) 239 240 zmskf = 1._wp / MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & 241 & + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ) , 1._wp ) 242 243 zcof1 = - rn_aht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 244 245 zivf(ji,jj) = ( zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) ) & 246 & + zcof1 * ( zdkv (ji,jj) + zdk1v(ji+1,jj) & 247 & + zdk1v(ji,jj) + zdkv (ji+1,jj) ) ) * fmask(ji,jj,jk) 250 248 END DO 251 249 END DO … … 255 253 DO jj = 2, jpj 256 254 DO ji = 1, fs_jpim1 ! vector opt. 257 zabe2 = ( fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) / e2t(ji,jj)258 259 zmskt = 1. /MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1)&260 & + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1.)261 262 zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )263 264 zjvt(ji,jj) = ( zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) ) &265 & + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj) &255 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) / e2t(ji,jj) 256 257 zmskt = 1._wp / MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 258 & + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ) , 1._wp ) 259 260 zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 261 262 zjvt(ji,jj) = ( zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) ) & 263 & + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj) & 266 264 & +zdk1v(ji,jj-1) + zdkv (ji,jj) ) ) * tmask(ji,jj,jk) 267 265 END DO … … 270 268 DO jj = 2, jpj 271 269 DO ji = 1, fs_jpim1 ! vector opt. 272 zabe2 = ( fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)270 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj) 273 271 274 272 zmskt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 275 273 & + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) 276 274 277 zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )275 zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 278 276 279 277 zjvt(ji,jj) = ( zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) ) & … … 359 357 DO jk = 2, jpkm1 360 358 DO ji = 2, jpim1 361 zcoef0= 0.5 * aht0 * umask(ji,jj,jk)362 359 zcoef0= 0.5 * rn_aht_0 * umask(ji,jj,jk) 360 ! 363 361 zuwslpi = zcoef0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) ) 364 362 zuwslpj = zcoef0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 365 363 ! 366 364 zmkt = 1./MAX( tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1) & 367 365 + tmask(ji,jj,jk )+tmask(ji+1,jj,jk ), 1. ) 368 zmkf = 1./MAX( fmask(ji,jj-1,jk-1) +fmask(ji,jj,jk-1) &369 + fmask(ji,jj-1,jk ) +fmask(ji,jj,jk ), 1. )366 zmkf = 1./MAX( fmask(ji,jj-1,jk-1) + fmask(ji,jj,jk-1) & 367 + fmask(ji,jj-1,jk ) + fmask(ji,jj,jk ), 1. ) 370 368 371 369 zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi … … 377 375 +zdj1u(ji,jk ) + zdju (ji ,jk ) ) 378 376 ! update avmu (add isopycnal vertical coefficient to avmu) 379 ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0380 avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / aht0377 ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 378 avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0 381 379 END DO 382 380 END DO … … 385 383 DO jk = 2, jpkm1 386 384 DO ji = 2, jpim1 387 zcoef0 = 0.5 * aht0 * vmask(ji,jj,jk)385 zcoef0 = 0.5 * rn_aht_0 * vmask(ji,jj,jk) 388 386 389 387 zvwslpi = zcoef0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) ) … … 399 397 ! vertical flux on v field 400 398 zfvw(ji,jk) = zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1) & 401 402 403 399 & +zdiv (ji,jk ) + zdiv (ji-1,jk ) ) & 400 & + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji ,jk-1) & 401 & +zdjv (ji,jk ) + zdj1v(ji ,jk ) ) 404 402 ! update avmv (add isopycnal vertical coefficient to avmv) 405 ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0406 avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / aht0403 ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 404 avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0 407 405 END DO 408 406 END DO … … 433 431 END SUBROUTINE dyn_ldf_iso 434 432 435 # else436 !!----------------------------------------------------------------------437 !! Dummy module NO rotation of mixing tensor438 !!----------------------------------------------------------------------439 CONTAINS440 SUBROUTINE dyn_ldf_iso( kt ) ! Empty routine441 INTEGER, INTENT(in) :: kt442 WRITE(*,*) 'dyn_ldf_iso: You should not have seen this print! error?', kt443 END SUBROUTINE dyn_ldf_iso444 #endif445 446 433 !!====================================================================== 447 434 END MODULE dynldf_iso -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
r3294 r4596 2 2 !!====================================================================== 3 3 !! *** MODULE dynldf_lap *** 4 !! Ocean dynamics: lateral viscosity trend 4 !! Ocean dynamics: lateral viscosity trend (laplacian and bilaplacian) 5 5 !!====================================================================== 6 6 !! History : OPA ! 1990-09 (G. Madec) Original code … … 9 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 10 10 !! - ! 2004-08 (C. Talandier) New trends organization 11 !! 3.7 ! 2014-01 (F. Lemarie, G. Madec) restructuration/simplification of ahm specification, 12 !! ! add velocity dependent coefficient and optional read in file 11 13 !!---------------------------------------------------------------------- 12 14 13 15 !!---------------------------------------------------------------------- 14 !! dyn_ldf_lap : update the momentum trend with the lateral diffusion15 !! using an iso-level harmonicoperator16 !! dyn_ldf_lap : update the momentum trend with the lateral viscosity using an iso-level laplacian operator 17 !! dyn_ldf_blp : update the momentum trend with the lateral viscosity using an iso-level bilaplacian operator 16 18 !!---------------------------------------------------------------------- 17 USE oce ! ocean dynamics and tracers 18 USE dom_oce ! ocean space and time domain 19 USE ldfdyn_oce ! ocean dynamics: lateral physics 20 USE zdf_oce ! ocean vertical physics 21 USE in_out_manager ! I/O manager 22 USE trdmod ! ocean dynamics trends 23 USE trdmod_oce ! ocean variables trends 24 USE ldfslp ! iso-neutral slopes 25 USE timing ! Timing 19 USE oce ! ocean dynamics and tracers 20 USE dom_oce ! ocean space and time domain 21 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 22 USE ldfslp ! iso-neutral slopes 23 USE zdf_oce ! ocean vertical physics 24 ! 25 USE trdmod ! ocean dynamics trends 26 USE trdmod_oce ! ocean variables trends 27 USE in_out_manager ! I/O manager 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 USE wrk_nemo ! Memory Allocation 30 USE timing ! Timing 26 31 27 32 IMPLICIT NONE 28 33 PRIVATE 29 34 30 PUBLIC dyn_ldf_lap ! called by step.F90 35 PUBLIC dyn_ldf_lap ! called by dynldf.F90 36 PUBLIC dyn_ldf_blp ! called by dynldf.F90 31 37 32 38 !! * Substitutions 33 39 # include "domzgr_substitute.h90" 34 # include "ldfdyn_substitute.h90"35 40 # include "vectopt_loop_substitute.h90" 36 41 !!---------------------------------------------------------------------- 37 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)42 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 38 43 !! $Id$ 39 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 41 46 CONTAINS 42 47 43 SUBROUTINE dyn_ldf_lap( kt )48 SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, kpass ) 44 49 !!---------------------------------------------------------------------- 45 50 !! *** ROUTINE dyn_ldf_lap *** 46 51 !! 47 !! ** Purpose : Compute the before horizontal tracer (t & s)diffusive48 !! trend and add it to the general trend of tracerequation.52 !! ** Purpose : Compute the before horizontal momentum diffusive 53 !! trend and add it to the general trend of momentum equation. 49 54 !! 50 !! ** Method : The before horizontal momentum diffusion trend is an 51 !! harmonic operator (laplacian type) which separates the divergent 52 !! and rotational parts of the flow. 53 !! Its horizontal components are computed as follow: 54 !! difu = 1/e1u di[ahmt hdivb] - 1/(e2u*e3u) dj-1[e3f ahmf rotb] 55 !! difv = 1/e2v dj[ahmt hdivb] + 1/(e1v*e3v) di-1[e3f ahmf rotb] 56 !! in the rotational part of the diffusion. 57 !! Add this before trend to the general trend (ua,va): 58 !! (ua,va) = (ua,va) + (diffu,diffv) 59 !! 'key_trddyn' activated: the two components of the horizontal 60 !! diffusion trend are saved. 55 !! ** Method : The Laplacian operator apply on horizontal velocity is 56 !! writen as : grad_h( ahm div_h(U )) - curl_h( ahm curl_z(U) ) 61 57 !! 62 !! ** Action : - Update (ua,va) with the before iso-level harmonic 63 !! mixing trend. 58 !! ** Action : - pua, pva increased by the harmonic operator applied on pub, pvb. 64 59 !!---------------------------------------------------------------------- 65 INTEGER, INTENT( in ) :: kt ! ocean time-step index 60 INTEGER , INTENT(in ) :: kt ! ocean time-step index 61 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 62 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pub, pvb ! before velocity [m/s] 63 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! velocity trend [m/s2] 66 64 ! 67 INTEGER :: ji, jj, jk ! dummy loop indices 68 REAL(wp) :: zua, zva, ze2u, ze1v ! local scalars 65 INTEGER :: ji, jj, jk ! dummy loop indices 66 REAL(wp) :: zsign ! local scalars 67 REAL(wp) :: zua, zva ! local scalars 68 REAL(wp), POINTER, DIMENSION(:,:) :: zcur, zdiv 69 69 !!---------------------------------------------------------------------- 70 70 ! 71 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_lap') 71 IF( kt == nit000 .AND. lwp ) THEN 72 WRITE(numout,*) 73 WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass 74 WRITE(numout,*) '~~~~~~~ ' 75 ENDIF 72 76 ! 73 IF( kt == nit000 ) THEN 74 IF(lwp) WRITE(numout,*) 75 IF(lwp) WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator' 76 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 77 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_lap') 78 ! 79 CALL wrk_alloc( jpi, jpj, zcur, zdiv ) 80 ! 81 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign 82 ELSE ; zsign = -1._wp ! (eddy viscosity coef. >0) 77 83 ENDIF 84 ! 78 85 ! ! =============== 79 86 DO jk = 1, jpkm1 ! Horizontal slab 80 87 ! ! =============== 81 DO jj = 2, jpjm1 88 DO jj = 2, jpj 89 DO ji = fs_2, jpi ! vector opt. 90 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 91 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * fse3f(ji-1,jj-1,jk) / ( e1f(ji-1,jj-1) * e2f(ji-1,jj-1) ) & 92 & * ( e2v(ji ,jj-1) * pvb(ji ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk) & 93 & - e1u(ji-1,jj ) * pub(ji-1,jj ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk) ) * fmask(ji-1,jj-1,jk) 94 ! ! ahm * div (computed from 2 to jpi/jpj) 95 zdiv(ji,jj) = ahmt(ji,jj,jk) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) & 96 & * ( e2u(ji,jj)*fse3u(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * pub(ji-1,jj,jk) & 97 & + e1v(ji,jj)*fse3v(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * pvb(ji,jj-1,jk) ) 98 END DO 99 END DO 100 101 DO jj = 2, jpjm1 ! - curl( curl) + grad( div ) 82 102 DO ji = fs_2, fs_jpim1 ! vector opt. 83 ze2u = rotb (ji,jj,jk) * fsahmf(ji,jj,jk) * fse3f(ji,jj,jk) 84 ze1v = hdivb(ji,jj,jk) * fsahmt(ji,jj,jk) 85 ! horizontal diffusive trends 86 zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) & 87 + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v ) / e1u(ji,jj) 88 89 zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)*fse3f(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) & 90 + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v ) / e2v(ji,jj) 91 92 ! add it to the general momentum trends 93 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 94 va(ji,jj,jk) = va(ji,jj,jk) + zva 103 pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * ( & 104 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) & 105 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) / e1u(ji,jj) ) 106 ! 107 pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * ( & 108 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) & 109 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) / e2v(ji,jj) ) 95 110 END DO 96 111 END DO … … 98 113 END DO ! End of slab 99 114 ! ! =============== 115 CALL wrk_dealloc( jpi, jpj, zcur, zdiv ) 116 ! 100 117 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_lap') 101 118 ! 102 119 END SUBROUTINE dyn_ldf_lap 103 120 121 122 SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva ) 123 !!---------------------------------------------------------------------- 124 !! *** ROUTINE dyn_ldf_blp *** 125 !! 126 !! ** Purpose : Compute the before lateral momentum viscous trend 127 !! and add it to the general trend of momentum equation. 128 !! 129 !! ** Method : The lateral viscous trends is provided by a bilaplacian 130 !! operator applied to before field (forward in time). 131 !! It is computed by two successive calls to dyn_ldf_lap routine 132 !! 133 !! ** Action : pta updated with the before rotated bilaplacian diffusion 134 !!---------------------------------------------------------------------- 135 INTEGER , INTENT(in ) :: kt ! ocean time-step index 136 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pub, pvb ! before velocity fields 137 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! momentum trend 138 ! 139 REAL(wp), POINTER, DIMENSION(:,:,:) :: zulap, zvlap ! laplacian at u- and v-point 140 !!---------------------------------------------------------------------- 141 ! 142 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_blp') 143 ! 144 CALL wrk_alloc( jpi, jpj, jpk, zulap, zvlap ) 145 ! 146 IF( kt == nit000 ) THEN 147 IF(lwp) WRITE(numout,*) 148 IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum ' 149 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 150 ENDIF 151 ! 152 zulap(:,:,:) = 0._wp 153 zvlap(:,:,:) = 0._wp 154 ! 155 CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 ) ! rotated laplacian applied to ptb (output in zlap) 156 ! 157 CALL lbc_lnk( zulap(:,:,:) , 'U', -1. ) ! Lateral boundary conditions 158 CALL lbc_lnk( zvlap(:,:,:) , 'V', -1. ) 159 ! 160 CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 ) ! rotated laplacian applied to zlap (output in pta) 161 ! 162 CALL wrk_dealloc( jpi, jpj, jpk, zulap, zvlap ) 163 ! 164 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_blp') 165 ! 166 END SUBROUTINE dyn_ldf_blp 167 104 168 !!====================================================================== 105 169 END MODULE dynldf_lap -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r4292 r4596 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-01 (G. Madec) suppression of velocity curl from in-core memory 17 18 !!---------------------------------------------------------------------- 18 19 … … 21 22 !! vor_ens : enstrophy conserving scheme (ln_dynvor_ens=T) 22 23 !! vor_ene : energy conserving scheme (ln_dynvor_ene=T) 23 !! vor_mix : mixed enstrophy/energy conserving (ln_dynvor_mix=T)24 24 !! vor_een : energy and enstrophy conserving (ln_dynvor_een=T) 25 25 !! dyn_vor_init : set and control of the different vorticity option … … 31 31 USE trdmod ! ocean dynamics trends 32 32 USE trdmod_oce ! ocean variables trends 33 ! 33 34 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 34 35 USE prtctl ! Print control … … 43 44 44 45 PUBLIC dyn_vor ! routine called by step.F90 45 PUBLIC dyn_vor_init ! routine called by opa.F9046 PUBLIC dyn_vor_init ! routine called by nemogcm.F90 46 47 47 48 ! !!* Namelist namdyn_vor: vorticity term … … 56 57 INTEGER :: ntot = 4 ! =4 total vorticity (relative + planetary) ; =5 coriolis + metric term 57 58 59 REAL(wp) :: r1_4 = 0.250_wp ! =1/4 60 REAL(wp) :: r1_8 = 0.125_wp ! =1/8 61 REAL(wp) :: r1_12 = 1._wp / 12._wp ! 1/12 62 58 63 !! * Substitutions 59 64 # include "domzgr_substitute.h90" 60 65 # include "vectopt_loop_substitute.h90" 61 66 !!---------------------------------------------------------------------- 62 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)67 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 63 68 !! $Id$ 64 69 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 94 99 CALL prt_ctl( tab3d_1=ua, clinfo1=' vor1 - Ua: ', mask1=umask, & 95 100 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 96 CALL vor_mix( kt )97 CALL prt_ctl( tab3d_1=ua, clinfo1=' vor2 - Ua: ', mask1=umask, &98 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )99 101 CALL vor_een( kt, ntot, ua, va ) 100 102 CALL prt_ctl( tab3d_1=ua, clinfo1=' vor3 - Ua: ', mask1=umask, & … … 155 157 CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt ) 156 158 ELSE 157 CALL vor_mix( kt ) ! total vorticity (mix=ens-ene) 158 ENDIF 159 CALL vor_ens( kt, nrvm, ua, va ) ! relative vorticity or metric trend (ens) 160 CALL vor_ene( kt, ncor, ua, va ) ! planetary vorticity trend (ene) 161 ENDIF 159 162 ! 160 163 CASE ( 3 ) ! energy and enstrophy conserving scheme … … 198 201 !! 199 202 !! ** Method : Trend evaluated using now fields (centered in time) 200 !! and the Sadourny (1975) flux form formulation : conserves the 201 !! horizontal kinetic energy. 202 !! The trend of the vorticity term is given by: 203 !! * s-coordinate (ln_sco=T), the e3. are inside the derivatives: 204 !! voru = 1/e1u mj-1[ (rotn+f)/e3f mi(e1v*e3v vn) ] 205 !! vorv = 1/e2v mi-1[ (rotn+f)/e3f mj(e2u*e3u un) ] 206 !! * z-coordinate (default key), e3t=e3u=e3v, the trend becomes: 207 !! voru = 1/e1u mj-1[ (rotn+f) mi(e1v vn) ] 208 !! vorv = 1/e2v mi-1[ (rotn+f) mj(e2u un) ] 209 !! Add this trend to the general momentum trend (ua,va): 210 !! (ua,va) = (ua,va) + ( voru , vorv ) 203 !! and the Sadourny (1975) flux form formulation : conserves the 204 !! horizontal kinetic energy. 205 !! The general trend of momentum is increased due to the vorticity 206 !! term which is given by: 207 !! voru = 1/e1u mj-1[ (rvor+f)/e3f mi(e1v*e3v vn) ] 208 !! vorv = 1/e2v mi-1[ (rvor+f)/e3f mj(e2u*e3u un) ] 209 !! where rvor is the relative vorticity 211 210 !! 212 211 !! ** 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 212 !! 216 213 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 217 214 !!---------------------------------------------------------------------- 218 !219 215 INTEGER , INTENT(in ) :: kt ! ocean time-step index 220 216 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; … … 223 219 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 224 220 ! 225 INTEGER :: ji, jj, jk ! dummy loop indices226 REAL(wp) :: zx1, zy1, z fact2, zx2, zy2 ! local scalars227 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz221 INTEGER :: ji, jj, jk ! dummy loop indices 222 REAL(wp) :: zx1, zy1, zx2, zy2 ! local scalars 223 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz ! 2D workspace 228 224 !!---------------------------------------------------------------------- 229 225 ! … … 237 233 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 238 234 ENDIF 239 240 zfact2 = 0.5 * 0.5 ! Local constant initialization 241 242 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) 235 ! 243 236 ! ! =============== 244 237 DO jk = 1, jpkm1 ! Horizontal slab 245 238 ! ! =============== 246 239 ! 247 ! Potential vorticity and horizontal fluxes 248 ! ----------------------------------------- 249 SELECT CASE( kvor ) ! vorticity considered 250 CASE ( 1 ) ; zwz(:,:) = ff(:,:) ! planetary vorticity (Coriolis) 251 CASE ( 2 ) ; zwz(:,:) = rotn(:,:,jk) ! relative vorticity 252 CASE ( 3 ) ! metric term 240 SELECT CASE( kvor ) !== vorticity considered ==! 241 CASE ( 1 ) ! planetary vorticity (Coriolis) 242 zwz(:,:) = ff(:,:) 243 CASE ( 2 ) ! relative vorticity (no fmask) 244 DO jj = 1, jpjm1 245 DO ji = 1, fs_jpim1 ! vector opt. 246 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 247 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 248 & / ( e1f(ji,jj) * e2f(ji,jj) ) 249 END DO 250 END DO 251 CASE ( 3 ) ! metric term 253 252 DO jj = 1, jpjm1 254 253 DO ji = 1, fs_jpim1 ! vector opt. … … 258 257 END DO 259 258 END DO 260 CASE ( 4 ) ; zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) ! total (relative + planetary vorticity) 261 CASE ( 5 ) ! total (coriolis + metric) 262 DO jj = 1, jpjm1 263 DO ji = 1, fs_jpim1 ! vector opt. 264 zwz(ji,jj) = ( ff (ji,jj) & 265 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 266 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 267 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) & 268 & ) 269 END DO 270 END DO 259 CASE ( 4 ) ! total ( planetary + relative vorticity) (no fmask) 260 DO jj = 1, jpjm1 261 DO ji = 1, fs_jpim1 ! vector opt. 262 zwz(ji,jj) = ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 263 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 264 & / ( e1f(ji,jj) * e2f(ji,jj) ) 265 END DO 266 END DO 267 CASE ( 5 ) ! total (coriolis + metric) 268 DO jj = 1, jpjm1 269 DO ji = 1, fs_jpim1 ! vector opt. 270 zwz(ji,jj) = ff(ji,jj) & 271 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 272 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 273 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 274 END DO 275 END DO 276 CASE DEFAULT ! error 277 CALL ctl_stop('STOP','dyn_vor: wrong value for kvor' ) 271 278 END SELECT 272 279 ! 273 280 IF( ln_sco ) THEN 274 281 zwz(:,:) = zwz(:,:) / fse3f(:,:,jk) … … 279 286 zwy(:,:) = e1v(:,:) * vn(:,:,jk) 280 287 ENDIF 281 282 ! Compute and add the vorticity term trend 283 ! ---------------------------------------- 288 ! !== compute and add the vorticity term trend =! 284 289 DO jj = 2, jpjm1 285 290 DO ji = fs_2, fs_jpim1 ! vector opt. … … 288 293 zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1) 289 294 zx2 = zwx(ji ,jj) + zwx(ji ,jj+1) 290 pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2/ e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )291 pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2/ e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )295 pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 / e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 296 pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 / e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 292 297 END DO 293 298 END DO … … 302 307 303 308 304 SUBROUTINE vor_mix( kt )305 !!----------------------------------------------------------------------306 !! *** ROUTINE vor_mix ***307 !!308 !! ** Purpose : Compute the now total vorticity trend and add it to309 !! the general trend of the momentum equation.310 !!311 !! ** Method : Trend evaluated using now fields (centered in time)312 !! Mixte formulation : conserves the potential enstrophy of a hori-313 !! zontally non-divergent flow for (rotzu x uh), the relative vor-314 !! ticity term and the horizontal kinetic energy for (f x uh), the315 !! coriolis term. the now trend of the vorticity term is given by:316 !! * s-coordinate (ln_sco=T), the e3. are inside the derivatives:317 !! voru = 1/e1u mj-1(rotn/e3f) mj-1[ mi(e1v*e3v vn) ]318 !! +1/e1u mj-1[ f/e3f mi(e1v*e3v vn) ]319 !! vorv = 1/e2v mi-1(rotn/e3f) mi-1[ mj(e2u*e3u un) ]320 !! +1/e2v mi-1[ f/e3f mj(e2u*e3u un) ]321 !! * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:322 !! voru = 1/e1u mj-1(rotn) mj-1[ mi(e1v vn) ]323 !! +1/e1u mj-1[ f mi(e1v vn) ]324 !! vorv = 1/e2v mi-1(rotn) mi-1[ mj(e2u un) ]325 !! +1/e2v mi-1[ f mj(e2u un) ]326 !! Add this now trend to the general momentum trend (ua,va):327 !! (ua,va) = (ua,va) + ( voru , vorv )328 !!329 !! ** Action : - Update (ua,va) arrays with the now vorticity term trend330 !! - Save the trends in (ztrdu,ztrdv) in 2 parts (relative331 !! and planetary vorticity trends) ('key_trddyn')332 !!333 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.334 !!----------------------------------------------------------------------335 !336 INTEGER, INTENT(in) :: kt ! ocean timestep index337 !338 INTEGER :: ji, jj, jk ! dummy loop indices339 REAL(wp) :: zfact1, zua, zcua, zx1, zy1 ! local scalars340 REAL(wp) :: zfact2, zva, zcva, zx2, zy2 ! - -341 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww342 !!----------------------------------------------------------------------343 !344 IF( nn_timing == 1 ) CALL timing_start('vor_mix')345 !346 CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz, zww )347 !348 IF( kt == nit000 ) THEN349 IF(lwp) WRITE(numout,*)350 IF(lwp) WRITE(numout,*) 'dyn:vor_mix : vorticity term: mixed energy/enstrophy conserving scheme'351 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'352 ENDIF353 354 zfact1 = 0.5 * 0.25 ! Local constant initialization355 zfact2 = 0.5 * 0.5356 357 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, zww )358 ! ! ===============359 DO jk = 1, jpkm1 ! Horizontal slab360 ! ! ===============361 !362 ! Relative and planetary potential vorticity and horizontal fluxes363 ! ----------------------------------------------------------------364 IF( ln_sco ) THEN365 IF( ln_dynadv_vec ) THEN366 zww(:,:) = rotn(:,:,jk) / fse3f(:,:,jk)367 ELSE368 DO jj = 1, jpjm1369 DO ji = 1, fs_jpim1 ! vector opt.370 zww(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) &371 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) &372 & * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) * fse3f(ji,jj,jk) )373 END DO374 END DO375 ENDIF376 zwz(:,:) = ff (:,:) / fse3f(:,:,jk)377 zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)378 zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)379 ELSE380 IF( ln_dynadv_vec ) THEN381 zww(:,:) = rotn(:,:,jk)382 ELSE383 DO jj = 1, jpjm1384 DO ji = 1, fs_jpim1 ! vector opt.385 zww(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) &386 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) &387 & * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) )388 END DO389 END DO390 ENDIF391 zwz(:,:) = ff (:,:)392 zwx(:,:) = e2u(:,:) * un(:,:,jk)393 zwy(:,:) = e1v(:,:) * vn(:,:,jk)394 ENDIF395 396 ! Compute and add the vorticity term trend397 ! ----------------------------------------398 DO jj = 2, jpjm1399 DO ji = fs_2, fs_jpim1 ! vector opt.400 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)401 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) / e1u(ji,jj)402 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj)403 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) / e2v(ji,jj)404 ! enstrophy conserving formulation for relative vorticity term405 zua = zfact1 * ( zww(ji ,jj-1) + zww(ji,jj) ) * ( zy1 + zy2 )406 zva =-zfact1 * ( zww(ji-1,jj ) + zww(ji,jj) ) * ( zx1 + zx2 )407 ! energy conserving formulation for planetary vorticity term408 zcua = zfact2 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )409 zcva =-zfact2 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )410 ! mixed vorticity trend added to the momentum trends411 ua(ji,jj,jk) = ua(ji,jj,jk) + zcua + zua412 va(ji,jj,jk) = va(ji,jj,jk) + zcva + zva413 END DO414 END DO415 ! ! ===============416 END DO ! End of slab417 ! ! ===============418 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz, zww )419 !420 IF( nn_timing == 1 ) CALL timing_stop('vor_mix')421 !422 END SUBROUTINE vor_mix423 424 425 309 SUBROUTINE vor_ens( kt, kvor, pua, pva ) 426 310 !!---------------------------------------------------------------------- … … 434 318 !! potential enstrophy of a horizontally non-divergent flow. the 435 319 !! trend of the vorticity term is given by: 436 !! * s-coordinate (ln_sco=T), the e3. are inside the derivative: 437 !! voru = 1/e1u mj-1[ (rotn+f)/e3f ] mj-1[ mi(e1v*e3v vn) ] 438 !! vorv = 1/e2v mi-1[ (rotn+f)/e3f ] mi-1[ mj(e2u*e3u un) ] 439 !! * z-coordinate (default key), e3t=e3u=e3v, the trend becomes: 440 !! voru = 1/e1u mj-1[ rotn+f ] mj-1[ mi(e1v vn) ] 441 !! vorv = 1/e2v mi-1[ rotn+f ] mi-1[ mj(e2u un) ] 320 !! voru = 1/e1u mj-1[ (rvor+f)/e3f ] mj-1[ mi(e1v*e3v vn) ] 321 !! vorv = 1/e2v mi-1[ (rvor+f)/e3f ] mi-1[ mj(e2u*e3u un) ] 442 322 !! Add this trend to the general momentum trend (ua,va): 443 323 !! (ua,va) = (ua,va) + ( voru , vorv ) 444 324 !! 445 325 !! ** 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 326 !! 449 327 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 450 328 !!---------------------------------------------------------------------- 451 !452 329 INTEGER , INTENT(in ) :: kt ! ocean time-step index 453 330 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; … … 456 333 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 457 334 ! 458 INTEGER :: ji, jj, jk 459 REAL(wp) :: z fact1, zuav, zvau ! temporaryscalars460 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww335 INTEGER :: ji, jj, jk ! dummy loop indices 336 REAL(wp) :: zuav, zvau ! local scalars 337 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww ! 2D workspace 461 338 !!---------------------------------------------------------------------- 462 339 ! … … 470 347 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 471 348 ENDIF 472 473 zfact1 = 0.5 * 0.25 ! Local constant initialization474 475 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz )476 349 ! ! =============== 477 350 DO jk = 1, jpkm1 ! Horizontal slab 478 351 ! ! =============== 479 ! 480 ! Potential vorticity and horizontal fluxes 481 ! ----------------------------------------- 482 SELECT CASE( kvor ) ! vorticity considered 483 CASE ( 1 ) ; zwz(:,:) = ff(:,:) ! planetary vorticity (Coriolis) 484 CASE ( 2 ) ; zwz(:,:) = rotn(:,:,jk) ! relative vorticity 485 CASE ( 3 ) ! metric term 352 SELECT CASE( kvor ) !== vorticity considered ==! 353 CASE ( 1 ) ! planetary vorticity (Coriolis) 354 zwz(:,:) = ff(:,:) 355 CASE ( 2 ) ! relative vorticity (no fmask) 356 DO jj = 1, jpjm1 357 DO ji = 1, fs_jpim1 ! vector opt. 358 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 359 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 360 & / ( e1f(ji,jj) * e2f(ji,jj) ) 361 END DO 362 END DO 363 CASE ( 3 ) ! metric term 486 364 DO jj = 1, jpjm1 487 365 DO ji = 1, fs_jpim1 ! vector opt. … … 491 369 END DO 492 370 END DO 493 CASE ( 4 ) ; zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) ! total (relative + planetary vorticity) 494 CASE ( 5 ) ! total (coriolis + metric) 495 DO jj = 1, jpjm1 496 DO ji = 1, fs_jpim1 ! vector opt. 497 zwz(ji,jj) = ( ff (ji,jj) & 498 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 499 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 500 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) & 501 & ) 502 END DO 503 END DO 371 CASE ( 4 ) ! total ( planetary + relative vorticity) (no fmask) 372 DO jj = 1, jpjm1 373 DO ji = 1, fs_jpim1 ! vector opt. 374 zwz(ji,jj) = ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 375 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 376 & / ( e1f(ji,jj) * e2f(ji,jj) ) 377 END DO 378 END DO 379 CASE ( 5 ) ! total (coriolis + metric) 380 DO jj = 1, jpjm1 381 DO ji = 1, fs_jpim1 ! vector opt. 382 zwz(ji,jj) = ff(ji,jj) & 383 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 384 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 385 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 386 END DO 387 END DO 388 CASE DEFAULT ! error 389 CALL ctl_stop('STOP','dyn_vor: wrong value for kvor' ) 504 390 END SELECT 505 391 ! 506 IF( ln_sco ) THEN 507 DO jj = 1, jpj ! caution: don't use (:,:) for this loop 508 DO ji = 1, jpi ! it causes optimization problems on NEC in auto-tasking 509 zwz(ji,jj) = zwz(ji,jj) / fse3f(ji,jj,jk) 510 zwx(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) 511 zwy(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) 512 END DO 513 END DO 392 IF( ln_sco ) THEN !== horizontal fluxes ==! 393 zwz(:,:) = zwz(:,:) / fse3f(:,:,jk) 394 zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 395 zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 514 396 ELSE 515 DO jj = 1, jpj ! caution: don't use (:,:) for this loop 516 DO ji = 1, jpi ! it causes optimization problems on NEC in auto-tasking 517 zwx(ji,jj) = e2u(ji,jj) * un(ji,jj,jk) 518 zwy(ji,jj) = e1v(ji,jj) * vn(ji,jj,jk) 519 END DO 520 END DO 397 zwx(:,:) = e2u(:,:) * un(:,:,jk) 398 zwy(:,:) = e1v(:,:) * vn(:,:,jk) 521 399 ENDIF 522 ! 523 ! Compute and add the vorticity term trend 524 ! ---------------------------------------- 400 ! !== compute and add the vorticity term trend =! 525 401 DO jj = 2, jpjm1 526 402 DO ji = fs_2, fs_jpim1 ! vector opt. 527 zuav = zfact1/ e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) &528 & 529 zvau =- zfact1/ e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) &530 & 403 zuav = r1_8 / e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 404 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) 405 zvau =-r1_8 / e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 406 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) 531 407 pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 532 408 pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 557 433 !! 558 434 !! ** 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 435 !! 562 436 !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 563 437 !!---------------------------------------------------------------------- 564 !565 438 INTEGER , INTENT(in ) :: kt ! ocean time-step index 566 439 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; … … 569 442 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 570 443 !! 571 INTEGER :: ji, jj, jk ! dummy loop indices 572 INTEGER :: ierr ! local integer 573 REAL(wp) :: zfac12, zua, zva ! local scalars 574 REAL(wp) :: zmsk, ze3 ! local scalars 575 ! ! 3D workspace 576 REAL(wp), POINTER , DIMENSION(:,: ) :: zwx, zwy, zwz 577 REAL(wp), POINTER , DIMENSION(:,: ) :: ztnw, ztne, ztsw, ztse 444 INTEGER :: ji, jj, jk ! dummy loop indices 445 INTEGER :: ierr ! local integer 446 REAL(wp) :: zua, zva ! local scalars 447 ! ! 2D workspace 448 REAL(wp), POINTER , DIMENSION(:,: ) :: zwx, zwy, zwz 449 REAL(wp), POINTER , DIMENSION(:,: ) :: ztnw, ztne, ztsw, ztse 578 450 #if defined key_vvl 579 REAL(wp), POINTER , DIMENSION(:,:,:) :: ze3f ! 3D workspace (lk_vvl=T) 580 #else 581 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: ze3f ! lk_vvl=F, ze3f=1/e3f saved one for all 451 REAL(wp), POINTER , DIMENSION(:,:,:) :: r1_e3f ! 3D workspace (lk_vvl=T) 452 #endif 453 #if ! defined key_vvl 454 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: r1_e3f ! lk_vvl=F, r1_e3f=1/e3f saved one for all 582 455 #endif 583 456 !!---------------------------------------------------------------------- … … 588 461 CALL wrk_alloc( jpi, jpj, ztnw, ztne, ztsw, ztse ) 589 462 #if defined key_vvl 590 CALL wrk_alloc( jpi, jpj, jpk, ze3f)463 CALL wrk_alloc( jpi, jpj, jpk, r1_e3f ) 591 464 #endif 592 465 ! … … 596 469 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 597 470 #if ! defined key_vvl 598 IF( .NOT.ALLOCATED( ze3f) ) THEN599 ALLOCATE( ze3f(jpi,jpj,jpk) , STAT=ierr )471 IF( .NOT.ALLOCATED(r1_e3f) ) THEN 472 ALLOCATE( r1_e3f(jpi,jpj,jpk) , STAT=ierr ) 600 473 IF( lk_mpp ) CALL mpp_sum ( ierr ) 601 474 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'dyn:vor_een : unable to allocate arrays' ) … … 604 477 ENDIF 605 478 606 IF( kt == nit000 .OR. lk_vvl ) THEN ! reciprocal of e3 at F-point (masked averaging of e3t over ocean points)479 IF( kt == nit000 .OR. lk_vvl ) THEN ! reciprocal of e3 at F-point (masked averaging of e3t) 607 480 DO jk = 1, jpk 608 481 DO jj = 1, jpjm1 609 482 DO ji = 1, jpim1 610 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 611 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 612 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 613 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) 614 IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = zmsk / ze3 483 r1_e3f(ji,jj,jk) = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 484 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) * r1_4 485 IF( r1_e3f(ji,jj,jk) /= 0._wp ) r1_e3f(ji,jj,jk) = 1._wp / r1_e3f(ji,jj,jk) 615 486 END DO 616 487 END DO 617 488 END DO 618 CALL lbc_lnk( ze3f, 'F', 1. ) 619 ENDIF 620 621 zfac12 = 1._wp / 12._wp ! Local constant initialization 622 623 624 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse ) 489 CALL lbc_lnk( r1_e3f, 'F', 1. ) 490 ENDIF 625 491 ! ! =============== 626 492 DO jk = 1, jpkm1 ! Horizontal slab 627 493 ! ! =============== 628 629 ! Potential vorticity and horizontal fluxes 630 ! ----------------------------------------- 631 SELECT CASE( kvor ) ! vorticity considered 632 CASE ( 1 ) ! planetary vorticity (Coriolis) 633 zwz(:,:) = ff(:,:) * ze3f(:,:,jk) 634 CASE ( 2 ) ! relative vorticity 635 zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk) 636 CASE ( 3 ) ! metric term 494 ! 495 SELECT CASE( kvor ) !== vorticity considered ==! 496 CASE ( 1 ) ! planetary vorticity (Coriolis) 497 zwz(:,:) = ff(:,:) * r1_e3f(:,:,jk) 498 CASE ( 2 ) ! relative vorticity (no fmask) 499 DO jj = 1, jpjm1 500 DO ji = 1, fs_jpim1 ! vector opt. 501 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 502 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 503 & / ( e1f(ji,jj) * e2f(ji,jj) ) * r1_e3f(ji,jj,jk) 504 END DO 505 END DO 506 CALL lbc_lnk( zwz, 'F', 1. ) 507 CASE ( 3 ) ! metric term 637 508 DO jj = 1, jpjm1 638 509 DO ji = 1, fs_jpim1 ! vector opt. 639 510 zwz(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 640 511 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 641 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk)512 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * r1_e3f(ji,jj,jk) 642 513 END DO 643 514 END DO 644 515 CALL lbc_lnk( zwz, 'F', 1. ) 645 CASE ( 4 ) ! total (relative + planetary vorticity) 646 zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk) 647 CASE ( 5 ) ! total (coriolis + metric) 648 DO jj = 1, jpjm1 649 DO ji = 1, fs_jpim1 ! vector opt. 650 zwz(ji,jj) = ( ff (ji,jj) & 651 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 652 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 653 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) & 654 & ) * ze3f(ji,jj,jk) 516 CASE ( 4 ) ! total ( planetary + relative vorticity) (no fmask) 517 DO jj = 1, jpjm1 518 DO ji = 1, fs_jpim1 ! vector opt. 519 zwz(ji,jj) = ( ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 520 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 521 & / ( e1f(ji,jj) * e2f(ji,jj) ) ) * r1_e3f(ji,jj,jk) 655 522 END DO 656 523 END DO 657 524 CALL lbc_lnk( zwz, 'F', 1. ) 525 CASE ( 5 ) ! total (coriolis + metric) 526 DO jj = 1, jpjm1 527 DO ji = 1, fs_jpim1 ! vector opt. 528 zwz(ji,jj) = ( ff(ji,jj) & 529 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 530 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 531 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) ) * r1_e3f(ji,jj,jk) 532 END DO 533 END DO 534 CALL lbc_lnk( zwz, 'F', 1. ) 535 CASE DEFAULT ! error 536 CALL ctl_stop('STOP','dyn_vor: wrong value for kvor' ) 658 537 END SELECT 659 538 ! 539 ! !== horizontal fluxes ==! 660 540 zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 661 541 zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 662 542 663 ! Compute and add the vorticity term trend 664 ! ---------------------------------------- 543 ! !== compute and add the vorticity term trend =! 665 544 jj = 2 666 545 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 … … 681 560 DO jj = 2, jpjm1 682 561 DO ji = fs_2, fs_jpim1 ! vector opt. 683 zua = + zfac12 / e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) &684 & 685 zva = - zfac12 / e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) &686 & 562 zua = + r1_12 / e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 563 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 564 zva = - r1_12 / e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) & 565 & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) ) 687 566 pua(ji,jj,jk) = pua(ji,jj,jk) + zua 688 567 pva(ji,jj,jk) = pva(ji,jj,jk) + zva … … 695 574 CALL wrk_dealloc( jpi, jpj, ztnw, ztne, ztsw, ztse ) 696 575 #if defined key_vvl 697 CALL wrk_dealloc( jpi, jpj, jpk, ze3f)576 CALL wrk_dealloc( jpi, jpj, jpk, r1_e3f ) 698 577 #endif 699 578 ! -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r3294 r4596 9 9 10 10 !!---------------------------------------------------------------------- 11 !! dyn_zdf : Update the momentum trend with the vertical diffusion12 !! dyn_zdf_init : initializations of the vertical diffusion scheme11 !! dyn_zdf : Update the momentum trend with the vertical diffusion 12 !! dyn_zdf_init : initializations of the vertical diffusion scheme 13 13 !!---------------------------------------------------------------------- 14 USE oce 15 USE dom_oce 16 USE zdf_oce 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 17 18 USE dynzdf_exp 19 USE dynzdf_imp 18 USE dynzdf_exp ! vertical diffusion: explicit (dyn_zdf_exp routine) 19 USE dynzdf_imp ! vertical diffusion: implicit (dyn_zdf_imp routine) 20 20 21 USE ldfdyn _oce ! ocean dynamics: lateral physics22 USE trdmod 23 USE trdmod_oce 24 USE in_out_manager 25 USE lib_mpp 26 USE prtctl 27 USE wrk_nemo 28 USE timing 21 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 22 USE trdmod ! ocean active dynamics and tracers trends 23 USE trdmod_oce ! ocean variables trends 24 USE in_out_manager ! I/O manager 25 USE lib_mpp ! MPP library 26 USE prtctl ! Print control 27 USE wrk_nemo ! Memory Allocation 28 USE timing ! Timing 29 29 30 30 IMPLICIT NONE -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r4486 r4596 19 19 USE dom_oce ! ocean space and time domain variables 20 20 USE sbc_oce ! surface boundary condition: ocean 21 USE domvvl ! Variable volume 22 USE divcur ! hor. divergence and curl (div & cur routines) 23 USE iom ! I/O library 24 USE restart ! only for lrst_oce 25 USE in_out_manager ! I/O manager 26 USE prtctl ! Print control 27 USE phycst 28 USE lbclnk ! ocean lateral boundary condition (or mpp link) 29 USE lib_mpp ! MPP library 30 USE bdy_oce 31 USE bdy_par 21 USE domvvl ! variable volume 22 USE divhor ! hor. divergence 23 USE phycst ! physical constants 24 USE bdy_oce ! boundary 25 USE bdy_par ! 32 26 USE bdydyn2d ! bdy_ssh routine 33 USE diaar5, ONLY: lk_diaar534 USE iom35 27 #if defined key_agrif 36 28 USE agrif_opa_update … … 40 32 USE asminc ! Assimilation increment 41 33 #endif 34 ! 35 USE diaar5, ONLY: lk_diaar5 36 USE in_out_manager ! I/O manager 37 USE iom ! I/O library 38 USE restart ! only for lrst_oce 39 USE prtctl ! Print control 40 USE lbclnk ! ocean lateral boundary condition (or mpp link) 41 USE lib_mpp ! MPP library 42 42 USE wrk_nemo ! Memory Allocation 43 43 USE timing ! Timing … … 70 70 !! by the time step. 71 71 !! 72 !! ** action : ssha :after sea surface height72 !! ** action : ssha, after sea surface height 73 73 !! 74 74 !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. 75 75 !!---------------------------------------------------------------------- 76 ! 77 REAL(wp), POINTER, DIMENSION(:,: ) :: zhdiv 78 INTEGER, INTENT(in) :: kt ! time step 76 INTEGER, INTENT(in) :: kt ! time step 79 77 ! 80 INTEGER :: jk ! dummy loop indice 81 REAL(wp) :: z2dt, z1_rau0 ! local scalars 82 !!---------------------------------------------------------------------- 83 ! 84 IF( nn_timing == 1 ) CALL timing_start('ssh_nxt') 78 INTEGER :: jk ! dummy loop indice 79 REAL(wp) :: z2dt, z1_rau0 ! local scalars 80 REAL(wp), POINTER, DIMENSION(:,: ) :: zhdiv ! 2D workspace 81 !!---------------------------------------------------------------------- 82 ! 83 IF( nn_timing == 1 ) CALL timing_start('ssh_nxt') 85 84 ! 86 85 CALL wrk_alloc( jpi, jpj, zhdiv ) 87 86 ! 88 87 IF( kt == nit000 ) THEN 89 !90 88 IF(lwp) WRITE(numout,*) 91 89 IF(lwp) WRITE(numout,*) 'ssh_nxt : after sea surface height' 92 90 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 93 ! 94 ENDIF 95 ! 96 CALL div_cur( kt ) ! Horizontal divergence & Relative vorticity 91 ENDIF 92 ! 93 CALL div_hor( kt ) ! Horizontal divergence 97 94 ! 98 95 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) … … 103 100 ! !------------------------------! 104 101 zhdiv(:,:) = 0._wp 105 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports102 DO jk = 1, jpkm1 ! barotropic transport divergence 106 103 zhdiv(:,:) = zhdiv(:,:) + fse3t_n(:,:,jk) * hdivn(:,:,jk) 107 104 END DO … … 116 113 ! These lines are not necessary with time splitting since 117 114 ! boundary condition on sea level is set during ts loop 118 # if defined key_agrif115 # if defined key_agrif 119 116 CALL agrif_ssh( kt ) 120 # endif121 # if defined key_bdy122 IF (lk_bdy) THEN123 CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary124 CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries125 ENDIF 126 # endif117 # endif 118 # if defined key_bdy 119 IF( lk_bdy ) THEN 120 CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary 121 CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries 122 ENDIF 123 # endif 127 124 #endif 128 125 129 126 #if defined key_asminc 130 ! ! Include the IAU weighted SSH increment 131 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 127 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN ! Include the IAU weighted SSH increment 132 128 CALL ssh_asm_inc( kt ) 133 129 ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 134 130 ENDIF 135 131 #endif 136 137 132 ! !------------------------------! 138 133 ! ! outputs ! … … 248 243 ! 249 244 IF( nn_timing == 1 ) CALL timing_stop('wzv') 250 251 245 ! 252 246 END SUBROUTINE wzv 247 253 248 254 249 SUBROUTINE ssh_swp( kt ) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
r3294 r4596 4 4 !! Ocean floats : domain 5 5 !!====================================================================== 6 !! History : OPA ! 1998-07 (Y.Drillet, CLIPPER) Original code 7 !! NEMO_3.3.1 ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): 8 ! add Ariane convention, Comsecitc changes 6 !! History : OPA ! 1998-07 (Y.Drillet, CLIPPER) Original code 7 !! NEMO 3.3.1 ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): add Ariane convention, Comsecitc changes 9 8 !!---------------------------------------------------------------------- 10 9 #if defined key_floats || defined key_esopa … … 438 437 dlx = SIN(dly1) * SIN(dly2) + COS(dly1) * COS(dly2) * COS(dlx2-dlx1) 439 438 ! 440 IF( ABS(dlx) > 1.0_wp ) dlx = 1.0_wp441 ! 442 dld = ATAN( DSQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )) * 222.24_wp / dls439 IF( ABS(dlx) > 1.0_wp ) dlx = 1.0_wp 440 ! 441 dld = ATAN( SQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) ) ) * 222.24_wp / dls 443 442 flo_dstnce = dld * 1000._wp 444 443 ! 445 444 END FUNCTION flo_dstnce 445 446 446 447 447 INTEGER FUNCTION flo_dom_alloc() … … 457 457 IF( flo_dom_alloc /= 0 ) CALL ctl_warn('flo_dom_alloc: failed to allocate arrays') 458 458 END FUNCTION flo_dom_alloc 459 460 459 461 460 #else -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r4334 r4596 9 9 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) modified LF-RA 10 10 !! - - ! 2010-10 (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D) 11 !! 3.7 ! 2014-01 (G. Madec) suppression of curl and hdiv from the restart 11 12 !!---------------------------------------------------------------------- 12 13 … … 18 19 USE oce ! ocean dynamics and tracers 19 20 USE dom_oce ! ocean space and time domain 21 USE sbc_ice ! only lk_lim3 20 22 USE phycst ! physical constants 23 USE eosbn2 ! equation of state (eos bn2 routine) 24 USE trdmld_oce ! ocean active mixed layer tracers trends variables 25 ! 21 26 USE in_out_manager ! I/O manager 22 27 USE iom ! I/O module 23 USE eosbn2 ! equation of state (eos bn2 routine)24 USE trdmld_oce ! ocean active mixed layer tracers trends variables25 USE divcur ! hor. divergence and curl (div & cur routines)26 USE sbc_ice, ONLY : lk_lim327 28 28 29 IMPLICIT NONE … … 117 118 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tsb(:,:,:,jp_tem) ) 118 119 CALL iom_rstput( kt, nitrst, numrow, 'sb' , tsb(:,:,:,jp_sal) ) 119 CALL iom_rstput( kt, nitrst, numrow, 'rotb' , rotb )120 CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb )121 120 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb ) 122 121 ! … … 125 124 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tsn(:,:,:,jp_tem) ) 126 125 CALL iom_rstput( kt, nitrst, numrow, 'sn' , tsn(:,:,:,jp_sal) ) 127 CALL iom_rstput( kt, nitrst, numrow, 'rotn' , rotn )128 CALL iom_rstput( kt, nitrst, numrow, 'hdivn' , hdivn )129 126 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn ) 130 127 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop ) … … 177 174 END SUBROUTINE rst_read_open 178 175 176 179 177 SUBROUTINE rst_read 180 178 !!---------------------------------------------------------------------- … … 207 205 CALL iom_get( numror, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem) ) 208 206 CALL iom_get( numror, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal) ) 209 CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb )210 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb )211 207 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 212 208 ELSE … … 219 215 CALL iom_get( numror, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal) ) 220 216 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn ) 221 IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN222 CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn )223 CALL iom_get( numror, jpdom_autoglo, 'hdivn' , hdivn )224 ELSE225 CALL div_cur( 0 ) ! Horizontal divergence & Relative vorticity226 ENDIF227 217 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 228 218 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop ) ! now potential density … … 242 232 ub (:,:,:) = un (:,:,:) 243 233 vb (:,:,:) = vn (:,:,:) 244 rotb (:,:,:) = rotn (:,:,:)245 hdivb(:,:,:) = hdivn(:,:,:)246 234 sshb (:,:) = sshn (:,:) 247 235 ENDIF -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90
r4147 r4596 182 182 IF(lwp) WRITE(numout,*) '~~~~~~~~~' 183 183 ! 184 ! Cross land advection hard coded only for ORCA_R2 with 31 levels linear filtred free surface 185 ! 186 IF( cp_cfg /= 'orca' ) CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' ) 187 IF( jp_cfg /= 2 ) CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' ) 188 IF( .NOT.lk_dynspg_flt ) CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' ) 189 IF( lk_vvl ) CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' ) 190 IF( jpk /= 31 ) CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' ) 191 ! 184 192 ! ! Allocate arrays for this module 185 193 ALLOCATE( hdiv_139_101(jpk) , hdiv_139_101_kt(jpk) , & ! Gibraltar … … 193 201 IF( lk_mpp ) CALL mpp_sum( ierr ) 194 202 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'cla_init: unable to allocate arrays' ) 195 !196 IF( .NOT.lk_dynspg_flt ) CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' )197 !198 IF( lk_vvl ) CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' )199 !200 IF( jpk /= 31 ) CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )201 203 ! 202 204 ! _|_______|_______|_ -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4328 r4596 3216 3216 STOP 'ctl_opn bad opening' 3217 3217 ENDIF 3218 3218 ! 3219 3219 END SUBROUTINE ctl_opn 3220 3220 3221 SUBROUTINE ctl_nam ( kios, cdnam, ldwp ) 3221 3222 SUBROUTINE ctl_nam( kios, cdnam, ldwp ) 3222 3223 !!---------------------------------------------------------------------- 3223 3224 !! *** ROUTINE ctl_nam *** … … 3232 3233 LOGICAL , INTENT(in ) :: ldwp ! boolean term for print 3233 3234 !!---------------------------------------------------------------------- 3234 3235 3235 ! 3236 ! ----------------3237 3236 WRITE (clios, '(I4.0)') kios 3238 IF( kios < 0 ) THEN 3239 CALL ctl_warn( 'W A R N I N G: end of record or file while reading namelist ' & 3240 & // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 3241 ENDIF 3242 3243 IF( kios > 0 ) THEN 3244 CALL ctl_stop( 'E R R O R : misspelled variable in namelist ' & 3245 & // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 3246 ENDIF 3237 IF( kios < 0 ) CALL ctl_warn( 'W A R N I N G: end of record or file while reading namelist ' & 3238 & // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 3239 IF( kios > 0 ) CALL ctl_stop( 'E R R O R : misspelled variable in namelist ' & 3240 & // TRIM(cdnam) // ' iostat = ' // TRIM(clios) ) 3247 3241 kios = 0 3248 RETURN 3249 3242 ! 3250 3243 END SUBROUTINE ctl_nam 3244 3251 3245 3252 3246 INTEGER FUNCTION get_unit() -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
r4292 r4596 6 6 !! History : OPA ! 1997-07 (G. Madec) multi dimensional coefficients 7 7 !! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module 8 !! 3.7 ! 2014-01 (F. Lemarie, G. Madec) restructuration/simplification of ahm specification, 9 !! ! add velocity dependent coefficient and optional read in file 8 10 !!---------------------------------------------------------------------- 9 11 … … 16 18 USE oce ! ocean dynamics and tracers 17 19 USE dom_oce ! ocean space and time domain 18 USE ldfdyn_oce ! ocean dynamics lateral physics19 20 USE phycst ! physical constants 20 USE ldfslp ! ??? 21 USE ioipsl 21 USE ldfc1d ! lateral diffusion: 1D case 22 USE ldfc2d ! lateral diffusion: 2D case 23 ! USE ldfc3d ! lateral diffusion: 3D case 24 ! 22 25 USE in_out_manager ! I/O manager 26 USE iom ! I/O module for ehanced bottom friction file 27 USE timing ! Timing 23 28 USE lib_mpp ! distribued memory computing library 24 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 30 35 PUBLIC ldf_dyn_init ! called by opa.F90 31 36 32 INTERFACE ldf_zpf 33 MODULE PROCEDURE ldf_zpf_1d, ldf_zpf_1d_3d, ldf_zpf_3d 34 END INTERFACE 37 ! !!* Namelist namdyn_ldf : lateral mixing on momentum * 38 LOGICAL , PUBLIC :: ln_dynldf_lap = .TRUE. !: laplacian operator 39 LOGICAL , PUBLIC :: ln_dynldf_blp = .FALSE. !: bilaplacian operator 40 LOGICAL , PUBLIC :: ln_dynldf_lev = .FALSE. !: iso-level direction 41 LOGICAL , PUBLIC :: ln_dynldf_hor = .TRUE. !: horizontal (geopotential) direction 42 LOGICAL , PUBLIC :: ln_dynldf_iso = .FALSE. !: iso-neutral direction 43 INTEGER , PUBLIC :: nn_ahm_ijk_t = 0 !: ?????? !!gm 44 REAL(wp), PUBLIC :: rn_ahm_0 = 40000._wp !: lateral laplacian eddy viscosity [m2/s] 45 REAL(wp), PUBLIC :: rn_ahm_b = 0._wp !: lateral laplacian background eddy viscosity [m2/s] 46 REAL(wp), PUBLIC :: rn_bhm_0 = 5.0e+11_wp !: lateral bilaplacian eddy viscosity [m4/s] 47 48 LOGICAL , PUBLIC :: l_ldfdyn_time = .FALSE. !: flag for time variation of the lateral eddy viscosity coef. 49 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahmt, ahmf !: eddy diffusivity coef. at U- and V-points [m2/s or m4/s] 51 52 REAL(wp) :: r1_12 = 1._wp / 12._wp ! =1/12 53 REAL(wp) :: r1_4 = 0.25_wp ! =1/4 54 REAL(wp) :: r1_288 = 1._wp / 288._wp ! =1/( 12^2 * 2 ) 35 55 36 56 !! * Substitutions 37 57 # include "domzgr_substitute.h90" 38 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 58 # include "vectopt_loop_substitute.h90" 59 !!---------------------------------------------------------------------- 60 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 40 61 !! $Id$ 41 62 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 49 70 !! ** Purpose : set the horizontal ocean dynamics physics 50 71 !! 51 !! ** Method : 52 !! - default option : ahm = constant coef. = rn_ahm_0 (namelist) 53 !! - 'key_dynldf_c1d': ahm = F(depth) see ldf_dyn_c1d.h90 54 !! - 'key_dynldf_c2d': ahm = F(latitude,longitude) see ldf_dyn_c2d.h90 55 !! - 'key_dynldf_c3d': ahm = F(latitude,longitude,depth) see ldf_dyn_c3d.h90 56 !! 57 !! N.B. User defined include files. By default, 3d and 2d coef. 58 !! are set to a constant value given in the namelist and the 1d 59 !! coefficients are initialized to a hyperbolic tangent vertical 60 !! profile. 61 !! 62 !! Reference : Madec, G. and M. Imbard, 1996: Climate Dynamics, 12, 381-388. 63 !!---------------------------------------------------------------------- 64 INTEGER :: ioptio ! ??? 65 INTEGER :: ios ! Local : output status for namelist read 66 LOGICAL :: ll_print = .FALSE. ! Logical flag for printing viscosity coef. 67 !! 68 NAMELIST/namdyn_ldf/ ln_dynldf_lap , ln_dynldf_bilap, & 69 & ln_dynldf_level, ln_dynldf_hor , ln_dynldf_iso, & 70 & rn_ahm_0_lap , rn_ahmb_0 , rn_ahm_0_blp , & 71 & rn_cmsmag_1 , rn_cmsmag_2 , rn_cmsh, & 72 & rn_ahm_m_lap , rn_ahm_m_blp 73 72 !! ** Method : the eddy viscosity coef. specification depends on: 73 !! 74 !! ln_dynldf_lap = T laplacian operator 75 !! ln_dynldf_blp = T bilaplacian operator 76 !! 77 !! nn_ahm_ijk_t = 0 => = constant 78 !! ! 79 !! = 10 => = F(z) : constant with a reduction of 1/4 with depth 80 !! ! 81 !! =-20 => = F(i,j) = shape read in 'eddy_viscosity.nc' file 82 !! = 20 = F(i,j) = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case) 83 !! ! 84 !! =-30 => = F(i,j,k) = shape read in 'eddy_viscosity.nc' file 85 !! = 30 = F(i,j,k) = 2D (case 20) + decrease with depth (case 10) 86 !! = 31 = F(i,j,k,t) = F(local velocity) ( |u|e /12 laplacian operator 87 !! or |u|e^3/12 bilaplacian operator ) 88 !! 89 !!---------------------------------------------------------------------- 90 INTEGER :: jk ! dummy loop indices 91 INTEGER :: ierr, inum, ios ! local integer 92 REAL(wp) :: zah0 ! local scalar 93 ! 94 NAMELIST/namdyn_ldf/ ln_dynldf_lap, ln_dynldf_blp, & 95 & ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso, & 96 & nn_ahm_ijk_t , rn_ahm_0, rn_ahm_b, rn_bhm_0 97 !!---------------------------------------------------------------------- 98 !! NAMELIST/namdyn_ldf/ ln_dynldf_lap , ln_dynldf_bilap, & 99 !! & ln_dynldf_level, ln_dynldf_hor , ln_dynldf_iso, & 100 !! & rn_ahm_0_lap , rn_ahmb_0 , rn_ahm_0_blp , & 101 ! 102 !! & rn_cmsmag_1 , rn_cmsmag_2 , rn_cmsh, & 103 ! 104 !! & rn_ahm_m_lap , rn_ahm_m_blp 74 105 !!---------------------------------------------------------------------- 75 106 … … 87 118 WRITE(numout,*) 'ldf_dyn : lateral momentum physics' 88 119 WRITE(numout,*) '~~~~~~~' 89 WRITE(numout,*) ' Namelist namdyn_ldf : set lateral mixing parameters' 90 WRITE(numout,*) ' laplacian operator ln_dynldf_lap = ', ln_dynldf_lap 91 WRITE(numout,*) ' bilaplacian operator ln_dynldf_bilap = ', ln_dynldf_bilap 92 WRITE(numout,*) ' iso-level ln_dynldf_level = ', ln_dynldf_level 93 WRITE(numout,*) ' horizontal (geopotential) ln_dynldf_hor = ', ln_dynldf_hor 94 WRITE(numout,*) ' iso-neutral ln_dynldf_iso = ', ln_dynldf_iso 95 WRITE(numout,*) ' horizontal laplacian eddy viscosity rn_ahm_0_lap = ', rn_ahm_0_lap 96 WRITE(numout,*) ' background viscosity rn_ahmb_0 = ', rn_ahmb_0 97 WRITE(numout,*) ' horizontal bilaplacian eddy viscosity rn_ahm_0_blp = ', rn_ahm_0_blp 98 WRITE(numout,*) ' upper limit for laplacian eddy visc rn_ahm_m_lap = ', rn_ahm_m_lap 99 WRITE(numout,*) ' upper limit for bilap eddy viscosity rn_ahm_m_blp = ', rn_ahm_m_blp 100 101 ENDIF 102 103 ahm0 = rn_ahm_0_lap ! OLD namelist variables defined from DOCTOR namelist variables 104 ahmb0 = rn_ahmb_0 105 ahm0_blp = rn_ahm_0_blp 106 107 ! ... check of lateral diffusive operator on tracers 108 ! ==> will be done in trazdf module 109 110 ! ... Space variation of eddy coefficients 111 ioptio = 0 112 #if defined key_dynldf_c3d 113 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( latitude, longitude, depth)' 114 ioptio = ioptio+1 115 #endif 116 #if defined key_dynldf_c2d 117 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( latitude, longitude)' 118 ioptio = ioptio+1 119 #endif 120 #if defined key_dynldf_c1d 121 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( depth )' 122 ioptio = ioptio+1 123 IF( ln_sco ) CALL ctl_stop( 'key_dynldf_c1d cannot be used in s-coordinate (ln_sco)' ) 124 #endif 125 IF( ioptio == 0 ) THEN 126 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = constant (default option)' 127 ELSEIF( ioptio > 1 ) THEN 128 CALL ctl_stop( 'use only one of the following keys: key_dynldf_c3d, key_dynldf_c2d, key_dynldf_c1d' ) 129 ENDIF 130 131 132 IF( ln_dynldf_bilap ) THEN 133 IF(lwp) WRITE(numout,*) ' biharmonic momentum diffusion' 134 IF( .NOT. ln_dynldf_lap ) ahm0 = ahm0_blp ! Allow spatially varying coefs, which use ahm0 as input 135 IF( ahm0_blp > 0 .AND. .NOT. lk_esopa ) CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' ) 136 ELSE 137 IF(lwp) WRITE(numout,*) ' harmonic momentum diff. (default)' 138 IF( ahm0 < 0 .AND. .NOT. lk_esopa ) CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be positive' ) 139 ENDIF 140 141 142 ! Lateral eddy viscosity 143 ! ====================== 144 #if defined key_dynldf_c3d 145 CALL ldf_dyn_c3d( ll_print ) ! ahm = 3D coef. = F( longitude, latitude, depth ) 146 #elif defined key_dynldf_c2d 147 CALL ldf_dyn_c2d( ll_print ) ! ahm = 1D coef. = F( longitude, latitude ) 148 #elif defined key_dynldf_c1d 149 CALL ldf_dyn_c1d( ll_print ) ! ahm = 1D coef. = F( depth ) 150 #else 151 ! Constant coefficients 152 IF(lwp) WRITE(numout,*) 153 IF(lwp) WRITE(numout,*) 'inildf: constant eddy viscosity coef. ' 154 IF(lwp) WRITE(numout,*) '~~~~~~' 155 IF(lwp) WRITE(numout,*) ' ahm1 = ahm2 = ahm0 = ',ahm0 156 #endif 157 nkahm_smag = 0 158 #if defined key_dynldf_smag 159 nkahm_smag = 1 160 #endif 161 120 WRITE(numout,*) ' Namelist nam_dynldf : set lateral mixing parameters' 121 ! 122 WRITE(numout,*) ' type :' 123 WRITE(numout,*) ' laplacian operator ln_dynldf_lap = ', ln_dynldf_lap 124 WRITE(numout,*) ' bilaplacian operator ln_dynldf_blp = ', ln_dynldf_blp 125 ! 126 WRITE(numout,*) ' direction of action :' 127 WRITE(numout,*) ' iso-level ln_dynldf_lev = ', ln_dynldf_lev 128 WRITE(numout,*) ' horizontal (geopotential) ln_dynldf_hor = ', ln_dynldf_hor 129 WRITE(numout,*) ' iso-neutral ln_dynldf_iso = ', ln_dynldf_iso 130 ! 131 WRITE(numout,*) ' coefficients :' 132 WRITE(numout,*) ' type of time-space variation nn_ahm_ijk_t = ', nn_ahm_ijk_t 133 WRITE(numout,*) ' lateral laplacian eddy viscosity rn_ahm_0_lap = ', rn_ahm_0, ' m2/s' 134 WRITE(numout,*) ' background viscosity (iso case) rn_ahm_b = ', rn_ahm_b, ' m2/s' 135 WRITE(numout,*) ' lateral bilaplacian eddy viscosity rn_ahm_0_blp = ', rn_bhm_0, ' m4/s' 136 ENDIF 137 138 ! ! Parameter control 139 IF( ln_dynldf_blp .AND. ln_dynldf_iso ) THEN ! iso-neutral bilaplacian not implemented 140 CALL ctl_stop( 'dyn_ldf_init: iso-neutral bilaplacian not coded yet' ) 141 ENDIF 142 143 ! ... Space/Time variation of eddy coefficients 144 ! ! allocate the ahm arrays 145 ALLOCATE( ahmt(jpi,jpj,jpk) , ahmf(jpi,jpj,jpk) , STAT=ierr ) 146 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays') 147 ! 148 ahmt(:,:,jpk) = 0._wp ! last level always 0 149 ahmf(:,:,jpk) = 0._wp 150 ! 151 ! ! value of eddy mixing coef. 152 IF ( ln_dynldf_lap ) THEN ; zah0 = rn_ahm_0 ! laplacian operator 153 ELSEIF( ln_dynldf_blp ) THEN ; zah0 = SQRT( ABS( rn_bhm_0 ) ) ! bilaplacian operator 154 ELSE ! NO viscous operator 155 CALL ctl_warn( 'ldf_dyn_init: No lateral viscous operator used ' ) 156 ENDIF 157 ! 158 l_ldfdyn_time = .FALSE. ! no time variation except in case defined below 159 ! 160 IF( ln_dynldf_lap .OR. ln_dynldf_blp ) THEN ! only if a lateral diffusion operator is used 161 ! 162 SELECT CASE( nn_ahm_ijk_t ) ! Specification of space time variations of ahmt, ahmf 163 ! 164 CASE( 0 ) !== constant ==! 165 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = constant ' 166 ahmt(:,:,:) = zah0 * tmask(:,:,:) 167 ahmf(:,:,:) = zah0 * fmask(:,:,:) 168 ! 169 CASE( 10 ) !== fixed profile ==! 170 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( depth )' 171 ahmt(:,:,1) = zah0 * tmask(:,:,1) ! constant surface value 172 ahmf(:,:,1) = zah0 * fmask(:,:,1) 173 CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 174 ! 175 CASE ( -20 ) !== fixed horizontal shape read in file ==! 176 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F(i,j) read in eddy_viscosity.nc file' 177 CALL iom_open( 'eddy_viscosity.nc', inum ) 178 CALL iom_get ( inum, jpdom_data, 'ahmt_2D', ahmt(:,:,1) ) 179 CALL iom_get ( inum, jpdom_data, 'ahmf_2D', ahmf(:,:,1) ) 180 CALL iom_close( inum ) 181 DO jk = 2, jpkm1 182 ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk) 183 ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk) 184 END DO 185 ! 186 CASE( 20 ) !== fixed horizontal shape ==! 187 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap. or blp. case)' 188 IF( ln_dynldf_lap ) CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf ) ! surface value proportional to scale factor 189 IF( ln_dynldf_blp ) CALL ldf_c2d( 'DYN', 'BiL', zah0, ahmt, ahmf ) ! surface value proportional to scale factor^3 190 ! 191 CASE( -30 ) !== fixed 3D shape read in file ==! 192 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 193 CALL iom_open( 'eddy_diffusivity_3D.nc', inum ) 194 CALL iom_get ( inum, jpdom_data, 'ahmt', ahmt ) 195 CALL iom_get ( inum, jpdom_data, 'ahmf', ahmf ) 196 CALL iom_close( inum ) 197 DO jk = 1, jpkm1 198 ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk) 199 ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk) 200 END DO 201 ! 202 CASE( 30 ) !== fixed 3D shape ==! 203 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( latitude, longitude, depth )' 204 IF( ln_dynldf_lap ) CALL ldf_c2d( 'DYN', 'LAP', zah0, ahmt, ahmf ) ! surface value proportional to scale factor 205 IF( ln_dynldf_blp ) CALL ldf_c2d( 'DYN', 'BiL', zah0, ahmt, ahmf ) ! surface value proportional to scale factor 206 ! ! reduction with depth 207 CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 208 ! 209 CASE( 31 ) !== time varying 3D field ==! 210 IF(lwp) WRITE(numout,*) ' momentum mixing coef. = F( latitude, longitude, depth , time )' 211 IF(lwp) WRITE(numout,*) ' proportional to the velocity : |u|e/12 or |u|e^3/12' 212 ! 213 l_ldfdyn_time = .TRUE. ! will be calculated by call to ldf_dyn routine in step.F90 214 ! 215 CALL ctl_stop( 'STOP', 'ldf_dyn_init: ahm=F(velocity) not yet implemented') 216 ! 217 CASE DEFAULT 218 CALL ctl_stop('ldf_dyn_init: wrong choice for nn_ahm_ijk_t, the type of space-time variation of ahm') 219 END SELECT 220 ! 221 ENDIF 162 222 ! 163 223 END SUBROUTINE ldf_dyn_init 164 224 165 #if defined key_dynldf_c3d 166 # include "ldfdyn_c3d.h90" 167 #elif defined key_dynldf_c2d 168 # include "ldfdyn_c2d.h90" 169 #elif defined key_dynldf_c1d 170 # include "ldfdyn_c1d.h90" 171 #endif 172 173 174 SUBROUTINE ldf_zpf_1d( ld_print, pdam, pwam, pbot, pdep, pah ) 175 !!---------------------------------------------------------------------- 176 !! *** ROUTINE ldf_zpf *** 177 !! 178 !! ** Purpose : vertical adimensional profile for eddy coefficient 179 !! 180 !! ** Method : 1D eddy viscosity coefficients ( depth ) 181 !!---------------------------------------------------------------------- 182 LOGICAL , INTENT(in ) :: ld_print ! If true, output arrays on numout 183 REAL(wp), INTENT(in ) :: pdam ! depth of the inflection point 184 REAL(wp), INTENT(in ) :: pwam ! width of inflection 185 REAL(wp), INTENT(in ) :: pbot ! bottom value (0<pbot<= 1) 186 REAL(wp), INTENT(in ), DIMENSION(jpk) :: pdep ! depth of the gridpoint (T, U, V, F) 187 REAL(wp), INTENT(inout), DIMENSION(jpk) :: pah ! adimensional vertical profile 188 !! 189 INTEGER :: jk ! dummy loop indices 190 REAL(wp) :: zm00, zm01, zmhb, zmhs ! temporary scalars 191 !!---------------------------------------------------------------------- 192 193 zm00 = TANH( ( pdam - gdept_1d(1 ) ) / pwam ) 194 zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam ) 195 zmhs = zm00 / zm01 196 zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01 197 198 DO jk = 1, jpk 199 pah(jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam ) ) 200 END DO 201 202 IF(lwp .AND. ld_print ) THEN ! Control print 203 WRITE(numout,*) 204 WRITE(numout,*) ' ahm profile : ' 205 WRITE(numout,*) 206 WRITE(numout,'(" jk ahm "," depth t-level " )') 207 DO jk = 1, jpk 208 WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(jk), pdep(jk) 209 END DO 210 ENDIF 211 ! 212 END SUBROUTINE ldf_zpf_1d 213 214 215 SUBROUTINE ldf_zpf_1d_3d( ld_print, pdam, pwam, pbot, pdep, pah ) 216 !!---------------------------------------------------------------------- 217 !! *** ROUTINE ldf_zpf *** 218 !! 219 !! ** Purpose : vertical adimensional profile for eddy coefficient 220 !! 221 !! ** Method : 1D eddy viscosity coefficients ( depth ) 222 !!---------------------------------------------------------------------- 223 LOGICAL , INTENT(in ) :: ld_print ! If true, output arrays on numout 224 REAL(wp), INTENT(in ) :: pdam ! depth of the inflection point 225 REAL(wp), INTENT(in ) :: pwam ! width of inflection 226 REAL(wp), INTENT(in ) :: pbot ! bottom value (0<pbot<= 1) 227 REAL(wp), INTENT(in ), DIMENSION (:) :: pdep ! depth of the gridpoint (T, U, V, F) 228 REAL(wp), INTENT(inout), DIMENSION (:,:,:) :: pah ! adimensional vertical profile 229 !! 230 INTEGER :: jk ! dummy loop indices 231 REAL(wp) :: zm00, zm01, zmhb, zmhs, zcf ! temporary scalars 232 !!---------------------------------------------------------------------- 233 234 zm00 = TANH( ( pdam - gdept_1d(1 ) ) / pwam ) 235 zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam ) 236 zmhs = zm00 / zm01 237 zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01 238 239 DO jk = 1, jpk 240 zcf = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam ) ) 241 pah(:,:,jk) = zcf 242 END DO 243 244 IF(lwp .AND. ld_print ) THEN ! Control print 245 WRITE(numout,*) 246 WRITE(numout,*) ' ahm profile : ' 247 WRITE(numout,*) 248 WRITE(numout,'(" jk ahm "," depth t-level " )') 249 DO jk = 1, jpk 250 WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(jk) 251 END DO 252 ENDIF 253 ! 254 END SUBROUTINE ldf_zpf_1d_3d 255 256 257 SUBROUTINE ldf_zpf_3d( ld_print, pdam, pwam, pbot, pdep, pah ) 258 !!---------------------------------------------------------------------- 259 !! *** ROUTINE ldf_zpf *** 260 !! 261 !! ** Purpose : vertical adimensional profile for eddy coefficient 262 !! 263 !! ** Method : 3D for partial step or s-coordinate 264 !!---------------------------------------------------------------------- 265 LOGICAL , INTENT(in ) :: ld_print ! If true, output arrays on numout 266 REAL(wp), INTENT(in ) :: pdam ! depth of the inflection point 267 REAL(wp), INTENT(in ) :: pwam ! width of inflection 268 REAL(wp), INTENT(in ) :: pbot ! bottom value (0<pbot<= 1) 269 REAL(wp), INTENT(in ), DIMENSION (:,:,:) :: pdep ! dep of the gridpoint (T, U, V, F) 270 REAL(wp), INTENT(inout), DIMENSION (:,:,:) :: pah ! adimensional vertical profile 271 !! 272 INTEGER :: jk ! dummy loop indices 273 REAL(wp) :: zm00, zm01, zmhb, zmhs ! temporary scalars 274 !!---------------------------------------------------------------------- 275 276 zm00 = TANH( ( pdam - gdept_1d(1 ) ) / pwam ) 277 zm01 = TANH( ( pdam - gdept_1d(jpkm1) ) / pwam ) 278 zmhs = zm00 / zm01 279 zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01 280 281 DO jk = 1, jpk 282 pah(:,:,jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(:,:,jk) ) / pwam ) ) 283 END DO 284 285 IF(lwp .AND. ld_print ) THEN ! Control print 286 WRITE(numout,*) 287 WRITE(numout,*) ' ahm profile : ' 288 WRITE(numout,*) 289 WRITE(numout,'(" jk ahm "," depth t-level " )') 290 DO jk = 1, jpk 291 WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(1,1,jk) 292 END DO 293 ENDIF 294 ! 295 END SUBROUTINE ldf_zpf_3d 225 226 SUBROUTINE ldf_dyn( kt ) 227 !!---------------------------------------------------------------------- 228 !! *** ROUTINE ldf_dyn_init *** 229 !! 230 !! ** Purpose : update at kt the momentum lateral mixing coeff. (ahmt and ahmf) 231 !! 232 !! ** Method : time varying eddy viscosity coefficients: 233 !! 234 !! nn_ahm_ijk_t = 31 ahmt, ahmf = F(i,j,k,t) = F(local velocity) 235 !! ( |u|e /12 or |u|e^3/12 for laplacian or bilaplacian operator ) 236 !! 237 !! ** action : ahmt, ahmf update at each time step 238 !!---------------------------------------------------------------------- 239 INTEGER, INTENT(in) :: kt ! time step index 240 ! 241 INTEGER :: ji, jj, jk ! dummy loop indices 242 REAL(wp) :: zu2pv2_i_j_p1, zu2pv2_i_j, zu2pv2_i_j_m1, zetmax, zefmax ! local scalar 243 !!---------------------------------------------------------------------- 244 ! 245 IF( nn_timing == 1 ) CALL timing_start('ldf_dyn') 246 ! 247 SELECT CASE( nn_ahm_ijk_t ) !== Eddy vicosity coefficients ==! 248 ! 249 CASE( 31 ) !== time varying 3D field ==! = F( local velocity ) 250 ! 251 IF( ln_dynldf_lap ) THEN ! laplacian operator : |u| e /12 252 DO jk = 1, jpkm1 253 DO jj = 2, jpjm1 254 DO ji = fs_2, fs_jpim1 255 !!gm should probably be defined as an average of " e1u*u + e2v*v " not the 256 zu2pv2_i_j_p1 = ub(ji+1,jj,jk) * ub(ji+1,jj,jk) + vb(ji,jj+1,jk) * vb(ji,jj+1,jk) 257 zu2pv2_i_j = ub(ji ,jj,jk) * ub(ji ,jj,jk) + vb(ji,jj ,jk) * vb(ji,jj ,jk) 258 zu2pv2_i_j_m1 = ub(ji-1,jj,jk) * ub(ji-1,jj,jk) + vb(ji,jj-1,jk) * vb(ji,jj-1,jk) 259 zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 260 zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 261 ahmt(ji,jj,jk) = SQRT( zu2pv2_i_j + zu2pv2_i_j_m1 * r1_288 ) * zetmax * tmask(ji,jj,jk) ! 288= 12*12 * 2 262 ahmf(ji,jj,jk) = SQRT( zu2pv2_i_j + zu2pv2_i_j_p1 * r1_288 ) * zefmax * fmask(ji,jj,jk) 263 END DO 264 END DO 265 END DO 266 ELSEIF( ln_dynldf_blp ) THEN ! bilaplacian operator : sqrt( |u| e^3 /12 ) 267 DO jk = 1, jpkm1 268 DO jj = 2, jpjm1 269 DO ji = fs_2, fs_jpim1 270 zu2pv2_i_j_p1 = ub(ji+1,jj,jk) * ub(ji+1,jj,jk) + vb(ji,jj+1,jk) * vb(ji,jj+1,jk) 271 zu2pv2_i_j = ub(ji ,jj,jk) * ub(ji ,jj,jk) + vb(ji,jj ,jk) * vb(ji,jj ,jk) 272 zu2pv2_i_j_m1 = ub(ji-1,jj,jk) * ub(ji-1,jj,jk) + vb(ji,jj-1,jk) * vb(ji,jj-1,jk) 273 zetmax = MAX( e1t(ji,jj) , e2t(ji,jj) ) 274 zefmax = MAX( e1f(ji,jj) , e2f(ji,jj) ) 275 ahmt(ji,jj,jk) = SQRT( SQRT( zu2pv2_i_j + zu2pv2_i_j_m1 * r1_288 ) * zetmax ) * zetmax * tmask(ji,jj,jk) 276 ahmf(ji,jj,jk) = SQRT( SQRT( zu2pv2_i_j + zu2pv2_i_j_p1 * r1_288 ) * zefmax ) * zefmax * fmask(ji,jj,jk) 277 END DO 278 END DO 279 END DO 280 ENDIF 281 ! 282 CALL lbc_lnk( ahmt, 'U', 1. ) ; CALL lbc_lnk( ahmf, 'V', 1. ) 283 ! 284 END SELECT 285 ! 286 IF( nn_timing == 1 ) CALL timing_stop('ldf_dyn') 287 ! 288 END SUBROUTINE ldf_dyn 296 289 297 290 !!====================================================================== -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90
r3634 r4596 82 82 !! last modified : Maria Luneva, September 2011 83 83 !!---------------------------------------------------------------------- 84 !! * Modules used85 84 !! ahm0 here is a background viscosity 86 87 !! * Arguments88 89 !! * local variables90 85 91 86 INTEGER :: kt ! timestep … … 95 90 REAL (wp), POINTER, DIMENSION (:,:) :: zux, zuy , zvx ,zvy, zue1, zue2, zve1, zve2 96 91 REAL (wp):: zcmsmag_1, zcmsmag_2 , zcmsh 97 98 99 92 !!---------------------------------------------------------------------- 100 93 … … 188 181 ! ahm3 and ahm4 at U- and V-points (used for bilaplacian operator 189 182 ! ================================ whatever its orientation is) 190 ! Here: ahm is proportional to the cube of the maximum of the grid spacing191 ! in the to horizontal direction192 183 193 184 IF( ln_dynldf_bilap ) THEN … … 286 277 ENDIF 287 278 ! 288 289 279 END SUBROUTINE ldf_dyn_smag 280 290 281 #else 291 282 !!---------------------------------------------------------------------- -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r4488 r4596 11 11 !! 3.3 ! 2010-10 (G. Nurser, C. Harris, G. Madec) add Griffies operator 12 12 !! - ! 2010-11 (F. Dupond, G. Madec) bug correction in slopes just below the ML 13 !! 3.7 ! 2013-12 (F. Lemarie, G. Madec) add limiter on triad slopes 13 14 !!---------------------------------------------------------------------- 14 #if defined key_ldfslp || defined key_esopa 15 15 16 !!---------------------------------------------------------------------- 16 !! 'key_ldfslp' Rotation of lateral mixing tensor 17 !!---------------------------------------------------------------------- 17 !! ldf_slp : calculates the slopes of neutral surface (Madec operator) 18 18 !! ldf_slp_grif : calculates the triads of isoneutral slopes (Griffies operator) 19 !! ldf_slp : calculates the slopes of neutral surface (Madec operator)20 19 !! ldf_slp_mxl : calculates the slopes at the base of the mixed layer (Madec operator) 21 20 !! ldf_slp_init : initialization of the slopes computation … … 23 22 USE oce ! ocean dynamics and tracers 24 23 USE dom_oce ! ocean space and time domain 25 USE ldftra_oce ! lateral diffusion: traceur 26 USE ldfdyn_oce ! lateral diffusion: dynamics 24 USE ldfdyn ! lateral diffusion: eddy viscosity coef. 27 25 USE phycst ! physical constants 28 26 USE zdfmxl ! mixed layer depth 29 27 USE eosbn2 ! equation of states 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link)28 ! 31 29 USE in_out_manager ! I/O manager 32 30 USE prtctl ! Print control 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE lib_mpp ! distribued memory computing library 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 33 34 USE wrk_nemo ! work arrays 34 35 USE timing ! Timing 35 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)36 36 37 37 IMPLICIT NONE … … 40 40 PUBLIC ldf_slp ! routine called by step.F90 41 41 PUBLIC ldf_slp_grif ! routine called by step.F90 42 PUBLIC ldf_slp_init ! routine called by opa.F90 43 44 LOGICAL , PUBLIC, PARAMETER :: lk_ldfslp = .TRUE. !: slopes flag 45 ! !! Madec operator 46 ! Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 42 PUBLIC ldf_slp_init ! routine called by nemogcm.F90 43 44 LOGICAL , PUBLIC :: l_ldfslp = .FALSE. !: slopes flag 45 46 LOGICAL , PUBLIC :: ln_traldf_iso = .TRUE. !: iso-neutral direction 47 LOGICAL , PUBLIC :: ln_traldf_triad = .FALSE. !: griffies triad scheme 48 49 LOGICAL , PUBLIC :: ln_triad_iso = .FALSE. !: pure horizontal mixing in ML 50 LOGICAL , PUBLIC :: ln_botmix_triad = .FALSE. !: mixing on bottom 51 REAL(wp), PUBLIC :: rn_slpmax = 0.01_wp !: slope limit 52 53 LOGICAL , PUBLIC :: l_grad_zps = .FALSE. !: special treatment for Horz Tgradients w partial steps (triad operator) 54 55 ! !! Classic operator (Madec) 47 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp, wslpi !: i_slope at U- and W-points 48 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vslp, wslpj !: j-slope at V- and W-points 49 ! !! Griffies operator58 ! !! triad operator (Griffies) 50 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslp2 !: wslp**2 from Griffies quarter cells 51 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: triadi_g, triadj_g !: skew flux slopes relative to geopotentials 52 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: triadi , triadj !: isoneutral slopes relative to model-coordinate 53 54 ! !! Madec operator 55 ! Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 62 ! !! both operators 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ah_wslp2 !: ah * slope^2 at w-point 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akz !: stabilizing vertical diffusivity 65 66 ! !! Madec operator 56 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: omlmask ! mask of the surface mixed layer at T-pt 57 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: uslpml, wslpiml ! i_slope at U- and W-points just below the mixed layer … … 62 73 !! * Substitutions 63 74 # include "domzgr_substitute.h90" 64 # include "ldftra_substitute.h90"65 # include "ldfeiv_substitute.h90"66 75 # include "vectopt_loop_substitute.h90" 67 76 !!---------------------------------------------------------------------- 68 !! NEMO/OPA 4.0 , NEMO Consortium (2011)77 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 69 78 !! $Id$ 70 79 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 104 113 INTEGER :: ii0, ii1, iku ! temporary integer 105 114 INTEGER :: ij0, ij1, ikv ! temporary integer 106 REAL(wp) :: zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars115 REAL(wp) :: zeps, zm1_g, zm1_2g, z1_16, zcofw, z1_slpmax ! local scalars 107 116 REAL(wp) :: zci, zfi, zau, zbu, zai, zbi ! - - 108 117 REAL(wp) :: zcj, zfj, zav, zbv, zaj, zbj ! - - … … 117 126 CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 118 127 119 IF ( ln_traldf_iso .OR. ln_dynldf_iso ) THEN 120 121 zeps = 1.e-20_wp !== Local constant initialization ==! 122 z1_16 = 1.0_wp / 16._wp 123 zm1_g = -1.0_wp / grav 124 zm1_2g = -0.5_wp / grav 128 zeps = 1.e-20_wp !== Local constant initialization ==! 129 z1_16 = 1.0_wp / 16._wp 130 zm1_g = -1.0_wp / grav 131 zm1_2g = -0.5_wp / grav 132 z1_slpmax = 1._wp / rn_slpmax 133 ! 134 zww(:,:,:) = 0._wp 135 zwz(:,:,:) = 0._wp 136 ! 137 DO jk = 1, jpk !== i- & j-gradient of density ==! 138 DO jj = 1, jpjm1 139 DO ji = 1, fs_jpim1 ! vector opt. 140 zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj ,jk) - prd(ji,jj,jk) ) 141 zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji ,jj+1,jk) - prd(ji,jj,jk) ) 142 END DO 143 END DO 144 END DO 145 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 146 # if defined key_vectopt_loop 147 DO jj = 1, 1 148 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 149 # else 150 DO jj = 1, jpjm1 151 DO ji = 1, jpim1 152 # endif 153 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 154 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 155 END DO 156 END DO 157 ENDIF 158 ! 159 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 160 DO jk = 2, jpkm1 161 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 162 ! ! trick: tmask(ik ) = 0 => all pn2 = 0 => zdzr = 0 163 ! ! else tmask(ik+1) = 0 => pn2(ik+1) = 0 => zdzr divides by 1 164 ! ! umask(ik+1) /= 0 => all pn2 /= 0 => zdzr divides by 2 165 ! ! NB: 1/(tmask+1) = (1-.5*tmask) substitute a / by a * ==> faster 166 zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp ) & 167 & * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 168 END DO 169 ! 170 ! !== Slopes just below the mixed layer ==! 171 CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr ) ! output: uslpml, vslpml, wslpiml, wslpjml 172 173 174 ! I. slopes at u and v point | uslp = d/di( prd ) / d/dz( prd ) 175 ! =========================== | vslp = d/dj( prd ) / d/dz( prd ) 176 ! 177 DO jk = 2, jpkm1 !* Slopes at u and v points 178 DO jj = 2, jpjm1 179 DO ji = fs_2, fs_jpim1 ! vector opt. 180 ! ! horizontal and vertical density gradient at u- and v-points 181 zau = zgru(ji,jj,jk) / e1u(ji,jj) 182 zav = zgrv(ji,jj,jk) / e2v(ji,jj) 183 zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj ,jk) ) 184 zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji ,jj+1,jk) ) 185 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 186 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 187 zbu = MIN( zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau ) ) 188 zbv = MIN( zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav ) ) 189 ! ! uslp and vslp output in zwz and zww, resp. 190 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 191 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 192 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) & 193 & + zfi * uslpml(ji,jj) & 194 & * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) & 195 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 196 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) & 197 & + zfj * vslpml(ji,jj) & 198 & * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) & 199 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 200 !!gm modif to suppress omlmask.... (as in Griffies case) 201 ! ! ! jk must be >= ML level for zf=1. otherwise zf=0. 202 ! zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp ) 203 ! zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp ) 204 ! zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 205 ! zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 206 ! zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk) 207 ! zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk) 208 !!gm end modif 209 END DO 210 END DO 211 END DO 212 CALL lbc_lnk( zwz, 'U', -1. ) ; CALL lbc_lnk( zww, 'V', -1. ) ! lateral boundary conditions 213 ! 214 ! !* horizontal Shapiro filter 215 DO jk = 2, jpkm1 216 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 217 DO ji = 2, jpim1 218 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 219 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 220 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 221 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 222 & + 4.* zwz(ji ,jj ,jk) ) 223 vslp(ji,jj,jk) = z1_16 * ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 224 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 225 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 226 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 227 & + 4.* zww(ji,jj ,jk) ) 228 END DO 229 END DO 230 DO jj = 3, jpj-2 ! other rows 231 DO ji = fs_2, fs_jpim1 ! vector opt. 232 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 233 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 234 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 235 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 236 & + 4.* zwz(ji ,jj ,jk) ) 237 vslp(ji,jj,jk) = z1_16 * ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 238 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 239 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 240 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 241 & + 4.* zww(ji,jj ,jk) ) 242 END DO 243 END DO 244 ! !* decrease along coastal boundaries 245 DO jj = 2, jpjm1 246 DO ji = fs_2, fs_jpim1 ! vector opt. 247 uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk ) ) * 0.5_wp & 248 & * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp 249 vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk ) ) * 0.5_wp & 250 & * ( vmask(ji ,jj,jk) + vmask(ji ,jj,jk+1) ) * 0.5_wp 251 END DO 252 END DO 253 END DO 254 255 256 ! II. slopes at w point | wslpi = mij( d/di( prd ) / d/dz( prd ) 257 ! =========================== | wslpj = mij( d/dj( prd ) / d/dz( prd ) 258 ! 259 DO jk = 2, jpkm1 260 DO jj = 2, jpjm1 261 DO ji = fs_2, fs_jpim1 ! vector opt. 262 ! !* Local vertical density gradient evaluated from N^2 263 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) 264 ! !* Slopes at w point 265 ! ! i- & j-gradient of density at w-points 266 zci = MAX( umask(ji-1,jj,jk ) + umask(ji,jj,jk ) & 267 & + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps ) * e1t(ji,jj) 268 zcj = MAX( vmask(ji,jj-1,jk ) + vmask(ji,jj,jk-1) & 269 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk ) , zeps ) * e2t(ji,jj) 270 zai = ( zgru (ji-1,jj,jk ) + zgru (ji,jj,jk-1) & 271 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci * tmask (ji,jj,jk) 272 zaj = ( zgrv (ji,jj-1,jk ) + zgrv (ji,jj,jk-1) & 273 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj * tmask (ji,jj,jk) 274 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 275 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 276 zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai ) ) 277 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj ) ) 278 ! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 279 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 280 zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp ) 281 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) 282 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) 283 284 !!gm modif to suppress omlmask.... (as in Griffies operator) 285 ! ! ! jk must be >= ML level for zfk=1. otherwise zfk=0. 286 ! zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 287 ! zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. ) 288 ! zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 289 ! zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) 290 !!gm end modif 291 END DO 292 END DO 293 END DO 294 CALL lbc_lnk( zwz, 'T', -1. ) ; CALL lbc_lnk( zww, 'T', -1. ) ! lateral boundary conditions 295 ! 296 ! !* horizontal Shapiro filter 297 DO jk = 2, jpkm1 298 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 299 DO ji = 2, jpim1 300 zcofw = tmask(ji,jj,jk) * z1_16 301 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 302 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 303 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 304 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 305 & + 4.* zwz(ji ,jj ,jk) ) * zcofw 306 307 wslpj(ji,jj,jk) = ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 308 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 309 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 310 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 311 & + 4.* zww(ji ,jj ,jk) ) * zcofw 312 END DO 313 END DO 314 DO jj = 3, jpj-2 ! other rows 315 DO ji = fs_2, fs_jpim1 ! vector opt. 316 zcofw = tmask(ji,jj,jk) * z1_16 317 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 318 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 319 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 320 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 321 & + 4.* zwz(ji ,jj ,jk) ) * zcofw 322 323 wslpj(ji,jj,jk) = ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 324 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 325 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 326 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 327 & + 4.* zww(ji ,jj ,jk) ) * zcofw 328 END DO 329 END DO 330 ! !* decrease along coastal boundaries 331 DO jj = 2, jpjm1 332 DO ji = fs_2, fs_jpim1 ! vector opt. 333 zck = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) & 334 & * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 335 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck 336 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck 337 END DO 338 END DO 339 END DO 340 341 ! III. Specific grid points 342 ! =========================== 343 ! 344 IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN ! ORCA_R4 configuration: horizontal diffusion in specific area 345 ! ! Gibraltar Strait 346 ij0 = 50 ; ij1 = 53 347 ii0 = 69 ; ii1 = 71 ; uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 348 ij0 = 51 ; ij1 = 53 349 ii0 = 68 ; ii1 = 71 ; vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 350 ii0 = 69 ; ii1 = 71 ; wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 351 ii0 = 69 ; ii1 = 71 ; wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 125 352 ! 126 zww(:,:,:) = 0._wp 127 zwz(:,:,:) = 0._wp 128 ! 129 DO jk = 1, jpk !== i- & j-gradient of density ==! 130 DO jj = 1, jpjm1 131 DO ji = 1, fs_jpim1 ! vector opt. 132 zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj ,jk) - prd(ji,jj,jk) ) 133 zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji ,jj+1,jk) - prd(ji,jj,jk) ) 134 END DO 135 END DO 136 END DO 137 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 138 # if defined key_vectopt_loop 139 DO jj = 1, 1 140 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 141 # else 142 DO jj = 1, jpjm1 143 DO ji = 1, jpim1 144 # endif 145 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 146 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 147 END DO 148 END DO 149 ENDIF 150 ! 151 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 152 DO jk = 2, jpkm1 153 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 154 ! ! trick: tmask(ik ) = 0 => all pn2 = 0 => zdzr = 0 155 ! ! else tmask(ik+1) = 0 => pn2(ik+1) = 0 => zdzr divides by 1 156 ! ! umask(ik+1) /= 0 => all pn2 /= 0 => zdzr divides by 2 157 ! ! NB: 1/(tmask+1) = (1-.5*tmask) substitute a / by a * ==> faster 158 zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp ) & 159 & * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 160 END DO 161 ! 162 ! !== Slopes just below the mixed layer ==! 163 CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr ) ! output: uslpml, vslpml, wslpiml, wslpjml 164 165 166 ! I. slopes at u and v point | uslp = d/di( prd ) / d/dz( prd ) 167 ! =========================== | vslp = d/dj( prd ) / d/dz( prd ) 168 ! 169 DO jk = 2, jpkm1 !* Slopes at u and v points 170 DO jj = 2, jpjm1 171 DO ji = fs_2, fs_jpim1 ! vector opt. 172 ! ! horizontal and vertical density gradient at u- and v-points 173 zau = zgru(ji,jj,jk) / e1u(ji,jj) 174 zav = zgrv(ji,jj,jk) / e2v(ji,jj) 175 zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj ,jk) ) 176 zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji ,jj+1,jk) ) 177 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 178 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 179 zbu = MIN( zbu, -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau ) ) 180 zbv = MIN( zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav ) ) 181 ! ! uslp and vslp output in zwz and zww, resp. 182 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 183 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 184 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) & 185 & + zfi * uslpml(ji,jj) & 186 & * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) & 187 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 188 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) & 189 & + zfj * vslpml(ji,jj) & 190 & * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) & 191 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 192 !!gm modif to suppress omlmask.... (as in Griffies case) 193 ! ! ! jk must be >= ML level for zf=1. otherwise zf=0. 194 ! zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp ) 195 ! zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp ) 196 ! zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 197 ! zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 198 ! zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk) 199 ! zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk) 200 !!gm end modif 201 END DO 202 END DO 203 END DO 204 CALL lbc_lnk( zwz, 'U', -1. ) ; CALL lbc_lnk( zww, 'V', -1. ) ! lateral boundary conditions 205 ! 206 ! !* horizontal Shapiro filter 207 DO jk = 2, jpkm1 208 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 209 DO ji = 2, jpim1 210 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 211 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 212 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 213 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 214 & + 4.* zwz(ji ,jj ,jk) ) 215 vslp(ji,jj,jk) = z1_16 * ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 216 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 217 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 218 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 219 & + 4.* zww(ji,jj ,jk) ) 220 END DO 221 END DO 222 DO jj = 3, jpj-2 ! other rows 223 DO ji = fs_2, fs_jpim1 ! vector opt. 224 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 225 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 226 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 227 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 228 & + 4.* zwz(ji ,jj ,jk) ) 229 vslp(ji,jj,jk) = z1_16 * ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 230 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 231 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 232 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 233 & + 4.* zww(ji,jj ,jk) ) 234 END DO 235 END DO 236 ! !* decrease along coastal boundaries 237 DO jj = 2, jpjm1 238 DO ji = fs_2, fs_jpim1 ! vector opt. 239 uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk ) ) * 0.5_wp & 240 & * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp 241 vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk ) ) * 0.5_wp & 242 & * ( vmask(ji ,jj,jk) + vmask(ji ,jj,jk+1) ) * 0.5_wp 243 END DO 244 END DO 245 END DO 246 247 248 ! II. slopes at w point | wslpi = mij( d/di( prd ) / d/dz( prd ) 249 ! =========================== | wslpj = mij( d/dj( prd ) / d/dz( prd ) 250 ! 251 DO jk = 2, jpkm1 252 DO jj = 2, jpjm1 253 DO ji = fs_2, fs_jpim1 ! vector opt. 254 ! !* Local vertical density gradient evaluated from N^2 255 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) 256 ! !* Slopes at w point 257 ! ! i- & j-gradient of density at w-points 258 zci = MAX( umask(ji-1,jj,jk ) + umask(ji,jj,jk ) & 259 & + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps ) * e1t(ji,jj) 260 zcj = MAX( vmask(ji,jj-1,jk ) + vmask(ji,jj,jk-1) & 261 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk ) , zeps ) * e2t(ji,jj) 262 zai = ( zgru (ji-1,jj,jk ) + zgru (ji,jj,jk-1) & 263 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci * tmask (ji,jj,jk) 264 zaj = ( zgrv (ji,jj-1,jk ) + zgrv (ji,jj,jk-1) & 265 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj * tmask (ji,jj,jk) 266 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 267 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 268 zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai ) ) 269 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj ) ) 270 ! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 271 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 272 zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp ) 273 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) 274 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) 275 276 !!gm modif to suppress omlmask.... (as in Griffies operator) 277 ! ! ! jk must be >= ML level for zfk=1. otherwise zfk=0. 278 ! zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 279 ! zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. ) 280 ! zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 281 ! zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) 282 !!gm end modif 283 END DO 284 END DO 285 END DO 286 CALL lbc_lnk( zwz, 'T', -1. ) ; CALL lbc_lnk( zww, 'T', -1. ) ! lateral boundary conditions 287 ! 288 ! !* horizontal Shapiro filter 289 DO jk = 2, jpkm1 290 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 291 DO ji = 2, jpim1 292 zcofw = tmask(ji,jj,jk) * z1_16 293 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 294 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 295 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 296 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 297 & + 4.* zwz(ji ,jj ,jk) ) * zcofw 298 299 wslpj(ji,jj,jk) = ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 300 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 301 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 302 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 303 & + 4.* zww(ji ,jj ,jk) ) * zcofw 304 END DO 305 END DO 306 DO jj = 3, jpj-2 ! other rows 307 DO ji = fs_2, fs_jpim1 ! vector opt. 308 zcofw = tmask(ji,jj,jk) * z1_16 309 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 310 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 311 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 312 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 313 & + 4.* zwz(ji ,jj ,jk) ) * zcofw 314 315 wslpj(ji,jj,jk) = ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 316 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 317 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 318 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 319 & + 4.* zww(ji ,jj ,jk) ) * zcofw 320 END DO 321 END DO 322 ! !* decrease along coastal boundaries 323 DO jj = 2, jpjm1 324 DO ji = fs_2, fs_jpim1 ! vector opt. 325 zck = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) & 326 & * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 327 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck 328 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck 329 END DO 330 END DO 331 END DO 332 333 ! III. Specific grid points 334 ! =========================== 335 ! 336 IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN ! ORCA_R4 configuration: horizontal diffusion in specific area 337 ! ! Gibraltar Strait 338 ij0 = 50 ; ij1 = 53 339 ii0 = 69 ; ii1 = 71 ; uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 340 ij0 = 51 ; ij1 = 53 341 ii0 = 68 ; ii1 = 71 ; vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 342 ii0 = 69 ; ii1 = 71 ; wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 343 ii0 = 69 ; ii1 = 71 ; wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 344 ! 345 ! ! Mediterrannean Sea 346 ij0 = 49 ; ij1 = 56 347 ii0 = 71 ; ii1 = 90 ; uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 348 ij0 = 50 ; ij1 = 56 349 ii0 = 70 ; ii1 = 90 ; vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 350 ii0 = 71 ; ii1 = 90 ; wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 351 ii0 = 71 ; ii1 = 90 ; wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 352 ENDIF 353 354 355 ! IV. Lateral boundary conditions 356 ! =============================== 357 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 358 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 359 360 361 IF(ln_ctl) THEN 362 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 363 CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 364 ENDIF 365 ! 366 367 ELSEIF ( lk_vvl ) THEN 368 369 IF(lwp) THEN 370 WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 371 ENDIF 372 373 ! geopotential diffusion in s-coordinates on tracers and/or momentum 374 ! The slopes of s-surfaces are computed at each time step due to vvl 375 ! The slopes for momentum diffusion are i- or j- averaged of those on tracers 376 377 ! set the slope of diffusion to the slope of s-surfaces 378 ! ( c a u t i o n : minus sign as fsdep has positive value ) 379 DO jk = 1, jpk 380 DO jj = 2, jpjm1 381 DO ji = fs_2, fs_jpim1 ! vector opt. 382 uslp(ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 383 vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 384 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 385 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 386 END DO 387 END DO 388 END DO 389 390 ! Lateral boundary conditions on the slopes 391 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 392 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 393 394 if( kt == nit000 ) then 395 IF(lwp) WRITE(numout,*) ' max slop: u',SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)), & 396 & ' wi', sqrt(MAXVAL(wslpi)), ' wj', sqrt(MAXVAL(wslpj)) 397 endif 398 399 IF(ln_ctl) THEN 400 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 401 CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 402 ENDIF 403 353 ! ! Mediterrannean Sea 354 ij0 = 49 ; ij1 = 56 355 ii0 = 71 ; ii1 = 90 ; uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 356 ij0 = 50 ; ij1 = 56 357 ii0 = 70 ; ii1 = 90 ; vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 358 ii0 = 71 ; ii1 = 90 ; wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 359 ii0 = 71 ; ii1 = 90 ; wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 404 360 ENDIF 405 361 362 363 ! IV. Lateral boundary conditions 364 ! =============================== 365 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 366 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 367 368 369 IF(ln_ctl) THEN 370 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 371 CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 372 ENDIF 373 ! 406 374 CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 407 375 ! … … 416 384 !! 417 385 !! ** Purpose : Compute the squared slopes of neutral surfaces (slope 418 !! of iso-pycnal surfaces referenced locally) (ln_traldf_ grif=T)386 !! of iso-pycnal surfaces referenced locally) (ln_traldf_triad=T) 419 387 !! at W-points using the Griffies quarter-cells. 420 388 !! … … 435 403 REAL(wp) :: zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 436 404 REAL(wp) :: zdzrho_raw 437 REAL(wp) :: zbeta0 405 REAL(wp) :: zbeta0, ze3_e1, ze3_e2 438 406 REAL(wp), POINTER, DIMENSION(:,:) :: z1_mlbw 439 407 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalbet … … 467 435 zdxrho_raw = ( - zalbet(ji+ip,jj ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj) 468 436 zdyrho_raw = ( - zalbet(ji ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 469 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw) ! keep the sign470 zdyrho(ji ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw)437 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 438 zdyrho(ji ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 471 439 END DO 472 440 END DO 473 441 END DO 474 442 ! 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 443 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 480 444 DO jj = 1, jpjm1 481 445 DO ji = 1, jpim1 482 # endif483 446 iku = mbku(ji,jj) ; ikv = mbkv(ji,jj) ! last ocean level (u- & v-points) 484 447 zdit = gtsu(ji,jj,jp_tem) ; zdjt = gtsv(ji,jj,jp_tem) ! i- & j-gradient of Temperature … … 539 502 ! 540 503 jk = nmln(ji+ip,jj) + 1 541 IF( jk .GT. mbkt(ji+ip,jj) ) THEN !ML reaches bottom 542 zti_mlb(ji+ip,jj ,1-ip,kp) = 0.0_wp 543 ELSE 544 ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 545 zti_g_raw = ( zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp) & 546 & - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj) ) * umask(ji,jj,jk) 547 zti_mlb(ji+ip,jj ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 504 IF( jk > mbkt(ji+ip,jj) ) THEN ! ML reaches bottom 505 zti_mlb(ji+ip,jj ,1-ip,kp) = 0.0_wp 506 ELSE 507 ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 508 zti_g_raw = ( zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp) & 509 & - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj) ) * umask(ji,jj,jk) 510 ze3_e1 = fse3w(ji+ip,jj,jk-kp) / e1u(ji,jj) 511 zti_mlb(ji+ip,jj ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1 , ABS( zti_g_raw ) ), zti_g_raw ) 548 512 ENDIF 549 513 ! 550 514 jk = nmln(ji,jj+jp) + 1 551 515 IF( jk .GT. mbkt(ji,jj+jp) ) THEN !ML reaches bottom 552 ztj_mlb(ji ,jj+jp,1-jp,kp) = 0.0_wp516 ztj_mlb(ji ,jj+jp,1-jp,kp) = 0.0_wp 553 517 ELSE 554 ztj_g_raw = ( zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp) & 555 & - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj) ) * vmask(ji,jj,jk) 556 ztj_mlb(ji ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 518 ztj_g_raw = ( zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp) & 519 & - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj) ) * vmask(ji,jj,jk) 520 ze3_e2 = fse3w(ji,jj+jp,jk-kp) / e2v(ji,jj) 521 ztj_mlb(ji ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2 , ABS( ztj_g_raw ) ), ztj_g_raw ) 557 522 ENDIF 558 523 END DO … … 583 548 zti_raw = zdxrho(ji+ip,jj ,jk,1-ip) / zdzrho(ji+ip,jj ,jk,kp) ! unmasked 584 549 ztj_raw = zdyrho(ji ,jj+jp,jk,1-jp) / zdzrho(ji ,jj+jp,jk,kp) 585 550 ! 586 551 ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 587 552 zti_coord = znot_thru_surface * ( fsdept(ji+1,jj ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj) … … 589 554 zti_g_raw = zti_raw - zti_coord ! ref to geopot surfaces 590 555 ztj_g_raw = ztj_raw - ztj_coord 591 zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 592 ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 556 ! additional limit required in bilaplacian case 557 ze3_e1 = fse3w(ji+ip,jj ,jk+kp) / e1u(ji,jj) 558 ze3_e2 = fse3w(ji ,jj+jp,jk+kp) / e2v(ji,jj) 559 ! NB: hard coded factor 5 (can be a namelist parameter...) 560 zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw ) 561 ztj_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2, ABS( ztj_g_raw ) ), ztj_g_raw ) 593 562 ! 594 563 ! Below ML use limited zti_g as is & mask … … 619 588 ! 620 589 IF( ln_triad_iso ) THEN 621 zti_raw = zti_lim* *2/ zti_raw622 ztj_raw = ztj_lim* *2/ ztj_raw590 zti_raw = zti_lim*zti_lim / zti_raw 591 ztj_raw = ztj_lim*ztj_lim / ztj_raw 623 592 zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw ) 624 593 ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw ) 625 zti_lim = zfacti * zti_lim & 626 & + ( 1._wp - zfacti ) * zti_raw 627 ztj_lim = zfactj * ztj_lim & 628 & + ( 1._wp - zfactj ) * ztj_raw 594 zti_lim = zfacti * zti_lim + ( 1._wp - zfacti ) * zti_raw 595 ztj_lim = zfactj * ztj_lim + ( 1._wp - zfactj ) * ztj_raw 629 596 ENDIF 630 triadi(ji+ip,jj ,jk,1-ip,kp) = zti_lim 631 triadj(ji ,jj+jp,jk,1-jp,kp) = ztj_lim 632 ! 633 zbu = e1u(ji ,jj) * e2u(ji ,jj) * fse3u(ji ,jj,jk ) 634 zbv = e1v(ji ,jj) * e2v(ji ,jj) * fse3v(ji ,jj,jk ) 635 zbti = e1t(ji+ip,jj) * e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp) 636 zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp) 597 #if defined key_switch_triad 598 triadi(ji+ip,jj ,jk,1-ip,kp) = zti_lim & 599 & * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - ip ) * SIGN( 1._wp , zdxrho(ji+ip,jj,jk,1-ip) ) ) 600 triadj(ji ,jj+jp,jk,1-jp,kp) = ztj_lim & 601 & * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - jp ) * SIGN( 1._wp , zdyrho(ji,jj+jp,jk,1-jp) ) ) 602 #endif 603 ! 604 zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji ,jj ,jk ) 605 zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji ,jj ,jk ) 606 zbti = e1e2t(ji+ip,jj ) * fse3w(ji+ip,jj ,jk+kp) 607 zbtj = e1e2t(ji ,jj+jp) * fse3w(ji ,jj+jp,jk+kp) 637 608 ! 638 609 !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers.... ==> to be checked 639 wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim**2! masked640 wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim**2610 wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim ! masked 611 wslp2(ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim*ztj_g_lim 641 612 END DO 642 613 END DO … … 682 653 INTEGER :: ji , jj , jk ! dummy loop indices 683 654 INTEGER :: iku, ikv, ik, ikm1 ! local integers 684 REAL(wp) :: zeps, zm1_g, zm1_2g 655 REAL(wp) :: zeps, zm1_g, zm1_2g, z1_slpmax ! local scalars 685 656 REAL(wp) :: zci, zfi, zau, zbu, zai, zbi ! - - 686 657 REAL(wp) :: zcj, zfj, zav, zbv, zaj, zbj ! - - … … 693 664 zm1_g = -1.0_wp / grav 694 665 zm1_2g = -0.5_wp / grav 666 z1_slpmax = 1._wp / rn_slpmax 695 667 ! 696 668 uslpml (1,:) = 0._wp ; uslpml (jpi,:) = 0._wp … … 746 718 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 747 719 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 748 zbu = MIN( zbu , - 100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau ) )749 zbv = MIN( zbv , - 100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav ) )720 zbu = MIN( zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau ) ) 721 zbv = MIN( zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav ) ) 750 722 ! !- Slope at u- & v-points (uslpml, vslpml) 751 723 uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku) … … 805 777 WRITE(numout,*) '~~~~~~~~~~~~' 806 778 ENDIF 807 808 IF( ln_traldf_grif ) THEN ! Griffies operator : triad of slopes 809 ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr ) 810 ALLOCATE( triadi (jpi,jpj,jpk,0:1,0:1) , triadj (jpi,jpj,jpk,0:1,0:1) , STAT=ierr ) 811 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' ) 812 ! 779 ! 780 ALLOCATE( ah_wslp2(jpi,jpj,jpk) , akz(jpi,jpj,jpk) , STAT=ierr ) 781 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate ah_slp2 or akz' ) 782 ! 783 IF( ln_traldf_triad ) THEN ! Griffies operator : triad of slopes 784 IF(lwp) WRITE(numout,*) ' Griffies (triad) operator initialisation' 785 ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , & 786 & triadi (jpi,jpj,jpk,0:1,0:1) , triadj (jpi,jpj,jpk,0:1,0:1) , & 787 & wslp2 (jpi,jpj,jpk) , STAT=ierr ) 788 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' ) 813 789 IF( ln_dynldf_iso ) CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' ) 814 790 ! 815 791 ELSE ! Madec operator : slopes at u-, v-, and w-points 816 ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) , & 817 & omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj) , vslpml(jpi,jpj) , wslpiml(jpi,jpj) , wslpjml(jpi,jpj) , STAT=ierr ) 792 IF(lwp) WRITE(numout,*) ' Madec operator initialisation' 793 ALLOCATE( omlmask(jpi,jpj,jpk) , & 794 & uslp(jpi,jpj,jpk) , uslpml(jpi,jpj) , wslpi(jpi,jpj,jpk) , wslpiml(jpi,jpj) , & 795 & vslp(jpi,jpj,jpk) , vslpml(jpi,jpj) , wslpj(jpi,jpj,jpk) , wslpjml(jpi,jpj) , STAT=ierr ) 818 796 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' ) 819 797 … … 825 803 wslpj(:,:,:) = 0._wp ; wslpjml(:,:) = 0._wp 826 804 827 IF( ln_traldf_hor .OR. ln_dynldf_hor ) THEN 828 IF(lwp) WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 829 830 ! geopotential diffusion in s-coordinates on tracers and/or momentum 831 ! The slopes of s-surfaces are computed once (no call to ldfslp in step) 832 ! The slopes for momentum diffusion are i- or j- averaged of those on tracers 833 834 ! set the slope of diffusion to the slope of s-surfaces 835 ! ( c a u t i o n : minus sign as fsdep has positive value ) 836 DO jk = 1, jpk 837 DO jj = 2, jpjm1 838 DO ji = fs_2, fs_jpim1 ! vector opt. 839 uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 840 vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 841 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 842 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 843 END DO 844 END DO 845 END DO 846 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) ! Lateral boundary conditions 847 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 848 ENDIF 805 !!gm I no longer understand this..... 806 !!gm IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN 807 ! IF(lwp) WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 808 ! 809 ! ! geopotential diffusion in s-coordinates on tracers and/or momentum 810 ! ! The slopes of s-surfaces are computed once (no call to ldfslp in step) 811 ! ! The slopes for momentum diffusion are i- or j- averaged of those on tracers 812 ! 813 ! ! set the slope of diffusion to the slope of s-surfaces 814 ! ! ( c a u t i o n : minus sign as fsdep has positive value ) 815 ! DO jk = 1, jpk 816 ! DO jj = 2, jpjm1 817 ! DO ji = fs_2, fs_jpim1 ! vector opt. 818 ! uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk) 819 ! vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk) 820 ! wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 821 ! wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 822 ! END DO 823 ! END DO 824 ! END DO 825 ! CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) ! Lateral boundary conditions 826 ! CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 827 !!gm ENDIF 849 828 ENDIF 850 829 ! … … 852 831 ! 853 832 END SUBROUTINE ldf_slp_init 854 855 #else856 !!------------------------------------------------------------------------857 !! Dummy module : NO Rotation of lateral mixing tensor858 !!------------------------------------------------------------------------859 LOGICAL, PUBLIC, PARAMETER :: lk_ldfslp = .FALSE. !: slopes flag860 CONTAINS861 SUBROUTINE ldf_slp( kt, prd, pn2 ) ! Dummy routine862 INTEGER, INTENT(in) :: kt863 REAL, DIMENSION(:,:,:), INTENT(in) :: prd, pn2864 WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1)865 END SUBROUTINE ldf_slp866 SUBROUTINE ldf_slp_grif( kt ) ! Dummy routine867 INTEGER, INTENT(in) :: kt868 WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt869 END SUBROUTINE ldf_slp_grif870 SUBROUTINE ldf_slp_init ! Dummy routine871 END SUBROUTINE ldf_slp_init872 #endif873 833 874 834 !!====================================================================== -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r4147 r4596 2 2 !!====================================================================== 3 3 !! *** MODULE ldftra *** 4 !! Ocean physics: lateral diffusivity coefficient 4 !! Ocean physics: lateral diffusivity coefficients 5 5 !!===================================================================== 6 !! History : ! 1997-07 (G. Madec) from inimix.F split in 2 routines 7 !! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module 8 !! 2.0 ! 2005-11 (G. Madec) 6 !! History : ! 1997-07 (G. Madec) from inimix.F split in 2 routines 7 !! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module 8 !! 2.0 ! 2005-11 (G. Madec) 9 !! 3.7 ! 2013-12 (F. Lemarie, G. Madec) restructuration/simplification of aht/aeiv specification, 10 !! ! add velocity dependent coefficient and optional read in file 9 11 !!---------------------------------------------------------------------- 10 12 11 13 !!---------------------------------------------------------------------- 12 14 !! ldf_tra_init : initialization, namelist read, and parameters control 13 !! ldf_tra_c3d : 3D eddy viscosity coefficient initialization 14 !! ldf_tra_c2d : 2D eddy viscosity coefficient initialization 15 !! ldf_tra_c1d : 1D eddy viscosity coefficient initialization 15 !! ldf_tra : update lateral eddy diffusivity coefficients at each time step 16 !! ldf_eiv_init : initialization of the eiv coeff. from namelist choices 17 !! ldf_eiv : time evolution of the eiv coefficients (function of the growth rate of baroclinic instability) 18 !! ldf_eiv_trp : add to the input ocean transport the contribution of the EIV parametrization 19 !! ldf_eiv_dia : diagnose the eddy induced velocity from the eiv streamfunction 16 20 !!---------------------------------------------------------------------- 17 21 USE oce ! ocean dynamics and tracers 18 22 USE dom_oce ! ocean space and time domain 19 23 USE phycst ! physical constants 20 USE ldftra_oce ! ocean tracer lateral physics 21 USE ldfslp ! ??? 24 USE ldfslp ! lateral diffusion: slope of iso-neutral surfaces 25 USE ldfc1d ! lateral diffusion: 1D case 26 USE ldfc2d ! lateral diffusion: 2D case 27 USE diaar5, ONLY: lk_diaar5 28 ! 22 29 USE in_out_manager ! I/O manager 23 USE io ipsl30 USE iom ! I/O module for ehanced bottom friction file 24 31 USE lib_mpp ! distribued memory computing library 25 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 USE wrk_nemo ! work arrays 34 USE timing ! timing 26 35 27 36 IMPLICIT NONE 28 37 PRIVATE 29 38 30 PUBLIC ldf_tra_init ! called by opa.F90 39 PUBLIC ldf_tra_init ! called by nemogcm.F90 40 PUBLIC ldf_tra ! called by step.F90 41 PUBLIC ldf_eiv_init ! called by nemogcm.F90 42 PUBLIC ldf_eiv ! called by step.F90 43 PUBLIC ldf_eiv_trp ! called by traadv.F90 44 PUBLIC ldf_eiv_dia ! called by traldf_iso and traldf_iso_triad.F90 45 46 ! !!* Namelist namtra_ldf : lateral mixing on tracers * 47 ! != Operator type =! 48 LOGICAL , PUBLIC :: ln_traldf_lap = .TRUE. !: laplacian operator 49 LOGICAL , PUBLIC :: ln_traldf_blp = .FALSE. !: bilaplacian operator 50 ! != Direction of action =! 51 LOGICAL , PUBLIC :: ln_traldf_lev = .FALSE. !: iso-level direction 52 LOGICAL , PUBLIC :: ln_traldf_hor = .FALSE. !: horizontal (geopotential) direction 53 ! LOGICAL , PUBLIC :: ln_traldf_iso = .TRUE. !: iso-neutral direction (see ldfslp) 54 ! LOGICAL , PUBLIC :: ln_traldf_triad = .FALSE. !: griffies triad scheme (see ldfslp) 55 LOGICAL , PUBLIC :: ln_traldf_msc = .FALSE. !: Method of Stabilizing Correction 56 ! LOGICAL , PUBLIC :: ln_triad_iso = .FALSE. !: pure horizontal mixing in ML (see ldfslp) 57 ! LOGICAL , PUBLIC :: ln_botmix_triad = .FALSE. !: mixing on bottom (see ldfslp) 58 ! REAL(wp), PUBLIC :: rn_slpmax = 0.01_wp !: slope limit (see ldfslp) 59 ! != Coefficients =! 60 INTEGER , PUBLIC :: nn_aht_ijk_t = 0 !: ?????? !!gm 61 REAL(wp), PUBLIC :: rn_aht_0 = 2000._wp !: laplacian lateral eddy diffusivity [m2/s] 62 REAL(wp), PUBLIC :: rn_bht_0 = 5.e+11_wp !: bilaplacian lateral eddy diffusivity [m4/s] 63 64 ! !!* Namelist namtra_ldfeiv : eddy induced velocity param. * 65 ! != Use/diagnose eiv =! 66 LOGICAL , PUBLIC :: ln_ldfeiv = .FALSE. !: eddy induced velocity flag 67 LOGICAL , PUBLIC :: ln_ldfeiv_dia = .FALSE. !: diagnose & output eiv streamfunction and velocity (IOM) 68 ! != Coefficients =! 69 INTEGER , PUBLIC :: nn_aei_ijk_t = 0 !: choice of time/space variation of the eiv coeff. 70 REAL(wp), PUBLIC :: rn_aeiv_0 = 2000._wp !: eddy induced velocity coefficient [m2/s] 71 72 LOGICAL , PUBLIC :: l_ldftra_time = .FALSE. !: flag for time variation of the lateral eddy diffusivity coef. 73 LOGICAL , PUBLIC :: l_ldfeiv_time = .FALSE. ! flag for time variation of the eiv coef. 74 REAL(wp), PUBLIC :: rldf !: multiplicative factor of diffusive coefficient 75 ! Needed to define the ratio between passive and active tracer diffusion coef. 76 77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahtu, ahtv !: eddy diffusivity coef. at U- and V-points [m2/s] 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aeiu, aeiv !: eddy induced velocity coeff. [m2/s] 79 80 REAL(wp) :: r1_4 = 0.25_wp ! =1/4 81 REAL(wp) :: r1_12 = 1._wp / 12._wp ! =1/12 31 82 32 83 !! * Substitutions … … 34 85 # include "vectopt_loop_substitute.h90" 35 86 !!---------------------------------------------------------------------- 36 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)87 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 37 88 !! $Id$ 38 89 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 46 97 !! ** Purpose : initializations of the tracer lateral mixing coeff. 47 98 !! 48 !! ** Method : the Eddy diffusivity and eddy induced velocity ceoff. 49 !! are defined as follows: 50 !! default option : constant coef. aht0, aeiv0 (namelist) 51 !! 'key_traldf_c1d': depth dependent coef. defined in 52 !! in ldf_tra_c1d routine 53 !! 'key_traldf_c2d': latitude and longitude dependent coef. 54 !! defined in ldf_tra_c2d routine 55 !! 'key_traldf_c3d': latitude, longitude, depth dependent coef. 56 !! defined in ldf_tra_c3d routine 57 !! 58 !! N.B. User defined include files. By default, 3d and 2d coef. 59 !! are set to a constant value given in the namelist and the 1d 60 !! coefficients are initialized to a hyperbolic tangent vertical 61 !! profile. 62 !!---------------------------------------------------------------------- 63 INTEGER :: ioptio ! temporary integer 64 INTEGER :: ios ! temporary integer 65 LOGICAL :: ll_print = .FALSE. ! =T print eddy coef. in numout 66 !! 67 NAMELIST/namtra_ldf/ ln_traldf_lap , ln_traldf_bilap, & 68 & ln_traldf_level, ln_traldf_hor , ln_traldf_iso, & 69 & ln_traldf_grif , ln_traldf_gdia , & 70 & ln_triad_iso , ln_botmix_grif , & 71 & rn_aht_0 , rn_ahtb_0 , rn_aeiv_0, & 72 & rn_slpmax , rn_chsmag , rn_smsh, & 73 & rn_aht_m 74 !!---------------------------------------------------------------------- 75 76 ! Define the lateral tracer physics parameters 77 ! ============================================= 78 79 99 !! ** Method : * the eddy diffusivity coef. specification depends on: 100 !! 101 !! ln_traldf_lap = T laplacian operator 102 !! ln_traldf_blp = T bilaplacian operator 103 !! 104 !! nn_aht_ijk_t = 0 => = constant 105 !! ! 106 !! = 10 => = F(z) : constant with a reduction of 1/4 with depth 107 !! ! 108 !! =-20 => = F(i,j) = shape read in 'eddy_diffusivity.nc' file 109 !! = 20 = F(i,j) = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case) 110 !! = 21 = F(i,j,t) = F(growth rate of baroclinic instability) 111 !! ! 112 !! =-30 => = F(i,j,k) = shape read in 'eddy_diffusivity.nc' file 113 !! = 30 = F(i,j,k) = 2D (case 20) + decrease with depth (case 10) 114 !! = 31 = F(i,j,k,t) = F(local velocity) ( |u|e /12 laplacian operator 115 !! or |u|e^3/12 bilaplacian operator ) 116 !! * initialisation of the eddy induced velocity coefficient by a call to ldf_eiv_init 117 !! 118 !! ** action : ahtu, ahtv initialized once for all or l_ldftra_time set to true 119 !! aeiu, aeiv initialized once for all or l_ldfeiv_time set to true 120 !!---------------------------------------------------------------------- 121 INTEGER :: jk ! dummy loop indices 122 INTEGER :: ierr, inum, ios ! local integer 123 REAL(wp) :: zah0 ! local scalar 124 ! 125 NAMELIST/namtra_ldf/ ln_traldf_lap, ln_traldf_blp, & ! type of operator 126 & ln_traldf_lev, ln_traldf_hor, ln_traldf_triad, & ! acting direction of the operator 127 & ln_traldf_iso, ln_traldf_msc, & ! option for iso-neutral operator 128 & ln_triad_iso , ln_botmix_triad, rn_slpmax , & ! 129 & rn_aht_0 , rn_bht_0 , nn_aht_ijk_t ! lateral eddy coefficient 130 !!---------------------------------------------------------------------- 131 ! 132 ! Choice of lateral tracer physics 133 ! ================================= 134 ! 80 135 REWIND( numnam_ref ) ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers 81 136 READ ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901) 82 137 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp ) 83 138 ! 84 139 REWIND( numnam_cfg ) ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers 85 140 READ ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 ) 86 141 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp ) 87 142 WRITE ( numond, namtra_ldf ) 88 143 ! 89 144 IF(lwp) THEN ! control print 90 145 WRITE(numout,*) … … 92 147 WRITE(numout,*) '~~~~~~~~~~~~ ' 93 148 WRITE(numout,*) ' Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)' 94 WRITE(numout,*) ' laplacian operator ln_traldf_lap = ', ln_traldf_lap 95 WRITE(numout,*) ' bilaplacian operator ln_traldf_bilap = ', ln_traldf_bilap 96 WRITE(numout,*) ' iso-level ln_traldf_level = ', ln_traldf_level 97 WRITE(numout,*) ' horizontal (geopotential) ln_traldf_hor = ', ln_traldf_hor 98 WRITE(numout,*) ' iso-neutral ln_traldf_iso = ', ln_traldf_iso 99 WRITE(numout,*) ' iso-neutral (Griffies) ln_traldf_grif = ', ln_traldf_grif 100 WRITE(numout,*) ' Griffies strmfn diagnostics ln_traldf_gdia = ', ln_traldf_gdia 101 WRITE(numout,*) ' lateral eddy diffusivity rn_aht_0 = ', rn_aht_0 102 WRITE(numout,*) ' background hor. diffusivity rn_ahtb_0 = ', rn_ahtb_0 103 WRITE(numout,*) ' eddy induced velocity coef. rn_aeiv_0 = ', rn_aeiv_0 104 WRITE(numout,*) ' maximum isoppycnal slope rn_slpmax = ', rn_slpmax 105 WRITE(numout,*) ' pure lateral mixing in ML ln_triad_iso = ', ln_triad_iso 106 WRITE(numout,*) ' lateral mixing on bottom ln_botmix_grif = ', ln_botmix_grif 149 ! 150 WRITE(numout,*) ' type :' 151 WRITE(numout,*) ' laplacian operator ln_traldf_lap = ', ln_traldf_lap 152 WRITE(numout,*) ' bilaplacian operator ln_traldf_blp = ', ln_traldf_blp 153 ! 154 WRITE(numout,*) ' direction of action :' 155 WRITE(numout,*) ' iso-level ln_traldf_lev = ', ln_traldf_lev 156 WRITE(numout,*) ' horizontal (geopotential) ln_traldf_hor = ', ln_traldf_hor 157 WRITE(numout,*) ' iso-neutral Madec operator ln_traldf_iso = ', ln_traldf_iso 158 WRITE(numout,*) ' iso-neutral triad operator ln_traldf_triad = ', ln_traldf_triad 159 WRITE(numout,*) ' iso-neutral (Method of Stab. Corr.) ln_traldf_msc = ', ln_traldf_msc 160 WRITE(numout,*) ' maximum isoppycnal slope rn_slpmax = ', rn_slpmax 161 WRITE(numout,*) ' pure lateral mixing in ML ln_triad_iso = ', ln_triad_iso 162 WRITE(numout,*) ' lateral mixing on bottom ln_botmix_triad = ', ln_botmix_triad 163 ! 164 WRITE(numout,*) ' coefficients :' 165 WRITE(numout,*) ' lateral eddy diffusivity (lap case) rn_aht_0 = ', rn_aht_0 166 WRITE(numout,*) ' lateral eddy diffusivity (bilap case) rn_bht_0 = ', rn_bht_0 167 WRITE(numout,*) ' type of time-space variation nn_aht_ijk_t = ', nn_aht_ijk_t 168 ENDIF 169 ! 170 ! ! Parameter control 171 ! 172 IF( ln_traldf_blp .AND. ( ln_traldf_iso .OR. ln_traldf_triad) ) THEN ! iso-neutral bilaplacian need MSC 173 IF( .NOT.ln_traldf_msc ) CALL ctl_stop( 'tra_ldf_init: iso-neutral bilaplacian requires ln_traldf_msc=.true.' ) 174 ENDIF 175 ! 176 ! 177 ! Space/time variation of eddy coefficients 178 ! =========================================== 179 ! ! allocate the aht arrays 180 ALLOCATE( ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , STAT=ierr ) 181 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays') 182 ! 183 ahtu(:,:,jpk) = 0._wp ! last level always 0 184 ahtv(:,:,jpk) = 0._wp 185 ! 186 ! ! value of eddy mixing coef. 187 IF ( ln_traldf_lap ) THEN ; zah0 = rn_aht_0 ! laplacian operator 188 ELSEIF( ln_traldf_blp ) THEN ; zah0 = SQRT( ABS( rn_bht_0 ) ) ! bilaplacian operator 189 ELSE ! NO diffusion/viscosity operator 190 CALL ctl_warn( 'ldf_tra_init: No lateral diffusive operator used ' ) 191 ENDIF 192 ! 193 l_ldftra_time = .FALSE. ! no time variation except in case defined below 194 ! 195 IF( ln_traldf_lap .OR. ln_traldf_blp ) THEN ! only if a lateral diffusion operator is used 196 ! 197 SELECT CASE( nn_aht_ijk_t ) ! Specification of space time variations of ehtu, ahtv 198 ! 199 CASE( 0 ) !== constant ==! 200 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = constant = ', rn_aht_0 201 ahtu(:,:,:) = zah0 * umask(:,:,:) 202 ahtv(:,:,:) = zah0 * vmask(:,:,:) 203 ! 204 CASE( 10 ) !== fixed profile ==! 205 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( depth )' 206 ahtu(:,:,1) = zah0 * umask(:,:,1) ! constant surface value 207 ahtv(:,:,1) = zah0 * vmask(:,:,1) 208 CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 209 ! 210 CASE ( -20 ) !== fixed horizontal shape read in file ==! 211 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F(i,j) read in eddy_diffusivity.nc file' 212 CALL iom_open( 'eddy_diffusivity.nc', inum ) 213 CALL iom_get ( inum, jpdom_data, 'ahtu_2D', ahtu(:,:,1) ) 214 CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 215 CALL iom_close( inum ) 216 DO jk = 2, jpkm1 217 ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 218 ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 219 END DO 220 ! 221 CASE( 20 ) !== fixed horizontal shape ==! 222 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or blp case)' 223 IF( ln_traldf_lap ) CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor 224 IF( ln_traldf_blp ) CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor 225 ! 226 CASE( 21 ) !== time varying 2D field ==! 227 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, time )' 228 IF(lwp) WRITE(numout,*) ' = F( growth rate of baroclinic instability )' 229 IF(lwp) WRITE(numout,*) ' min value = 0.1 * rn_aht_0' 230 IF(lwp) WRITE(numout,*) ' max value = rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)' 231 IF(lwp) WRITE(numout,*) ' increased to rn_aht_0 within 20N-20S' 232 ! 233 l_ldftra_time = .TRUE. ! will be calculated by call to ldf_tra routine in step.F90 234 ! 235 IF( ln_traldf_blp ) THEN 236 CALL ctl_stop( 'ldf_tra_init: aht=F(growth rate of baroc. insta.) incompatible with bilaplacian operator' ) 237 ENDIF 238 ! 239 CASE( -30 ) !== fixed 3D shape read in file ==! 240 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F(i,j,k) read in eddy_diffusivity.nc file' 241 CALL iom_open( 'eddy_diffusivity.nc', inum ) 242 CALL iom_get ( inum, jpdom_data, 'ahtu_3D', ahtu ) 243 CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 244 CALL iom_close( inum ) 245 DO jk = 1, jpkm1 246 ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk) 247 ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk) 248 END DO 249 ! 250 CASE( 30 ) !== fixed 3D shape ==! 251 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, depth )' 252 IF( ln_traldf_lap ) CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor 253 IF( ln_traldf_blp ) CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor 254 ! ! reduction with depth 255 CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 256 ! 257 CASE( 31 ) !== time varying 3D field ==! 258 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, depth , time )' 259 IF(lwp) WRITE(numout,*) ' proportional to the velocity : |u|e/12 or |u|e^3/12' 260 ! 261 l_ldftra_time = .TRUE. ! will be calculated by call to ldf_tra routine in step.F90 262 ! 263 CASE DEFAULT 264 CALL ctl_stop('ldf_tra_init: wrong choice for nn_aht_ijk_t, the type of space-time variation of aht') 265 END SELECT 266 ! 267 ENDIF 268 ! 269 END SUBROUTINE ldf_tra_init 270 271 272 SUBROUTINE ldf_tra( kt ) 273 !!---------------------------------------------------------------------- 274 !! *** ROUTINE ldf_tra *** 275 !! 276 !! ** Purpose : update at kt the tracer lateral mixing coeff. (aht and aeiv) 277 !! 278 !! ** Method : time varying eddy diffusivity coefficients: 279 !! 280 !! nn_aei_ijk_t = 21 aeiu, aeiv = F(i,j,t) = F(growth rate of baroclinic instability) 281 !! with a reduction to 0 in vicinity of the Equator 282 !! nn_aht_ijk_t = 21 ahtu, ahtv = F(i,j,t) = F(growth rate of baroclinic instability) 283 !! 284 !! = 31 ahtu, ahtv = F(i,j,k,t) = F(local velocity) ( |u|e /12 laplacian operator 285 !! or |u|e^3/12 bilaplacian operator ) 286 !! 287 !! ** action : ahtu, ahtv update at each time step 288 !! and/or aeiu, aeiv - - - - 289 !!---------------------------------------------------------------------- 290 INTEGER, INTENT(in) :: kt ! time step 291 ! 292 INTEGER :: ji, jj, jk ! dummy loop indices 293 REAL(wp) :: zaht, zaht_min, z1_f20 ! local scalar 294 !!---------------------------------------------------------------------- 295 ! 296 IF( nn_aei_ijk_t == 21 ) THEN ! eddy induced velocity coefficients 297 ! ! =F(growth rate of baroclinic instability) 298 ! ! max value rn_aeiv_0 ; decreased to 0 within 20N-20S 299 CALL ldf_eiv( kt, rn_aeiv_0, aeiu, aeiv ) 300 IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt , ldf_eiv appel', kt 301 ENDIF 302 ! 303 SELECT CASE( nn_aht_ijk_t ) ! Eddy diffusivity coefficients 304 ! 305 CASE( 21 ) !== time varying 2D field ==! = F( growth rate of baroclinic instability ) 306 ! ! min value rn_aht_0 / 10 307 ! ! max value rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21) 308 ! ! increase to rn_aht_0 within 20N-20S 309 310 311 IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt ,nn_aei_ijk_t, aeiuv max', kt, & 312 & nn_aei_ijk_t, MAXVAL( aeiu(:,:,1) ), MAXVAL( aeiv(:,:,1) ) 313 314 315 IF( nn_aei_ijk_t /= 21 ) THEN 316 CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv ) 317 IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt , ldf_eiv appel 2', kt 318 ELSE 319 ahtu(:,:,1) = aeiu(:,:,1) 320 ahtv(:,:,1) = aeiv(:,:,1) 321 IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt , ahtu=aeiu', kt 322 ENDIF 323 324 IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt , ahtuv max ', kt, MAXVAL( ahtu(:,:,1) ), MAXVAL( ahtv(:,:,1) ) 325 326 ! 327 z1_f20 = 1._wp / ( 2._wp * omega * SIN( rad * 20._wp ) ) ! 1 / ff(20 degrees) 328 zaht_min = 0.2_wp * rn_aht_0 ! minimum value for aht 329 330 IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' kt , aht0 et ahtmin', kt, rn_aht_0, zaht_min 331 332 DO jj = 1, jpj 333 DO ji = 1, jpi 334 zaht = ( 1._wp - MIN( 1._wp , ABS( ff(ji,jj) * z1_f20 ) ) ) * ( rn_aht_0 - zaht_min ) 335 !! IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' avant zaht, ahtuv', zaht, ahtu(ji,jj,1), ahtv(ji,jj,1), zaht_min, ji,jj 336 !! IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' avant zaht, aeiuv', zaht, aeiu(ji,jj,1), aeiv(ji,jj,1) 337 ahtu(ji,jj,1) = ( MAX( zaht_min, ahtu(ji,jj,1) ) + zaht ) * umask(ji,jj,1) ! min value zaht_min 338 ahtv(ji,jj,1) = ( MAX( zaht_min, ahtv(ji,jj,1) ) + zaht ) * vmask(ji,jj,1) ! increase within 20S-20N 339 !! IF(lwp .AND. kt<=nit000+20 ) write(numout,*) ' zaht et ahtu ahtv', zaht, ahtu(ji,jj,1), ahtv(ji,jj,1) 340 END DO 341 END DO 342 !! IF(lwp ) write(numout,*) ' max ahtu ahtv', MAXVAL( ahtu(:,:,1) ), MAXVAL( ahtv(:,:,1) ) 343 DO jk = 2, jpkm1 ! deeper value = surface value 344 ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 345 ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 346 END DO 347 ! 348 CASE( 31 ) !== time varying 3D field ==! = F( local velocity ) 349 IF( ln_traldf_lap ) THEN ! laplacian operator 350 DO jk = 1, jpkm1 351 ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 352 ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 353 END DO 354 ELSEIF( ln_traldf_blp ) THEN ! bilaplacian operator 355 DO jk = 1, jpkm1 356 ahtu(:,:,jk) = SQRT( ABS( ub(:,:,jk) ) * e1u(:,:) * e1u(:,:) * e1u(:,:) * r1_12 ) 357 ahtv(:,:,jk) = SQRT( ABS( vb(:,:,jk) ) * e2v(:,:) * e2v(:,:) * e2v(:,:) * r1_12 ) 358 END DO 359 ENDIF 360 ! 361 END SELECT 362 ! 363 CALL iom_put( "ahtu_2d", ahtu(:,:,1) ) ! surface u-eddy diffusivity coeff. 364 CALL iom_put( "ahtv_2d", ahtv(:,:,1) ) ! surface v-eddy diffusivity coeff. 365 CALL iom_put( "ahtu_3d", ahtu(:,:,:) ) ! 3D u-eddy diffusivity coeff. 366 CALL iom_put( "ahtv_3d", ahtv(:,:,:) ) ! 3D v-eddy diffusivity coeff. 367 ! 368 CALL iom_put( "aeiu_2d", aeiu(:,:,1) ) ! surface u-EIV coeff. 369 CALL iom_put( "aeiv_2d", aeiv(:,:,1) ) ! surface v-EIV coeff. 370 CALL iom_put( "aeiu_3d", aeiu(:,:,:) ) ! 3D u-EIV coeff. 371 CALL iom_put( "aeiv_3d", aeiv(:,:,:) ) ! 3D v-EIV coeff. 372 ! 373 END SUBROUTINE ldf_tra 374 375 376 SUBROUTINE ldf_eiv_init 377 !!---------------------------------------------------------------------- 378 !! *** ROUTINE ldf_eiv_init *** 379 !! 380 !! ** Purpose : initialization of the eiv coeff. from namelist choices. 381 !! 382 !! ** Method : 383 !! 384 !! ** Action : aeiu , aeiv : EIV coeff. at u- & v-points 385 !! l_ldfeiv_time : =T if EIV coefficients vary with time 386 !!---------------------------------------------------------------------- 387 INTEGER :: jk ! dummy loop indices 388 INTEGER :: ierr, inum, ios ! local integer 389 ! 390 NAMELIST/namtra_ldfeiv/ ln_ldfeiv , ln_ldfeiv_dia, & ! eddy induced velocity (eiv) 391 & nn_aei_ijk_t, rn_aeiv_0 ! eiv coefficient 392 !!---------------------------------------------------------------------- 393 ! 394 REWIND( numnam_ref ) ! Namelist namtra_ldfeiv in reference namelist : eddy induced velocity param. 395 READ ( numnam_ref, namtra_ldfeiv, IOSTAT = ios, ERR = 901) 396 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in reference namelist', lwp ) 397 ! 398 REWIND( numnam_cfg ) ! Namelist namtra_ldfeiv in configuration namelist : eddy induced velocity param. 399 READ ( numnam_cfg, namtra_ldfeiv, IOSTAT = ios, ERR = 902 ) 400 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in configuration namelist', lwp ) 401 WRITE ( numond, namtra_ldfeiv ) 402 403 IF(lwp) THEN ! control print 107 404 WRITE(numout,*) 108 ENDIF 109 110 ! ! convert DOCTOR namelist names into OLD names 111 aht0 = rn_aht_0 112 ahtb0 = rn_ahtb_0 113 aeiv0 = rn_aeiv_0 114 115 ! ! Parameter control 116 117 ! ... Check consistency for type and direction : 118 ! ==> will be done in traldf module 119 120 ! ... Space variation of eddy coefficients 121 ioptio = 0 122 #if defined key_traldf_c3d 123 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, depth)' 124 ioptio = ioptio + 1 125 #endif 126 #if defined key_traldf_c2d 127 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude)' 128 ioptio = ioptio + 1 129 #endif 130 #if defined key_traldf_c1d 131 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( depth )' 132 ioptio = ioptio + 1 133 IF( .NOT. ln_zco ) CALL ctl_stop( 'key_traldf_c1d can only be used in z-coordinate - full step' ) 134 #endif 135 IF( ioptio == 0 ) THEN 136 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = constant (default option)' 137 ELSEIF( ioptio > 1 ) THEN 138 CALL ctl_stop(' use only one of the following keys:', & 139 & ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d' ) 140 ENDIF 141 142 IF( ln_traldf_bilap ) THEN 143 IF(lwp) WRITE(numout,*) ' biharmonic tracer diffusion' 144 IF( aht0 > 0 .AND. .NOT. lk_esopa ) CALL ctl_stop( 'The horizontal diffusivity coef. aht0 must be negative' ) 405 WRITE(numout,*) 'ldf_eiv_init : eddy induced velocity parametrization' 406 WRITE(numout,*) '~~~~~~~~~~~~ ' 407 WRITE(numout,*) ' Namelist namtra_ldfeiv : ' 408 WRITE(numout,*) ' Eddy Induced Velocity (eiv) param. ln_ldfeiv = ', ln_ldfeiv 409 WRITE(numout,*) ' eiv streamfunction & velocity diag. ln_ldfeiv_dia = ', ln_ldfeiv_dia 410 WRITE(numout,*) ' eddy induced velocity coef. rn_aeiv_0 = ', rn_aeiv_0 411 WRITE(numout,*) ' type of time-space variation nn_aei_ijk_t = ', nn_aei_ijk_t 412 WRITE(numout,*) 413 ENDIF 414 ! 415 IF( ln_traldf_blp ) CALL ctl_stop( 'ldf_eiv_init: bilaplacian and eddy induced velocity are not compatible' ) 416 417 ! ! Parameter control 418 l_ldfeiv_time = .FALSE. 419 ! 420 IF( ln_ldfeiv ) THEN ! allocate the aei arrays 421 ALLOCATE( aeiu(jpi,jpj,jpk), aeiv(jpi,jpj,jpk), STAT=ierr ) 422 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ldf_eiv: failed to allocate arrays') 423 ! 424 SELECT CASE( nn_aei_ijk_t ) ! Specification of space time variations of eaiu, aeiv 425 ! 426 CASE( 0 ) !== constant ==! 427 IF(lwp) WRITE(numout,*) ' eddy induced velocity coef. = constant = ', rn_aeiv_0 428 aeiu(:,:,:) = rn_aeiv_0 429 aeiv(:,:,:) = rn_aeiv_0 430 ! 431 CASE( 10 ) !== fixed profile ==! 432 IF(lwp) WRITE(numout,*) ' eddy induced velocity coef. = F( depth )' 433 aeiu(:,:,1) = rn_aeiv_0 ! constant surface value 434 aeiv(:,:,1) = rn_aeiv_0 435 CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 436 ! 437 CASE ( -20 ) !== fixed horizontal shape read in file ==! 438 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F(i,j) read in eddy_diffusivity_2D.nc file' 439 CALL iom_open ( 'eddy_induced_velocity_2D.nc', inum ) 440 CALL iom_get ( inum, jpdom_data, 'aeiu', aeiu(:,:,1) ) 441 CALL iom_get ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 442 CALL iom_close( inum ) 443 DO jk = 2, jpk 444 aeiu(:,:,jk) = aeiu(:,:,1) 445 aeiv(:,:,jk) = aeiv(:,:,1) 446 END DO 447 ! 448 CASE( 20 ) !== fixed horizontal shape ==! 449 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or bilap case)' 450 CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv ) ! surface value proportional to scale factor 451 ! 452 CASE( 21 ) !== time varying 2D field ==! 453 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, time )' 454 IF(lwp) WRITE(numout,*) ' = F( growth rate of baroclinic instability )' 455 ! 456 l_ldfeiv_time = .TRUE. ! will be calculated by call to ldf_tra routine in step.F90 457 ! 458 CASE( -30 ) !== fixed 3D shape read in file ==! 459 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 460 CALL iom_open ( 'eddy_induced_velocity_3D.nc', inum ) 461 CALL iom_get ( inum, jpdom_data, 'aeiu', aeiu ) 462 CALL iom_get ( inum, jpdom_data, 'aeiv', aeiv ) 463 CALL iom_close( inum ) 464 ! 465 CASE( 30 ) !== fixed 3D shape ==! 466 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, depth )' 467 CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv ) ! surface value proportional to scale factor 468 ! ! reduction with depth 469 CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 470 ! 471 CASE DEFAULT 472 CALL ctl_stop('ldf_tra_init: wrong choice for nn_aei_ijk_t, the type of space-time variation of aei') 473 END SELECT 474 ! 145 475 ELSE 146 IF(lwp) WRITE(numout,*) ' harmonic tracer diffusion (default)' 147 IF( aht0 < 0 .AND. .NOT. lk_esopa ) CALL ctl_stop('The horizontal diffusivity coef. aht0 must be positive' ) 148 ENDIF 149 150 151 ! Lateral eddy diffusivity and eddy induced velocity coefficients 152 ! ================================================================ 153 #if defined key_traldf_c3d 154 CALL ldf_tra_c3d( ll_print ) ! aht = 3D coef. = F( longitude, latitude, depth ) 155 #elif defined key_traldf_c2d 156 CALL ldf_tra_c2d( ll_print ) ! aht = 2D coef. = F( longitude, latitude ) 157 #elif defined key_traldf_c1d 158 CALL ldf_tra_c1d( ll_print ) ! aht = 1D coef. = F( depth ) 159 #else 160 ! Constant coefficients 161 IF(lwp)WRITE(numout,*) 162 IF(lwp)WRITE(numout,*) ' constant eddy diffusivity coef. ahtu = ahtv = ahtw = aht0 = ', aht0 163 IF( lk_traldf_eiv ) THEN 164 IF(lwp)WRITE(numout,*) ' constant eddy induced velocity coef. aeiu = aeiv = aeiw = aeiv0 = ', aeiv0 476 IF(lwp) WRITE(numout,*) ' eddy induced velocity param is NOT used neither diagnosed' 477 ln_ldfeiv_dia = .FALSE. 478 ENDIF 479 ! 480 END SUBROUTINE ldf_eiv_init 481 482 483 SUBROUTINE ldf_eiv( kt, paei0, paeiu, paeiv ) 484 !!---------------------------------------------------------------------- 485 !! *** ROUTINE ldf_eiv *** 486 !! 487 !! ** Purpose : Compute the eddy induced velocity coefficient from the 488 !! growth rate of baroclinic instability. 489 !! 490 !! ** Method : coefficient function of the growth rate of baroclinic instability 491 !! 492 !! Reference : Treguier et al. JPO 1997 ; Held and Larichev JAS 1996 493 !!---------------------------------------------------------------------- 494 INTEGER , INTENT(in ) :: kt ! ocean time-step index 495 REAL(wp) , INTENT(inout) :: paei0 ! max value [m2/s] 496 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: paeiu, paeiv ! eiv coefficient [m2/s] 497 ! 498 INTEGER :: ji, jj, jk ! dummy loop indices 499 REAL(wp) :: zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei ! local scalars 500 REAL(wp), DIMENSION(:,:), POINTER :: zn, zah, zhw, zross, zaeiw ! 2D workspace 501 !!---------------------------------------------------------------------- 502 ! 503 IF( nn_timing == 1 ) CALL timing_start('ldf_eiv') 504 ! 505 CALL wrk_alloc( jpi,jpj, zn, zah, zhw, zross, zaeiw ) 506 ! 507 zn (:,:) = 0._wp ! Local initialization 508 zhw (:,:) = 5._wp 509 zah (:,:) = 0._wp 510 zross(:,:) = 0._wp 511 ! ! Compute lateral diffusive coefficient at T-point 512 IF( ln_traldf_triad ) THEN 513 DO jk = 1, jpk 514 DO jj = 2, jpjm1 515 DO ji = 2, jpim1 516 ! Take the max of N^2 and zero then take the vertical sum 517 ! of the square root of the resulting N^2 ( required to compute 518 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 519 zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 520 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk) 521 ! Compute elements required for the inverse time scale of baroclinic 522 ! eddies using the isopycnal slopes calculated in ldfslp.F : 523 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 524 ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk) 525 zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w 526 zhw(ji,jj) = zhw(ji,jj) + ze3w 527 END DO 528 END DO 529 END DO 530 ELSE 531 DO jk = 1, jpk 532 DO jj = 2, jpjm1 533 DO ji = 2, jpim1 534 ! Take the max of N^2 and zero then take the vertical sum 535 ! of the square root of the resulting N^2 ( required to compute 536 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 537 zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 538 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk) 539 ! Compute elements required for the inverse time scale of baroclinic 540 ! eddies using the isopycnal slopes calculated in ldfslp.F : 541 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 542 ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk) 543 zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 544 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w 545 zhw(ji,jj) = zhw(ji,jj) + ze3w 546 END DO 547 END DO 548 END DO 549 END IF 550 551 DO jj = 2, jpjm1 552 DO ji = fs_2, fs_jpim1 ! vector opt. 553 zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) 554 ! Rossby radius at w-point taken < 40km and > 2km 555 zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 ) 556 ! Compute aeiw by multiplying Ro^2 and T^-1 557 zaeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1) 558 END DO 559 END DO 560 561 !!gm IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 562 !!gm DO jj = 2, jpjm1 563 !!gm DO ji = fs_2, fs_jpim1 ! vector opt. 564 !!gm ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m) 565 !!gm IF( mbkt(ji,jj) <= 20 ) zaeiw(ji,jj) = MIN( zaeiw(ji,jj), 1000. ) 566 !!gm END DO 567 !!gm END DO 568 !!gm ENDIF 569 570 ! !== Bound on eiv coeff. ==! 571 z1_f20 = 1._wp / ( 2._wp * omega * sin( rad * 20._wp ) ) 572 DO jj = 2, jpjm1 573 DO ji = fs_2, fs_jpim1 ! vector opt. 574 zzaei = MIN( 1._wp, ABS( ff(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj) ! tropical decrease 575 zaeiw(ji,jj) = MIN( zzaei , paei0 ) ! Max value = paei0 576 END DO 577 END DO 578 CALL lbc_lnk( zaeiw(:,:), 'W', 1. ) ! lateral boundary condition 579 ! 580 DO jj = 2, jpjm1 !== aei at u- and v-points ==! 581 DO ji = fs_2, fs_jpim1 ! vector opt. 582 paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj ) ) * umask(ji,jj,1) 583 paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji ,jj+1) ) * vmask(ji,jj,1) 584 END DO 585 END DO 586 CALL lbc_lnk( paeiu(:,:,1), 'U', 1. ) ; CALL lbc_lnk( paeiv(:,:,1), 'V', 1. ) ! lateral boundary condition 587 588 DO jk = 2, jpkm1 !== deeper values equal the surface one ==! 589 paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk) 590 paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk) 591 END DO 592 ! 593 CALL wrk_dealloc( jpi,jpj, zn, zah, zhw, zross, zaeiw ) 594 ! 595 IF( nn_timing == 1 ) CALL timing_stop('ldf_eiv') 596 ! 597 END SUBROUTINE ldf_eiv 598 599 600 SUBROUTINE ldf_eiv_trp( kt, kit000, pun, pvn, pwn, cdtype ) 601 !!---------------------------------------------------------------------- 602 !! *** ROUTINE ldf_eiv_trp *** 603 !! 604 !! ** Purpose : add to the input ocean transport the contribution of 605 !! the eddy induced velocity parametrization. 606 !! 607 !! ** Method : The eddy induced transport is computed from a flux stream- 608 !! function which depends on the slope of iso-neutral surfaces 609 !! (see ldf_slp). For example, in the i-k plan : 610 !! psi_uw = mk(aeiu) e2u mi(wslpi) [in m3/s] 611 !! Utr_eiv = - dk[psi_uw] 612 !! Vtr_eiv = + di[psi_uw] 613 !! ln_traldf_eiv_dia = T : output the associated streamfunction, 614 !! velocity and heat transport (call ldf_eiv_dia) 615 !! 616 !! ** Action : pun, pvn increased by the eiv transport 617 !!---------------------------------------------------------------------- 618 INTEGER , INTENT(in ) :: kt ! ocean time-step index 619 INTEGER , INTENT(in ) :: kit000 ! first time step index 620 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 621 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pun ! in : 3 ocean transport components [m3/s] 622 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pvn ! out: 3 ocean transport components [m3/s] 623 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pwn ! increased by the eiv [m3/s] 624 !! 625 INTEGER :: ji, jj, jk ! dummy loop indices 626 REAL(wp) :: zuwk, zuwk1, zuwi, zuwi1 ! local scalars 627 REAL(wp) :: zvwk, zvwk1, zvwj, zvwj1 ! - - 628 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpsi_uw, zpsi_vw 629 !!---------------------------------------------------------------------- 630 ! 631 IF( nn_timing == 1 ) CALL timing_start( 'ldf_eiv_trp') 632 ! 633 CALL wrk_alloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw ) 634 635 IF( kt == kit000 ) THEN 636 IF(lwp) WRITE(numout,*) 637 IF(lwp) WRITE(numout,*) 'ldf_eiv_trp : eddy induced advection on ', cdtype,' :' 638 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ add to velocity fields the eiv component' 639 ENDIF 640 165 641 166 ENDIF 167 #endif 168 169 #if defined key_traldf_smag && ! defined key_traldf_c3d 170 CALL ctl_stop( 'key_traldf_smag can only be used with key_traldf_c3d' ) 171 #endif 172 #if defined key_traldf_smag 173 IF(lwp) WRITE(numout,*)' SMAGORINSKY DIFFUSION' 174 IF(lwp .AND. rn_smsh < 1) WRITE(numout,*)' only shear is used ' 175 IF(lwp.and.ln_traldf_bilap) CALL ctl_stop(' SMAGORINSKY + BILAPLACIAN - UNSTABLE OR NON_CONSERVATIVE' ) 176 #endif 177 178 ! 179 END SUBROUTINE ldf_tra_init 180 181 #if defined key_traldf_c3d 182 # include "ldftra_c3d.h90" 183 #elif defined key_traldf_c2d 184 # include "ldftra_c2d.h90" 185 #elif defined key_traldf_c1d 186 # include "ldftra_c1d.h90" 187 #endif 642 zpsi_uw(:,:, 1 ) = 0._wp ; zpsi_vw(:,:, 1 ) = 0._wp 643 zpsi_uw(:,:,jpk) = 0._wp ; zpsi_vw(:,:,jpk) = 0._wp 644 645 DO jk = 2, jpkm1 646 DO jj = 1, jpjm1 647 DO ji = 1, fs_jpim1 ! vector opt. 648 zpsi_uw(ji,jj,jk) = - 0.25_wp * e2u(ji,jj) * ( wslpi(ji,jj,jk ) + wslpi(ji+1,jj,jk) ) & 649 & * ( aeiu (ji,jj,jk-1) + aeiu (ji ,jj,jk) ) * umask(ji,jj,jk) 650 zpsi_vw(ji,jj,jk) = - 0.25_wp * e1v(ji,jj) * ( wslpj(ji,jj,jk ) + wslpj(ji,jj+1,jk) ) & 651 & * ( aeiv (ji,jj,jk-1) + aeiv (ji,jj ,jk) ) * vmask(ji,jj,jk) 652 END DO 653 END DO 654 END DO 655 656 DO jk = 1, jpkm1 657 DO jj = 1, jpjm1 658 DO ji = 1, fs_jpim1 ! vector opt. 659 pun(ji,jj,jk) = pun(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 660 pvn(ji,jj,jk) = pvn(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 661 END DO 662 END DO 663 END DO 664 DO jk = 1, jpkm1 665 DO jj = 2, jpjm1 666 DO ji = fs_2, fs_jpim1 ! vector opt. 667 pwn(ji,jj,jk) = pwn(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj ,jk) & 668 & + zpsi_vw(ji,jj,jk) - zpsi_vw(ji ,jj-1,jk) ) 669 END DO 670 END DO 671 END DO 672 673 ! ! diagnose the eddy induced velocity and associated heat transport 674 IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 675 ! 676 IF( nn_timing == 1 ) CALL timing_stop( 'ldf_eiv_trp') 677 ! 678 END SUBROUTINE ldf_eiv_trp 679 680 681 SUBROUTINE ldf_eiv_dia( psi_uw, psi_vw ) 682 !!---------------------------------------------------------------------- 683 !! *** ROUTINE ldf_eiv_dia *** 684 !! 685 !! ** Purpose : diagnose the eddy induced velocity and its associated 686 !! vertically integrated heat transport. 687 !! 688 !! ** Method : 689 !! 690 !!---------------------------------------------------------------------- 691 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: psi_uw, psi_vw ! streamfunction [m3/s] 692 ! 693 INTEGER :: ji, jj, jk ! dummy loop indices 694 REAL(wp) :: zztmp ! local scalar 695 REAL(wp), DIMENSION(:,:) , POINTER :: zw2d ! 2D workspace 696 REAL(wp), DIMENSION(:,:,:), POINTER :: zw3d ! 3D workspace 697 !!---------------------------------------------------------------------- 698 ! 699 IF( nn_timing == 1 ) CALL timing_start( 'ldf_eiv_dia') 700 ! 701 ! !== eiv stream function: output ==! 702 CALL lbc_lnk( psi_uw, 'U', -1. ) ! lateral boundary condition 703 CALL lbc_lnk( psi_vw, 'V', -1. ) 704 ! 705 !!gm CALL iom_put( "psi_eiv_uw", psi_uw ) ! output 706 !!gm CALL iom_put( "psi_eiv_vw", psi_vw ) 707 ! 708 ! !== eiv velocities: calculate and output ==! 709 CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 710 ! 711 zw3d(:,:,jpk) = 0._wp ! bottom value always 0 712 ! 713 DO jk = 1, jpkm1 ! e2u e3u u_eiv = -dk[psi_uw] 714 zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * fse3u(:,:,jk) ) 715 END DO 716 CALL iom_put( "uoce_eiv", zw3d ) 717 ! 718 DO jk = 1, jpkm1 ! e1v e3v v_eiv = -dk[psi_vw] 719 zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * fse3v(:,:,jk) ) 720 END DO 721 CALL iom_put( "voce_eiv", zw3d ) 722 ! 723 DO jk = 1, jpkm1 ! e1 e2 w_eiv = dk[psix] + dk[psix] 724 DO jj = 2, jpjm1 725 DO ji = fs_2, fs_jpim1 ! vector opt. 726 zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk) - psi_vw(ji ,jj-1,jk) & 727 & + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj ,jk) ) / e1e2t(ji,jj) 728 END DO 729 END DO 730 END DO 731 CALL lbc_lnk( zw3d, 'T', 1. ) ! lateral boundary condition 732 CALL iom_put( "woce_eiv", zw3d ) 733 ! 734 CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 735 ! 736 ! 737 IF( lk_diaar5 ) THEN !== eiv heat transport: calculate and output ==! 738 CALL wrk_alloc( jpi, jpj, zw2d ) 739 ! 740 zztmp = 0.5_wp * rau0 * rcp 741 zw2d(:,:) = 0._wp 742 DO jk = 1, jpkm1 743 DO jj = 2, jpjm1 744 DO ji = fs_2, fs_jpim1 ! vector opt. 745 zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) & 746 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji+1,jj,jk,jp_tem) ) 747 END DO 748 END DO 749 END DO 750 CALL lbc_lnk( zw2d, 'U', -1. ) 751 CALL iom_put( "ueiv_heattr", zw2d ) ! heat transport in i-direction 752 zw2d(:,:) = 0._wp 753 DO jk = 1, jpkm1 754 DO jj = 2, jpjm1 755 DO ji = fs_2, fs_jpim1 ! vector opt. 756 zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) & 757 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji,jj+1,jk,jp_tem) ) 758 END DO 759 END DO 760 END DO 761 CALL lbc_lnk( zw2d, 'V', -1. ) 762 CALL iom_put( "veiv_heattr", zw2d ) ! heat transport in i-direction 763 ! 764 CALL wrk_dealloc( jpi, jpj, zw2d ) 765 ENDIF 766 ! 767 IF( nn_timing == 1 ) CALL timing_stop( 'ldf_eiv_dia') 768 ! 769 END SUBROUTINE ldf_eiv_dia 188 770 189 771 !!====================================================================== -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90
r3634 r4596 4 4 !! Ocean physics: variable eddy induced velocity coefficients 5 5 !!====================================================================== 6 #if defined key_traldf_smag && defined key_traldf_c3d 6 !! last modified : Maria Luneva, October 2012 7 !!---------------------------------------------------------------------- 8 #if defined key_traldf_smag 7 9 !!---------------------------------------------------------------------- 8 10 !! 'key_traldf_smag' and smagorinsky diffusivity 9 !! 'key_traldf_c3d' 3D tracer lateral mixing coef.10 11 !!---------------------------------------------------------------------- 11 !! ldf_ eiv : compute the eddy induced velocity coefficients12 !! ldf_tra_smag : compute the smagorinski eddy coefficients 12 13 !!---------------------------------------------------------------------- 13 !! * Modules used 14 USE oce ! ocean dynamics and tracers 15 USE dom_oce ! ocean space and time domain 16 USE sbc_oce ! surface boundary condition: ocean 17 USE sbcrnf ! river runoffs 18 USE ldftra_oce ! ocean tracer lateral physics 19 USE phycst ! physical constants 20 USE ldfslp ! iso-neutral slopes 21 USE in_out_manager ! I/O manager 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 USE prtctl ! Print control 24 USE iom 25 USE wrk_nemo 14 USE oce ! ocean dynamics and tracers 15 USE dom_oce ! ocean space and time domain 16 USE sbc_oce ! surface boundary condition: ocean 17 USE sbcrnf ! river runoffs 18 USE ldftra ! ocean tracer lateral physics 19 USE phycst ! physical constants 20 USE ldfslp ! iso-neutral slopes 21 ! 22 USE in_out_manager ! I/O manager 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 24 USE prtctl ! Print control 25 USE iom ! 26 USE ioipsl ! 27 USE wrk_nemo ! 28 26 29 IMPLICIT NONE 27 30 PRIVATE 28 31 29 !! * Routine accessibility30 32 PUBLIC ldf_tra_smag ! routine called by step.F90 31 !!---------------------------------------------------------------------- 32 !! OPA 9.0 , LOCEAN-IPSL (2005) 33 !! $Id: ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z $ 34 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 35 !!---------------------------------------------------------------------- 33 36 34 !! * Substitutions 37 35 # include "domzgr_substitute.h90" 38 36 # include "vectopt_loop_substitute.h90" 39 37 !!---------------------------------------------------------------------- 40 38 !! NEMO/OPA 3.6 , LOCEAN-IPSL (2014) 39 !! $Id: ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z $ 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 41 42 CONTAINS 42 43 43 44 45 46 47 !!----------------------------------------------------------------------48 !! *** ldf_tra_smag.F90 ***49 !!----------------------------------------------------------------------50 51 52 44 SUBROUTINE ldf_tra_smag( kt ) 53 !!----------------------------------------------------------------------54 45 !!---------------------------------------------------------------------- 55 46 !! *** ROUTINE ldf_tra_smag *** … … 75 66 !! : ahm3, ahm4 defined at U- and V-points 76 67 !! ??? explanation of the default is missing 77 !! last modified : Maria Luneva, October 201278 68 !!---------------------------------------------------------------------- 79 !! 80 !!---------------------------------------------------------------------- 81 !! * Modules used 82 USE ioipsl 83 REAL ( wp), POINTER , DIMENSION (:,:) :: zux, zvx , zuy , zvy 84 REAL ( wp), POINTER , DIMENSION (:,:) :: zue1, zue2 , zve1 , zve2 85 INTEGER, INTENT( in ) :: kt ! ocean time-step inedx 86 !! * Arguments 87 INTEGER :: ji,jj,jk 88 89 REAL (wp) :: zdeltau, zdeltav, zhsmag ,zsmsh ! temporary scalars 69 INTEGER, INTENT( in ) :: kt ! ocean time-step inedx 70 ! 71 INTEGER :: ji, jj, jk ! dummy loop indices 72 REAL(wp) :: zdeltau, zhsmag ! local scalars 73 REAL(wp) :: zdeltav, zsmsh , zcoef ! - - 74 REAL(wp), POINTER , DIMENSION (:,:) :: zux, zvx , zuy , zvy 75 REAL(wp), POINTER , DIMENSION (:,:) :: zue1, zue2 , zve1 , zve2 90 76 91 77 CALL wrk_alloc (jpi,jpj,zux, zvx , zuy , zvy ) 92 78 CALL wrk_alloc (jpi,jpj,zue1, zue2 , zve1 , zve2 ) 93 79 !!---------------------------------------------------------------------- 80 ! 94 81 IF( kt == nit000 ) THEN 95 82 IF(lwp) WRITE(numout,*) 96 83 IF(lwp) WRITE(numout,*) ' ldf_tra_smag : 3D eddy smagorinsky diffusivity ' 97 84 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~ -- ' 98 IF(lwp) WRITE(numout,*) ' Coefficients are computed'99 IF(lwp) WRITE(numout,*)100 IF(lwp) WRITE(numout,*)101 85 ENDIF 102 86 103 87 zhsmag = rn_chsmag 104 88 zsmsh = rn_smsh 105 zux(:,:) =0._wp ; zuy(:,:)=0._wp ; zvx(:,:)=0._wp ; zvy(:,:)=0._wp89 zux(:,:) = 0._wp ; zuy(:,:) = 0._wp ; zvx(:,:) = 0._wp ; zvy(:,:) = 0._wp 106 90 107 91 ! ------------------- 108 92 ahtt(:,:,:) = rn_aht_0 109 110 IF( lwp .AND. kt == nit000) WRITE(numout,* )'ldf_tra_smag :no bilaplacian Smagorinsky diffusivity'111 IF( lwp .AND. kt == nit000) WRITE(numout,* )'ldf_tra_smag :bilaplacian diffusivity set to constant'112 93 IF( ln_traldf_bilap ) THEN 94 IF( lwp .AND. kt == nit000) WRITE(numout,* ) 'ldf_tra_smag :no bilaplacian Smagorinsky diffusivity' 95 IF( lwp .AND. kt == nit000) WRITE(numout,* ) 'ldf_tra_smag :bilaplacian diffusivity set to constant' 96 ENDIF 113 97 114 98 … … 116 100 ! harmonic operator (U-, V-, W-points) 117 101 ! ----------------- 118 119 102 ahtu(:,:,:) = rn_aht_0 ! set ahtu , ahtv at u- and v-points, 120 103 ahtv(:,:,:) = rn_aht_0 ! and ahtw at w-point 121 ahtw(:,:,:) = rn_aht_0 ! (here example: no space variation)122 104 123 105 IF( ln_traldf_lap ) THEN 124 125 DO jk=1,jpk 126 127 zue2(:,:)=un(:,:,jk)/e2u(:,:) 128 zve1(:,:)=vn(:,:,jk)/e1v(:,:) 129 zue1(:,:)=un(:,:,jk)/e1u(:,:) 130 zve2(:,:)=vn(:,:,jk)/e2v(:,:) 131 132 133 DO jj=2,jpj 134 DO ji=2,jpi 135 zux(ji,jj)=(zue2(ji,jj)-zue2(ji-1,jj))/e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) * zsmsh 136 zvy(ji,jj)=(zve1(ji,jj)-zve1(ji,jj-1))/e2t(ji,jj)*e1t(ji,jj)*tmask(ji,jj,jk) * zsmsh 137 ENDDO 138 ENDDO 139 140 DO jj=1,jpjm1 141 DO ji=1,jpim1 142 zuy(ji,jj)=(zue1(ji,jj+1)-zue1(ji,jj))/e2f(ji,jj)*e1f(ji,jj)*fmask(ji,jj,jk) 143 zvx(ji,jj)=(zve2(ji+1,jj)-zve2(ji,jj))/e1f(ji,jj)*e2f(ji,jj)*fmask(ji,jj,jk) 144 ENDDO 145 ENDDO 146 147 148 DO jj=2,jpjm1 149 DO ji=2,jpim1 150 zdeltau=2._wp/( e1u(ji,jj)**(-2)+e2u(ji,jj)**(-2) ) 151 zdeltav=2._wp/( e1v(ji,jj)**(-2)+e2v(ji,jj)**(-2) ) 152 153 ahtu(ji,jj,jk)=MAX( rn_aht_0 , (zhsmag/rpi)**2*zdeltau* & 154 SQRT(0.25_wp*( zux(ji,jj)+zux(ji+1,jj)-zvy(ji,jj)-zvy(ji+1,jj) )**2+ & 155 0.25_wp*( zuy(ji,jj)+zuy(ji,jj-1)+zvx(ji,jj)+zvx(ji,jj-1) )**2) ) 156 157 ahtv(ji,jj,jk)=MAX( rn_aht_0 , (zhsmag/rpi)**2*zdeltav* & 158 SQRT(0.25_wp*( zux(ji,jj)+zux(ji,jj+1)-zvy(ji,jj)-zvy(ji,jj+1) )**2+ & 159 0.25_wp*( zuy(ji,jj)+zuy(ji-1,jj)+zvx(ji-1,jj)+zvx(ji,jj) )**2) ) 160 161 162 !!! stability criteria: aht<delta**2/(4*dt) dt=2*rdt , positiveness require aht<delta**2/(8*dt) 163 ahtu(ji,jj,jk)=MIN(ahtu(ji,jj,jk),zdeltau/(16*rdt) ,rn_aht_m) 164 ahtv(ji,jj,jk)=MIN(ahtv(ji,jj,jk),zdeltav/(16*rdt) ,rn_aht_m) 165 ! so... 166 167 168 ENDDO 169 ENDDO 170 ENDDO 171 ENDIF 172 ahtu(:,:,jpk) = ahtu(:,:,jpkm1) 173 ahtv(:,:,jpk) = ahtv(:,:,jpkm1) 174 CALL lbc_lnk( ahtu, 'U', 1. ) ! Lateral boundary conditions 175 CALL lbc_lnk( ahtv, 'V', 1. ) 176 177 IF( kt == nit000 ) THEN 178 179 IF(lwp ) THEN ! Control print 180 WRITE(numout,*) 181 WRITE(numout,*) 'inildf: ahtu at k = 1' 182 CALL prihre( ahtu(:,:,1), jpi, jpj, 1, jpi, 1, & 183 & 1, jpj, 1, 1.e-1, numout ) 184 WRITE(numout,*) 185 WRITE(numout,*) 'inildf: ahtv at k = 1' 186 CALL prihre( ahtv(:,:,1), jpi, jpj, 1, jpi, 1, & 187 & 1, jpj, 1, 1.e-1, numout ) 188 WRITE(numout,*) 189 WRITE(numout,*) 'inildf: ahtw at k = 1' 190 CALL prihre( ahtw(:,:,1), jpi, jpj, 1, jpi, 1, & 191 & 1, jpj, 1, 1.e-1, numout ) 106 ! 107 DO jk = 1 , jpkm1 108 zue2(:,:) = un(:,:,jk) / e2u(:,:) !!gm for stability reason use of before instead of now here !!!! 109 zve1(:,:) = vn(:,:,jk) / e1v(:,:) 110 zue1(:,:) = un(:,:,jk) / e1u(:,:) 111 zve2(:,:) = vn(:,:,jk) / e2v(:,:) 112 ! 113 DO jj = 2, jpj !!gm multiplication by tmask useless as un, vn maked field ! 114 DO ji= 2, jpi 115 zux(ji,jj) = ( zue2(ji,jj) - zue2(ji-1,jj ) ) / e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh 116 zvy(ji,jj) = ( zve1(ji,jj) - zve1(ji ,jj-1) ) / e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh 117 END DO 118 END DO 119 ! 120 DO jj = 1, jpjm1 121 DO ji = 1, jpim1 122 zuy(ji,jj) = ( zue1(ji ,jj+1) - zue1(ji,jj) ) / e2f(ji,jj) *e1f(ji,jj) * fmask(ji,jj,jk) 123 zvx(ji,jj) = ( zve2(ji+1,jj ) - zve2(ji,jj) ) / e1f(ji,jj) *e2f(ji,jj) * fmask(ji,jj,jk) 124 END DO 125 END DO 126 ! 127 DO jj = 2, jpjm1 128 DO ji = 2, jpim1 129 zdeltau = 2._wp / ( e1u(ji,jj)**(-2) + e2u(ji,jj)**(-2) ) 130 zdeltav = 2._wp / ( e1v(ji,jj)**(-2) + e2v(ji,jj)**(-2) ) 131 ! 132 ahtu(ji,jj,jk) = MAX( rn_aht_0 , (zhsmag/rpi)**2*zdeltau* & 133 & SQRT( 0.25_wp*( zux(ji,jj)+zux(ji+1,jj )-zvy(ji,jj)-zvy(ji+1,jj ) )**2 & 134 & + 0.25_wp*( zuy(ji,jj)+zuy(ji ,jj-1)+zvx(ji,jj)+zvx(ji ,jj-1) )**2 ) ) 135 ! 136 ahtv(ji,jj,jk) = MAX( rn_aht_0 , (zhsmag/rpi)**2*zdeltav* & 137 & SQRT( 0.25_wp*( zux(ji,jj)+zux(ji ,jj+1)-zvy(ji ,jj)-zvy(ji,jj+1) )**2 & 138 & + 0.25_wp*( zuy(ji,jj)+zuy(ji-1,jj )+zvx(ji-1,jj)+zvx(ji,jj ) )**2 ) ) 139 ! 140 ! stability criteria: aht<delta**2/(4*dt) dt=2*rdt , positiveness require aht<delta**2/(8*dt) 141 ahtu(ji,jj,jk) = MIN( ahtu(ji,jj,jk) , zdeltau / (16*rdt) , rn_aht_m ) 142 ahtv(ji,jj,jk) = MIN( ahtv(ji,jj,jk) , zdeltav / (16*rdt) , rn_aht_m ) 143 END DO 144 END DO 145 END DO 192 146 ENDIF 193 ENDIF 194 147 ahtu(:,:,jpk) = ahtu(:,:,jpkm1) 148 ahtv(:,:,jpk) = ahtv(:,:,jpkm1) 149 CALL lbc_lnk( ahtu, 'U', 1. ) ! Lateral boundary conditions 150 CALL lbc_lnk( ahtv, 'V', 1. ) 151 ! 195 152 CALL wrk_dealloc ( jpi,jpj,zux, zvx , zuy , zvy ) 196 153 CALL wrk_dealloc ( jpi,jpj,zue1, zue2 , zve1 , zve2 ) 154 ! 155 END SUBROUTINE ldf_tra_smag 197 156 198 199 END SUBROUTINE ldf_tra_smag200 157 #else 201 158 !!---------------------------------------------------------------------- 202 159 !! Default option Dummy module 203 160 !!---------------------------------------------------------------------- 204 CONTAINS161 CONTAINS 205 162 SUBROUTINE ldf_tra_smag( kt ) ! Empty routine 206 163 WRITE(*,*) 'ldf_dyn_smag: You should not have seen this print! error? check keys ldf:c3d+smag', kt … … 208 165 #endif 209 166 167 !!====================================================================== 210 168 END MODULE ldftra_smag -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
r4292 r4596 5 5 !!====================================================================== 6 6 !! History : 3.3.1 ! 2011-09 (Adani M) Original code: Drag Coefficient 7 !! : 3.4 ! 2012-10 (Adani M) Stokes Drift 7 !! 3.4 ! 2012-10 (Adani M) Stokes Drift 8 !!---------------------------------------------------------------------- 9 10 !!---------------------------------------------------------------------- 11 !! sbc_wave : read drag coefficient from wave model in netcdf files 8 12 !!---------------------------------------------------------------------- 9 13 USE iom ! I/O manager library 10 14 USE in_out_manager ! I/O manager 11 15 USE lib_mpp ! distribued memory computing library 12 USE fldread ! read input fields16 USE fldread ! read input fields 13 17 USE oce 14 USE sbc_oce ! Surface boundary condition: ocean fields18 USE sbc_oce ! Surface boundary condition: ocean fields 15 19 USE domvvl 16 17 18 !!----------------------------------------------------------------------19 !! sbc_wave : read drag coefficient from wave model in netcdf files20 !!----------------------------------------------------------------------21 20 22 21 IMPLICIT NONE … … 58 57 !! 59 58 !!--------------------------------------------------------------------- 60 USE oce, ONLY : un,vn,hdivn ,rotn61 USE div cur59 USE oce, ONLY : un,vn,hdivn 60 USE divhor 62 61 USE wrk_nemo 63 62 #if defined key_bdy … … 68 67 INTEGER :: ifpr, jj,ji,jk 69 68 INTEGER :: ios ! Local integer output status for namelist read 70 REAL(wp),DIMENSION(:,:,:),POINTER :: udummy,vdummy,hdivdummy ,rotdummy69 REAL(wp),DIMENSION(:,:,:),POINTER :: udummy,vdummy,hdivdummy 71 70 REAL :: z2dt,z1_2dt 72 71 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read … … 159 158 END DO 160 159 161 CALL wrk_alloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy ,rotdummy)160 CALL wrk_alloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy) 162 161 163 162 udummy(:,:,:)=un(:,:,:) 164 163 vdummy(:,:,:)=vn(:,:,:) 165 164 hdivdummy(:,:,:)=hdivn(:,:,:) 166 rotdummy(:,:,:)=rotn(:,:,:)167 165 un(:,:,:)=usd3d(:,:,:) 168 166 vn(:,:,:)=vsd3d(:,:,:) 169 CALL div_ cur(kt)167 CALL div_hor(kt) 170 168 ! !------------------------------! 171 169 ! ! Now Vertical Velocity ! … … 184 182 END DO 185 183 hdivn(:,:,:)=hdivdummy(:,:,:) 186 rotn(:,:,:)=rotdummy(:,:,:)187 184 vn(:,:,:)=vdummy(:,:,:) 188 185 un(:,:,:)=udummy(:,:,:) 189 CALL wrk_dealloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy ,rotdummy)186 CALL wrk_dealloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy) 190 187 ENDIF 191 188 END SUBROUTINE sbc_wave -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r4292 r4596 6 6 !! History : 2.0 ! 2005-11 (G. Madec) Original code 7 7 !! 3.3 ! 2010-09 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport 8 !! 4.0! 2011-06 (G. Madec) Addition of Mixed Layer Eddy parameterisation8 !! 3.6 ! 2011-06 (G. Madec) Addition of Mixed Layer Eddy parameterisation 9 9 !!---------------------------------------------------------------------- 10 10 … … 22 22 USE traadv_ubs ! UBS scheme (tra_adv_ubs routine) 23 23 USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine) 24 USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine)25 24 USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine) 26 25 USE cla ! cross land advection (cla_traadv routine) 27 USE ldftra_oce ! lateral diffusion coefficient on tracers 26 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 27 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 28 28 USE in_out_manager ! I/O manager 29 29 USE iom ! I/O module … … 32 32 USE wrk_nemo ! Memory Allocation 33 33 USE timing ! Timing 34 35 34 36 35 IMPLICIT NONE … … 87 86 ENDIF 88 87 ! 89 IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2) CALL cla_traadv( kt ) !== Cross Land Advection ==! (hor. advection)88 IF( nn_cla == 1 ) CALL cla_traadv( kt ) !== Cross Land Advection ==! (hor. advection) 90 89 ! 91 90 ! !== effective transport ==! … … 105 104 zwn(:,:,jpk) = 0._wp ! no transport trough the bottom 106 105 ! 107 IF( l k_traldf_eiv .AND. .NOT. ln_traldf_grif) &108 & CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' )! add the eiv transport (if necessary)106 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 107 & CALL ldf_eiv_trp( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary) 109 108 ! 110 109 IF( ln_mle ) CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the mle transport (if necessary) … … 160 159 !! tracer advection schemes and set nadv 161 160 !!---------------------------------------------------------------------- 162 INTEGER :: ioptio 163 INTEGER :: ios ! Local integer output status for namelist read 161 INTEGER :: ioptio, ios ! Local integers 164 162 !! 165 163 NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd, & … … 168 166 & ln_traadv_msc_ups 169 167 !!---------------------------------------------------------------------- 170 168 ! 171 169 REWIND( numnam_ref ) ! Namelist namtra_adv in reference namelist : Tracer advection scheme 172 170 READ ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901) 173 171 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp ) 174 172 ! 175 173 REWIND( numnam_cfg ) ! Namelist namtra_adv in configuration namelist : Tracer advection scheme 176 174 READ ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 ) 177 175 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp ) 178 176 WRITE ( numond, namtra_adv ) 179 177 ! 180 178 IF(lwp) THEN ! Namelist print 181 179 WRITE(numout,*) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r4488 r4596 4 4 !! Ocean Active tracers : lateral diffusive trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 2005-11 (G. Madec) Original code 7 !! NEMO 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 6 !! History : 9.0 ! 2005-11 (G. Madec) Original code 7 !! NEMO 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 8 !! 3.7 ! 2013-12 (G. Madec) remove the optional computation from T & S anomaly profiles and traldf_bilapg 9 !! - ! 2013-12 (F. Lemarie, G. Madec) triad operator (Griffies) + Method of Stabilizing Correction 10 !! - ! 2014-01 (G. Madec) restructuration/simplification of aht/aeiv specification 8 11 !!---------------------------------------------------------------------- 9 12 … … 11 14 !! tra_ldf : update the tracer trend with the lateral diffusion 12 15 !! tra_ldf_init : initialization, namelist read, and parameters control 13 !! ldf_ano : compute lateral diffusion for constant T-S profiles 14 !!---------------------------------------------------------------------- 15 USE oce ! ocean dynamics and tracers 16 USE dom_oce ! ocean space and time domain 17 USE phycst ! physical constants 18 USE ldftra_oce ! ocean tracer lateral physics 19 USE ldfslp ! ??? 20 USE traldf_bilapg ! lateral mixing (tra_ldf_bilapg routine) 21 USE traldf_bilap ! lateral mixing (tra_ldf_bilap routine) 22 USE traldf_iso ! lateral mixing (tra_ldf_iso routine) 23 USE traldf_iso_grif ! lateral mixing (tra_ldf_iso_grif routine) 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 27 USE prtctl ! Print control 28 USE in_out_manager ! I/O manager 29 USE lib_mpp ! distribued memory computing library 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 USE wrk_nemo ! Memory allocation 32 USE timing ! Timing 16 !!---------------------------------------------------------------------- 17 USE oce ! ocean dynamics and tracers 18 USE dom_oce ! ocean space and time domain 19 USE phycst ! physical constants 20 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 21 USE ldfslp ! lateral diffusion: iso-neutral slope 22 USE traldf_iso ! lateral diffusion (Madec operator) (tra_ldf_iso routine) 23 USE traldf_iso_triad ! lateral diffusion (triad operator) (tra_ldf_iso_triad routine) 24 USE traldf_lap ! lateral diffusion (iso-level lap/blp) (tra_ldf_lap/_blp routine) 25 USE trdmod_oce ! ocean space and time domain 26 USE trdtra ! ocean active tracers trends 27 ! 28 USE prtctl ! Print control 29 USE in_out_manager ! I/O manager 30 USE lib_mpp ! distribued memory computing library 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE wrk_nemo ! Memory allocation 33 USE timing ! Timing 33 34 34 35 IMPLICIT NONE … … 36 37 37 38 PUBLIC tra_ldf ! called by step.F90 38 PUBLIC tra_ldf_init ! called by opa.F9039 PUBLIC tra_ldf_init ! called by nemogcm.F90 39 40 ! 40 41 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 41 42 REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: t0_ldf, s0_ldf !: lateral diffusion trends of T & S for a cst profile43 ! ! (key_traldf_ano only)44 42 45 43 !! * Substitutions … … 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) … … 75 73 76 74 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 77 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts) ! iso-level laplacian78 CASE ( 1 ) ! rotated laplacian79 IF( ln_traldf_ grif) THEN80 CALL tra_ldf_iso_ grif( kt, nit000,'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Griffiesoperator75 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nit000, 'TRA', gtsu, gtsv, ahtu, ahtv, tsb , tsa, jpts, 1) ! iso-level laplacian 76 CASE ( 1 ) ! rotated laplacian 77 IF( ln_traldf_triad ) THEN 78 CALL tra_ldf_iso_triad( kt, nit000,'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsb, tsa, jpts, 1 ) ! triad operator 81 79 ELSE 82 CALL tra_ldf_iso ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )! Madec operator83 ENDIF 84 CASE ( 2 ) ; CALL tra_ldf_b ilap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts )! iso-level bilaplacian85 CASE ( 3 ) ; CALL tra_ldf_ bilapg ( kt, nit000, 'TRA', tsb, tsa, jpts ) ! s-coord. geopot. bilap.80 CALL tra_ldf_iso ( kt, nit000,'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsb, tsa, jpts, 1 ) ! Madec operator 81 ENDIF 82 CASE ( 2 ) ; CALL tra_ldf_blp ( kt, nit000,'TRA', gtsu, gtsv, ahtu, ahtv, tsb , tsa, jpts ) ! iso-level bilaplacian 83 CASE ( 3 ) ; CALL tra_ldf_iso_blp ( kt, nit000,'TRA', gtsu, gtsv, ahtu, ahtv, tsb , tsa, jpts ) ! rotated bilaplacian 86 84 ! 87 85 CASE ( -1 ) ! esopa: test all possibility with control print 88 CALL tra_ldf_lap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts)86 CALL tra_ldf_lap ( kt, nit000, 'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsa, jpts, 1 ) 89 87 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask, & 90 88 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 91 IF( ln_traldf_ grif) THEN92 CALL tra_ldf_iso_ grif( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0)89 IF( ln_traldf_triad ) THEN 90 CALL tra_ldf_iso_triad( kt, nit000, 'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsb, tsa, jpts, 1 ) 93 91 ELSE 94 CALL tra_ldf_iso ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0)92 CALL tra_ldf_iso ( kt, nit000, 'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsb, tsa, jpts, 1 ) 95 93 ENDIF 96 94 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask, & 97 95 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 98 CALL tra_ldf_b ilap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts )96 CALL tra_ldf_blp ( kt, nit000, 'TRA', gtsu, gtsv, ahtu, ahtv, tsb, tsa, jpts ) 99 97 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask, & 100 98 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 101 CALL tra_ldf_bilapg( kt, nit000, 'TRA', tsb, tsa, jpts )102 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask, &103 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )104 99 END SELECT 105 106 #if defined key_traldf_ano107 tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) - t0_ldf(:,:,:) ! anomaly: substract the reference diffusivity108 tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) - s0_ldf(:,:,:)109 #endif110 100 111 101 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics … … 132 122 !! 133 123 !! ** Method : set nldf from the namtra_ldf logicals 124 !! nldf == -2 NO diffusive operator used (advective operator should include diffusion) 134 125 !! nldf == -1 ESOPA test: ALL operators are used 135 126 !! nldf == 0 laplacian operator … … 155 146 ! ! control the input 156 147 ioptio = 0 157 IF( ln_traldf_lap 158 IF( ln_traldf_b ilap ) ioptio = ioptio + 1159 IF( ioptio > 1 ) CALL ctl_stop( ' use ONE or NONE of the 2 lap/bilap operator type on tracer' )160 IF( ioptio == 0 ) nldf = -2! No lateral diffusion148 IF( ln_traldf_lap ) ioptio = ioptio + 1 149 IF( ln_traldf_blp ) ioptio = ioptio + 1 150 IF( ioptio > 1 ) CALL ctl_stop( ' use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 151 IF( ioptio == 0 ) nldf = -2 ! No lateral diffusion 161 152 ioptio = 0 162 IF( ln_traldf_lev el) ioptio = ioptio + 1163 IF( ln_traldf_hor 164 IF( ln_traldf_iso 153 IF( ln_traldf_lev ) ioptio = ioptio + 1 154 IF( ln_traldf_hor ) ioptio = ioptio + 1 155 IF( ln_traldf_iso ) ioptio = ioptio + 1 165 156 IF( ioptio > 1 ) CALL ctl_stop( ' use only ONE direction (level/hor/iso)' ) 166 157 … … 170 161 IF( ln_traldf_lap ) THEN ! laplacian operator 171 162 IF ( ln_zco ) THEN ! z-coordinate 172 IF ( ln_traldf_level ) nldf = 0 ! iso-level (no rotation) 163 IF ( ln_traldf_lev .OR. & 164 & ln_traldf_hor ) nldf = 0 ! iso-level = horizontal (no rotation) 165 IF ( ln_traldf_iso .OR. & 166 & ln_traldf_triad ) nldf = 1 ! isoneutral ( rotation) 167 ENDIF 168 IF ( ln_zps ) THEN ! z-coordinate 169 IF ( ln_traldf_lev ) ierr = 1 ! iso-level not allowed 173 170 IF ( ln_traldf_hor ) nldf = 0 ! horizontal (no rotation) 174 IF ( ln_traldf_iso ) nldf = 1 ! isoneutral ( rotation) 175 ENDIF 176 IF ( ln_zps ) THEN ! z-coordinate 177 IF ( ln_traldf_level ) ierr = 1 ! iso-level not allowed 178 IF ( ln_traldf_hor ) nldf = 0 ! horizontal (no rotation) 179 IF ( ln_traldf_iso ) nldf = 1 ! isoneutral ( rotation) 171 IF ( ln_traldf_iso .OR. & 172 & ln_traldf_triad ) nldf = 1 ! isoneutral ( rotation) 180 173 ENDIF 181 174 IF ( ln_sco ) THEN ! z-coordinate 182 IF ( ln_traldf_lev el) nldf = 0 ! iso-level (no rotation)175 IF ( ln_traldf_lev ) nldf = 0 ! iso-level (no rotation) 183 176 IF ( ln_traldf_hor ) nldf = 1 ! horizontal ( rotation) 184 IF ( ln_traldf_iso ) nldf = 1 ! isoneutral ( rotation) 185 ENDIF 186 ENDIF 187 188 IF( ln_traldf_bilap ) THEN ! bilaplacian operator 177 IF ( ln_traldf_iso .OR. & 178 & ln_traldf_triad ) nldf = 1 ! isoneutral ( rotation) 179 ENDIF 180 ENDIF 181 182 IF( ln_traldf_blp ) THEN ! bilaplacian operator 189 183 IF ( ln_zco ) THEN ! z-coordinate 190 IF ( ln_traldf_level ) nldf = 2 ! iso-level (no rotation) 184 IF ( ln_traldf_lev .OR. & 185 & ln_traldf_hor ) nldf = 2 ! iso-level = horizontal (no rotation) 186 IF ( ln_traldf_iso .OR. & 187 & ln_traldf_triad ) nldf = 3 ! isoneutral ( rotation) 188 ENDIF 189 IF ( ln_zps ) THEN ! z-coordinate with partial step 190 IF ( ln_traldf_lev ) ierr = 1 ! iso-level not allowed 191 191 IF ( ln_traldf_hor ) nldf = 2 ! horizontal (no rotation) 192 IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) 193 ENDIF 194 IF ( ln_zps ) THEN ! z-coordinate 195 IF ( ln_traldf_level ) ierr = 1 ! iso-level not allowed 196 IF ( ln_traldf_hor ) nldf = 2 ! horizontal (no rotation) 197 IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) 198 ENDIF 199 IF ( ln_sco ) THEN ! z-coordinate 200 IF ( ln_traldf_level ) nldf = 2 ! iso-level (no rotation) 201 IF ( ln_traldf_hor ) nldf = 3 ! horizontal ( rotation) 202 IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) 203 ENDIF 204 ENDIF 205 206 IF( nldf == 3 ) CALL ctl_warn( 'geopotential bilaplacian tracer diffusion in s-coords not thoroughly tested' ) 192 IF ( ln_traldf_iso .OR. & 193 & ln_traldf_triad ) nldf = 3 ! isoneutral ( rotation) 194 ENDIF 195 IF ( ln_sco ) THEN ! s-coordinate 196 IF ( ln_traldf_lev ) nldf = 2 ! iso-level (no rotation) 197 IF ( ln_traldf_hor ) nldf = 3 ! horizontal ( rotation) !!gm a checker.... 198 IF ( ln_traldf_iso .OR. & 199 & ln_traldf_triad ) nldf = 3 ! isoneutral ( rotation) 200 ENDIF 201 ENDIF 202 207 203 IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 208 IF( ierr == 2 ) CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 209 IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso ) & 210 CALL ctl_stop( ' eddy induced velocity on tracers', & 211 & ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 212 IF( nldf == 1 .OR. nldf == 3 ) THEN ! rotation 213 IF( .NOT.lk_ldfslp ) CALL ctl_stop( ' the rotation of the diffusive tensor require key_ldfslp' ) 214 l_traldf_rot = .TRUE. ! needed for trazdf_imp 215 ENDIF 216 204 IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) ) & 205 & CALL ctl_stop( ' eddy induced velocity on tracers requires isopycnal', & 206 & ' laplacian diffusion' ) 207 IF( nldf == 1 .OR. nldf == 3 ) l_ldfslp = .TRUE. ! slope of neutral surfaces required 217 208 IF( lk_esopa ) THEN 218 209 IF(lwp) WRITE(numout,*) ' esopa control: use all lateral physics options' … … 229 220 IF( nldf == 3 ) WRITE(numout,*) ' Rotated bilaplacian' 230 221 ENDIF 231 232 ! Reference T & S diffusivity (if necessary)233 ! ===========================234 CALL ldf_ano235 222 ! 236 223 END SUBROUTINE tra_ldf_init 237 238 #if defined key_traldf_ano239 !!----------------------------------------------------------------------240 !! 'key_traldf_ano' T & S lateral diffusion on anomalies241 !!----------------------------------------------------------------------242 243 SUBROUTINE ldf_ano244 !!----------------------------------------------------------------------245 !! *** ROUTINE ldf_ano ***246 !!247 !! ** Purpose : initializations of248 !!----------------------------------------------------------------------249 !250 USE zdf_oce ! vertical mixing251 USE trazdf ! vertical mixing: double diffusion252 USE zdfddm ! vertical mixing: double diffusion253 !254 INTEGER :: jk ! Dummy loop indice255 INTEGER :: ierr ! local integer256 LOGICAL :: llsave ! local logical257 REAL(wp) :: zt0, zs0, z12 ! local scalar258 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_ref, zs_ref, ztb, zsb, zavt259 !!----------------------------------------------------------------------260 !261 IF( nn_timing == 1 ) CALL timing_start('ldf_ano')262 !263 CALL wrk_alloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt )264 !265 266 IF(lwp) THEN267 WRITE(numout,*)268 WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on anomalies'269 WRITE(numout,*) '~~~~~~~~~~~'270 ENDIF271 272 ! ! allocate trabbl arrays273 ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr )274 IF( lk_mpp ) CALL mpp_sum( ierr )275 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_ano: unable to allocate arrays' )276 277 ! defined the T & S reference profiles278 ! ------------------------------------279 zt0 =10.e0 ! homogeneous ocean280 zs0 =35.e0281 zt_ref(:,:,:) = 10.0 * tmask(:,:,:)282 zs_ref(:,:,:) = 35.0 * tmask(:,:,:)283 IF(lwp) WRITE(numout,*) ' homogeneous ocean T = ', zt0, ' S = ',zs0284 285 ! ! T & S profile (to be coded +namelist parameter286 287 ! prepare the ldf computation288 ! ---------------------------289 llsave = l_trdtra290 l_trdtra = .false. ! desactivate trend computation291 t0_ldf(:,:,:) = 0.e0292 s0_ldf(:,:,:) = 0.e0293 ztb (:,:,:) = tsb (:,:,:,jp_tem)294 zsb (:,:,:) = tsb (:,:,:,jp_sal)295 ua (:,:,:) = tsa (:,:,:,jp_tem)296 va (:,:,:) = tsa (:,:,:,jp_sal)297 zavt (:,:,:) = avt(:,:,:)298 IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' )299 ! set tb, sb to reference values and avr to zero300 tsb (:,:,:,jp_tem) = zt_ref(:,:,:)301 tsb (:,:,:,jp_sal) = zs_ref(:,:,:)302 tsa (:,:,:,jp_tem) = 0.e0303 tsa (:,:,:,jp_sal) = 0.e0304 avt(:,:,:) = 0.e0305 306 ! Compute the ldf trends307 ! ----------------------308 CALL tra_ldf( nit000 + 1 ) ! horizontal components (+1: no more init)309 CALL tra_zdf( nit000 ) ! vertical component (if necessary nit000 to performed the init)310 311 ! finalise the computation and recover all arrays312 ! -----------------------------------------------313 l_trdtra = llsave314 z12 = 2.e0315 IF( neuler == 1) z12 = 1.e0316 IF( ln_zdfexp ) THEN ! ta,sa are the trends317 t0_ldf(:,:,:) = tsa(:,:,:,jp_tem)318 s0_ldf(:,:,:) = tsa(:,:,:,jp_sal)319 ELSE320 DO jk = 1, jpkm1321 t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) )322 s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) )323 END DO324 ENDIF325 tsb(:,:,:,jp_tem) = ztb (:,:,:)326 tsb(:,:,:,jp_sal) = zsb (:,:,:)327 tsa(:,:,:,jp_tem) = ua (:,:,:)328 tsa(:,:,:,jp_sal) = va (:,:,:)329 avt(:,:,:) = zavt(:,:,:)330 !331 CALL wrk_dealloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt )332 !333 IF( nn_timing == 1 ) CALL timing_stop('ldf_ano')334 !335 END SUBROUTINE ldf_ano336 337 #else338 !!----------------------------------------------------------------------339 !! default option : Dummy code NO T & S background profiles340 !!----------------------------------------------------------------------341 SUBROUTINE ldf_ano342 IF(lwp) THEN343 WRITE(numout,*)344 WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on the full fields'345 WRITE(numout,*) '~~~~~~~~~~~'346 ENDIF347 END SUBROUTINE ldf_ano348 #endif349 224 350 225 !!====================================================================== -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r4292 r4596 4 4 !! Ocean tracers: horizontal component of the lateral tracer mixing trend 5 5 !!====================================================================== 6 !! History : OPA ! 1994-08 (G. Madec, M. Imbard) 7 !! 8.0 ! 1997-05 (G. Madec) split into traldf and trazdf 8 !! NEMO ! 2002-08 (G. Madec) Free form, F90 9 !! 1.0 ! 2005-11 (G. Madec) merge traldf and trazdf :-) 10 !! 3.3 ! 2010-09 (C. Ethe, G. Madec) Merge TRA-TRC 6 !! History : OPA ! 1994-08 (G. Madec, M. Imbard) 7 !! 8.0 ! 1997-05 (G. Madec) split into traldf and trazdf 8 !! NEMO ! 2002-08 (G. Madec) Free form, F90 9 !! 1.0 ! 2005-11 (G. Madec) merge traldf and trazdf :-) 10 !! 3.3 ! 2010-09 (C. Ethe, G. Madec) Merge TRA-TRC 11 !! 3.7 ! 2014-01 (G. Madec) restructuration/simplification of aht/aeiv specification 12 !! 3.7 ! 2014-02 (F. Lemarie, G. Madec) triad operator (Griffies) + Method of Stabilizing Correction 11 13 !!---------------------------------------------------------------------- 12 #if defined key_ldfslp || defined key_esopa 14 13 15 !!---------------------------------------------------------------------- 14 !! 'key_ldfslp' slope of the lateral diffusive direction 15 !!---------------------------------------------------------------------- 16 !! tra_ldf_iso : update the tracer trend with the horizontal 17 !! component of a iso-neutral laplacian operator 18 !! and with the vertical part of 19 !! the isopycnal or geopotential s-coord. operator 16 !! tra_ldf_iso : update the tracer trend with the horizontal component of a iso-neutral laplacian operator 17 !! and with the vertical part of the isopycnal or geopotential s-coord. operator 20 18 !!---------------------------------------------------------------------- 21 19 USE oce ! ocean dynamics and active tracers … … 23 21 USE trc_oce ! share passive tracers/Ocean variables 24 22 USE zdf_oce ! ocean vertical physics 25 USE ldftra _oce ! ocean active tracers: lateral physics23 USE ldftra ! lateral diffusion: tracer eddy coefficients 26 24 USE ldfslp ! iso-neutral slopes 27 25 USE diaptr ! poleward transport diagnostics 26 ! 28 27 USE in_out_manager ! I/O manager 29 28 USE iom ! I/O library 30 #if defined key_diaar531 29 USE phycst ! physical constants 32 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 #endif34 31 USE wrk_nemo ! Memory Allocation 35 32 USE timing ! Timing … … 42 39 !! * Substitutions 43 40 # include "domzgr_substitute.h90" 44 # include "ldftra_substitute.h90"45 41 # include "vectopt_loop_substitute.h90" 46 42 !!---------------------------------------------------------------------- 47 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)43 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 48 44 !! $Id$ 49 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 51 47 CONTAINS 52 48 53 SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv,&54 & ptb, pta, kjpt, pahtb0)49 SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv , pahu, pahv , & 50 & ptb, ptbb, pta , kjpt , kpass ) 55 51 !!---------------------------------------------------------------------- 56 52 !! *** ROUTINE tra_ldf_iso *** … … 71 67 !! 2nd part : horizontal fluxes of the lateral mixing operator 72 68 !! ======== 73 !! zftu = (aht+ahtb0)e2u*e3u/e1u di[ tb ]74 !! - ahte2u*uslp dk[ mi(mk(tb)) ]75 !! zftv = (aht+ahtb0)e1v*e3v/e2v dj[ tb ]76 !! - ahte2u*vslp dk[ mj(mk(tb)) ]69 !! zftu = pahu e2u*e3u/e1u di[ tb ] 70 !! - pahu e2u*uslp dk[ mi(mk(tb)) ] 71 !! zftv = pahv e1v*e3v/e2v dj[ tb ] 72 !! - pahv e2u*vslp dk[ mj(mk(tb)) ] 77 73 !! take the horizontal divergence of the fluxes: 78 74 !! difft = 1/(e1t*e2t*e3t) { di-1[ zftu ] + dj-1[ zftv ] } … … 83 79 !! ======== (excluding the vertical flux proportional to dk[t] ) 84 80 !! vertical fluxes associated with the rotated lateral mixing: 85 !! zftw = -aht {e2t*wslpi di[ mi(mk(tb)) ]86 !! +e1t*wslpj dj[ mj(mk(tb)) ] }81 !! zftw = - { mi(mk(pahu)) * e2t*wslpi di[ mi(mk(tb)) ] 82 !! + mj(mk(pahv)) * e1t*wslpj dj[ mj(mk(tb)) ] } 87 83 !! take the horizontal divergence of the fluxes: 88 84 !! difft = 1/(e1t*e2t*e3t) dk[ zftw ] … … 92 88 !! ** Action : Update pta arrays with the before rotated diffusion 93 89 !!---------------------------------------------------------------------- 94 USE oce , ONLY: zftu => ua , zftv => va ! (ua,va) used as workspace95 !96 90 INTEGER , INTENT(in ) :: kt ! ocean time-step index 97 INTEGER , INTENT(in ) :: kit000 91 INTEGER , INTENT(in ) :: kit000 ! first time step index 98 92 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 99 93 INTEGER , INTENT(in ) :: kjpt ! number of tracers 100 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 101 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 102 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 103 REAL(wp) , INTENT(in ) :: pahtb0 ! background diffusion coef 94 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 95 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu , pgv ! tracer gradient at pstep levels 96 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 97 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! tracer (kpass=1) or laplacian of tracer (kpass=2) 98 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptbb ! tracer (only used in kpass=2) 99 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 104 100 ! 105 101 INTEGER :: ji, jj, jk, jn ! dummy loop indices 106 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 107 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 108 REAL(wp) :: zcoef0, zbtr, ztra ! - - 102 INTEGER :: ierr ! local integer 103 REAL(wp) :: zmsku, zahu_w, zabe1, zcof1, zcoef3 ! local scalars 104 REAL(wp) :: zmskv, zahv_w, zabe2, zcof2, zcoef4 ! - - 105 REAL(wp) :: zcoef0, ze3w_2, zsign, z2dt, z1_2dt ! - - 109 106 #if defined key_diaar5 110 107 REAL(wp) :: zztmp ! local scalar 111 108 #endif 112 REAL(wp), POINTER, DIMENSION(:,: ) ::zdkt, zdk1t, z2d113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw109 REAL(wp), POINTER, DIMENSION(:,:) :: zdkt, zdk1t, z2d 110 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw 114 111 !!---------------------------------------------------------------------- 115 112 ! … … 117 114 ! 118 115 CALL wrk_alloc( jpi, jpj, zdkt, zdk1t, z2d ) 119 CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw ) 120 ! 121 116 CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, zftu, zftv, ztfw ) 117 ! 122 118 IF( kt == kit000 ) THEN 123 119 IF(lwp) WRITE(numout,*) 124 120 IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 125 121 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 122 ! 123 akz (:,:,:) = 0._wp 124 ah_wslp2(:,:,:) = 0._wp 125 ENDIF 126 ! 127 ! ! set time step size (Euler/Leapfrog) 128 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2dt = rdttra(1) ! at nit000 (Euler) 129 ELSE ; z2dt = 2.* rdttra(1) ! (Leapfrog) 130 ENDIF 131 z1_2dt = 1._wp / z2dt 132 ! 133 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) 134 ELSE ; zsign = -1._wp 135 ENDIF 136 137 138 !!---------------------------------------------------------------------- 139 !! 0 - calculate ah_wslp2 and akz 140 !!---------------------------------------------------------------------- 141 ! 142 IF( kpass == 1 ) THEN !== first pass only ==! 143 ! 144 DO jk = 2, jpkm1 145 DO jj = 2, jpjm1 146 DO ji = fs_2, fs_jpim1 ! vector opt. 147 ! 148 zmsku = tmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & 149 & + umask(ji-1,jj,jk-1) + umask(ji ,jj,jk) , 1._wp ) 150 zmskv = tmask(ji,jj,jk) / MAX( vmask(ji,jj ,jk-1) + vmask(ji,jj-1,jk) & 151 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj ,jk) , 1._wp ) 152 ! 153 zahu_w = ( pahu(ji ,jj,jk-1) + pahu(ji-1,jj,jk) & 154 & + pahu(ji-1,jj,jk-1) + pahu(ji ,jj,jk) ) * zmsku 155 zahv_w = ( pahv(ji,jj ,jk-1) + pahv(ji,jj-1,jk) & 156 & + pahv(ji,jj-1,jk-1) + pahv(ji,jj ,jk) ) * zmskv 157 ! 158 ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 159 & + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk) 160 END DO 161 END DO 162 END DO 163 ! 164 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 165 DO jk = 2, jpkm1 166 DO jj = 2, jpjm1 167 DO ji = fs_2, fs_jpim1 168 akz(ji,jj,jk) = 0.25_wp * ( & 169 & ( pahu(ji ,jj,jk) + pahu(ji ,jj,jk-1) ) / ( e1u(ji ,jj) * e1u(ji ,jj) ) & 170 & + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) ) & 171 & + ( pahv(ji,jj ,jk) + pahv(ji,jj ,jk-1) ) / ( e2v(ji,jj ) * e2v(ji,jj ) ) & 172 & + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) ) ) 173 END DO 174 END DO 175 END DO 176 ! 177 IF( ln_traldf_blp ) THEN ! bilaplacian operator 178 DO jk = 2, jpkm1 179 DO jj = 1, jpjm1 180 DO ji = 1, fs_jpim1 181 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 182 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) ) ) 183 END DO 184 END DO 185 END DO 186 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 187 DO jk = 2, jpkm1 188 DO jj = 1, jpjm1 189 DO ji = 1, fs_jpim1 190 ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 191 zcoef0 = z2dt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) 192 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 193 END DO 194 END DO 195 END DO 196 ENDIF 197 ! 198 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 199 akz(:,:,:) = ah_wslp2(:,:,:) 200 ENDIF 126 201 ENDIF 127 202 ! … … 133 208 !! I - masked horizontal derivative 134 209 !!---------------------------------------------------------------------- 135 !!bug ajout.... why? (1,jpj,:) and (jpi,1,:) should be sufficient....136 zdit (1,:,:) = 0. e0 ; zdit (jpi,:,:) = 0.e0137 zdjt (1,:,:) = 0. e0 ; zdjt (jpi,:,:) = 0.e0210 !!gm : bug.... why (x,:,:)? (1,jpj,:) and (jpi,1,:) should be sufficient.... 211 zdit (1,:,:) = 0._wp ; zdit (jpi,:,:) = 0._wp 212 zdjt (1,:,:) = 0._wp ; zdjt (jpi,:,:) = 0._wp 138 213 !!end 139 214 … … 159 234 !! II - horizontal trend (full) 160 235 !!---------------------------------------------------------------------- 161 !CDIR PARALLEL DO PRIVATE( zdk1t ) 162 ! ! =============== 236 ! 163 237 DO jk = 1, jpkm1 ! Horizontal slab 164 ! ! =============== 165 ! 1. Vertical tracer gradient at level jk and jk+1 166 ! ------------------------------------------------ 167 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 168 zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 169 ! 170 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:) 238 ! 239 ! !== Vertical tracer gradient 240 zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) ! level jk+1 241 ! 242 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:) ! surface: zdkt(jk=1)=zdkt(jk=2) 171 243 ELSE ; zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 172 244 ENDIF 173 245 174 ! 2. Horizontal fluxes 175 ! -------------------- 176 DO jj = 1 , jpjm1 246 DO jj = 1 , jpjm1 !== Horizontal fluxes 177 247 DO ji = 1, fs_jpim1 ! vector opt. 178 zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)179 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)248 zabe1 = pahu(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) 249 zabe2 = pahv(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) 180 250 ! 181 251 zmsku = 1. / MAX( tmask(ji+1,jj,jk ) + tmask(ji,jj,jk+1) & … … 185 255 & + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk ), 1. ) 186 256 ! 187 zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku188 zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv257 zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 258 zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 189 259 ! 190 260 zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) & … … 196 266 END DO 197 267 END DO 198 199 ! II.4 Second derivative (divergence) and add to the general trend 200 ! ---------------------------------------------------------------- 201 DO jj = 2 , jpjm1 268 ! 269 DO jj = 2 , jpjm1 !== horizontal divergence and add to pta 202 270 DO ji = fs_2, fs_jpim1 ! vector opt. 203 zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 204 ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 205 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 206 END DO 207 END DO 208 ! ! =============== 271 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) & 272 & + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) & 273 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 274 END DO 275 END DO 209 276 END DO ! End of slab 210 ! ! =============== 211 ! 212 ! "Poleward" diffusive heat or salt transports (T-S case only) 213 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 214 ! note sign is reversed to give down-gradient diffusive transports (#1043) 215 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( -zftv(:,:,:) ) 216 IF( jn == jp_sal) str_ldf(:) = ptr_vj( -zftv(:,:,:) ) 217 ENDIF 218 219 #if defined key_diaar5 220 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 221 z2d(:,:) = 0._wp 222 ! note sign is reversed to give down-gradient diffusive transports (#1043) 223 zztmp = -1.0_wp * rau0 * rcp 224 DO jk = 1, jpkm1 225 DO jj = 2, jpjm1 226 DO ji = fs_2, fs_jpim1 ! vector opt. 227 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 228 END DO 229 END DO 230 END DO 231 z2d(:,:) = zztmp * z2d(:,:) 232 CALL lbc_lnk( z2d, 'U', -1. ) 233 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 234 z2d(:,:) = 0._wp 235 DO jk = 1, jpkm1 236 DO jj = 2, jpjm1 237 DO ji = fs_2, fs_jpim1 ! vector opt. 238 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 239 END DO 240 END DO 241 END DO 242 z2d(:,:) = zztmp * z2d(:,:) 243 CALL lbc_lnk( z2d, 'V', -1. ) 244 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 245 END IF 246 #endif 247 248 !!---------------------------------------------------------------------- 249 !! III - vertical trend of T & S (extra diagonal terms only) 250 !!---------------------------------------------------------------------- 251 252 ! Local constant initialization 253 ! ----------------------------- 254 ztfw(1,:,:) = 0.e0 ; ztfw(jpi,:,:) = 0.e0 277 278 279 !!---------------------------------------------------------------------- 280 !! III - vertical trend (full) 281 !!---------------------------------------------------------------------- 282 283 ztfw(1,:,:) = 0._wp ; ztfw(jpi,:,:) = 0._wp 255 284 256 285 ! Vertical fluxes … … 258 287 259 288 ! Surface and bottom vertical fluxes set to zero 260 ztfw(:,:, 1 ) = 0. e0 ; ztfw(:,:,jpk) = 0.e0289 ztfw(:,:, 1 ) = 0._wp ; ztfw(:,:,jpk) = 0._wp 261 290 262 291 ! interior (2=<jk=<jpk-1) … … 264 293 DO jj = 2, jpjm1 265 294 DO ji = fs_2, fs_jpim1 ! vector opt. 266 zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk) 267 ! 268 zmsku = 1./MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & 269 & + umask(ji-1,jj,jk-1) + umask(ji ,jj,jk), 1. ) 270 zmskv = 1./MAX( vmask(ji,jj ,jk-1) + vmask(ji,jj-1,jk) & 271 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj ,jk), 1. ) 272 ! 273 zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk) 274 zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 295 ! 296 zmsku = tmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & 297 & + umask(ji-1,jj,jk-1) + umask(ji ,jj,jk) , 1._wp ) 298 zmskv = tmask(ji,jj,jk) / MAX( vmask(ji,jj ,jk-1) + vmask(ji,jj-1,jk) & 299 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj ,jk) , 1._wp ) 300 ! 301 zahu_w = ( pahu(ji ,jj,jk-1) + pahu(ji-1,jj,jk) & 302 & + pahu(ji-1,jj,jk-1) + pahu(ji ,jj,jk) ) * zmsku 303 zahv_w = ( pahv(ji,jj ,jk-1) + pahv(ji,jj-1,jk) & 304 & + pahv(ji,jj-1,jk-1) + pahv(ji,jj ,jk) ) * zmskv 305 ! 306 ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 307 & + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk) 308 ! 309 zcoef3 = - zahu_w * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk) 310 zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 275 311 ! 276 312 ztfw(ji,jj,jk) = zcoef3 * ( zdit(ji ,jj ,jk-1) + zdit(ji-1,jj ,jk) & … … 281 317 END DO 282 318 END DO 283 284 285 ! I.5 Divergence of vertical fluxes added to the general tracer trend 286 ! ------------------------------------------------------------------- 287 DO jk = 1, jpkm1 319 ! 320 ! !== add the vertical 33 flux ==! 321 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 322 DO jk = 2, jpkm1 323 DO jj = 1, jpjm1 324 DO ji = fs_2, fs_jpim1 325 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) & 326 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & 327 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 328 END DO 329 END DO 330 END DO 331 ! 332 ELSE ! bilaplacian 333 SELECT CASE( kpass ) 334 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 335 DO jk = 2, jpkm1 336 DO jj = 1, jpjm1 337 DO ji = fs_2, fs_jpim1 338 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) & 339 & + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj) & 340 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) / fse3w(ji,jj,jk) 341 END DO 342 END DO 343 END DO 344 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb and ptbb gradients, resp. 345 DO jk = 2, jpkm1 346 DO jj = 1, jpjm1 347 DO ji = fs_2, fs_jpim1 348 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) & 349 & * ( ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) ) & 350 & + akz (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) ) ) 351 END DO 352 END DO 353 END DO 354 END SELECT 355 ENDIF 356 ! 357 DO jk = 1, jpkm1 !== Divergence of vertical fluxes added to pta ==! 288 358 DO jj = 2, jpjm1 289 359 DO ji = fs_2, fs_jpim1 ! vector opt. 290 zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 291 ztra = ( ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1) ) * zbtr 292 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 360 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1) ) & 361 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 293 362 END DO 294 363 END DO 295 364 END DO 296 365 ! 297 END DO 366 IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR. & !== first pass only ( laplacian) ==! 367 ( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass (bilaplacian) ==! 368 ! 369 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 370 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 371 ! note sign is reversed to give down-gradient diffusive transports (#1043) 372 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( -zftv(:,:,:) ) 373 IF( jn == jp_sal) str_ldf(:) = ptr_vj( -zftv(:,:,:) ) 374 ENDIF 375 #if defined key_diaar5 376 ! ! AR5 diagnostics: vertical integrated heat transport 377 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 378 z2d(:,:) = 0._wp 379 ! note sign is reversed to give down-gradient diffusive transports (#1043) 380 zztmp = -1.0_wp * rau0 * rcp 381 DO jk = 1, jpkm1 382 DO jj = 2, jpjm1 383 DO ji = fs_2, fs_jpim1 ! vector opt. 384 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 385 END DO 386 END DO 387 END DO 388 z2d(:,:) = zztmp * z2d(:,:) 389 CALL lbc_lnk( z2d, 'U', -1. ) 390 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 391 z2d(:,:) = 0._wp 392 DO jk = 1, jpkm1 393 DO jj = 2, jpjm1 394 DO ji = fs_2, fs_jpim1 ! vector opt. 395 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 396 END DO 397 END DO 398 END DO 399 z2d(:,:) = zztmp * z2d(:,:) 400 CALL lbc_lnk( z2d, 'V', -1. ) 401 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 402 END IF 403 #endif 404 ENDIF !== end pass selection ==! 405 ! 406 ! ! =============== 407 END DO ! end tracer loop 408 ! ! =============== 298 409 ! 299 410 CALL wrk_dealloc( jpi, jpj, zdkt, zdk1t, z2d ) 300 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, z tfw )411 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, zftu, zftv, ztfw ) 301 412 ! 302 413 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_iso') 303 414 ! 304 415 END SUBROUTINE tra_ldf_iso 305 306 #else307 !!----------------------------------------------------------------------308 !! default option : Dummy code NO rotation of the diffusive tensor309 !!----------------------------------------------------------------------310 CONTAINS311 SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 ) ! Empty routine312 INTEGER:: kt, kit000313 CHARACTER(len=3) :: cdtype314 REAL, DIMENSION(:,:,:) :: pgu, pgv ! tracer gradient at pstep levels315 REAL, DIMENSION(:,:,:,:) :: ptb, pta316 WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype, &317 & pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0318 END SUBROUTINE tra_ldf_iso319 #endif320 416 321 417 !!============================================================================== -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r4364 r4596 2 2 !!============================================================================== 3 3 !! *** MODULE traldf_lap *** 4 !! Ocean tracers: horizontal component of the lateral tracer mixing trend4 !! Ocean tracers: lateral diffusivity trend (laplacian and bilaplacian) 5 5 !!============================================================================== 6 !! History : OPA ! 87-06 (P. Andrich, D. L Hostis) Original code 7 !! ! 91-11 (G. Madec) 8 !! ! 95-11 (G. Madec) suppress volumetric scale factors 9 !! ! 96-01 (G. Madec) statement function for e3 10 !! NEMO ! 02-06 (G. Madec) F90: Free form and module 11 !! 1.0 ! 04-08 (C. Talandier) New trends organization 12 !! ! 05-11 (G. Madec) add zps case 13 !! 3.0 ! 10-06 (C. Ethe, G. Madec) Merge TRA-TRC 14 !!---------------------------------------------------------------------- 15 16 !!---------------------------------------------------------------------- 17 !! tra_ldf_lap : update the tracer trend with the horizontal diffusion 18 !! using a iso-level harmonic (laplacien) operator. 6 !! History : OPA ! 1987-06 (P. Andrich, D. L Hostis) Original code 7 !! ! 1991-11 (G. Madec) 8 !! ! 1995-11 (G. Madec) suppress volumetric scale factors 9 !! ! 1996-01 (G. Madec) statement function for e3 10 !! NEMO ! 2002-06 (G. Madec) F90: Free form and module 11 !! 1.0 ! 2004-08 (C. Talandier) New trends organization 12 !! ! 2005-11 (G. Madec) add zps case 13 !! 3.0 ! 2010-06 (C. Ethe, G. Madec) Merge TRA-TRC 14 !! 3.7 ! 2014-01 (G. Madec) re-entrant laplacian 15 !!---------------------------------------------------------------------- 16 17 !!---------------------------------------------------------------------- 18 !! tra_ldf_lap : update the tracer trend with the lateral diffusion : iso-level laplacian operator 19 !! tra_ldf_bilap : update the tracer trend with the lateral diffusion : iso-level bilaplacian operator 19 20 !!---------------------------------------------------------------------- 20 21 USE oce ! ocean dynamics and active tracers 21 22 USE dom_oce ! ocean space and time domain 22 USE ldftra_oce ! ocean active tracers: lateral physics 23 USE in_out_manager ! I/O manager 23 USE ldftra ! lateral physics: eddy diffusivity 24 24 USE diaptr ! poleward transport diagnostics 25 25 USE trc_oce ! share passive tracers/Ocean variables 26 USE lib_mpp ! MPP library 26 USE zpshde ! partial step: hor. derivative (zps_hde routine) 27 ! 28 USE in_out_manager ! I/O manager 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 USE lib_mpp ! distribued memory computing library 27 31 USE timing ! Timing 32 USE wrk_nemo ! Memory allocation 28 33 29 34 IMPLICIT NONE … … 31 36 32 37 PUBLIC tra_ldf_lap ! routine called by step.F90 38 PUBLIC tra_ldf_blp ! routine called by step.F90 39 40 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: e1ur, e2vr ! scale factor coefficients 33 41 34 42 !! * Substitutions 35 43 # include "domzgr_substitute.h90" 36 # include "ldftra_substitute.h90"37 44 # include "vectopt_loop_substitute.h90" 38 45 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)46 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 40 47 !! $Id$ 41 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 50 CONTAINS 44 51 45 SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu, pgv, 46 & ptb, pta, kjpt)52 SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu, pgv, pahu, pahv, & 53 & ptb, pta, kjpt, kpass ) 47 54 !!---------------------------------------------------------------------- 48 55 !! *** ROUTINE tra_ldf_lap *** … … 54 61 !! fields (forward time scheme). The horizontal diffusive trends of 55 62 !! the tracer is given by: 56 !! difft = 1/(e1t*e2t*e3t) { di-1[ ahte2u*e3u/e1u di(tb) ]57 !! + dj-1[ ahte1v*e3v/e2v dj(tb) ] }63 !! difft = 1/(e1t*e2t*e3t) { di-1[ pahu e2u*e3u/e1u di(tb) ] 64 !! + dj-1[ pahv e1v*e3v/e2v dj(tb) ] } 58 65 !! Add this trend to the general tracer trend pta : 59 66 !! pta = pta + difft … … 62 69 !! harmonic mixing trend. 63 70 !!---------------------------------------------------------------------- 64 USE oce, ONLY: ztu => ua , ztv => va ! (ua,va) used as workspace65 !66 71 INTEGER , INTENT(in ) :: kt ! ocean time-step index 67 INTEGER , INTENT(in ) :: kit000 ! first time step index 72 INTEGER , INTENT(in ) :: kit000 ! first time step index 73 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 74 INTEGER , INTENT(in ) :: kjpt ! number of tracers 75 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 76 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 77 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 78 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 79 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 80 ! 81 INTEGER :: ji, jj, jk, jn ! dummy loop indices 82 INTEGER :: iku, ikv ! local integers 83 REAL(wp) :: zsign ! local scalars 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zaheeu, zaheev 85 !!---------------------------------------------------------------------- 86 ! 87 IF( kt == nit000 .AND. lwp ) THEN 88 WRITE(numout,*) 89 WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass 90 WRITE(numout,*) '~~~~~~~~~~~ ' 91 ENDIF 92 ! 93 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap') 94 ! 95 CALL wrk_alloc( jpi, jpj, jpk, ztu, ztv, zaheeu, zaheev ) 96 ! 97 DO jk = 1, jpkm1 !== Initialization of metric arrays used for all tracers ==! 98 DO jj = 1, jpjm1 99 DO ji = 1, fs_jpim1 ! vector opt. 100 zaheeu(ji,jj,jk) = pahu(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) !!gm * umask(ji,jj,jk) 101 zaheev(ji,jj,jk) = pahv(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) !!gm * vmask(ji,jj,jk) 102 END DO 103 END DO 104 END DO 105 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) 106 ELSE ; zsign = -1._wp 107 ENDIF 108 ! 109 ! ! =========== ! 110 DO jn = 1, kjpt ! tracer loop ! 111 ! ! =========== ! 112 ! 113 DO jk = 1, jpkm1 !== First derivative (gradient) ==! 114 DO jj = 1, jpjm1 115 DO ji = 1, fs_jpim1 116 ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 117 ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 118 END DO 119 END DO 120 END DO 121 IF( ln_zps ) THEN ! set gradient at partial step level 122 DO jj = 1, jpjm1 123 DO ji = 1, fs_jpim1 124 iku = mbku(ji,jj) ! last level 125 ikv = mbkv(ji,jj) 126 ztu(ji,jj,iku) = zaheeu(ji,jj,iku) * pgu(ji,jj,jn) 127 ztv(ji,jj,ikv) = zaheev(ji,jj,ikv) * pgv(ji,jj,jn) 128 END DO 129 END DO 130 ENDIF 131 ! 132 DO jk = 1, jpkm1 !== Second derivative (divergence) added to the general tracer trends ==! 133 DO jj = 2, jpjm1 134 DO ji = fs_2, fs_jpim1 135 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 136 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & 137 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 138 END DO 139 END DO 140 END DO 141 ! 142 ! !== "Poleward" diffusive heat or salt transports ==! 143 IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR. & !== first pass only ( laplacian) ==! 144 ( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass only (bilaplacian) ==! 145 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 146 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 147 IF( jn == jp_sal) str_ldf(:) = ptr_vj( ztv(:,:,:) ) 148 ENDIF 149 ENDIF 150 ! ! ================== 151 END DO ! end of tracer loop 152 ! ! ================== 153 ! 154 CALL wrk_dealloc( jpi, jpj, jpk, ztu, ztv, zaheeu, zaheev ) 155 ! 156 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap') 157 ! 158 END SUBROUTINE tra_ldf_lap 159 160 161 SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pgu, pgv, pahu, pahv, & 162 & ptb, pta, kjpt ) 163 !!---------------------------------------------------------------------- 164 !! *** ROUTINE tra_ldf_blp *** 165 !! 166 !! ** Purpose : Compute the before horizontal tracer diffusive 167 !! trend and add it to the general trend of tracer equation. 168 !! 169 !! ** Method : The lateral diffusive trends is provided by a bilaplacian 170 !! operator applied to before field (forward in time). 171 !! It is computed by two successive calls to tra_ldf_lap routine 172 !! 173 !! ** Action : pta updated with the before rotated bilaplacian diffusion 174 !!---------------------------------------------------------------------- 175 INTEGER , INTENT(in ) :: kt ! ocean time-step index 176 INTEGER , INTENT(in ) :: kit000 ! first time step index 68 177 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 69 178 INTEGER , INTENT(in ) :: kjpt ! number of tracers 70 179 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 180 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 71 181 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 72 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 73 ! 74 INTEGER :: ji, jj, jk, jn ! dummy loop indices 75 INTEGER :: iku, ikv, ierr ! local integers 76 REAL(wp) :: zabe1, zabe2, zbtr ! local scalars 77 !!---------------------------------------------------------------------- 78 ! 79 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap') 80 ! 81 IF( kt == kit000 ) THEN 182 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 183 ! 184 INTEGER :: ji, jj, jk, jn ! dummy loop indices 185 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap ! laplacian at t-point 186 REAL(wp), POINTER, DIMENSION(:,:,:) :: zglu, zglv ! gradient of the laplacian at partial step level (u- and v-points) 187 !!---------------------------------------------------------------------- 188 ! 189 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_iso_blp') 190 ! 191 CALL wrk_alloc( jpi, jpj, jpk, kjpt, zlap ) 192 CALL wrk_alloc( jpi, jpj , kjpt, zglu, zglv ) 193 ! 194 IF( kt == nit000 ) THEN 82 195 IF(lwp) WRITE(numout,*) 83 IF(lwp) WRITE(numout,*) 'tra_ldf_ lap : iso-level laplacian diffusionon ', cdtype84 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ 196 IF(lwp) WRITE(numout,*) 'tra_ldf_iso_blp : iso-neutral biharmonic operator on ', cdtype 197 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 85 198 ENDIF 86 199 87 ! ! =========== ! 88 DO jn = 1, kjpt ! tracer loop ! 89 ! ! =========== ! 90 DO jk = 1, jpkm1 ! slab loop 91 ! 92 ! 1. First derivative (gradient) 93 ! ------------------- 94 DO jj = 1, jpjm1 95 DO ji = 1, fs_jpim1 ! vector opt. 96 zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 97 zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 98 ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 99 ztv(ji,jj,jk) = zabe2 * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 100 END DO 101 END DO 102 IF( ln_zps ) THEN ! set gradient at partial step level 103 DO jj = 1, jpjm1 104 DO ji = 1, fs_jpim1 ! vector opt. 105 ! last level 106 iku = mbku(ji,jj) 107 ikv = mbkv(ji,jj) 108 IF( iku == jk ) THEN 109 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku) 110 ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn) 111 ENDIF 112 IF( ikv == jk ) THEN 113 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 114 ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn) 115 ENDIF 116 END DO 117 END DO 118 ENDIF 119 120 121 ! 2. Second derivative (divergence) added to the general tracer trends 122 ! --------------------------------------------------------------------- 123 DO jj = 2, jpjm1 124 DO ji = fs_2, fs_jpim1 ! vector opt. 125 zbtr = 1._wp / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 126 ! horizontal diffusive trends added to the general tracer trends 127 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 128 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 129 END DO 130 END DO 131 ! 132 END DO ! End of slab 133 ! 134 ! "Poleward" diffusive heat or salt transports 135 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 136 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 137 IF( jn == jp_sal) str_ldf(:) = ptr_vj( ztv(:,:,:) ) 138 ENDIF 139 ! ! ================== 140 END DO ! end of tracer loop 141 ! ! ================== 142 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap') 143 ! 144 END SUBROUTINE tra_ldf_lap 200 zlap(:,:,:,:) = 0._wp 201 CALL tra_ldf_lap( kt, kit000, cdtype, pgu, pgv, pahu, pahv, ptb, zlap, kjpt, 1 ) ! rotated laplacian applied to ptb (output in zlap) 202 ! 203 DO jn = 1, kjpt 204 CALL lbc_lnk( zlap(:,:,:,jn) , 'T', 1. ) ! Lateral boundary conditions (unchanged sign) 205 END DO 206 ! 207 IF( ln_zps ) CALL zps_hde( kt, jpts, zlap, zglu, zglv ) ! Partial steps: hor. gradient of laplacian at the partial step level 208 ! 209 CALL tra_ldf_lap( kt, kit000, cdtype, pgu, pgv, pahu, pahv, zlap, pta, kjpt, 2 ) ! rotated laplacian applied to zlap (output in pta) 210 ! 211 CALL wrk_dealloc( jpi, jpj, jpk, kjpt, zlap ) 212 CALL wrk_dealloc( jpi, jpj , kjpt, zglu, zglv ) 213 ! 214 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_iso_blp') 215 ! 216 END SUBROUTINE tra_ldf_blp 145 217 146 218 !!============================================================================== -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r3294 r4596 19 19 USE sbc_oce ! surface boundary condition: ocean 20 20 USE dynspg_oce 21 21 ! 22 USE ldftra ! lateral diffusion: eddy diffusivity 23 USE ldfslp ! lateral diffusion: iso-neutral slope 22 24 USE trazdf_exp ! vertical diffusion: explicit (tra_zdf_exp routine) 23 25 USE trazdf_imp ! vertical diffusion: implicit (tra_zdf_imp routine) 24 25 USE ldftra_oce ! ocean active tracers: lateral physics26 USE trd mod_oce ! ocean active tracers: lateral physics27 USE trdtra ! ocean tracers trends26 ! 27 USE trdmod_oce ! trends diagnostics 28 USE trdtra ! trends: ocean tracers 29 ! 28 30 USE in_out_manager ! I/O manager 29 31 USE prtctl ! Print control -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r3294 r4596 19 19 20 20 !!---------------------------------------------------------------------- 21 !! tra_zdf_imp : Update the tracer trend with the diagonal vertical 22 !! part of the mixing tensor. 23 !!---------------------------------------------------------------------- 24 USE oce ! ocean dynamics and tracers variables 25 USE dom_oce ! ocean space and time domain variables 26 USE zdf_oce ! ocean vertical physics variables 27 USE trc_oce ! share passive tracers/ocean variables 28 USE domvvl ! variable volume 29 USE ldftra_oce ! ocean active tracers: lateral physics 30 USE ldftra ! lateral mixing type 31 USE ldfslp ! lateral physics: slope of diffusion 32 USE zdfddm ! ocean vertical physics: double diffusion 33 USE traldf_iso_grif ! active tracers: Griffies operator 34 USE in_out_manager ! I/O manager 35 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 36 USE lib_mpp ! MPP library 37 USE wrk_nemo ! Memory Allocation 38 USE timing ! Timing 21 !! tra_zdf_imp : Update the tracer trend with the diagonal vertical part of the mixing tensor. 22 !!---------------------------------------------------------------------- 23 USE oce ! ocean dynamics and tracers variables 24 USE dom_oce ! ocean space and time domain variables 25 USE zdf_oce ! ocean vertical physics variables 26 USE trc_oce ! share passive tracers/ocean variables 27 USE domvvl ! variable volume 28 USE ldftra ! lateral mixing type 29 USE ldfslp ! lateral physics: slope of diffusion 30 USE zdfddm ! ocean vertical physics: double diffusion 31 USE traldf_iso_triad ! active tracers: Method of Stabilizing Correction 32 ! 33 USE in_out_manager ! I/O manager 34 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 35 USE lib_mpp ! MPP library 36 USE wrk_nemo ! Memory Allocation 37 USE timing ! Timing 39 38 40 39 IMPLICIT NONE … … 47 46 !! * Substitutions 48 47 # include "domzgr_substitute.h90" 49 # include "ldftra_substitute.h90"50 48 # include "zdfddm_substitute.h90" 51 49 # include "vectopt_loop_substitute.h90" 52 50 !!---------------------------------------------------------------------- 53 !! NEMO/OPA 3. 3, NEMO Consortium (2010)51 !! NEMO/OPA 3.7 , NEMO Consortium (2010) 54 52 !! $Id$ 55 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 122 120 zwt(:,:,1) = 0._wp 123 121 ! 124 #if defined key_ldfslp 125 ! isoneutral diffusion: add the contribution126 IF( ln_traldf_grif ) THEN ! Griffies isoneutral diff127 DO jk = 2, jpkm1128 DO jj = 2, jpjm1129 DO ji = fs_2, fs_jpim1 ! vector opt.130 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk)122 IF( l_ldfslp ) THEN ! isoneutral diffusion: add the contribution 123 IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator 124 DO jk = 2, jpkm1 125 DO jj = 2, jpjm1 126 DO ji = fs_2, fs_jpim1 ! vector opt. 127 zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk) 128 END DO 131 129 END DO 132 130 END DO 133 END DO 134 ELSE IF( l_traldf_rot ) THEN ! standard isoneutral diff 135 DO jk = 2, jpkm1 136 DO jj = 2, jpjm1 137 DO ji = fs_2, fs_jpim1 ! vector opt. 138 zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk) & 139 & * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 140 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) 131 ELSE ! standard or triad iso-neutral operator 132 DO jk = 2, jpkm1 133 DO jj = 2, jpjm1 134 DO ji = fs_2, fs_jpim1 ! vector opt. 135 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 136 END DO 141 137 END DO 142 138 END DO 143 END DO139 ENDIF 144 140 ENDIF 145 #endif 141 ! 146 142 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 147 143 DO jk = 1, jpkm1 -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r3294 r4596 18 18 USE phycst ! physical constants 19 19 USE eosbn2 ! ocean equation of state 20 ! 20 21 USE in_out_manager ! I/O manager 21 22 USE lbclnk ! lateral boundary conditions (or mpp link) … … 40 41 41 42 SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv, & 42 43 & prd, pgru, pgrv ) 43 44 !!---------------------------------------------------------------------- 44 45 !! *** ROUTINE zps_hde *** … … 83 84 !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 84 85 !!---------------------------------------------------------------------- 85 !86 86 INTEGER , INTENT(in ) :: kt ! ocean time-step index 87 87 INTEGER , INTENT(in ) :: kjpt ! number of tracers -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90
r4313 r4596 18 18 USE oce ! ocean dynamics and tracers variables 19 19 USE dom_oce ! ocean space and time domain variables 20 USE eosbn2 ! equation of state 21 USE phycst ! physical constants 20 22 USE trdmod_oce ! ocean variables trends 21 USE ldftra_oce ! ocean active tracers: lateral physics 22 USE ldfdyn_oce ! ocean dynamics: lateral physics 23 USE ldftra ! lateral physics: eddy diffusivity 23 24 USE zdf_oce ! ocean vertical physics 25 ! 24 26 USE in_out_manager ! I/O manager 25 27 USE lib_mpp ! distibuted memory computing library 26 USE eosbn2 ! equation of state27 USE phycst ! physical constants28 28 USE wrk_nemo ! Memory allocation 29 29 -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90
r3792 r4596 23 23 USE trdmod_oce ! ocean variables trends 24 24 USE trdmld_oce ! ocean variables trends 25 USE ldftra _oce ! ocean active tracers lateral physics25 USE ldftra ! lateral physics : eddy diffusivity 26 26 USE zdf_oce ! ocean vertical physics 27 27 USE in_out_manager ! I/O manager … … 36 36 USE trdmld_rst ! restart for diagnosing the ML trends 37 37 USE prtctl ! Print control 38 USE restart ! for lrst_oce 38 39 USE lib_mpp ! MPP library 39 40 USE wrk_nemo ! Memory allocation … … 55 56 !! * Substitutions 56 57 # include "domzgr_substitute.h90" 57 # include "ldftra_substitute.h90"58 58 # include "zdfddm_substitute.h90" 59 59 !!---------------------------------------------------------------------- … … 93 93 !! surface and the control surface is called "mixed-layer" 94 94 !!---------------------------------------------------------------------- 95 !96 95 INTEGER , INTENT( in ) :: ktrd ! ocean trend index 97 96 CHARACTER(len=2) , INTENT( in ) :: ctype ! 2D surface/bottom or 3D interior physics -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90
r4147 r4596 17 17 USE zdf_oce ! ocean vertical physics variables 18 18 USE trdmod_oce ! ocean variables trends 19 USE ldftra_oce ! ocean active tracers lateral physics 19 USE ldftra ! lateral physics: eddy diffusivity 20 USE ldfslp ! lateral physics: slope of iso-neutral surfaces 20 21 USE sbc_oce ! surface boundary condition: ocean 21 22 USE phycst ! physical constants … … 252 253 USE in_out_manager ! I/O manager 253 254 USE lib_mpp ! MPP library 254 !! 255 ! 256 INTEGER :: ios ! Local integer output status for namelist read 257 ! 255 258 NAMELIST/namtrd/ nn_trd, nn_ctls, cn_trdrst_in, cn_trdrst_out, ln_trdmld_restart, rn_ucf, ln_trdmld_instant 256 INTEGER :: ios ! Local integer output status for namelist read 257 !!---------------------------------------------------------------------- 258 259 !!---------------------------------------------------------------------- 260 ! 259 261 IF( l_trdtra .OR. l_trddyn ) THEN 260 262 ! 261 263 REWIND( numnam_ref ) ! Namelist namtrd in reference namelist : Diagnostics: trends 262 264 READ ( numnam_ref, namtrd, IOSTAT = ios, ERR = 901) 263 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in reference namelist', lwp )264 265 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in reference namelist', lwp ) 266 ! 265 267 REWIND( numnam_cfg ) ! Namelist namtrd in configuration namelist : Diagnostics: trends 266 268 READ ( numnam_cfg, namtrd, IOSTAT = ios, ERR = 902 ) 267 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in configuration namelist', lwp )269 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrd in configuration namelist', lwp ) 268 270 WRITE ( numond, namtrd ) 269 271 ! 270 272 IF(lwp) THEN 271 273 WRITE(numout,*) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
r3294 r4596 21 21 USE in_out_manager ! I/O manager 22 22 USE phycst ! Define parameters for the routines 23 USE ldfdyn_oce ! ocean active tracers: lateral physics24 23 USE dianam ! build the name of file (routine) 25 24 USE zdfmxl ! mixed layer depth … … 59 58 !! * Substitutions 60 59 # include "domzgr_substitute.h90" 61 # include "ldfdyn_substitute.h90"62 60 # include "vectopt_loop_substitute.h90" 63 61 !!---------------------------------------------------------------------- … … 109 107 !! trends output in netCDF format using ioipsl 110 108 !!---------------------------------------------------------------------- 111 !112 109 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 113 110 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: putrdvor ! u vorticity trend … … 118 115 REAL(wp), POINTER, DIMENSION(:,:) :: zudpvor, zvdpvor ! total cmulative trends 119 116 !!---------------------------------------------------------------------- 120 121 117 ! 122 118 CALL wrk_alloc( jpi, jpj, zudpvor, zvdpvor ) ! Memory allocation 123 119 ! 124 125 120 zudpvor(:,:) = 0._wp ; zvdpvor(:,:) = 0._wp ! Initialisation 126 121 CALL lbc_lnk( putrdvor, 'U', -1. ) ; CALL lbc_lnk( pvtrdvor, 'V', -1. ) ! lateral boundary condition … … 133 128 SELECT CASE (ktrd) 134 129 ! 135 CASE (jpvor_bfr) ! bottom friction130 CASE (jpvor_bfr) ! bottom friction 136 131 DO jj = 2, jpjm1 137 132 DO ji = fs_2, fs_jpim1 … … 143 138 END DO 144 139 ! 145 CASE (jpvor_swf) ! wind stress140 CASE (jpvor_swf) ! wind stress 146 141 zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1) 147 142 zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1) … … 149 144 END SELECT 150 145 151 ! Average except for Beta.V146 ! ! Average except for Beta.V 152 147 zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 153 148 zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 154 149 155 ! Curl156 DO ji=1,jpim1157 DO jj=1,jpjm1158 vortrd(ji,jj,ktrd) =( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) &159 &- ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) )150 DO ji = 1, jpim1 ! Curl 151 DO jj = 1, jpjm1 152 vortrd(ji,jj,ktrd) = umask(ji+1,jj,1) * umask(ji,jj,1) & ! surface mask at f-point 153 & * ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 154 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 160 155 END DO 161 156 END DO 162 vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) ! Surface mask163 157 164 158 IF( ndebug /= 0 ) THEN … … 241 235 242 236 ! Curl 243 DO ji=1,jpim1 244 DO jj=1,jpjm1 245 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 246 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 237 DO ji = 1, jpim1 238 DO jj = 1, jpjm1 239 vortrd(ji,jj,ktrd) = umask(ji+1,jj,1) * umask(ji,jj,1) & ! surface mask at f-point 240 & * ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 241 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 247 242 END DO 248 243 END DO 249 250 ! Surface mask251 vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1)252 244 253 245 ! Special treatement for the Beta.V term 254 246 ! Compute the Curl of the Beta.V term which is not averaged 255 247 IF( ktrd == jpvor_bev ) THEN 256 DO ji=1,jpim1 257 DO jj=1,jpjm1 258 vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) & 248 DO ji = 1, jpim1 249 DO jj = 1, jpjm1 250 vortrd(ji,jj,jpvor_bev) = umask(ji+1,jj,1) * umask(ji,jj,1) & ! surface mask at f-point 251 & * ( zvbet(ji+1,jj) - zvbet(ji,jj) & 259 252 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 260 253 END DO 261 254 END DO 262 263 ! Average on the Curl 255 ! ! Average on the Curl 264 256 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) 265 266 ! Surface mask267 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * fmask(:,:,1)268 257 ENDIF 269 258 … … 330 319 331 320 ! Curl 332 DO ji=1,jpim1 333 DO jj=1,jpjm1 334 vor_avr(ji,jj) = ( ( zvn(ji+1,jj) - zvn(ji,jj) ) & 335 & - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 321 DO ji = 1, jpim1 322 DO jj = 1, jpjm1 323 vor_avr(ji,jj) = umask(ji+1,jj,1) * umask(ji,jj,1) & ! surface mask at f-point 324 & * ( ( zvn(ji+1,jj) - zvn(ji,jj) ) & 325 & - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 336 326 END DO 337 327 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
r4292 r4596 14 14 !!---------------------------------------------------------------------- 15 15 USE par_oce ! mesh and scale factors 16 USE ldftra_oce ! ocean active tracers: lateral physics17 USE ldfdyn_oce ! ocean dynamics lateral physics18 16 USE zdf_oce ! TKE vertical mixing 19 17 USE lib_mpp ! distribued memory computing … … 26 24 USE tranpc ! convection: non penetrative adjustment 27 25 USE ldfslp ! iso-neutral slopes 28 26 USE restart ! ocean restart 27 ! 29 28 USE in_out_manager ! I/O manager 30 29 USE iom ! IOM library … … 50 49 !! ** Method : Read namelist namzdf, control logicals 51 50 !!---------------------------------------------------------------------- 52 INTEGER :: ioptio ! temporary scalar 53 INTEGER :: ios 51 INTEGER :: ioptio, ios ! local integers 54 52 !! 55 53 NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp, & -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4354 r4596 28 28 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 29 29 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 30 !! 3.4 ! 2011-11 (C. Harris) decomposition changes for running with CICE 31 !! ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 30 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms 31 !! - ! 2011-11 (C. Harris) decomposition changes for running with CICE 32 !! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 33 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 32 34 !!---------------------------------------------------------------------- 33 35 … … 40 42 !! nemo_partition : calculate MPP domain decomposition 41 43 !! factorise : calculate the factors of the no. of MPI processes 44 !! nemo_northcomms: Setup for north fold exchanges with explicit point-to-point messaging 42 45 !!---------------------------------------------------------------------- 43 USE step_oce ! module used in the ocean time stepping module 46 USE step_oce ! module used in the ocean time stepping module (step.F90) 44 47 USE sbc_oce ! surface boundary condition: ocean 45 48 USE cla ! cross land advection (tra_cla routine) … … 86 89 USE sbctide, ONLY: lk_tide 87 90 USE crsini ! initialise grid coarsening utility 88 USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges89 91 90 92 IMPLICIT NONE … … 121 123 !!---------------------------------------------------------------------- 122 124 ! 123 124 125 #if defined key_agrif 125 126 CALL Agrif_Init_Grids() ! AGRIF: set the meshes … … 139 140 # endif 140 141 #endif 141 142 142 ! check that all process are still there... If some process have an error, 143 143 ! they will never enter in step and other processes will wait until the end of the cpu time! … … 166 166 167 167 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 168 169 168 #if defined key_agrif 170 169 CALL Agrif_Step( stp ) ! AGRIF: time stepping … … 172 171 CALL stp( istp ) ! standard time stepping 173 172 #endif 174 175 173 istp = istp + 1 176 174 IF( lk_mpp ) CALL mpp_max( nstop ) … … 228 226 CHARACTER(len=80), DIMENSION(16) :: cltxt 229 227 !! 230 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, &228 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 231 229 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & 232 230 & nn_bench, nn_timing 233 NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 234 & jpizoom, jpjzoom, jperio 231 NAMELIST/namcfg/ cp_cfg, jp_cfg, jpidta , jpjdta , jpkdta, & 232 & cp_cfz, jperio, jpiglo , jpjglo , & 233 & jpizoom, jpjzoom 235 234 !!---------------------------------------------------------------------- 236 235 ! … … 238 237 ! 239 238 ! ! Open reference namelist and configuration namelist files 240 CALL ctl_opn( numnam_ref, 'namelist_ref' , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE.)241 CALL ctl_opn( numnam_cfg, 'namelist_cfg' , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE.)242 CALL ctl_opn( numond , 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., 1 )239 CALL ctl_opn( numnam_ref, 'namelist_ref' , 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 240 CALL ctl_opn( numnam_cfg, 'namelist_cfg' , 'OLD' , 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 241 CALL ctl_opn( numond , 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., 1 ) 243 242 ! 244 243 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark … … 261 260 WRITE( numond, namcfg ) 262 261 263 ! Force values for AGRIF zoom (cf. agrif_user.F90)262 ! Force values for AGRIF zoom (cf. agrif_user.F90) 264 263 #if defined key_agrif 265 264 IF( .NOT. Agrif_Root() ) THEN … … 307 306 ! If dimensions of processor grid weren't specified in the namelist file 308 307 ! then we calculate them here now that we have our communicator size 309 IF( (jpni < 1) .OR. (jpnj < 1) ) THEN308 IF( (jpni < 1) .OR. (jpnj < 1) ) THEN 310 309 #if defined key_mpp_mpi 311 IF( Agrif_Root() ) CALL nemo_partition( mppsize)310 IF( Agrif_Root() ) CALL nemo_partition( mppsize ) 312 311 #else 313 312 jpni = 1 … … 315 314 jpnij = jpni*jpnj 316 315 #endif 317 END 316 ENDIF 318 317 319 318 ! Calculate domain dimensions given calculated jpni and jpnj 320 ! This used to be done in par_oce.F90 when they were parameters rather 321 ! than variables 319 ! This used to be done in par_oce.F90 when they were parameters rather than variables 322 320 IF( Agrif_Root() ) THEN 323 321 #if defined key_nemocice_decomp … … 325 323 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 326 324 #else 327 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim.328 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.329 #endif 330 ENDIF 331 jpk = jpkdta! third dim332 jpim1 = jpi-1! inner domain indices333 jpjm1 = jpj-1! " "334 jpkm1 = jpk-1! " "335 jpij = jpi*jpj! jpi x j325 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 326 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 327 #endif 328 ENDIF 329 jpk = jpkdta ! third dim 330 jpim1 = jpi-1 ! inner domain indices 331 jpjm1 = jpj-1 ! " " 332 jpkm1 = jpk-1 ! " " 333 jpij = jpi*jpj ! jpi x j 336 334 337 335 IF(lwp) THEN ! open listing units … … 343 341 WRITE(numout,*) ' NEMO team' 344 342 WRITE(numout,*) ' Ocean General Circulation Model' 345 WRITE(numout,*) ' version 3. 4 (2011) '343 WRITE(numout,*) ' version 3.6 (2014) ' 346 344 WRITE(numout,*) 347 345 WRITE(numout,*) … … 391 389 392 390 CALL dyn_nept_init ! simplified form of Neptune effect 393 394 391 ! 395 392 IF( ln_crs ) CALL crs_init ! Domain initialization of coarsened grid 396 393 ! 397 394 ! ! Ocean physics 398 395 CALL sbc_init ! Forcings : surface module 396 399 397 ! ! Vertical physics 400 401 398 CALL zdf_init ! namelist read 402 403 399 CALL zdf_bfr_init ! bottom friction 404 405 400 IF( lk_zdfric ) CALL zdf_ric_init ! Richardson number dependent Kz 406 401 IF( lk_zdftke ) CALL zdf_tke_init ! TKE closure scheme … … 410 405 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & 411 406 & CALL zdf_ddm_init ! double diffusive mixing 407 412 408 ! ! Lateral physics 413 409 CALL ldf_tra_init ! Lateral ocean tracer physics 410 CALL ldf_eiv_init ! eddy induced velocity param. 414 411 CALL ldf_dyn_init ! Lateral ocean momentum physics 415 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 416 417 ! ! Active tracers 418 CALL tra_qsr_init ! penetrative solar radiation qsr 419 CALL tra_bbc_init ! bottom heat flux 420 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 421 CALL tra_dmp_init ! internal damping trends- tracers 422 CALL tra_adv_init ! horizontal & vertical advection 423 CALL tra_ldf_init ! lateral mixing 424 CALL tra_zdf_init ! vertical mixing and after tracer fields 425 426 ! ! Dynamics 427 IF( lk_c1d ) CALL dyn_dmp_init ! internal damping trends- momentum 428 CALL dyn_adv_init ! advection (vector or flux form) 429 CALL dyn_vor_init ! vorticity term including Coriolis 430 CALL dyn_ldf_init ! lateral mixing 431 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 432 CALL dyn_zdf_init ! vertical diffusion 433 CALL dyn_spg_init ! surface pressure gradient 412 413 ! ! Active tracers 414 CALL tra_qsr_init ! penetrative solar radiation qsr 415 CALL tra_bbc_init ! bottom heat flux 416 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 417 CALL tra_dmp_init ! internal tracer damping 418 CALL tra_adv_init ! horizontal & vertical advection 419 CALL tra_ldf_init ! lateral mixing 420 CALL tra_zdf_init ! vertical mixing and after tracer fields 421 422 ! ! Dynamics 423 IF( lk_c1d ) CALL dyn_dmp_init ! internal momentum damping 424 CALL dyn_adv_init ! advection (vector or flux form) 425 CALL dyn_vor_init ! vorticity term including Coriolis 426 CALL dyn_ldf_init ! lateral mixing 427 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 428 CALL dyn_zdf_init ! vertical diffusion 429 CALL dyn_spg_init ! surface pressure gradient 430 431 432 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 433 434 434 435 435 436 ! ! Misc. options 436 IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2) CALL cla_init ! Cross Land Advection437 IF( nn_cla == 1 ) CALL cla_init ! Cross Land Advection 437 438 CALL icb_init( rdt, nit000) ! initialise icebergs instance 438 439 … … 441 442 CALL trc_init 442 443 #endif 443 ! 444 445 ! Diagnostics 444 ! ! Diagnostics 446 445 IF( lk_floats ) CALL flo_init ! drifting Floats 447 446 IF( lk_diaar5 ) CALL dia_ar5_init ! ar5 diag … … 501 500 WRITE(numout,*) '~~~~~~~ ' 502 501 WRITE(numout,*) ' Namelist namcfg' 503 WRITE(numout,*) ' configuration name cp_cfg= ', TRIM(cp_cfg)504 WRITE(numout,*) ' configuration zoom name cp_cfz= ', TRIM(cp_cfz)505 WRITE(numout,*) ' configuration resolution jp_cfg= ', jp_cfg506 WRITE(numout,*) ' 1st lateral dimension ( >= jpi ) jpidta= ', jpidta507 WRITE(numout,*) ' 2nd " " ( >= jpj ) jpjdta= ', jpjdta508 WRITE(numout,*) ' 3nd " " jpkdta= ', jpkdta509 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo510 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo502 WRITE(numout,*) ' configuration name cp_cfg = ', TRIM(cp_cfg) 503 WRITE(numout,*) ' configuration zoom name cp_cfz = ', TRIM(cp_cfz) 504 WRITE(numout,*) ' configuration resolution jp_cfg = ', jp_cfg 505 WRITE(numout,*) ' 1st lateral dimension ( >= jpiglo ) jpidta = ', jpidta 506 WRITE(numout,*) ' 2nd " " ( >= jpjglo ) jpjdta = ', jpjdta 507 WRITE(numout,*) ' 3nd " " jpkdta = ', jpkdta 508 WRITE(numout,*) ' 1st dimension of global domain in i jpiglo = ', jpiglo 509 WRITE(numout,*) ' 2nd - - in j jpjglo = ', jpjglo 511 510 WRITE(numout,*) ' left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 512 511 WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 513 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio512 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 514 513 ENDIF 515 514 ! ! Parameter control … … 595 594 IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports 596 595 IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports 597 598 596 ! 599 597 numout = 6 ! redefine numout in case it is used after this point... … … 612 610 USE diawri , ONLY: dia_wri_alloc 613 611 USE dom_oce , ONLY: dom_oce_alloc 614 USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc615 USE ldftra_oce, ONLY: ldftra_oce_alloc616 612 USE trc_oce , ONLY: trc_oce_alloc 617 613 #if defined key_diadct … … 628 624 ierr = ierr + dia_wri_alloc () 629 625 ierr = ierr + dom_oce_alloc () ! ocean domain 630 ierr = ierr + ldfdyn_oce_alloc() ! ocean lateral physics : dynamics631 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers632 626 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 633 627 ! … … 715 709 & 128, 64, 32, 16, 8, 4, 2 / 716 710 !!---------------------------------------------------------------------- 717 711 ! 718 712 ! Clear the error flag and initialise output vars 719 kerr = 0720 kfax = 1713 kerr = 0 714 kfax = 1 721 715 knfax = 0 722 716 ! 723 717 ! Find the factors of n. 724 718 IF( kn == 1 ) GOTO 20 … … 728 722 ! l points to the allowed factor list. 729 723 ! ifac holds the current factor. 730 724 ! 731 725 inu = kn 732 726 knfax = 0 733 727 ! 734 728 DO jl = ntest, 1, -1 735 729 ! … … 755 749 ! 756 750 END DO 757 751 ! 758 752 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 759 753 ! 760 754 END SUBROUTINE factorise 761 755 762 #if defined key_mpp_mpi 756 763 757 SUBROUTINE nemo_northcomms 764 !! ======================================================================758 !!---------------------------------------------------------------------- 765 759 !! *** ROUTINE nemo_northcomms *** 766 !! nemo_northcomms : Setup for north fold exchanges with explicit 767 !! point-to-point messaging 768 !!===================================================================== 769 !!---------------------------------------------------------------------- 770 !! 771 !! ** Purpose : Initialization of the northern neighbours lists. 772 !!---------------------------------------------------------------------- 773 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 774 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 775 !!---------------------------------------------------------------------- 776 777 INTEGER :: sxM, dxM, sxT, dxT, jn 778 INTEGER :: njmppmax 779 780 njmppmax = MAXVAL( njmppt ) 781 782 !initializes the north-fold communication variables 760 !! ** Purpose : Setup for north fold exchanges with explicit 761 !! point-to-point messaging 762 !! 763 !! ** Method : Initialization of the northern neighbours lists. 764 !!---------------------------------------------------------------------- 765 USE lbcnfd, ONLY: isendto, nsndto ! setup of north fold exchanges 766 ! 767 INTEGER :: jn 768 INTEGER :: isxM, idxM, isxT, idxT, ijmppmax 769 !!---------------------------------------------------------------------- 770 ! 771 ijmppmax = MAXVAL( njmppt ) 772 ! 773 ! initializes the north-fold communication variables 783 774 isendto(:) = 0 784 nsndto = 0 785 786 !if I am a process in the north 787 IF ( njmpp == njmppmax ) THEN 788 !sxM is the first point (in the global domain) needed to compute the 789 !north-fold for the current process 790 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 791 !dxM is the last point (in the global domain) needed to compute the 792 !north-fold for the current process 793 dxM = jpiglo - nimppt(narea) + 2 794 795 !loop over the other north-fold processes to find the processes 796 !managing the points belonging to the sxT-dxT range 797 DO jn = jpnij - jpni +1, jpnij 798 IF ( njmppt(jn) == njmppmax ) THEN 799 !sxT is the first point (in the global domain) of the jn 800 !process 801 sxT = nimppt(jn) 802 !dxT is the last point (in the global domain) of the jn 803 !process 804 dxT = nimppt(jn) + nlcit(jn) - 1 805 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 775 nsndto = 0 776 ! 777 IF( njmpp == ijmppmax ) THEN ! if I am a process in the north 778 ! 779 ! isxM is the first point (in the global domain) needed to compute the 780 ! north-fold for the current process 781 isxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 782 ! idxM is the last point (in the global domain) needed to compute the 783 ! north-fold for the current process 784 idxM = jpiglo - nimppt(narea) + 2 785 ! 786 ! loop over the other north-fold processes to find the processes 787 ! managing the points belonging to the isxT-idxT range 788 DO jn = jpnij - jpni +1, jpnij 789 IF( njmppt(jn) == ijmppmax ) THEN 790 ! isxT is the first point (in the global domain) of the jn process 791 isxT = nimppt(jn) 792 ! idxT is the last point (in the global domain) of the jn process 793 idxT = nimppt(jn) + nlcit(jn) - 1 794 IF( (isxM .gt. isxT) .AND. (isxM .lt. idxT) ) THEN 806 795 nsndto = nsndto + 1 807 796 isendto(nsndto) = jn 808 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN797 ELSEIF( (isxM .le. isxT) .AND. (idxM .gt. idxT) ) THEN 809 798 nsndto = nsndto + 1 810 799 isendto(nsndto) = jn 811 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN800 ELSEIF( (idxM .lt. idxT) .AND. (isxT .lt. idxM) ) THEN 812 801 nsndto = nsndto + 1 813 802 isendto(nsndto) = jn … … 817 806 ENDIF 818 807 l_north_nogather = .TRUE. 808 ! 819 809 END SUBROUTINE nemo_northcomms 820 #else 821 SUBROUTINE nemo_northcomms ! Dummy routine 822 WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?' 823 END SUBROUTINE nemo_northcomms 824 #endif 810 825 811 !!====================================================================== 826 812 END MODULE nemogcm 827 828 -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/oce.F90
r4354 r4596 7 7 !! 3.1 ! 2009-02 (G. Madec, M. Leclair) pure z* coordinate 8 8 !! 3.3 ! 2010-09 (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays 9 !! 3.7 ! 2014-01 (G. Madec) suppression of curl and before hdiv from in-core memory 9 10 !!---------------------------------------------------------------------- 10 11 USE par_oce ! ocean parameters … … 16 17 PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 17 18 18 LOGICAL, PUBLIC :: l_traldf_rot = .FALSE. !: rotated laplacian operator for lateral diffusion19 20 19 !! dynamics and tracer fields ! before ! now ! after ! the after trends becomes the fields 21 20 !! -------------------------- ! fields ! fields ! trends ! only after tra_zdf and dyn_spg … … 24 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ua_sv, va_sv !: Saved trends (time spliting) [m/s2] 25 24 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] 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivn !: horizontal divergence [s-1] 28 26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsb , tsn !: 4D T-S fields [Celcius,psu] 29 27 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rn2b , rn2 !: brunt-vaisala frequency**2 [s-2] … … 61 59 62 60 !!---------------------------------------------------------------------- 63 !! NEMO/OPA 4.0 , NEMO Consortium (201 1)61 !! NEMO/OPA 4.0 , NEMO Consortium (2014) 64 62 !! $Id$ 65 63 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 77 75 & vb (jpi,jpj,jpk) , vn (jpi,jpj,jpk) , va(jpi,jpj,jpk) , & 78 76 & ua_sv(jpi,jpj,jpk) , va_sv(jpi,jpj,jpk) , & 79 & wn (jpi,jpj,jpk) , & 80 & rotb (jpi,jpj,jpk) , rotn (jpi,jpj,jpk) , & 81 & hdivb(jpi,jpj,jpk) , hdivn(jpi,jpj,jpk) , & 77 & wn (jpi,jpj,jpk) , hdivn(jpi,jpj,jpk) , & 82 78 & tsb (jpi,jpj,jpk,jpts) , tsn (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) , & 83 & rn2b (jpi,jpj,jpk) , rn2 (jpi,jpj,jpk) , STAT=ierr(1) ) 79 & rn2b (jpi,jpj,jpk) , rn2 (jpi,jpj,jpk) , & 80 & rhd (jpi,jpj,jpk) , rhop (jpi,jpj,jpk) , STAT=ierr(1) ) 84 81 ! 85 ALLOCATE(rhd (jpi,jpj,jpk) , & 86 & rhop(jpi,jpj,jpk) , & 87 & sshb(jpi,jpj) , sshn(jpi,jpj) , ssha(jpi,jpj) , & 88 & ub_b(jpi,jpj) , un_b(jpi,jpj) , ua_b(jpi,jpj) , & 89 & vb_b(jpi,jpj) , vn_b(jpi,jpj) , va_b(jpi,jpj) , & 90 & spgu (jpi,jpj) , spgv(jpi,jpj) , & 91 & gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts), & 92 & gru(jpi,jpj) , grv(jpi,jpj) , STAT=ierr(2) ) 82 ALLOCATE( sshb(jpi,jpj) , sshn(jpi,jpj) , ssha(jpi,jpj), & 83 & ub_b(jpi,jpj) , un_b(jpi,jpj) , ua_b(jpi,jpj), & 84 & vb_b(jpi,jpj) , vn_b(jpi,jpj) , va_b(jpi,jpj), & 85 & spgu(jpi,jpj) , spgv(jpi,jpj) , & 86 & gru (jpi,jpj) , grv (jpi,jpj) , & 87 & gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts) , STAT=ierr(2) ) 93 88 ! 94 89 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) ) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/step.F90
r4491 r4596 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 !! 3.6 ! 2012-07 (J. Simeon, G. Madec. C. Ethe) Online coarsening of outputs 27 !! 3.7 ! 2014-01 (G. Madec) LDF simplication 27 28 !!---------------------------------------------------------------------- 28 29 … … 35 36 PRIVATE 36 37 37 PUBLIC stp ! called by opa.F9038 PUBLIC stp ! called by nemogcm.F90 38 39 39 40 !! * Substitutions … … 74 75 INTEGER :: kcall ! optional integer argument (dom_vvl_sf_nxt) 75 76 !! --------------------------------------------------------------------- 76 77 77 #if defined key_agrif 78 78 kstp = nit000 + Agrif_Nb_Step() 79 ! IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 80 ! IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 81 IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 79 IF( kstp == nit000 + 1 ) lk_agrif_fstep = .FALSE. 82 80 # if defined key_iomput 83 81 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( "nemo" ) 84 82 # endif 85 83 #endif 86 indic = 0 ! reset to no error condition 84 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 85 ! update I/O and calendar 86 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 87 indic = 0 ! reset to no error condition 87 88 IF( kstp == nit000 ) THEN 88 CALL iom_init( "nemo" ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 89 IF( ln_crs ) CALL iom_init( "nemo_crs" ) ! initialize context for coarse grid 90 ENDIF 91 92 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 89 CALL iom_init( "nemo" ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 90 IF( ln_crs ) CALL iom_init( "nemo_crs" ) ! initialize context for coarse grid 91 ENDIF 92 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 93 93 CALL iom_setkt( kstp - nit000 + 1, "nemo" ) ! say to iom that we are at time step kstp 94 IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" ) ! say to iom that we are at time step kstp 95 96 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 97 ! Update data, open boundaries, surface boundary condition (including sea-ice) 98 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 99 IF( lk_tide ) CALL sbc_tide( kstp ) 100 IF( lk_bdy ) CALL bdy_dta ( kstp, time_offset=+1 ) ! update dynamic & tracer data at open boundaries 101 102 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) 103 ! clem: moved here for bdy ice purpose 94 IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" ) ! say to iom that we are at time step kstp 95 96 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 97 ! Update tide, open boundaries, and surface boundary condition (including sea-ice) 98 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 99 IF( lk_tide ) CALL sbc_tide( kstp ) ! update tide potential 100 IF( lk_bdy ) CALL bdy_dta ( kstp, time_offset=+1 ) ! update dynamic, tracer & ice data at open boundaries 101 CALL sbc ( kstp ) ! Surface Boundary Condition (including sea-ice) 104 102 105 103 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 139 137 ! LATERAL PHYSICS 140 138 ! 141 IF( l k_ldfslp ) THEN! slope of lateral mixing142 CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density 139 IF( l_ldfslp ) THEN ! slope of lateral mixing 140 CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density at reference level 143 141 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient 144 142 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 145 IF( ln_traldf_ grif ) THEN ! before slope for Griffies operator146 CALL ldf_slp_grif( kstp ) 147 ELSE148 CALL ldf_slp ( kstp, rhd, rn2b )! before slope for Madec operator143 IF( ln_traldf_triad ) THEN 144 CALL ldf_slp_grif( kstp ) ! before slope for Griffies operator 145 ELSE 146 CALL ldf_slp ( kstp, rhd, rn2b ) ! before slope for Madec operator 149 147 ENDIF 150 148 ENDIF 151 #if defined key_traldf_c2d 152 IF( lk_traldf_eiv ) CALL ldf_eiv( kstp ) ! eddy induced velocity coefficient 153 #endif 149 150 ! ! eddy diffusivity coeff. and/or eiv coeff. 151 IF( l_ldftra_time .OR. l_ldfeiv_time ) CALL ldf_tra( kstp ) 152 153 !!gm CALL to ldf_dyn is missing 154 154 155 #if defined key_traldf_c3d && key_traldf_smag 155 156 CALL ldf_tra_smag( kstp ) ! eddy induced velocity coefficient … … 160 161 161 162 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 162 ! Ocean dynamics : hdiv, rot,ssh, e3, wn163 ! Ocean dynamics : hdiv, ssh, e3, wn 163 164 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 164 165 CALL ssh_nxt ( kstp ) ! after ssh (includes call to div_cur) … … 209 210 IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis 210 211 CALL dia_wri( kstp ) ! ocean model: outputs 211 !212 212 IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output 213 213 … … 266 266 ua(:,:,:) = ua_sv(:,:,:) 267 267 va(:,:,:) = va_sv(:,:,:) 268 ! Revert now divergence and rotational to previously computed ones269 !(needed because of the time swap in div_cur, at the beginning of each time step)270 hdivn(:,:,:) = hdivb(:,:,:)271 rotn(:,:,:) = rotb(:,:,:)272 268 273 269 CALL dyn_bfr( kstp ) ! bottom friction -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r4328 r4596 4 4 !! Ocean time-stepping : module used in both initialisation phase and time stepping 5 5 !!====================================================================== 6 !! History : 3.3 ! 2010-08 (C. Ethe) Original code - reorganisation of the initial phase 6 !! History : 3.3 ! 2010-08 (C. Ethe) Original code - reorganisation of the initial phase 7 !! 3.7 ! 2014-01 (G. Madec) LDF simplication 7 8 !!---------------------------------------------------------------------- 8 9 USE oce ! ocean dynamics and tracers variables 9 10 USE dom_oce ! ocean space and time domain variables 10 11 USE zdf_oce ! ocean vertical physics variables 11 USE ldftra_oce ! ocean tracer - trends12 USE ldfdyn_oce ! ocean dynamics - trends13 USE divcur ! hor. divergence and curl (div & cur routines)14 USE in_out_manager ! I/O manager15 USE iom !16 USE lbclnk17 USE restart ! restart18 #if defined key_iomput19 USE xios20 #endif21 12 22 13 USE daymod ! calendar (day routine) … … 67 58 68 59 USE ldfslp ! iso-neutral slopes (ldf_slp routine) 69 USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine) 60 USE ldfdyn ! lateral eddy viscosity coef. (ldf_dyn routine) 61 USE ldftra ! lateral eddy diffusive coef. (ldf_tra routine) 70 62 USE ldftra_smag ! Smagirinsky diffusion (ldftra_smag routine) 71 63 USE ldfdyn_smag ! Smagorinsky viscosity (ldfdyn_smag routine) … … 106 98 USE asmbkg 107 99 USE stpctl ! time stepping control (stp_ctl routine) 100 USE restart ! ocean restart (rst_wri routine) 108 101 USE prtctl ! Print control (prt_ctl routine) 109 102 110 103 USE diaobs ! Observation operator 111 104 105 USE in_out_manager ! I/O manager 106 USE iom ! 107 USE lbclnk 112 108 USE timing ! Timing 113 109 110 #if defined key_iomput 111 USE xios 112 #endif 114 113 #if defined key_agrif 115 114 USE agrif_opa_sponge ! Momemtum and tracers sponges … … 119 118 #endif 120 119 !!---------------------------------------------------------------------- 121 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)120 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 122 121 !! $Id$ 123 122 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
Note: See TracChangeset
for help on using the changeset viewer.