- Timestamp:
- 2015-12-04T17:05:58+01:00 (8 years ago)
- Location:
- branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM
- Files:
-
- 4 deleted
- 144 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
r5904 r6004 71 71 / 72 72 !----------------------------------------------------------------------- 73 &namsplit ! time splitting parameters ("key_dynspg_ts")74 !-----------------------------------------------------------------------75 ln_bt_nn_auto = .FALSE. ! Set nn_baro automatically to be just below76 ! a user defined maximum courant number (rn_bt_cmax)77 nn_baro = 30 ! Number of iterations of barotropic mode78 /79 !-----------------------------------------------------------------------80 73 &namcrs ! Grid coarsening for dynamics output and/or 81 74 ! passive tracer coarsened online simulations … … 99 92 nn_fwb = 0 ! FreshWater Budget: =0 unchecked 100 93 ln_apr_dyn = .false. ! Patm gradient added in ocean & ice Eqs. (T => fill namsbc_apr ) 101 ln_traqsr = .false. ! Light penetration (T) or not (F)102 94 103 95 / … … 137 129 &namtra_qsr ! penetrative solar radiation 138 130 !----------------------------------------------------------------------- 131 ln_traqsr = .false. ! Light penetration (T) or not (F) 139 132 nn_chldta = 0 ! RGB : Chl data (=1) or cst value (=0) 140 133 / … … 256 249 / 257 250 !----------------------------------------------------------------------- 258 &nambbc ! bottom temperature boundary condition 259 !----------------------------------------------------------------------- 260 ln_trabbc = .false. ! Apply a geothermal heating at the ocean bottom 251 &nambbc ! bottom temperature boundary condition (default: NO) 252 !----------------------------------------------------------------------- 261 253 / 262 254 !----------------------------------------------------------------------- … … 343 335 / 344 336 !----------------------------------------------------------------------- 345 !namdyn_spg ! surface pressure gradient (CPP key only) 346 !----------------------------------------------------------------------- 347 ! ! explicit free surface ("key_dynspg_exp") 348 ! ! filtered free surface ("key_dynspg_flt") 349 ! ! split-explicit free surface ("key_dynspg_ts") 350 337 &namdyn_spg ! surface pressure gradient 338 !----------------------------------------------------------------------- 339 ln_dynspg_ts = .true. ! split-explicit free surface 340 ln_bt_auto = .false. ! Number of sub-step defined from: 341 nn_baro = 30 ! =F : the number of sub-step in rn_rdt seconds 342 / 351 343 !----------------------------------------------------------------------- 352 344 &namdyn_ldf ! lateral diffusion on momentum … … 407 399 / 408 400 !----------------------------------------------------------------------- 409 &namsol ! elliptic solver / island / free surface410 !-----------------------------------------------------------------------411 /412 !-----------------------------------------------------------------------413 401 &nammpp ! Massively Parallel Processing ("key_mpp_mpi) 414 402 !----------------------------------------------------------------------- … … 458 446 !----------------------------------------------------------------------- 459 447 / 460 !-----------------------------------------------------------------------461 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed)462 !-----------------------------------------------------------------------463 / -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm
r5866 r6004 1 bld::tool::fppkeys key_bdy key_tide key_ dynspg_ts key_zdfgls key_diainstant key_mpp_mpi key_iomput1 bld::tool::fppkeys key_bdy key_tide key_zdfgls key_diainstant key_mpp_mpi key_iomput -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
r5866 r6004 65 65 / 66 66 !----------------------------------------------------------------------- 67 &namsplit ! time splitting parameters ("key_dynspg_ts")68 !-----------------------------------------------------------------------69 /70 !-----------------------------------------------------------------------71 67 &namcrs ! Grid coarsening for dynamics output and/or 72 68 ! passive tracer coarsened online simulations … … 142 138 &namtra_qsr ! penetrative solar radiation 143 139 !----------------------------------------------------------------------- 140 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 141 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 142 sn_chl ='chlorophyll_PAPASTATION', -1 , 'CHLA' , .true. , .true. , 'yearly' , '' , '' , '' 144 143 / 145 144 !----------------------------------------------------------------------- … … 198 197 / 199 198 !----------------------------------------------------------------------- 200 &nambbc ! bottom temperature boundary condition 201 !----------------------------------------------------------------------- 202 ln_trabbc = .false. ! Apply a geothermal heating at the ocean bottom 203 nn_geoflx = 0 ! geothermal heat flux: = 0 no flux 199 &nambbc ! bottom temperature boundary condition (default: NO) 200 !----------------------------------------------------------------------- 204 201 / 205 202 !----------------------------------------------------------------------- … … 262 259 / 263 260 !----------------------------------------------------------------------- 264 !namdyn_spg ! surface pressure gradient (CPP key only) 265 !----------------------------------------------------------------------- 261 &namdyn_spg ! surface pressure gradient (default: NO spg) 262 !----------------------------------------------------------------------- 263 / 266 264 !----------------------------------------------------------------------- 267 265 &namdyn_ldf ! lateral diffusion on momentum … … 294 292 !----------------------------------------------------------------------- 295 293 ln_tmx_itf = .false. ! ITF specific parameterisation 296 /297 !-----------------------------------------------------------------------298 &namsol ! elliptic solver / island / free surface299 !-----------------------------------------------------------------------300 nn_solv = 2 ! elliptic solver: =1 preconditioned conjugate gradient (pcg)301 nn_nmin = 210 ! minimum of iterations for the SOR solver302 rn_sor = 1.96 ! optimal coefficient for SOR solver (to be adjusted with the domain)303 294 / 304 295 !----------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
r5866 r6004 64 64 ppkth2 = 999999.0 ! 65 65 ppacr2 = 999999.0 ! 66 /67 !-----------------------------------------------------------------------68 &namsplit ! time splitting parameters ("key_dynspg_ts")69 !-----------------------------------------------------------------------70 66 / 71 67 !----------------------------------------------------------------------- … … 286 282 / 287 283 !----------------------------------------------------------------------- 288 !namdyn_spg ! surface pressure gradient (CPP key only) 289 !----------------------------------------------------------------------- 290 284 &namdyn_spg ! surface pressure gradient 285 !----------------------------------------------------------------------- 286 ln_dynspg_ts = .true. ! split-explicit free surface 287 / 291 288 !----------------------------------------------------------------------- 292 289 &namdyn_ldf ! lateral diffusion on momentum … … 341 338 / 342 339 !----------------------------------------------------------------------- 343 &namsol ! elliptic solver / island / free surface344 !-----------------------------------------------------------------------345 nn_solv = 2 ! elliptic solver: =1 preconditioned conjugate gradient (pcg)346 nn_nmin = 210 ! minimum of iterations for the SOR solver347 rn_sor = 1.96 ! optimal coefficient for SOR solver (to be adjusted with the domain)348 /349 !-----------------------------------------------------------------------350 340 &nammpp ! Massively Parallel Processing ("key_mpp_mpi) 351 341 !----------------------------------------------------------------------- … … 411 401 !----------------------------------------------------------------------- 412 402 / 413 !-----------------------------------------------------------------------414 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed)415 !-----------------------------------------------------------------------416 ln_neptramp = .false. ! ramp down Neptune velocity in shallow water417 / -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm
r5836 r6004 1 bld::tool::fppkeys key_ dynspg_flt key_zdftke key_iomput key_mpp_mpi1 bld::tool::fppkeys key_zdftke key_iomput key_mpp_mpi -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
r5866 r6004 69 69 / 70 70 !----------------------------------------------------------------------- 71 &namsplit ! time splitting parameters ("key_dynspg_ts")72 !-----------------------------------------------------------------------73 /74 !-----------------------------------------------------------------------75 71 &namcrs ! Grid coarsening for dynamics output and/or 76 72 ! passive tracer coarsened online simulations … … 186 182 / 187 183 !----------------------------------------------------------------------- 188 &nambbc ! bottom temperature boundary condition 189 !----------------------------------------------------------------------- 190 ln_trabbc = .false. ! Apply a geothermal heating at the ocean bottom 191 nn_geoflx = 0 ! geothermal heat flux: = 0 no flux 184 &nambbc ! bottom temperature boundary condition (default: NO) 185 !----------------------------------------------------------------------- 192 186 / 193 187 !----------------------------------------------------------------------- … … 287 281 / 288 282 !----------------------------------------------------------------------- 289 !namdyn_spg ! surface pressure gradient (CPP key only) 290 !----------------------------------------------------------------------- 283 &namdyn_spg ! surface pressure gradient 284 !----------------------------------------------------------------------- 285 ln_dynspg_ts = .true. ! split-explicit free surface 286 / 291 287 !----------------------------------------------------------------------- 292 288 &namdyn_ldf ! lateral diffusion on momentum … … 345 341 / 346 342 !----------------------------------------------------------------------- 347 &namsol ! elliptic solver / island / free surface348 !-----------------------------------------------------------------------349 nn_solv = 2 ! elliptic solver: =1 preconditioned conjugate gradient (pcg)350 nn_nmin = 210 ! minimum of iterations for the SOR solver351 rn_sor = 1.96 ! optimal coefficient for SOR solver (to be adjusted with the domain)352 /353 !-----------------------------------------------------------------------354 343 &nammpp ! Massively Parallel Processing ("key_mpp_mpi) 355 344 !----------------------------------------------------------------------- … … 399 388 !----------------------------------------------------------------------- 400 389 / 401 !-----------------------------------------------------------------------402 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed)403 !-----------------------------------------------------------------------404 ln_neptramp = .false. ! ramp down Neptune velocity in shallow water405 / -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm
r5836 r6004 1 bld::tool::fppkeys key_ dynspg_flt key_zdftke key_top key_my_trc key_mpp_mpi key_iomput1 bld::tool::fppkeys key_zdftke key_top key_my_trc key_mpp_mpi key_iomput 2 2 inc $BFMDIR/src/nemo/bfm.fcm -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg
r5866 r6004 59 59 / 60 60 !----------------------------------------------------------------------- 61 &namsplit ! time splitting parameters ("key_dynspg_ts")62 !-----------------------------------------------------------------------63 /64 !-----------------------------------------------------------------------65 61 &namcrs ! Grid coarsening for dynamics output and/or 66 62 ! passive tracer coarsened online simulations … … 109 105 / 110 106 !----------------------------------------------------------------------- 111 &nambbc ! bottom temperature boundary condition 112 !----------------------------------------------------------------------- 113 ln_trabbc = .false. ! Apply a geothermal heating at the ocean bottom 114 nn_geoflx = 0 ! geothermal heat flux: = 0 no flux 107 &nambbc ! bottom temperature boundary condition (default: NO) 108 !----------------------------------------------------------------------- 115 109 / 116 110 !----------------------------------------------------------------------- … … 206 200 / 207 201 !----------------------------------------------------------------------- 202 &namdyn_spg ! surface pressure gradient 203 !----------------------------------------------------------------------- 204 ln_dynspg_ts = .true. ! split-explicit free surface 205 / 206 !----------------------------------------------------------------------- 208 207 &namdyn_ldf ! lateral diffusion on momentum 209 208 !----------------------------------------------------------------------- … … 244 243 / 245 244 !----------------------------------------------------------------------- 246 &namsol ! elliptic solver / island / free surface247 !-----------------------------------------------------------------------248 nn_solv = 2 ! elliptic solver: =1 preconditioned conjugate gradient (pcg)249 nn_nmin = 210 ! minimum of iterations for the SOR solver250 rn_sor = 1.96 ! optimal coefficient for SOR solver (to be adjusted with the domain)251 /252 !-----------------------------------------------------------------------253 245 &nammpp ! Massively Parallel Processing ("key_mpp_mpi) 254 246 !----------------------------------------------------------------------- … … 266 258 !----------------------------------------------------------------------- 267 259 / 268 !-----------------------------------------------------------------------269 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed)270 !-----------------------------------------------------------------------271 ln_neptramp = .false. ! ramp down Neptune velocity in shallow water272 / -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_PISCES/cpp_GYRE_PISCES.fcm
r5836 r6004 1 bld::tool::fppkeys key_dynspg_fltkey_zdftke key_top key_pisces_reduced key_mpp_mpi1 bld::tool::fppkeys key_zdftke key_top key_pisces_reduced key_mpp_mpi -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg
r5866 r6004 41 41 nn_bathy = 0 ! compute (=0) or read (=1) the bathymetry file 42 42 rn_rdt = 7200. ! time step for the dynamics (and tracer if nn_acc=0) 43 ! nn_baro = 60 ! number of barotropic time step ("key_dynspg_ts")44 43 rn_rdtmin = 7200. ! minimum time step on tracers (used if nn_acc=1) 45 44 rn_rdtmax = 7200. ! maximum time step on tracers (used if nn_acc=1) … … 175 174 / 176 175 !----------------------------------------------------------------------- 177 &nambbc ! bottom temperature boundary condition 178 !----------------------------------------------------------------------- 179 ln_trabbc = .false. ! Apply a geothermal heating at the ocean bottom 180 nn_geoflx = 0 ! geothermal heat flux: = 0 no flux 176 &nambbc ! bottom temperature boundary condition (default: NO) 177 !----------------------------------------------------------------------- 181 178 / 182 179 !----------------------------------------------------------------------- … … 261 258 / 262 259 !----------------------------------------------------------------------- 263 !namdyn_spg ! surface pressure gradient (CPP key only) 264 !----------------------------------------------------------------------- 260 &namdyn_spg ! surface pressure gradient 261 !----------------------------------------------------------------------- 262 ln_dynspg_ts = .true. ! split-explicit free surface 263 / 265 264 !----------------------------------------------------------------------- 266 265 &namdyn_ldf ! lateral diffusion on momentum … … 300 299 / 301 300 !----------------------------------------------------------------------- 302 &namsol ! elliptic solver / island / free surface303 !-----------------------------------------------------------------------304 nn_solv = 2 ! elliptic solver: =1 preconditioned conjugate gradient (pcg)305 nn_nmin = 210 ! minimum of iterations for the SOR solver306 rn_sor = 1.96 ! optimal coefficient for SOR solver (to be adjusted with the domain)307 /308 !-----------------------------------------------------------------------309 301 &nammpp ! Massively Parallel Processing ("key_mpp_mpi) 310 302 !----------------------------------------------------------------------- … … 354 346 !----------------------------------------------------------------------- 355 347 / 356 !-----------------------------------------------------------------------357 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed)358 !-----------------------------------------------------------------------359 ln_neptramp = .false. ! ramp down Neptune velocity in shallow water360 / -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm
r5836 r6004 1 bld::tool::fppkeys key_ dynspg_flt key_zdftke key_iomput key_mpp_mpi1 bld::tool::fppkeys key_zdftke key_iomput key_mpp_mpi -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg
r5866 r6004 127 127 / 128 128 !----------------------------------------------------------------------- 129 &nambbc ! bottom temperature boundary condition 130 !----------------------------------------------------------------------- 129 &nambbc ! bottom temperature boundary condition (default: NO) 130 !----------------------------------------------------------------------- 131 ln_trabbc = .true. ! Apply a geothermal heating at the ocean bottom 131 132 / 132 133 !----------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg
r5866 r6004 103 103 / 104 104 !----------------------------------------------------------------------- 105 &nambbc ! bottom temperature boundary condition 106 !----------------------------------------------------------------------- 105 &nambbc ! bottom temperature boundary condition (default: NO) 106 !----------------------------------------------------------------------- 107 ln_trabbc = .true. ! Apply a geothermal heating at the ocean bottom 107 108 / 108 109 !----------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm
r5866 r6004 1 bld::tool::fppkeys key_trabbl key_lim2 key_ dynspg_flt key_zdftke key_zdfddm key_zdftmx key_mpp_mpi key_iomput key_nosignedzero1 bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx key_mpp_mpi key_iomput key_nosignedzero -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg
r5866 r6004 56 56 / 57 57 !----------------------------------------------------------------------- 58 &namsplit ! time splitting parameters ("key_dynspg_ts")59 !-----------------------------------------------------------------------60 /61 !-----------------------------------------------------------------------62 58 &namcrs ! Grid coarsening for dynamics output and/or 63 59 ! passive tracer coarsened online simulations … … 127 123 &nambbc ! bottom temperature boundary condition 128 124 !----------------------------------------------------------------------- 125 ln_trabbc = .true. ! Apply a geothermal heating at the ocean bottom 129 126 / 130 127 !----------------------------------------------------------------------- … … 205 202 / 206 203 !----------------------------------------------------------------------- 204 &namdyn_spg ! surface pressure gradient 205 !----------------------------------------------------------------------- 206 ln_dynspg_ts = .true. ! split-explicit free surface 207 / 208 !----------------------------------------------------------------------- 207 209 &namdyn_ldf ! lateral diffusion on momentum 208 210 !----------------------------------------------------------------------- … … 246 248 / 247 249 !----------------------------------------------------------------------- 248 &namsol ! elliptic solver / island / free surface249 !-----------------------------------------------------------------------250 /251 !-----------------------------------------------------------------------252 250 &nammpp ! Massively Parallel Processing ("key_mpp_mpi) 253 251 !----------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg
r5883 r6004 53 53 / 54 54 !----------------------------------------------------------------------- 55 &namsplit ! time splitting parameters ("key_dynspg_ts")56 !-----------------------------------------------------------------------57 /58 !-----------------------------------------------------------------------59 55 &namcrs ! Grid coarsening for dynamics output and/or 60 56 ! passive tracer coarsened online simulations … … 102 98 / 103 99 !----------------------------------------------------------------------- 104 &nambbc ! bottom temperature boundary condition 105 !----------------------------------------------------------------------- 100 &nambbc ! bottom temperature boundary condition (default: NO) 101 !----------------------------------------------------------------------- 102 ln_trabbc = .true. ! Apply a geothermal heating at the ocean bottom 106 103 / 107 104 !----------------------------------------------------------------------- … … 190 187 &namdyn_hpg ! Hydrostatic pressure gradient option 191 188 !----------------------------------------------------------------------- 192 ln_hpg_zco = .false. ! z-coordinate - full steps 193 ln_hpg_zps = .false. ! z-coordinate - partial steps (interpolation) 194 ln_hpg_sco = .false. ! s-coordinate (standard jacobian formulation) 195 ln_hpg_djc = .false. ! s-coordinate (Density Jacobian with Cubic polynomial) 196 ln_hpg_prj = .true. ! s-coordinate (Pressure Jacobian scheme) 197 ln_dynhpg_imp = .false. ! time stepping: semi-implicit time scheme (T) 198 ! centered time scheme (F) 189 ln_hpg_sco = .true. ! s-coordinate (standard jacobian formulation) 190 / 191 !----------------------------------------------------------------------- 192 &namdyn_spg ! surface pressure gradient 193 !----------------------------------------------------------------------- 194 ln_dynspg_ts = .true. ! split-explicit free surface 199 195 / 200 196 !----------------------------------------------------------------------- … … 241 237 / 242 238 !----------------------------------------------------------------------- 243 &namsol ! elliptic solver / island / free surface244 !-----------------------------------------------------------------------245 /246 !-----------------------------------------------------------------------247 239 &nammpp ! Massively Parallel Processing ("key_mpp_mpi) 248 240 !----------------------------------------------------------------------- … … 262 254 / 263 255 !----------------------------------------------------------------------- 264 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed)265 !-----------------------------------------------------------------------266 /267 !-----------------------------------------------------------------------268 256 &namobs ! observation usage ('key_diaobs') 269 257 !----------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM3/cpp_ORCA2_LIM3.fcm
r5866 r6004 1 bld::tool::fppkeys key_trabbl key_lim3 key_ dynspg_ts key_zdftke key_zdfddm key_zdftmx key_mpp_mpi key_diaobs key_asminc key_iomput key_nosignedzero1 bld::tool::fppkeys key_trabbl key_lim3 key_zdftke key_zdfddm key_zdftmx key_mpp_mpi key_diaobs key_asminc key_iomput key_nosignedzero -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg
r5866 r6004 85 85 ! 86 86 rn_rdt = 2880. ! time step for the dynamics (and tracer if nn_acc=0) 87 nn_baro = 64 ! number of barotropic time step ("key_dynspg_ts")88 87 rn_atfp = 0.1 ! asselin time filter parameter 89 88 nn_acc = 0 ! acceleration of convergence : =1 used, rdt < rdttra(k) … … 295 294 rn_alphc = 0.65 ! compute albedo between two extremes values 296 295 rn_alphdi = 0.72 ! (Pyane, 1972) 296 / 297 !----------------------------------------------------------------------- 298 &namsbc_wave ! External fields from wave model 299 !----------------------------------------------------------------------- 300 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! 301 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 302 sn_cdg = 'cdg_wave' , 1 , 'drag_coeff' , .true. , .false. , 'daily' ,'' , '' 303 ! 304 cn_dir_cdg = './' ! root directory for the location of drag coefficient files 297 305 / 298 306 … … 551 559 ln_hpg_djc = .false. ! s-coordinate (Density Jacobian with Cubic polynomial) 552 560 ln_hpg_prj = .false. ! s-coordinate (Pressure Jacobian scheme) 553 ln_dynhpg_imp = .false. ! time stepping: semi-implicit time scheme (T) 554 ! centered time scheme (F) 555 / 556 !----------------------------------------------------------------------- 557 !namdyn_spg ! surface pressure gradient (CPP key only) 558 !----------------------------------------------------------------------- 559 ! ! explicit free surface ("key_dynspg_exp") 560 ! ! filtered free surface ("key_dynspg_flt") 561 ! ! split-explicit free surface ("key_dynspg_ts") 562 561 / 562 !----------------------------------------------------------------------- 563 &namdyn_spg ! surface pressure gradient 564 !----------------------------------------------------------------------- 565 ln_dynspg_ts = .true. ! split-explicit free surface 566 / 563 567 !----------------------------------------------------------------------- 564 568 &namdyn_ldf ! lateral diffusion on momentum … … 701 705 !! nammpp_dyndist Massively Parallel domain decomposition ("key_agrif" && "key_mpp_dyndist") 702 706 !! namctl Control prints & Benchmark 703 !! namsol elliptic solver / island / free surface 704 !!====================================================================== 705 ! 706 !----------------------------------------------------------------------- 707 &namsol ! elliptic solver / island / free surface 708 !----------------------------------------------------------------------- 709 nn_solv = 1 ! elliptic solver: =1 preconditioned conjugate gradient (pcg) 710 ! =2 successive-over-relaxation (sor) 711 nn_sol_arp = 0 ! absolute/relative (0/1) precision convergence test 712 rn_eps = 1.e-6 ! absolute precision of the solver 713 nn_nmin = 300 ! minimum of iterations for the SOR solver 714 nn_nmax = 800 ! maximum of iterations for the SOR solver 715 nn_nmod = 10 ! frequency of test for the SOR solver 716 rn_resmax = 1.e-10 ! absolute precision for the SOR solver 717 rn_sor = 1.92 ! optimal coefficient for SOR solver (to be adjusted with the domain) 718 / 707 !!====================================================================== 708 ! 719 709 !----------------------------------------------------------------------- 720 710 &nammpp ! Massively Parallel Processing ("key_mpp_mpi) … … 898 888 salfixmin = -9999 ! Minimum salinity after applying the increments 899 889 / 900 !-----------------------------------------------------------------------901 &namsbc_wave ! External fields from wave model902 !-----------------------------------------------------------------------903 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation !904 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing !905 sn_cdg = 'cdg_wave' , 1 , 'drag_coeff' , .true. , .false. , 'daily' ,'' , ''906 !907 cn_dir_cdg = './' ! root directory for the location of drag coefficient files908 /909 !-----------------------------------------------------------------------910 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed)911 !-----------------------------------------------------------------------912 ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model913 ln_neptsimp = .false. ! yes/no use simplified neptune914 915 ln_smooth_neptvel = .false. ! yes/no smooth zunep, zvnep916 rn_tslse = 1.2e4 ! value of lengthscale L at the equator917 rn_tslsp = 3.0e3 ! value of lengthscale L at the pole918 ! Specify whether to ramp down the Neptune velocity in shallow919 ! water, and if so the depth range controlling such ramping down920 ln_neptramp = .true. ! ramp down Neptune velocity in shallow water921 rn_htrmin = 100.0 ! min. depth of transition range922 rn_htrmax = 200.0 ! max. depth of transition range923 / -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg
r5866 r6004 158 158 / 159 159 !----------------------------------------------------------------------- 160 &nambbc ! bottom temperature boundary condition 160 &nambbc ! bottom temperature boundary condition (default: NO) 161 161 !----------------------------------------------------------------------- 162 ln_trabbc = .true. ! Apply a geothermal heating at the ocean bottom 162 163 / 163 164 !----------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/cpp_ORCA2_LIM_CFC_C14b.fcm
r5836 r6004 1 bld::tool::fppkeys key_trabbl key_lim2 key_ dynspg_flt key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi1 bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg
r5866 r6004 50 50 / 51 51 !----------------------------------------------------------------------- 52 &namsplit ! time splitting parameters ("key_dynspg_ts")53 !-----------------------------------------------------------------------54 /55 !-----------------------------------------------------------------------56 52 &namcrs ! Grid coarsening for dynamics output and/or 57 53 ! passive tracer coarsened online simulations … … 99 95 / 100 96 !----------------------------------------------------------------------- 101 &nambbc ! bottom temperature boundary condition 102 !----------------------------------------------------------------------- 97 &nambbc ! bottom temperature boundary condition (default: NO) 98 !----------------------------------------------------------------------- 99 ln_trabbc = .true. ! Apply a geothermal heating at the ocean bottom 103 100 / 104 101 !----------------------------------------------------------------------- … … 190 187 / 191 188 !----------------------------------------------------------------------- 189 &namdyn_spg ! surface pressure gradient 190 !----------------------------------------------------------------------- 191 ln_dynspg_ts = .true. ! split-explicit free surface 192 / 193 !----------------------------------------------------------------------- 192 194 &namdyn_ldf ! lateral diffusion on momentum 193 195 !----------------------------------------------------------------------- … … 230 232 / 231 233 !----------------------------------------------------------------------- 232 &namsol ! elliptic solver / island / free surface233 !-----------------------------------------------------------------------234 /235 !-----------------------------------------------------------------------236 234 &nammpp ! Massively Parallel Processing ("key_mpp_mpi) 237 235 !----------------------------------------------------------------------- … … 249 247 !----------------------------------------------------------------------- 250 248 / 251 !-----------------------------------------------------------------------252 &namdyn_nept ! Neptune effect (simplified: lateral and vertical diffusions removed)253 !-----------------------------------------------------------------------254 / -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm
r5836 r6004 1 bld::tool::fppkeys key_trabbl key_lim2 key_ dynspg_flt key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_mpp_mpi key_iomput1 bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_mpp_mpi key_iomput -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/namelist_cfg
r5866 r6004 52 52 / 53 53 !----------------------------------------------------------------------- 54 &namsplit ! time splitting parameters ("key_dynspg_ts")55 !-----------------------------------------------------------------------56 /57 !-----------------------------------------------------------------------58 54 &namcrs ! Grid coarsening for dynamics output and/or 59 55 ! passive tracer coarsened online simulations -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/ORCA2_SAS_LIM/cpp_ORCA2_SAS_LIM.fcm
r5836 r6004 1 bld::tool::fppkeys key_trabbl key_lim2 key_dynspg_fltkey_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi1 bld::tool::fppkeys key_trabbl key_lim2 key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/CONFIG/SHARED/namelist_ref
r5883 r6004 6 6 !! 3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, namsbc_sas 7 7 !! namsbc_cpl, namtra_qsr, namsbc_rnf, 8 !! namsbc_apr, namsbc_ssr, namsbc_alb )8 !! namsbc_apr, namsbc_ssr, namsbc_alb, namsbc_wave) 9 9 !! 4 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide) 10 10 !! 5 - bottom boundary (nambfr, nambbc, nambbl) … … 13 13 !! 8 - Verical physics (namzdf, namzdf_ric, namzdf_tke, namzdf_ddm, namzdf_tmx) 14 14 !! 9 - diagnostics (namnc4, namtrd, namspr, namflo, namhsb, namsto) 15 !! 10 - miscellaneous (nam sol, nammpp, namctl)15 !! 10 - miscellaneous (nammpp, namctl) 16 16 !! 11 - Obs & Assim (namobs, nam_asminc) 17 17 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 61 61 !! namzgr_sco s-coordinate or hybrid z-s-coordinate 62 62 !! namdom space and time domain (bathymetry, mesh, timestep) 63 !! namcrs coarsened grid (for outputs and/or TOP) ("key_crs") 64 !! namc1d 1D configuration options ("key_c1d") 65 !! namc1d_uvd 1D data (currents) ("key_c1d") 66 !! namc1d_dyndmp 1D newtonian damping applied on currents ("key_c1d") 63 67 !! namtsd data: temperature & salinity 64 68 !!====================================================================== … … 87 91 / 88 92 !----------------------------------------------------------------------- 89 &namzgr ! vertical coordinate 93 &namzgr ! vertical coordinate (default: NO selection) 90 94 !----------------------------------------------------------------------- 91 95 ln_zco = .false. ! z-coordinate - full steps … … 98 102 &namzgr_sco ! s-coordinate or hybrid z-s-coordinate 99 103 !----------------------------------------------------------------------- 100 ln_s_sh94 = . true. ! Song & Haidvogel 1994 hybrid S-sigma (T)|104 ln_s_sh94 = .false. ! Song & Haidvogel 1994 hybrid S-sigma (T)| 101 105 ln_s_sf12 = .false. ! Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied 102 106 ln_sigcrit = .false. ! use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch … … 164 168 / 165 169 !----------------------------------------------------------------------- 166 &namsplit ! time splitting parameters ("key_dynspg_ts") 167 !----------------------------------------------------------------------- 168 ln_bt_fw = .TRUE. ! Forward integration of barotropic equations 169 ln_bt_av = .TRUE. ! Time filtering of barotropic variables 170 ln_bt_nn_auto = .TRUE. ! Set nn_baro automatically to be just below 171 ! a user defined maximum courant number (rn_bt_cmax) 172 nn_baro = 30 ! Number of iterations of barotropic mode 173 ! during rn_rdt seconds. Only used if ln_bt_nn_auto=F 174 rn_bt_cmax = 0.8 ! Maximum courant number allowed if ln_bt_nn_auto=T 175 nn_bt_flt = 1 ! Time filter choice 176 ! = 0 None 177 ! = 1 Boxcar over nn_baro barotropic steps 178 ! = 2 Boxcar over 2*nn_baro " " 179 / 180 !----------------------------------------------------------------------- 181 &namcrs ! Grid coarsening for dynamics output and/or 182 ! passive tracer coarsened online simulations 170 &namcrs ! coarsened grid (for outputs and/or TOP) ("key_crs") 183 171 !----------------------------------------------------------------------- 184 172 nn_factx = 3 ! Reduction factor of x-direction … … 202 190 / 203 191 !----------------------------------------------------------------------- 192 &namc1d_dyndmp ! U & V newtonian damping ("key_c1d") 193 !----------------------------------------------------------------------- 194 ln_dyndmp = .false. ! add a damping term (T) or not (F) 195 / 196 !----------------------------------------------------------------------- 197 &namc1d_uvd ! data: U & V currents ("key_c1d") 198 !----------------------------------------------------------------------- 199 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 200 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 201 sn_ucur = 'ucurrent' , -1 ,'u_current', .false. , .true. , 'monthly' , '' , 'Ume' , '' 202 sn_vcur = 'vcurrent' , -1 ,'v_current', .false. , .true. , 'monthly' , '' , 'Vme' , '' 203 ! 204 cn_dir = './' ! root directory for the location of the files 205 ln_uvd_init = .false. ! Initialisation of ocean U & V with U & V input data (T) or not (F) 206 ln_uvd_dyndmp = .false. ! damping of ocean U & V toward U & V input data (T) or not (F) 207 / 208 !----------------------------------------------------------------------- 204 209 &namtsd ! data : Temperature & Salinity 205 210 !----------------------------------------------------------------------- … … 213 218 ln_tsd_tradmp = .true. ! damping of ocean T & S toward T &S input data (T) or not (F) 214 219 / 220 215 221 !!====================================================================== 216 222 !! *** Surface Boundary Condition namelists *** 217 223 !!====================================================================== 218 224 !! namsbc surface boundary condition 219 !! namsbc_ana analytical formulation 220 !! namsbc_flx flux formulation 221 !! namsbc_clio CLIO bulk formulae formulation 222 !! namsbc_core CORE bulk formulae formulation 223 !! namsbc_mfs MFS bulk formulae formulation 224 !! namsbc_cpl CouPLed formulation ("key_oasis3" )225 !! namsbc_ana analytical formulation (ln_ana =T) 226 !! namsbc_flx flux formulation (ln_flx =T) 227 !! namsbc_clio CLIO bulk formulae formulation (ln_blk_clio=T) 228 !! namsbc_core CORE bulk formulae formulation (ln_blk_core=T) 229 !! namsbc_mfs MFS bulk formulae formulation (ln_blk_mfs =T) 230 !! namsbc_cpl CouPLed formulation ("key_oasis3" ) 225 231 !! namsbc_sas StAndalone Surface module 226 !! namtra_qsr penetrative solar radiation 227 !! namsbc_rnf river runoffs 228 !! namsbc_isf ice shelf melting/freezing 229 !! namsbc_apr Atmospheric Pressure 230 !! namsbc_ssr sea surface restoring term (for T and/or S) 232 !! namtra_qsr penetrative solar radiation (ln_traqsr =T) 233 !! namsbc_rnf river runoffs (ln_rnf =T) 234 !! namsbc_isf ice shelf melting/freezing (nn_isf >0) 235 !! namsbc_apr Atmospheric Pressure (ln_apr_dyn =T) 236 !! namsbc_ssr sea surface restoring term (for T and/or S) (ln_ssr =T) 231 237 !! namsbc_alb albedo parameters 238 !! namsbc_wave external fields from wave model (ln_wave =T) 239 !! namberg iceberg floats ("key_") 232 240 !!====================================================================== 233 241 ! … … 258 266 nn_ice = 2 ! =0 no ice boundary condition , 259 267 ! =1 use observed ice-cover , 260 ! =2 ice-model used ("key_lim3" or "key_lim2")268 ! =2 ice-model used ("key_lim3", "key_lim2", "key_cice") 261 269 nn_ice_embd = 1 ! =0 levitating ice (no mass exchange, concentration/dilution effect) 262 270 ! =1 levitating ice with mass and salt exchange but no presure effect … … 321 329 &namsbc_core ! namsbc_core CORE bulk formulae 322 330 !----------------------------------------------------------------------- 323 ! ! file name 324 ! ! 325 sn_wndi = 'u_10.15JUNE2009_fill' 326 sn_wndj = 'v_10.15JUNE2009_fill' 327 sn_qsr = 'ncar_rad.15JUNE2009_fill' 328 sn_qlw = 'ncar_rad.15JUNE2009_fill' 329 sn_tair = 't_10.15JUNE2009_fill' 330 sn_humi = 'q_10.15JUNE2009_fill' 331 sn_prec = 'ncar_precip.15JUNE2009_fill' 332 sn_snow = 'ncar_precip.15JUNE2009_fill' 333 sn_tdif = 'taudif_core' 331 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 332 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 333 sn_wndi = 'u_10.15JUNE2009_fill' , 6 , 'U_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bicubic_noc.nc' , 'Uwnd' , '' 334 sn_wndj = 'v_10.15JUNE2009_fill' , 6 , 'V_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bicubic_noc.nc' , 'Vwnd' , '' 335 sn_qsr = 'ncar_rad.15JUNE2009_fill' , 24 , 'SWDN_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 336 sn_qlw = 'ncar_rad.15JUNE2009_fill' , 24 , 'LWDN_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 337 sn_tair = 't_10.15JUNE2009_fill' , 6 , 'T_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 338 sn_humi = 'q_10.15JUNE2009_fill' , 6 , 'Q_10_MOD', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 339 sn_prec = 'ncar_precip.15JUNE2009_fill', -1 , 'PRC_MOD1', .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 340 sn_snow = 'ncar_precip.15JUNE2009_fill', -1 , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 341 sn_tdif = 'taudif_core' , 24 , 'taudif' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 334 342 335 343 cn_dir = './' ! root directory for the location of the bulk files 336 344 ln_taudif = .false. ! HF tau contribution: use "mean of stress module - module of the mean stress" data 337 rn_zqt = 10. 338 rn_zu = 10. 345 rn_zqt = 10. ! Air temperature and humidity reference height (m) 346 rn_zu = 10. ! Wind vector reference height (m) 339 347 rn_pfac = 1. ! multiplicative factor for precipitation (total & snow) 340 348 rn_efac = 1. ! multiplicative factor for evaporation (0. or 1.) … … 345 353 &namsbc_mfs ! namsbc_mfs MFS bulk formulae 346 354 !----------------------------------------------------------------------- 347 ! ! file name ! frequency (hours) ! variable 348 ! ! ! (if <0 months) ! name 349 sn_wndi = 'ecmwf' , 6 , 'u10' , .true. , .false. , 'daily' ,'bicubic.nc' , '' ,''350 sn_wndj = 'ecmwf' , 6 , 'v10' , .true. , .false. , 'daily' ,'bicubic.nc' , '' ,''351 sn_clc = 'ecmwf' , 6 , 'clc' , .true. , .false. , 'daily' ,'bilinear.nc', '' ,''352 sn_msl = 'ecmwf' , 6 , 'msl' , .true. , .false. , 'daily' ,'bicubic.nc' , '' ,''353 sn_tair = 'ecmwf' , 6 , 't2' , .true. , .false. , 'daily' ,'bicubic.nc' , '' ,''354 sn_rhm = 'ecmwf' , 6 , 'rh' , .true. , .false. , 'daily' ,'bilinear.nc', '' ,''355 sn_prec = 'ecmwf' , 6 , 'precip' , .true. , .true. , 'daily' ,'bicubic.nc' , '' ,''355 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 356 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 357 sn_wndi = 'ecmwf' , 6 , 'u10' , .true. , .false., 'daily' ,'bicubic.nc' , '' , '' 358 sn_wndj = 'ecmwf' , 6 , 'v10' , .true. , .false., 'daily' ,'bicubic.nc' , '' , '' 359 sn_clc = 'ecmwf' , 6 , 'clc' , .true. , .false., 'daily' ,'bilinear.nc', '' , '' 360 sn_msl = 'ecmwf' , 6 , 'msl' , .true. , .false., 'daily' ,'bicubic.nc' , '' , '' 361 sn_tair = 'ecmwf' , 6 , 't2' , .true. , .false., 'daily' ,'bicubic.nc' , '' , '' 362 sn_rhm = 'ecmwf' , 6 , 'rh' , .true. , .false., 'daily' ,'bilinear.nc', '' , '' 363 sn_prec = 'ecmwf' , 6 , 'precip' , .true. , .true. , 'daily' ,'bicubic.nc' , '' , '' 356 364 357 365 cn_dir = './ECMWF/' ! root directory for the location of the bulk files … … 360 368 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 361 369 !----------------------------------------------------------------------- 362 ! ! description 363 ! ! 370 ! ! description ! multiple ! vector ! vector ! vector ! 371 ! ! ! categories ! reference ! orientation ! grids ! 364 372 ! send 365 sn_snd_temp = 366 sn_snd_alb = 367 sn_snd_thick = 'none' , 'no', '' , '' , ''368 sn_snd_crt = 369 sn_snd_co2 = 373 sn_snd_temp = 'weighted oce and ice' , 'no' , '' , '' , '' 374 sn_snd_alb = 'weighted ice' , 'no' , '' , '' , '' 375 sn_snd_thick = 'none' , 'no' , '' , '' , '' 376 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 377 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 370 378 ! receive 371 sn_rcv_w10m = 372 sn_rcv_taumod = 373 sn_rcv_tau = 374 sn_rcv_dqnsdt = 375 sn_rcv_qsr = 376 sn_rcv_qns = 377 sn_rcv_emp = 378 sn_rcv_rnf = 379 sn_rcv_cal = 380 sn_rcv_co2 = 379 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' 380 sn_rcv_taumod = 'coupled' , 'no' , '' , '' , '' 381 sn_rcv_tau = 'oce only' , 'no' , 'cartesian' , 'eastward-northward', 'U,V' 382 sn_rcv_dqnsdt = 'coupled' , 'no' , '' , '' , '' 383 sn_rcv_qsr = 'oce and ice' , 'no' , '' , '' , '' 384 sn_rcv_qns = 'oce and ice' , 'no' , '' , '' , '' 385 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 386 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 387 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 388 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 381 389 ! 382 390 nn_cplmodel = 1 ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 402 410 / 403 411 !----------------------------------------------------------------------- 404 &namtra_qsr ! penetrative solar radiation 412 &namtra_qsr ! penetrative solar radiation (ln_traqsr=T) 405 413 !----------------------------------------------------------------------- 406 414 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! … … 419 427 / 420 428 !----------------------------------------------------------------------- 421 &namsbc_rnf ! runoffs namelist surface boundary condition 429 &namsbc_rnf ! runoffs namelist surface boundary condition (ln_rnf=T) 422 430 !----------------------------------------------------------------------- 423 431 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! … … 443 451 / 444 452 !----------------------------------------------------------------------- 445 &namsbc_isf ! Top boundary layer (ISF) 446 !----------------------------------------------------------------------- 447 ! ! file name ! frequency (hours) ! variable ! time interp ol. !clim ! 'yearly'/ ! weights ! rotation !448 ! ! ! (if <0 months) ! name ! (logical) !(T/F) ! 'monthly' ! filename ! pairing !453 &namsbc_isf ! Top boundary layer (ISF) (nn_isf >0) 454 !----------------------------------------------------------------------- 455 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! 456 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! 449 457 ! nn_isf == 4 450 sn_qisf = 'rnfisf' , -12 ,'sohflisf', .false. , .true., 'yearly' , '' , ''451 sn_fwfisf = 'rnfisf' , -12 ,'sowflisf', .false. , .true., 'yearly' , '' , ''458 sn_qisf = 'rnfisf' , -12 ,'sohflisf', .false. , .true. , 'yearly' , '' , '' 459 sn_fwfisf = 'rnfisf' , -12 ,'sowflisf', .false. , .true. , 'yearly' , '' , '' 452 460 ! nn_isf == 3 453 sn_rnfisf = 'runoffs' , -12 ,'sofwfisf', .false. , .true., 'yearly' , '' , ''461 sn_rnfisf = 'runoffs', -12 ,'sofwfisf', .false. , .true. , 'yearly' , '' , '' 454 462 ! nn_isf == 2 and 3 455 sn_depmax_isf = 'runoffs' , -12 ,'sozisfmax' , .false. , .true., 'yearly' , '' , ''456 sn_depmin_isf = 'runoffs' , -12 ,'sozisfmin' , .false. , .true., 'yearly' , '' , ''463 sn_depmax_isf = 'runoffs', -12 ,'sozisfmax', .false. , .true. , 'yearly' , '' , '' 464 sn_depmin_isf = 'runoffs', -12 ,'sozisfmin', .false. , .true. , 'yearly' , '' , '' 457 465 ! nn_isf == 2 458 sn_Leff_isf = 'rnfisf' , 0 ,'Leff' , .false. , .true. , 'yearly' , '' , '' 466 sn_Leff_isf = 'rnfisf' , 0 ,'Leff' , .false. , .true. , 'yearly' , '' , '' 467 459 468 ! for all case 460 ln_divisf = .true. ! apply isf melting as a mass flux or in the salinity trend. (maybe I should remove this option as for runoff?)469 ln_divisf = .true. ! apply isf melting as a mass flux or in the salinity trend. (maybe I should remove this option as for runoff?) 461 470 ! only for nn_isf = 1 or 2 462 rn_gammat0 = 1. 0e-4! gammat coefficient used in blk formula463 rn_gammas0 = 1. 0e-4! gammas coefficient used in blk formula471 rn_gammat0 = 1.e-4 ! gammat coefficient used in blk formula 472 rn_gammas0 = 1.e-4 ! gammas coefficient used in blk formula 464 473 ! only for nn_isf = 1 465 474 nn_isfblk = 1 ! 1 ISOMIP ; 2 conservative (3 equation formulation, Jenkins et al. 1991 ??) 466 rn_hisf_tbl = 30. 475 rn_hisf_tbl = 30. ! thickness of the top boundary layer (Losh et al. 2008) 467 476 ! 0 => thickness of the tbl = thickness of the first wet cell 468 477 ln_conserve = .true. ! conservative case (take into account meltwater advection) … … 473 482 / 474 483 !----------------------------------------------------------------------- 475 &namsbc_apr ! Atmospheric pressure used as ocean forcing or in bulk476 !----------------------------------------------------------------------- 477 ! ! file name 478 ! ! ! (if <0 months) ! name ! (logical)! (T/F) ! 'monthly' ! filename ! pairing ! filename !479 sn_apr = 'patm' 484 &namsbc_apr ! Atmospheric pressure forcing (in ocean or bulk) (ln_apr_dyn=T) 485 !----------------------------------------------------------------------- 486 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 487 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 488 sn_apr = 'patm' , -1 ,'somslpre', .true. , .true. , 'yearly' , '' , '' , '' 480 489 481 490 cn_dir = './' ! root directory for the location of the bulk files … … 485 494 / 486 495 !----------------------------------------------------------------------- 487 &namsbc_ssr ! surface boundary condition : sea surface restoring 496 &namsbc_ssr ! surface boundary condition : sea surface restoring (ln_ssr=T) 488 497 !----------------------------------------------------------------------- 489 498 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! … … 511 520 / 512 521 !----------------------------------------------------------------------- 513 &namberg ! iceberg parameters 514 !----------------------------------------------------------------------- 515 ln_icebergs = .false. 522 &namsbc_wave ! External fields from wave model (ln_wave=T) 523 !----------------------------------------------------------------------- 524 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 525 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 526 sn_cdg = 'cdg_wave' , 1 , 'drag_coeff', .true. , .false., 'daily' , '' , '' , '' 527 sn_usd = 'sdw_wave' , 1 , 'u_sd2d' , .true. , .false., 'daily' , '' , '' , '' 528 sn_vsd = 'sdw_wave' , 1 , 'v_sd2d' , .true. , .false., 'daily' , '' , '' , '' 529 sn_wn = 'sdw_wave' , 1 , 'wave_num' , .true. , .false., 'daily' , '' , '' , '' 530 ! 531 cn_dir_cdg = './' ! root directory for the location of drag coefficient files 532 ln_cdgw = .false. ! Neutral drag coefficient read from wave model 533 ln_sdw = .false. ! Computation of 3D stokes drift 534 / 535 !----------------------------------------------------------------------- 536 &namberg ! iceberg parameters (default: No iceberg) 537 !----------------------------------------------------------------------- 538 ln_icebergs = .false. ! iceberg floats or not 516 539 ln_bergdia = .true. ! Calculate budgets 517 540 nn_verbose_level = 1 ! Turn on more verbose output if level > 0 … … 558 581 &namlbc ! lateral momentum boundary condition 559 582 !----------------------------------------------------------------------- 583 ! ! free slip ! partial slip ! no slip ! strong slip 560 584 rn_shlat = 2. ! shlat = 0 ! 0 < shlat < 2 ! shlat = 2 ! 2 < shlat 561 ! free slip ! partial slip ! no slip ! strong slip 562 ln_vorlat = .false. ! consistency of vorticity boundary condition with analytical eqs. 585 ln_vorlat = .false. ! consistency of vorticity boundary condition with analytical Eqs. 563 586 / 564 587 !----------------------------------------------------------------------- … … 572 595 / 573 596 !----------------------------------------------------------------------- 574 &nam_tide ! tide parameters (#ifdef key_tide)597 &nam_tide ! tide parameters ("key_tide") 575 598 !----------------------------------------------------------------------- 576 599 ln_tide_pot = .true. ! use tidal potential forcing … … 614 637 / 615 638 !----------------------------------------------------------------------- 616 &nambdy_dta ! open boundaries - external data("key_bdy")617 !----------------------------------------------------------------------- 618 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !619 ! ! ! (if <0 months) ! name ! (logical)! (T/F ) ! 'monthly' ! filename ! pairing ! filename !620 bn_ssh = 'amm12_bdyT_u2d' , 24 , 'sossheig' , .true., .false. , 'daily' , '' , '' , ''621 bn_u2d = 'amm12_bdyU_u2d' , 24 , 'vobtcrtx' , .true., .false. , 'daily' , '' , '' , ''622 bn_v2d = 'amm12_bdyV_u2d' , 24 , 'vobtcrty' , .true., .false. , 'daily' , '' , '' , ''623 bn_u3d = 'amm12_bdyU_u3d' , 24 , 'vozocrtx' , .true., .false. , 'daily' , '' , '' , ''624 bn_v3d = 'amm12_bdyV_u3d' , 24 , 'vomecrty' , .true., .false. , 'daily' , '' , '' , ''625 bn_tem = 'amm12_bdyT_tra' , 24 , 'votemper' , .true., .false. , 'daily' , '' , '' , ''626 bn_sal = 'amm12_bdyT_tra' , 24 , 'vosaline' , .true., .false. , 'daily' , '' , '' , ''639 &nambdy_dta ! open boundaries - external data ("key_bdy") 640 !----------------------------------------------------------------------- 641 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 642 ! ! ! (if <0 months) ! name ! (logical) ! (T/F ) ! 'monthly' ! filename ! pairing ! filename ! 643 bn_ssh = 'amm12_bdyT_u2d' , 24 , 'sossheig', .true. , .false. , 'daily' , '' , '' , '' 644 bn_u2d = 'amm12_bdyU_u2d' , 24 , 'vobtcrtx', .true. , .false. , 'daily' , '' , '' , '' 645 bn_v2d = 'amm12_bdyV_u2d' , 24 , 'vobtcrty', .true. , .false. , 'daily' , '' , '' , '' 646 bn_u3d = 'amm12_bdyU_u3d' , 24 , 'vozocrtx', .true. , .false. , 'daily' , '' , '' , '' 647 bn_v3d = 'amm12_bdyV_u3d' , 24 , 'vomecrty', .true. , .false. , 'daily' , '' , '' , '' 648 bn_tem = 'amm12_bdyT_tra' , 24 , 'votemper', .true. , .false. , 'daily' , '' , '' , '' 649 bn_sal = 'amm12_bdyT_tra' , 24 , 'vosaline', .true. , .false. , 'daily' , '' , '' , '' 627 650 ! for lim2 628 ! bn_frld = 'amm12_bdyT_ice' , 24 , 'ileadfra' , .true., .false. , 'daily' , '' , '' , ''629 ! bn_hicif = 'amm12_bdyT_ice' , 24 , 'iicethic' , .true., .false. , 'daily' , '' , '' , ''630 ! bn_hsnif = 'amm12_bdyT_ice' , 24 , 'isnowthi' , .true., .false. , 'daily' , '' , '' , ''651 ! bn_frld = 'amm12_bdyT_ice' , 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' , '' 652 ! bn_hicif = 'amm12_bdyT_ice' , 24 , 'iicethic', .true. , .false. , 'daily' , '' , '' , '' 653 ! bn_hsnif = 'amm12_bdyT_ice' , 24 , 'isnowthi', .true. , .false. , 'daily' , '' , '' , '' 631 654 ! for lim3 632 ! bn_a_i = 'amm12_bdyT_ice' , 24 , 'ileadfra' , .true. , .false. , 'daily' , '' , '' , '' 633 ! bn_ht_i = 'amm12_bdyT_ice' , 24 , 'iicethic' , .true. , .false. , 'daily' , '' , '' , '' 634 ! bn_ht_s = 'amm12_bdyT_ice' , 24 , 'isnowthi' , .true. , .false. , 'daily' , '' , '' , '' 635 cn_dir = 'bdydta/' 636 ln_full_vel = .false. 655 ! bn_a_i = 'amm12_bdyT_ice' , 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' , '' 656 ! bn_ht_i = 'amm12_bdyT_ice' , 24 , 'iicethic', .true. , .false. , 'daily' , '' , '' , '' 657 ! bn_ht_s = 'amm12_bdyT_ice' , 24 , 'isnowthi', .true. , .false. , 'daily' , '' , '' , '' 658 659 cn_dir = 'bdydta/' ! root directory for the location of the bulk files 660 ln_full_vel = .false. ! 637 661 / 638 662 !----------------------------------------------------------------------- 639 663 &nambdy_tide ! tidal forcing at open boundaries 640 664 !----------------------------------------------------------------------- 641 filtide = 'bdydta/amm12_bdytide_' 642 ln_bdytide_2ddta = .false. 643 ln_bdytide_conj = .false. 665 filtide = 'bdydta/amm12_bdytide_' ! file name root of tidal forcing files 666 ln_bdytide_2ddta = .false. ! 667 ln_bdytide_conj = .false. ! 644 668 / 645 669 !!====================================================================== … … 652 676 ! 653 677 !----------------------------------------------------------------------- 654 &nambfr ! bottom friction 678 &nambfr ! bottom friction (default: linear) 655 679 !----------------------------------------------------------------------- 656 680 nn_bfr = 1 ! type of bottom friction : = 0 : free slip, = 1 : linear friction … … 675 699 / 676 700 !----------------------------------------------------------------------- 677 &nambbc ! bottom temperature boundary condition 678 !----------------------------------------------------------------------- 679 ! ! ! (if <0 months) ! 680 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 681 ! ! ! (if <0 months) ! name ! (logical) ! (T/F ) ! 'monthly' ! filename ! pairing ! filename ! 682 sn_qgh ='geothermal_heating.nc', -12. , 'heatflow' , .false. , .true. , 'yearly' , '' , '' , '' 701 &nambbc ! bottom temperature boundary condition (default: NO) 702 !----------------------------------------------------------------------- 703 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 704 ! ! ! (if <0 months) ! name ! (logical) ! (T/F ) ! 'monthly' ! filename ! pairing ! filename ! 705 sn_qgh ='geothermal_heating.nc', -12. , 'heatflow', .false. , .true. , 'yearly' , '' , '' , '' 683 706 ! 684 cn_dir = './' ! root directory for the location of the runoff files 685 ln_trabbc = .true. ! Apply a geothermal heating at the ocean bottom 707 ln_trabbc = .false. ! Apply a geothermal heating at the ocean bottom 686 708 nn_geoflx = 2 ! geothermal heat flux: = 0 no flux 687 709 ! = 1 constant flux 688 710 ! = 2 variable flux (read in geothermal_heating.nc in mW/m2) 689 711 rn_geoflx_cst = 86.4e-3 ! Constant value of geothermal heat flux [W/m2] 690 / 691 !----------------------------------------------------------------------- 692 &nambbl ! bottom boundary layer scheme 712 cn_dir = './' ! root directory for the location of the runoff files 713 / 714 !----------------------------------------------------------------------- 715 &nambbl ! bottom boundary layer scheme ("key_trabbl") 693 716 !----------------------------------------------------------------------- 694 717 nn_bbl_ldf = 1 ! diffusive bbl (=1) or not (=0) … … 729 752 / 730 753 !----------------------------------------------------------------------- 731 &namtra_adv ! advection scheme for tracer 754 &namtra_adv ! advection scheme for tracer (default: NO advection) 732 755 !----------------------------------------------------------------------- 733 756 ln_traadv_cen = .false. ! 2nd order centered scheme … … 746 769 / 747 770 !----------------------------------------------------------------------- 748 &namtra_adv_mle ! mixed layer eddy parametrisation (Fox-Kemper param) 771 &namtra_adv_mle ! mixed layer eddy parametrisation (Fox-Kemper param) (default: NO) 749 772 !----------------------------------------------------------------------- 750 773 ln_mle = .false. ! (T) use the Mixed Layer Eddy (MLE) parameterisation … … 758 781 rn_rho_c_mle = 0.01 ! delta rho criterion used to calculate MLD for FK 759 782 / 760 !----------------------------------------------------------------------- -----------761 &namtra_ldf ! lateral diffusion scheme for tracers 762 !----------------------------------------------------------------------- -----------783 !----------------------------------------------------------------------- 784 &namtra_ldf ! lateral diffusion scheme for tracers (default: NO diffusion) 785 !----------------------------------------------------------------------- 763 786 ! ! Operator type: 764 787 ! ! no diffusion: set ln_traldf_lap=..._blp=F … … 790 813 rn_bht_0 = 1.e+12 ! lateral eddy diffusivity (bilap. operator) [m4/s] 791 814 / 792 !----------------------------------------------------------------------- -----------793 &namtra_ldfeiv ! eddy induced velocity param. 794 !----------------------------------------------------------------------- -----------795 ln_ldfeiv =.false. 796 ln_ldfeiv_dia =.false. 797 rn_aeiv_0 = 2000. 798 nn_aei_ijk_t = 21 815 !----------------------------------------------------------------------- 816 &namtra_ldfeiv ! eddy induced velocity param. (default: NO) 817 !----------------------------------------------------------------------- 818 ln_ldfeiv =.false. ! use eddy induced velocity parameterization 819 ln_ldfeiv_dia =.false. ! diagnose eiv stream function and velocities 820 rn_aeiv_0 = 2000. ! eddy induced velocity coefficient [m2/s] 821 nn_aei_ijk_t = 21 ! space/time variation of the eiv coeficient 799 822 ! ! =-20 (=-30) read in eddy_induced_velocity_2D.nc (..._3D.nc) file 800 823 ! ! = 0 constant … … 805 828 / 806 829 !----------------------------------------------------------------------- 807 &namtra_dmp ! tracer: T & S newtonian damping 830 &namtra_dmp ! tracer: T & S newtonian damping (default: NO) 808 831 !----------------------------------------------------------------------- 809 832 ln_tradmp = .true. ! add a damping termn (T) or not (F) … … 811 834 ! =1 no damping in the mixing layer (kz criteria) 812 835 ! =2 no damping in the mixed layer (rho crieria) 813 cn_resto = 'resto.nc' ! Name of file containing restoration coefficientfield (use dmp_tools to create this)836 cn_resto ='resto.nc' ! Name of file containing restoration coeff. field (use dmp_tools to create this) 814 837 / 815 838 … … 820 843 !! namdyn_vor advection scheme 821 844 !! namdyn_hpg hydrostatic pressure gradient 822 !! namdyn_spg surface pressure gradient (CPP key only)845 !! namdyn_spg surface pressure gradient 823 846 !! namdyn_ldf lateral diffusion scheme 824 847 !!====================================================================== 825 848 ! 826 849 !----------------------------------------------------------------------- 827 &namdyn_adv ! formulation of the momentum advection 850 &namdyn_adv ! formulation of the momentum advection (default: vector form) 828 851 !----------------------------------------------------------------------- 829 852 ln_dynadv_vec = .true. ! vector form (T) or flux form (F) … … 834 857 / 835 858 !----------------------------------------------------------------------- 836 &nam_vvl ! vertical coordinate options 859 &nam_vvl ! vertical coordinate options (default: zstar) 837 860 !----------------------------------------------------------------------- 838 861 ln_vvl_zstar = .true. ! zstar vertical coordinate … … 848 871 / 849 872 !----------------------------------------------------------------------- 850 &namdyn_vor ! option of physics/algorithm (not control by CPP keys)873 &namdyn_vor ! option of physics/algorithm (default: NO) 851 874 !----------------------------------------------------------------------- 852 875 ln_dynvor_ene = .false. ! enstrophy conserving scheme … … 854 877 ln_dynvor_mix = .false. ! mixed scheme 855 878 ln_dynvor_een = .false. ! energy & enstrophy scheme 856 nn_een_e3f = 1 !e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)879 nn_een_e3f = 1 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 857 880 ln_dynvor_msk = .false. ! vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes) ! PLEASE DO NOT USE 858 881 / 859 882 !----------------------------------------------------------------------- 860 &namdyn_hpg ! Hydrostatic pressure gradient option 883 &namdyn_hpg ! Hydrostatic pressure gradient option (default: zps) 861 884 !----------------------------------------------------------------------- 862 885 ln_hpg_zco = .false. ! z-coordinate - full steps … … 866 889 ln_hpg_djc = .false. ! s-coordinate (Density Jacobian with Cubic polynomial) 867 890 ln_hpg_prj = .false. ! s-coordinate (Pressure Jacobian scheme) 868 ln_dynhpg_imp = .false. ! time stepping: semi-implicit time scheme (T) 869 ! centered time scheme (F) 870 / 871 !----------------------------------------------------------------------- 872 !namdyn_spg ! surface pressure gradient (CPP key only) 873 !----------------------------------------------------------------------- 874 ! ! explicit free surface ("key_dynspg_exp") 875 ! ! filtered free surface ("key_dynspg_flt") 876 ! ! split-explicit free surface ("key_dynspg_ts") 877 878 !----------------------------------------------------------------------- 879 &namdyn_ldf ! lateral diffusion on momentum 891 / 892 !----------------------------------------------------------------------- 893 &namdyn_spg ! surface pressure gradient (default: NO) 894 !----------------------------------------------------------------------- 895 ln_dynspg_exp = .false. ! explicit free surface 896 ln_dynspg_ts = .false. ! split-explicit free surface 897 ln_bt_fw = .true. ! Forward integration of barotropic Eqs. 898 ln_bt_av = .true. ! Time filtering of barotropic variables 899 nn_bt_flt = 1 ! Time filter choice = 0 None 900 ! ! = 1 Boxcar over nn_baro sub-steps 901 ! ! = 2 Boxcar over 2*nn_baro " " 902 ln_bt_auto = .true. ! Number of sub-step defined from: 903 rn_bt_cmax = 0.8 ! =T : the Maximum Courant Number allowed 904 nn_baro = 30 ! =F : the number of sub-step in rn_rdt seconds 905 / 906 !----------------------------------------------------------------------- 907 &namdyn_ldf ! lateral diffusion on momentum (default: NO) 880 908 !----------------------------------------------------------------------- 881 909 ! ! Type of the operator : … … 909 937 !! namzdf_ric richardson number dependent vertical mixing ("key_zdfric") 910 938 !! namzdf_tke TKE dependent vertical mixing ("key_zdftke") 939 !! namzdf_gls GLS vertical mixing ("key_zdfgls") 911 940 !! namzdf_ddm double diffusive mixing parameterization ("key_zdfddm") 912 941 !! namzdf_tmx tidal mixing parameterization ("key_zdftmx") … … 1008 1037 !! *** Miscellaneous namelists *** 1009 1038 !!====================================================================== 1010 !! namsol elliptic solver / island / free surface1011 1039 !! nammpp Massively Parallel Processing ("key_mpp_mpi) 1012 1040 !! namctl Control prints & Benchmark 1013 !! namc1d 1D configuration options ("key_c1d")1014 !! namc1d_uvd data: U & V currents ("key_c1d")1015 !! namc1d_dyndmp U & V newtonian damping ("key_c1d")1016 1041 !! namsto Stochastic parametrization of EOS 1017 1042 !!====================================================================== 1018 1043 ! 1019 !-----------------------------------------------------------------------1020 &namsol ! elliptic solver / island / free surface1021 !-----------------------------------------------------------------------1022 nn_solv = 1 ! elliptic solver: =1 preconditioned conjugate gradient (pcg)1023 ! =2 successive-over-relaxation (sor)1024 nn_sol_arp = 0 ! absolute/relative (0/1) precision convergence test1025 rn_eps = 1.e-6 ! absolute precision of the solver1026 nn_nmin = 300 ! minimum of iterations for the SOR solver1027 nn_nmax = 800 ! maximum of iterations for the SOR solver1028 nn_nmod = 10 ! frequency of test for the SOR solver1029 rn_resmax = 1.e-10 ! absolute precision for the SOR solver1030 rn_sor = 1.92 ! optimal coefficient for SOR solver (to be adjusted with the domain)1031 /1032 1044 !----------------------------------------------------------------------- 1033 1045 &nammpp ! Massively Parallel Processing ("key_mpp_mpi) … … 1057 1069 / 1058 1070 !----------------------------------------------------------------------- 1059 &namc1d_uvd ! data: U & V currents ("key_c1d") 1060 !----------------------------------------------------------------------- 1061 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 1062 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 1063 sn_ucur = 'ucurrent' , -1 ,'u_current', .false. , .true. , 'monthly' , '' , 'Ume' , '' 1064 sn_vcur = 'vcurrent' , -1 ,'v_current', .false. , .true. , 'monthly' , '' , 'Vme' , '' 1065 ! 1066 cn_dir = './' ! root directory for the location of the files 1067 ln_uvd_init = .false. ! Initialisation of ocean U & V with U & V input data (T) or not (F) 1068 ln_uvd_dyndmp = .false. ! damping of ocean U & V toward U & V input data (T) or not (F) 1069 / 1070 !----------------------------------------------------------------------- 1071 &namc1d_dyndmp ! U & V newtonian damping ("key_c1d") 1072 !----------------------------------------------------------------------- 1073 ln_dyndmp = .false. ! add a damping term (T) or not (F) 1074 / 1075 !----------------------------------------------------------------------- 1076 &namsto ! Stochastic parametrization of EOS 1077 !----------------------------------------------------------------------- 1078 ln_rststo = .false. ! start from mean parameter (F) or from restart file (T) 1071 &namsto ! Stochastic parametrization of EOS (default: NO) 1072 !----------------------------------------------------------------------- 1073 ln_sto_eos = .false. ! stochastic equation of state 1074 nn_sto_eos = 1 ! number of independent random walks 1075 rn_eos_stdxy = 1.4 ! random walk horz. standard deviation (in grid points) 1076 rn_eos_stdz = 0.7 ! random walk vert. standard deviation (in grid points) 1077 rn_eos_tcor = 1440. ! random walk time correlation (in timesteps) 1078 nn_eos_ord = 1 ! order of autoregressive processes 1079 nn_eos_flt = 0 ! passes of Laplacian filter 1080 rn_eos_lim = 2.0 ! limitation factor (default = 3.0) 1081 ln_rststo = .false. ! start from mean parameter (F) or from restart file (T) 1079 1082 ln_rstseed = .true. ! read seed of RNG from restart file 1080 1083 cn_storst_in = "restart_sto" ! suffix of stochastic parameter restart file (input) 1081 1084 cn_storst_out = "restart_sto" ! suffix of stochastic parameter restart file (output) 1082 1083 ln_sto_eos = .false. ! stochastic equation of state1084 nn_sto_eos = 1 ! number of independent random walks1085 rn_eos_stdxy = 1.4 ! random walk horz. standard deviation (in grid points)1086 rn_eos_stdz = 0.7 ! random walk vert. standard deviation (in grid points)1087 rn_eos_tcor = 1440.0 ! random walk time correlation (in timesteps)1088 nn_eos_ord = 1 ! order of autoregressive processes1089 nn_eos_flt = 0 ! passes of Laplacian filter1090 rn_eos_lim = 2.0 ! limitation factor (default = 3.0)1091 1085 / 1092 1086 … … 1094 1088 !! *** Diagnostics namelists *** 1095 1089 !!====================================================================== 1096 !! namnc4 netcdf4 chunking and compression settings ("key_netcdf4")1097 1090 !! namtrd dynamics and/or tracer trends 1098 1091 !! namptr Poleward Transport Diagnostics 1092 !! namhsb Heat and salt budgets 1099 1093 !! namflo float parameters ("key_float") 1100 !! namhsb Heat and salt budgets 1101 !!====================================================================== 1102 ! 1103 !----------------------------------------------------------------------- 1104 &namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4") 1105 !----------------------------------------------------------------------- 1106 nn_nchunks_i= 4 ! number of chunks in i-dimension 1107 nn_nchunks_j= 4 ! number of chunks in j-dimension 1108 nn_nchunks_k= 31 ! number of chunks in k-dimension 1109 ! setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which 1110 ! is optimal for postprocessing which works exclusively with horizontal slabs 1111 ln_nc4zip = .true. ! (T) use netcdf4 chunking and compression 1112 ! (F) ignore chunking information and produce netcdf3-compatible files 1113 / 1114 !----------------------------------------------------------------------- 1115 &namtrd ! diagnostics on dynamics and/or tracer trends 1116 ! ! and/or mixed-layer trends and/or barotropic vorticity 1094 !! nam_diaharm Harmonic analysis of tidal constituents ('key_diaharm') 1095 !! namdct transports through some sections 1096 !! namnc4 netcdf4 chunking and compression settings ("key_netcdf4") 1097 !!====================================================================== 1098 ! 1099 !----------------------------------------------------------------------- 1100 &namtrd ! diagnostics on dynamics and/or tracer trends (default F) 1101 ! ! and/or mixed-layer trends and/or barotropic vorticity 1117 1102 !----------------------------------------------------------------------- 1118 1103 ln_glo_trd = .false. ! (T) global domain averaged diag for T, T^2, KE, and PE 1119 1104 ln_dyn_trd = .false. ! (T) 3D momentum trend output 1120 ln_dyn_mxl = . FALSE. ! (T) 2D momentum trends averaged over the mixed layer (not coded yet)1121 ln_vor_trd = . FALSE. ! (T) 2D barotropic vorticity trends (not coded yet)1105 ln_dyn_mxl = .false. ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 1106 ln_vor_trd = .false. ! (T) 2D barotropic vorticity trends (not coded yet) 1122 1107 ln_KE_trd = .false. ! (T) 3D Kinetic Energy trends 1123 1108 ln_PE_trd = .false. ! (T) 3D Potential Energy trends 1124 ln_tra_trd = . FALSE. ! (T) 3D tracer trend output1109 ln_tra_trd = .false. ! (T) 3D tracer trend output 1125 1110 ln_tra_mxl = .false. ! (T) 2D tracer trends averaged over the mixed layer (not coded yet) 1126 1111 nn_trd = 365 ! print frequency (ln_glo_trd=T) (unit=time step) … … 1133 1118 !!gm ln_trdmld_instant = .false. ! flag to diagnose trends of instantantaneous or mean ML T/S 1134 1119 !!gm 1120 !----------------------------------------------------------------------- 1121 &namptr ! Poleward Transport Diagnostic (default F) 1122 !----------------------------------------------------------------------- 1123 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 1124 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 1125 / 1126 !----------------------------------------------------------------------- 1127 &namhsb ! Heat and salt budgets (default F) 1128 !----------------------------------------------------------------------- 1129 ln_diahsb = .false. ! check the heat and salt budgets (T) or not (F) 1130 / 1135 1131 !----------------------------------------------------------------------- 1136 1132 &namflo ! float parameters ("key_float") … … 1148 1144 / 1149 1145 !----------------------------------------------------------------------- 1150 &namptr ! Poleward Transport Diagnostic 1151 !----------------------------------------------------------------------- 1152 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 1153 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 1154 / 1155 !----------------------------------------------------------------------- 1156 &namhsb ! Heat and salt budgets (default F) 1157 !----------------------------------------------------------------------- 1158 ln_diahsb = .false. ! check the heat and salt budgets (T) or not (F) 1159 / 1160 !----------------------------------------------------------------------- 1161 &nam_diaharm ! Harmonic analysis of tidal constituents ('key_diaharm') 1146 &nam_diaharm ! Harmonic analysis of tidal constituents ('key_diaharm') 1162 1147 !----------------------------------------------------------------------- 1163 1148 nit000_han = 1 ! First time step used for harmonic analysis … … 1168 1153 / 1169 1154 !----------------------------------------------------------------------- 1170 &namdct ! transports through s ections1155 &namdct ! transports through some sections 1171 1156 !----------------------------------------------------------------------- 1172 1157 nn_dct = 15 ! time step frequency for transports computing … … 1176 1161 ! 0 < n : debug section number n 1177 1162 / 1178 1179 !!====================================================================== 1180 !! *** Observation & Assimilation namelists *** 1163 !----------------------------------------------------------------------- 1164 &namnc4 ! netcdf4 chunking and compression settings ("key_netcdf4") 1165 !----------------------------------------------------------------------- 1166 nn_nchunks_i= 4 ! number of chunks in i-dimension 1167 nn_nchunks_j= 4 ! number of chunks in j-dimension 1168 nn_nchunks_k= 31 ! number of chunks in k-dimension 1169 ! setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which 1170 ! is optimal for postprocessing which works exclusively with horizontal slabs 1171 ln_nc4zip = .true. ! (T) use netcdf4 chunking and compression 1172 ! (F) ignore chunking information and produce netcdf3-compatible files 1173 / 1174 1175 !!====================================================================== 1176 !! *** Observation & Assimilation *** 1181 1177 !!====================================================================== 1182 1178 !! namobs observation and model comparison ('key_diaobs') … … 1205 1201 ln_velavcur= .false ! Logical switch for velocity daily av. cur. 1206 1202 ln_velhrcur= .false ! Logical switch for velocity high freq. cur. 1207 ln_velavadcp = .false.! Logical switch for velocity daily av. ADCP1208 ln_velhradcp = .false.! Logical switch for velocity high freq. ADCP1203 ln_velavadcp=.false. ! Logical switch for velocity daily av. ADCP 1204 ln_velhradcp=.false. ! Logical switch for velocity high freq. ADCP 1209 1205 ln_velfb = .false. ! Logical switch for feedback velocity data 1210 ln_grid_global = .false.! Global distribtion of observations1206 ln_grid_global=.false. ! Global distribtion of observations 1211 1207 ln_grid_search_lookup = .false. ! Logical switch for obs grid search w/lookup table 1212 1208 grid_search_file = 'grid_search' ! Grid search lookup file header … … 1222 1218 sstfbfiles = 'sst_01.nc' ! Feedback SST input observation file names 1223 1219 seaicefiles = 'seaice_01.nc' ! Sea Ice input observation file names 1224 velavcurfiles = 'velavcurfile.nc' ! Vel. cur. daily av. input file name1225 velhrcurfiles = 'velhrcurfile.nc' ! Vel. cur. high freq. input file name1220 velavcurfiles = 'velavcurfile.nc' ! Vel. cur. daily av. input file name 1221 velhrcurfiles = 'velhrcurfile.nc' ! Vel. cur. high freq. input file name 1226 1222 velavadcpfiles = 'velavadcpfile.nc' ! Vel. ADCP daily av. input file name 1227 1223 velhradcpfiles = 'velhradcpfile.nc' ! Vel. ADCP high freq. input file name … … 1238 1234 ln_ignmis = .true. ! Logical switch for ignoring missing files 1239 1235 endailyavtypes = 820 ! ENACT daily average types - array (use namelist_cfg to set more values) 1240 ln_grid_global = .true.1241 ln_grid_search_lookup = .false.1242 1236 / 1243 1237 !----------------------------------------------------------------------- … … 1259 1253 nn_divdmp = 0 ! Number of iterations of divergence damping operator 1260 1254 / 1261 !-----------------------------------------------------------------------1262 &namsbc_wave ! External fields from wave model1263 !-----------------------------------------------------------------------1264 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask !1265 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename !1266 sn_cdg = 'cdg_wave' , 1 , 'drag_coeff' , .true. , .false. , 'daily' , '' , '' , ''1267 sn_usd = 'sdw_wave' , 1 , 'u_sd2d' , .true. , .false. , 'daily' , '' , '' , ''1268 sn_vsd = 'sdw_wave' , 1 , 'v_sd2d' , .true. , .false. , 'daily' , '' , '' , ''1269 sn_wn = 'sdw_wave' , 1 , 'wave_num' , .true. , .false. , 'daily' , '' , '' , ''1270 !1271 cn_dir_cdg = './' ! root directory for the location of drag coefficient files1272 ln_cdgw = .false. ! Neutral drag coefficient read from wave model1273 ln_sdw = .false. ! Computation of 3D stokes drift1274 / -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r5866 r6004 29 29 USE sbc_ice ! surface boundary condition: ice 30 30 USE sbc_oce ! surface boundary condition: ocean 31 USE sbccpl 31 USE sbccpl ! surface boundary condition: coupled interface 32 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 33 33 USE albedo ! albedo parameters 34 ! 34 35 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 35 36 USE lib_mpp ! MPP library … … 43 44 PRIVATE 44 45 45 PUBLIC lim_sbc_init_2 46 PUBLIC lim_sbc_flx_2 47 PUBLIC lim_sbc_tau_2 46 PUBLIC lim_sbc_init_2 ! called by ice_init_2 47 PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2 48 PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2 48 49 49 50 REAL(wp) :: r1_rdtice ! = 1. / rdt_ice … … 52 53 REAL(wp) :: rone = 1._wp ! - - 53 54 ! 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soce_0, sice_0 ! constant SSS and ice salinity used in levitating sea-ice case55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soce_0, sice_0 ! fix SSS and ice salinity used in levitating case 0 55 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] 56 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmod_io ! modulus of the ice-ocean relative velocity [m/s] … … 101 102 !!--------------------------------------------------------------------- 102 103 INTEGER, INTENT(in) :: kt ! number of iteration 103 ! !104 ! 104 105 INTEGER :: ji, jj ! dummy loop indices 105 106 INTEGER :: ii0, ii1, ij0, ij1 ! local integers … … 113 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 114 115 !!--------------------------------------------------------------------- 115 116 ! 116 117 CALL wrk_alloc( jpi, jpj, zqnsoce ) 117 118 CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp ) 118 119 SELECT CASE( nn_ice_embd ) 120 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only121 CASE( 1, 2 ) ; zswitch = 0! (1) levitating sea-ice: salt and volume exchange but no pressure effect122 123 END SELECT !119 ! 120 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option 121 CASE( 0 ) ; zswitch = 1 ! (0) old levitating sea-ice : salt exchange only 122 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 123 ! ! (2) embedded sea-ice : salt and volume fluxes and pressure 124 END SELECT 124 125 125 126 !------------------------------------------! … … 302 303 INTEGER , INTENT(in) :: kt ! ocean time-step index 303 304 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents 304 ! !305 ! 305 306 INTEGER :: ji, jj ! dummy loop indices 306 307 REAL(wp) :: zfrldu, zat_u, zu_i, zutau_ice, zu_t, zmodt ! local scalar … … 434 435 !! ** input : Namelist namicedia 435 436 !!------------------------------------------------------------------- 436 !437 INTEGER :: jk ! local integer437 INTEGER :: jk ! local integer 438 !!------------------------------------------------------------------- 438 439 ! 439 440 IF(lwp) WRITE(numout,*) … … 471 472 !!gm I really don't like this staff here... Find a way to put that elsewhere or differently 472 473 !!gm 473 IF( .NOT. 474 IF( .NOT.ln_linssh ) THEN 474 475 475 476 do jk = 1,jpkm1 ! adjust initial vertical scale factors -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r5845 r6004 18 18 USE phycst ! physical constants 19 19 USE dom_oce ! ocean space and time domain variables 20 USE domvvl 21 USE lbclnk 20 USE domvvl ! ocean domain 21 USE ice_2 ! LIM sea-ice variables 22 USE sbc_oce ! surface boundary condition: ocean 23 USE sbc_ice ! surface boundary condition: sea-ice 24 USE thd_ice_2 ! LIM thermodynamic sea-ice variables 25 USE dom_ice_2 ! LIM sea-ice domain 26 USE limthd_zdf_2 ! 27 USE limthd_lac_2 ! 28 USE limtab_2 ! 29 ! 22 30 USE in_out_manager ! I/O manager 23 USE lib_mpp 31 USE lbclnk ! 32 USE lib_mpp ! 24 33 USE wrk_nemo ! work arrays 25 34 USE iom ! IOM library 26 USE ice_2 ! LIM sea-ice variables27 USE sbc_oce !28 USE sbc_ice !29 USE thd_ice_2 ! LIM thermodynamic sea-ice variables30 USE dom_ice_2 ! LIM sea-ice domain31 USE limthd_zdf_232 USE limthd_lac_233 USE limtab_234 35 USE prtctl ! Print control 35 36 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 43 44 REAL(wp) :: epsi16 = 1.e-16 ! 44 45 REAL(wp) :: epsi04 = 1.e-04 ! 45 REAL(wp) :: rzero = 0. e0!46 REAL(wp) :: rone = 1. e0!46 REAL(wp) :: rzero = 0._wp ! 47 REAL(wp) :: rone = 1._wp ! 47 48 48 49 !! * Substitutions … … 74 75 !!--------------------------------------------------------------------- 75 76 INTEGER, INTENT(in) :: kt ! number of iteration 76 ! !77 ! 77 78 INTEGER :: ji, jj ! dummy loop indices 78 79 INTEGER :: nbpb ! nb of icy pts for thermo. cal. -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5866 r6004 23 23 !! lim_sbc_tau : update i- and j-stresses, and its modulus at the ocean surface 24 24 !!---------------------------------------------------------------------- 25 USE par_oce ! ocean parameters 26 USE phycst ! physical constants 27 USE dom_oce ! ocean domain 28 USE ice ! LIM sea-ice variables 29 USE sbc_ice ! Surface boundary condition: sea-ice fields 30 USE sbc_oce ! Surface boundary condition: ocean fields 31 USE sbccpl 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 33 USE albedo ! albedo parameters 34 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 35 USE lib_mpp ! MPP library 36 USE wrk_nemo ! work arrays 37 USE in_out_manager ! I/O manager 38 USE prtctl ! Print control 39 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 40 USE traqsr ! add penetration of solar flux in the calculation of heat budget 41 USE iom 42 USE domvvl ! Variable volume 43 USE limctl 44 USE limcons 25 USE par_oce ! ocean parameters 26 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 27 USE phycst ! physical constants 28 USE dom_oce ! ocean domain 29 USE ice ! LIM sea-ice variables 30 USE sbc_ice ! Surface boundary condition: sea-ice fields 31 USE sbc_oce ! Surface boundary condition: ocean fields 32 USE sbccpl ! Surface boundary condition: coupled interface 33 USE albedo ! albedo parameters 34 USE traqsr ! add penetration of solar flux in the calculation of heat budget 35 USE domvvl ! Variable volume 36 USE limctl ! 37 USE limcons ! 38 ! 39 USE in_out_manager ! I/O manager 40 USE iom ! xIO server 41 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 42 USE lib_mpp ! MPP library 43 USE wrk_nemo ! work arrays 44 USE prtctl ! Print control 45 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 45 46 46 47 IMPLICIT NONE 47 48 PRIVATE 48 49 49 PUBLIC lim_sbc_init ! called by sbc _lim_init50 PUBLIC lim_sbc_init ! called by sbcice_lim 50 51 PUBLIC lim_sbc_flx ! called by sbc_ice_lim 51 52 PUBLIC lim_sbc_tau ! called by sbc_ice_lim … … 100 101 !! The ref should be Rousset et al., 2015 101 102 !!--------------------------------------------------------------------- 102 INTEGER, INTENT(in) :: kt 103 INTEGER :: ji, jj, jl, jk ! dummy loop indices104 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2)105 REAL(wp) :: zq sr ! New solar flux received by the ocean106 !107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 2D/3D workspace103 INTEGER, INTENT(in) :: kt ! number of iteration 104 ! 105 INTEGER :: ji, jj, jl, jk ! dummy loop indices 106 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 107 REAL(wp) :: zqsr ! New solar flux received by the ocean 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 3D workspace 108 109 !!--------------------------------------------------------------------- 109 110 ! 110 111 ! make calls for heat fluxes before it is modified 111 112 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface … … 197 198 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) ! 198 199 !------------------------------------------------------------------------! 199 CALL wrk_alloc( jpi, jpj, jpl,zalb_cs, zalb_os )200 CALL wrk_alloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 200 201 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 201 202 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 202 CALL wrk_dealloc( jpi, jpj, jpl,zalb_cs, zalb_os )203 CALL wrk_dealloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 203 204 204 205 ! conservation test 205 IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' )206 IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' ) 206 207 207 208 ! control prints 208 209 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 209 210 ! 210 211 IF(ln_ctl) THEN 211 212 CALL prt_ctl( tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ' ) … … 214 215 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 215 216 ENDIF 216 217 ! 217 218 END SUBROUTINE lim_sbc_flx 218 219 … … 245 246 INTEGER , INTENT(in) :: kt ! ocean time-step index 246 247 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents 247 ! !248 ! 248 249 INTEGER :: ji, jj ! dummy loop indices 249 250 REAL(wp) :: zat_u, zutau_ice, zu_t, zmodt ! local scalar … … 302 303 !! ** input : Namelist namicedia 303 304 !!------------------------------------------------------------------- 304 INTEGER :: ji, jj, jk ! dummy loop indices 305 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 305 INTEGER :: ji, jj, jk ! dummy loop indices 306 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 307 !!------------------------------------------------------------------- 308 ! 306 309 IF(lwp) WRITE(numout,*) 307 310 IF(lwp) WRITE(numout,*) 'lim_sbc_init : LIM-3 sea-ice - surface boundary condition' -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5845 r6004 25 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 26 USE sbc_ice ! Surface boundary condition: ice fields 27 USE thd_ice ! LIM thermodynamic sea-ice variables28 USE dom_ice ! LIM sea-ice domain27 USE dom_ice ! LIM: sea-ice domain 28 USE thd_ice ! LIM: thermodynamic sea-ice variables 29 29 USE limthd_dif ! LIM: thermodynamics, vertical diffusion 30 30 USE limthd_dh ! LIM: thermodynamics, ice and snow thickness variation 31 31 USE limthd_sal ! LIM: thermodynamics, ice salinity 32 32 USE limthd_ent ! LIM: thermodynamics, ice enthalpy redistribution 33 USE limthd_lac ! LIM -3lateral accretion34 USE limitd_th ! remapping thickness distribution33 USE limthd_lac ! LIM: lateral accretion 34 USE limitd_th ! LIM: remapping thickness distribution 35 35 USE limtab ! LIM: 1D <==> 2D transformation 36 36 USE limvar ! LIM: sea-ice variables 37 USE limcons ! LIM: conservation tests 38 USE limctl ! LIM: control print 39 ! 40 USE in_out_manager ! I/O manager 41 USE prtctl ! Print control 37 42 USE lbclnk ! lateral boundary condition - MPP links 38 43 USE lib_mpp ! MPP library 39 44 USE wrk_nemo ! work arrays 40 USE in_out_manager ! I/O manager41 USE prtctl ! Print control42 45 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 43 46 USE timing ! Timing 44 USE limcons ! conservation tests45 USE limctl46 47 47 48 IMPLICIT NONE … … 80 81 !!--------------------------------------------------------------------- 81 82 INTEGER, INTENT(in) :: kt ! number of iteration 82 ! !83 ! 83 84 INTEGER :: ji, jj, jk, jl ! dummy loop indices 84 85 INTEGER :: nbpb ! nb of icy pts for vertical thermo calculations 85 INTEGER :: ii, ij ! temporary dummy loop index86 86 REAL(wp) :: zfric_u, zqld, zqfr 87 87 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 88 88 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 89 89 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 90 !91 90 !!------------------------------------------------------------------- 92 91 93 IF( nn_timing == 1 ) CALL timing_start('limthd')92 IF( nn_timing == 1 ) CALL timing_start('limthd') 94 93 95 94 ! conservation test 96 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)95 IF( ln_limdiahsb ) CALL lim_cons_hsm( 0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 97 96 98 97 CALL lim_var_glo2eqv … … 225 224 226 225 IF( nbpb > 0 ) THEN ! If there is no ice, do nothing. 227 228 !-------------------------! 229 ! --- Move to 1D arrays --- 230 !-------------------------! 231 CALL lim_thd_1d2d( nbpb, jl, 1 ) 232 233 !--------------------------------------! 234 ! --- Ice/Snow Temperature profile --- ! 235 !--------------------------------------! 236 CALL lim_thd_dif( 1, nbpb ) 237 238 !---------------------------------! 239 ! --- Ice/Snow thickness --- ! 240 !---------------------------------! 241 CALL lim_thd_dh( 1, nbpb ) 242 243 ! --- Ice enthalpy remapping --- ! 244 CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) ) 245 246 !---------------------------------! 247 ! --- Ice salinity --- ! 248 !---------------------------------! 249 CALL lim_thd_sal( 1, nbpb ) 250 251 !---------------------------------! 252 ! --- temperature update --- ! 253 !---------------------------------! 254 CALL lim_thd_temp( 1, nbpb ) 255 256 !------------------------------------! 257 ! --- lateral melting if monocat --- ! 258 !------------------------------------! 226 ! 227 CALL lim_thd_1d2d( nbpb, jl, 1 ) ! --- Move to 1D arrays ---! 228 ! 229 CALL lim_thd_dif ( 1, nbpb ) ! --- Ice/Snow Temperature profile --- ! 230 ! 231 CALL lim_thd_dh ( 1, nbpb ) ! --- Ice/Snow thickness ---! 232 ! 233 CALL lim_thd_ent ( 1, nbpb, q_i_1d(1:nbpb,:) ) ! --- Ice enthalpy remapping --- ! 234 ! 235 CALL lim_thd_sal ( 1, nbpb ) ! --- Ice salinity --- ! 236 ! 237 CALL lim_thd_temp( 1, nbpb ) ! --- temperature update --- ! 238 ! 239 ! ! --- lateral melting if monocat --- ! 259 240 IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 260 241 CALL lim_thd_lam( 1, nbpb ) 261 242 END IF 262 263 !-------------------------! 264 ! --- Move to 2D arrays --- 265 !-------------------------! 266 CALL lim_thd_1d2d( nbpb, jl, 2 ) 267 268 ! 269 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 243 ! 244 CALL lim_thd_1d2d( nbpb, jl, 2 ) ! --- Move to 2D arrays --- 245 ! 246 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 270 247 ENDIF 271 248 ! … … 409 386 ENDIF 410 387 ! 411 IF( nn_timing == 1 ) CALL timing_stop('limthd')412 388 IF( nn_timing == 1 ) CALL timing_stop('limthd') 389 ! 413 390 END SUBROUTINE lim_thd 414 391 … … 423 400 !!------------------------------------------------------------------- 424 401 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 425 ! !402 ! 426 403 INTEGER :: ji, jk ! dummy loop indices 427 404 REAL(wp) :: ztmelts, zaaa, zbbb, zccc, zdiscrim ! local scalar … … 443 420 END DO 444 421 END DO 445 422 ! 446 423 END SUBROUTINE lim_thd_temp 424 447 425 448 426 SUBROUTINE lim_thd_lam( kideb, kiut ) … … 454 432 !!----------------------------------------------------------------------- 455 433 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 456 INTEGER :: ji ! dummy loop indices 457 REAL(wp) :: zhi_bef ! ice thickness before thermo 458 REAL(wp) :: zdh_mel, zda_mel ! net melting 459 REAL(wp) :: zvi, zvs ! ice/snow volumes 460 434 ! 435 INTEGER :: ji ! dummy loop indices 436 REAL(wp) :: zhi_bef ! ice thickness before thermo 437 REAL(wp) :: zdh_mel, zda_mel ! net melting 438 REAL(wp) :: zvi, zvs ! ice/snow volumes 439 !!----------------------------------------------------------------------- 440 ! 461 441 DO ji = kideb, kiut 462 442 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) … … 476 456 END IF 477 457 END DO 478 458 ! 479 459 END SUBROUTINE lim_thd_lam 460 480 461 481 462 SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) … … 485 466 !! ** Purpose : move arrays from 1d to 2d and the reverse 486 467 !!----------------------------------------------------------------------- 487 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D 488 ! 2= from 1D to 2D 468 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D ; 2= from 1D to 2D 489 469 INTEGER, INTENT(in) :: nbpb ! size of 1D arrays 490 470 INTEGER, INTENT(in) :: jl ! ice cat 471 ! 491 472 INTEGER :: jk ! dummy loop indices 492 473 !!----------------------------------------------------------------------- 474 ! 493 475 SELECT CASE( kn ) 494 495 CASE( 1 ) 496 476 ! 477 CASE( 1 ) ! from 2D to 1D 478 ! 497 479 CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) ) 498 480 CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 499 481 CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 500 482 CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 501 483 ! 502 484 CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 503 485 CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) … … 511 493 CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 512 494 END DO 513 495 ! 514 496 CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 515 497 CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) … … 525 507 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 526 508 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 527 509 ! 528 510 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 529 511 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 530 512 ! 531 513 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 532 514 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) … … 535 517 CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) ) 536 518 CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) ) 537 519 ! 538 520 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 539 521 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) … … 542 524 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 543 525 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 544 526 ! 545 527 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 546 528 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) … … 556 538 CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 557 539 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 558 559 CASE( 2 ) 560 540 ! 541 CASE( 2 ) ! from 1D to 2D 542 ! 561 543 CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj ) 562 544 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj ) … … 575 557 END DO 576 558 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 577 559 ! 578 560 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 579 561 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 580 562 ! 581 563 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 582 564 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) … … 585 567 CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj ) 586 568 CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj ) 587 569 ! 588 570 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 589 571 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) … … 592 574 CALL tab_1d_2d( nbpb, sfx_res , npb, sfx_res_1d(1:nbpb) , jpi, jpj ) 593 575 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 594 576 ! 595 577 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 596 578 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) … … 611 593 ! 612 594 END SELECT 613 595 ! 614 596 END SUBROUTINE lim_thd_1d2d 615 597 … … 628 610 !!------------------------------------------------------------------- 629 611 INTEGER :: ios ! Local integer output status for namelist read 630 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, & 631 & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 612 !! 613 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, & 614 & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 632 615 & nn_monocat, ln_it_qnsice 633 616 !!------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r5845 r6004 22 22 USE oce 23 23 USE dom_oce 24 USE sol_oce24 USE zdf_oce 25 25 USE agrif_oce 26 26 USE phycst 27 ! 27 28 USE in_out_manager 28 29 USE agrif_opa_sponge 29 30 USE lib_mpp 30 31 USE wrk_nemo 31 USE dynspg_oce32 USE zdf_oce33 32 34 33 IMPLICIT NONE 35 34 PRIVATE 36 35 37 INTEGER :: bdy_tinterp = 038 39 36 PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 40 PUBLIC interpun, interpvn , interpun2d, interpvn2d37 PUBLIC interpun, interpvn 41 38 PUBLIC interptsn, interpsshn 42 39 PUBLIC interpunb, interpvnb, interpub2b, interpvb2b … … 46 43 # endif 47 44 45 INTEGER :: bdy_tinterp = 0 46 48 47 # include "vectopt_loop_substitute.h90" 49 48 !!---------------------------------------------------------------------- 50 !! NEMO/NST 3. 6 , NEMO Consortium (2010)49 !! NEMO/NST 3.7 , NEMO Consortium (2015) 51 50 !! $Id$ 52 51 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 53 52 !!---------------------------------------------------------------------- 54 55 53 CONTAINS 56 54 … … 61 59 ! 62 60 IF( Agrif_Root() ) RETURN 63 64 Agrif_SpecialValue = 0. e061 ! 62 Agrif_SpecialValue = 0._wp 65 63 Agrif_UseSpecialValue = .TRUE. 66 64 ! 67 65 CALL Agrif_Bc_variable( tsn_id, procname=interptsn ) 66 ! 68 67 Agrif_UseSpecialValue = .FALSE. 69 68 ! … … 77 76 INTEGER, INTENT(in) :: kt 78 77 ! 79 INTEGER :: ji,jj,jk, j1,j2, i1,i2 80 REAL(wp) :: timeref 81 REAL(wp) :: z2dt, znugdt 82 REAL(wp) :: zrhox, zrhoy 83 REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1 84 !!---------------------------------------------------------------------- 85 78 INTEGER :: ji, jj, jk ! dummy loop indices 79 INTEGER :: j1, j2, i1, i2 80 REAL(wp), POINTER, DIMENSION(:,:) :: zub, zvb 81 !!---------------------------------------------------------------------- 82 ! 86 83 IF( Agrif_Root() ) RETURN 87 88 CALL wrk_alloc( jpi, jpj, spgv1, spgu1)89 90 Agrif_SpecialValue =0.84 ! 85 CALL wrk_alloc( jpi,jpj, zub, zvb ) 86 ! 87 Agrif_SpecialValue = 0._wp 91 88 Agrif_UseSpecialValue = ln_spc_dyn 92 93 CALL Agrif_Bc_variable(un_interp_id,procname=interpun) 94 CALL Agrif_Bc_variable(vn_interp_id,procname=interpvn) 95 96 #if defined key_dynspg_flt 97 CALL Agrif_Bc_variable(e1u_id,calledweight=1., procname=interpun2d) 98 CALL Agrif_Bc_variable(e2v_id,calledweight=1., procname=interpvn2d) 99 #endif 100 89 ! 90 CALL Agrif_Bc_variable( un_interp_id, procname=interpun ) 91 CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn ) 92 ! 101 93 Agrif_UseSpecialValue = .FALSE. 102 103 zrhox = Agrif_Rhox() 104 zrhoy = Agrif_Rhoy() 105 106 timeref = 1. 107 ! time step: leap-frog 108 z2dt = 2. * rdt 109 ! time step: Euler if restart from rest 110 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 111 ! coefficients 112 znugdt = grav * z2dt 113 94 ! 114 95 ! prevent smoothing in ghost cells 115 i1=1 116 i2=jpi 117 j1=1 118 j2=jpj 119 IF((nbondj == -1).OR.(nbondj == 2)) j1 = 3 120 IF((nbondj == +1).OR.(nbondj == 2)) j2 = nlcj-2 121 IF((nbondi == -1).OR.(nbondi == 2)) i1 = 3 122 IF((nbondi == +1).OR.(nbondi == 2)) i2 = nlci-2 123 124 125 IF((nbondi == -1).OR.(nbondi == 2)) THEN 126 #if defined key_dynspg_flt 127 DO jk=1,jpkm1 96 i1 = 1 ; i2 = jpi 97 j1 = 1 ; j2 = jpj 98 IF( nbondj == -1 .OR. nbondj == 2 ) j1 = 3 99 IF( nbondj == +1 .OR. nbondj == 2 ) j2 = nlcj-2 100 IF( nbondi == -1 .OR. nbondi == 2 ) i1 = 3 101 IF( nbondi == +1 .OR. nbondi == 2 ) i2 = nlci-2 102 103 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 104 ! 105 ! Smoothing 106 ! --------- 107 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 108 ua_b(2,:) = 0._wp 109 DO jk = 1, jpkm1 110 DO jj = 1, jpj 111 ua_b(2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 112 END DO 113 END DO 114 DO jj = 1, jpj 115 ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj) 116 END DO 117 ENDIF 118 ! 119 DO jk=1,jpkm1 ! Smooth 128 120 DO jj=j1,j2 129 ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk) 130 END DO 131 END DO 132 133 spgu(2,:)=0. 121 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 122 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 123 END DO 124 END DO 125 ! 126 zub(2,:) = 0._wp ! Correct transport 127 DO jk = 1, jpkm1 128 DO jj = 1, jpj 129 zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 130 END DO 131 END DO 132 DO jj=1,jpj 133 zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 134 END DO 134 135 135 136 DO jk=1,jpkm1 136 137 DO jj=1,jpj 137 spgu(2,jj)=spgu(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 138 END DO 139 END DO 140 141 DO jj=1,jpj 142 IF (umask(2,jj,1).NE.0.) THEN 143 spgu(2,jj)=spgu(2,jj)*r1_hu_n(2,jj) 144 ENDIF 145 END DO 146 #else 147 spgu(2,:) = ua_b(2,:) 148 #endif 149 150 DO jk=1,jpkm1 151 DO jj=j1,j2 152 ua(2,jj,jk) = 0.25*(ua(1,jj,jk)+2.*ua(2,jj,jk)+ua(3,jj,jk)) 153 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 154 END DO 155 END DO 156 157 spgu1(2,:)=0. 158 159 DO jk=1,jpkm1 138 ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 139 END DO 140 END DO 141 142 ! Set tangential velocities to time splitting estimate 143 !----------------------------------------------------- 144 IF( ln_dynspg_ts ) THEN 145 zvb(2,:) = 0._wp 146 DO jk = 1, jpkm1 147 DO jj = 1, jpj 148 zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 149 END DO 150 END DO 151 DO jj = 1, jpj 152 zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 153 END DO 154 DO jk = 1, jpkm1 155 DO jj = 1, jpj 156 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 157 END DO 158 END DO 159 ENDIF 160 ! 161 ! Mask domain edges: 162 !------------------- 163 DO jk = 1, jpkm1 164 DO jj = 1, jpj 165 ua(1,jj,jk) = 0._wp 166 va(1,jj,jk) = 0._wp 167 END DO 168 END DO 169 ! 170 ENDIF 171 172 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 173 174 ! Smoothing 175 ! --------- 176 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 177 ua_b(nlci-2,:) = 0._wp 178 DO jk=1,jpkm1 179 DO jj=1,jpj 180 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 181 END DO 182 END DO 160 183 DO jj=1,jpj 161 spgu1(2,jj)=spgu1(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 162 END DO 163 END DO 164 165 DO jj=1,jpj 166 IF (umask(2,jj,1).NE.0.) THEN 167 spgu1(2,jj)=spgu1(2,jj)*r1_hu_n(2,jj) 168 ENDIF 169 END DO 170 171 DO jk=1,jpkm1 172 DO jj=j1,j2 173 ua(2,jj,jk) = (ua(2,jj,jk)+spgu(2,jj)-spgu1(2,jj))*umask(2,jj,jk) 174 END DO 175 END DO 176 177 #if defined key_dynspg_ts 184 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj) 185 END DO 186 ENDIF 187 188 DO jk = 1, jpkm1 ! Smooth 189 DO jj = j1, j2 190 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 191 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 192 END DO 193 END DO 194 195 zub(nlci-2,:) = 0._wp ! Correct transport 196 DO jk = 1, jpkm1 197 DO jj = 1, jpj 198 zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 199 END DO 200 END DO 201 DO jj = 1, jpj 202 zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 203 END DO 204 205 DO jk = 1, jpkm1 206 DO jj = 1, jpj 207 ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 208 END DO 209 END DO 210 ! 178 211 ! Set tangential velocities to time splitting estimate 179 spgv1(2,:)=0. 180 DO jk=1,jpkm1 212 !----------------------------------------------------- 213 IF( ln_dynspg_ts ) THEN 214 zvb(nlci-1,:) = 0._wp 215 DO jk = 1, jpkm1 216 DO jj = 1, jpj 217 zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 218 END DO 219 END DO 181 220 DO jj=1,jpj 182 spgv1(2,jj)=spgv1(2,jj)+e3v_a(2,jj,jk)*va(2,jj,jk) 183 END DO 184 END DO 185 DO jj=1,jpj 186 spgv1(2,jj)=spgv1(2,jj)*r1_hv_a(2,jj) 187 END DO 188 DO jk=1,jpkm1 189 DO jj=1,jpj 190 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-spgv1(2,jj))*vmask(2,jj,jk) 191 END DO 192 END DO 193 #endif 194 195 ENDIF 196 197 IF((nbondi == 1).OR.(nbondi == 2)) THEN 198 #if defined key_dynspg_flt 199 DO jk=1,jpkm1 200 DO jj=j1,j2 201 ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk) 202 END DO 203 END DO 204 spgu(nlci-2,:)=0. 205 DO jk=1,jpkm1 206 DO jj=1,jpj 207 spgu(nlci-2,jj)=spgu(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 208 ENDDO 209 ENDDO 210 DO jj=1,jpj 211 IF (umask(nlci-2,jj,1).NE.0.) THEN 212 spgu(nlci-2,jj)=spgu(nlci-2,jj)*r1_hu_n(nlci-2,jj) 213 ENDIF 214 END DO 215 #else 216 spgu(nlci-2,:) = ua_b(nlci-2,:) 217 #endif 218 DO jk=1,jpkm1 219 DO jj=j1,j2 220 ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 221 222 ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 223 224 END DO 225 END DO 226 spgu1(nlci-2,:)=0. 227 DO jk=1,jpkm1 228 DO jj=1,jpj 229 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 230 END DO 231 END DO 232 DO jj=1,jpj 233 IF (umask(nlci-2,jj,1).NE.0.) THEN 234 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*r1_hu_n(nlci-2,jj) 235 ENDIF 236 END DO 237 DO jk=1,jpkm1 238 DO jj=j1,j2 239 ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+spgu(nlci-2,jj)-spgu1(nlci-2,jj))*umask(nlci-2,jj,jk) 240 END DO 241 END DO 242 243 #if defined key_dynspg_ts 244 ! Set tangential velocities to time splitting estimate 245 spgv1(nlci-1,:)=0._wp 246 DO jk=1,jpkm1 247 DO jj=1,jpj 248 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+e3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk) 249 END DO 250 END DO 251 252 DO jj=1,jpj 253 spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*r1_hv_a(nlci-1,jj) 254 END DO 255 256 DO jk=1,jpkm1 257 DO jj=1,jpj 258 va(nlci-1,jj,jk) = (va(nlci-1,jj,jk)+va_b(nlci-1,jj)-spgv1(nlci-1,jj))*vmask(nlci-1,jj,jk) 259 END DO 260 END DO 261 #endif 262 263 ENDIF 264 265 IF((nbondj == -1).OR.(nbondj == 2)) THEN 266 267 #if defined key_dynspg_flt 221 zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 222 END DO 223 DO jk = 1, jpkm1 224 DO jj = 1, jpj 225 va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 226 END DO 227 END DO 228 ENDIF 229 ! 230 ! Mask domain edges: 231 !------------------- 232 DO jk = 1, jpkm1 233 DO jj = 1, jpj 234 ua(nlci-1,jj,jk) = 0._wp 235 va(nlci ,jj,jk) = 0._wp 236 END DO 237 END DO 238 ! 239 ENDIF 240 241 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 242 243 ! Smoothing 244 ! --------- 245 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 246 va_b(:,2) = 0._wp 247 DO jk = 1, jpkm1 248 DO ji = 1, jpi 249 va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) 250 END DO 251 END DO 252 DO ji=1,jpi 253 va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2) 254 END DO 255 ENDIF 256 ! 257 DO jk = 1, jpkm1 ! Smooth 258 DO ji = i1, i2 259 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 260 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 261 END DO 262 END DO 263 ! 264 zvb(:,2) = 0._wp ! Correct transport 268 265 DO jk=1,jpkm1 269 266 DO ji=1,jpi 270 va(ji,2,jk) = (va(ji,2,jk) - z2dt * znugdt * laplacv(ji,2))*vmask(ji,2,jk) 271 END DO 272 END DO 273 274 spgv(:,2)=0. 275 276 DO jk=1,jpkm1 277 DO ji=1,jpi 278 spgv(ji,2)=spgv(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk) 279 END DO 280 END DO 281 282 DO ji=1,jpi 283 IF (vmask(ji,2,1).NE.0.) THEN 284 spgv(ji,2)=spgv(ji,2)* r1_hv_n(ji,2) 285 ENDIF 286 END DO 287 #else 288 spgv(:,2)=va_b(:,2) 289 #endif 290 291 DO jk=1,jpkm1 292 DO ji=i1,i2 293 va(ji,2,jk)=0.25*(va(ji,1,jk)+2.*va(ji,2,jk)+va(ji,3,jk)) 294 va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk) 295 END DO 296 END DO 297 298 spgv1(:,2)=0. 299 300 DO jk=1,jpkm1 301 DO ji=1,jpi 302 spgv1(ji,2)=spgv1(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 303 END DO 304 END DO 305 306 DO ji=1,jpi 307 IF (vmask(ji,2,1).NE.0.) THEN 308 spgv1(ji,2)=spgv1(ji,2)*r1_hv_n(ji,2) 309 ENDIF 310 END DO 311 312 DO jk=1,jpkm1 313 DO ji=1,jpi 314 va(ji,2,jk) = (va(ji,2,jk)+spgv(ji,2)-spgv1(ji,2))*vmask(ji,2,jk) 315 END DO 316 END DO 317 318 #if defined key_dynspg_ts 267 zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 268 END DO 269 END DO 270 DO ji = 1, jpi 271 zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 272 END DO 273 DO jk = 1, jpkm1 274 DO ji = 1, jpi 275 va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 276 END DO 277 END DO 278 319 279 ! Set tangential velocities to time splitting estimate 320 spgu1(:,2)=0._wp 321 DO jk=1,jpkm1 322 DO ji=1,jpi 323 spgu1(ji,2)=spgu1(ji,2)+e3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk) 324 END DO 325 END DO 326 327 DO ji=1,jpi 328 spgu1(ji,2)=spgu1(ji,2)*r1_hu_a(ji,2) 329 END DO 330 331 DO jk=1,jpkm1 332 DO ji=1,jpi 333 ua(ji,2,jk) = (ua(ji,2,jk)+ua_b(ji,2)-spgu1(ji,2))*umask(ji,2,jk) 334 END DO 335 END DO 336 #endif 337 ENDIF 338 339 IF((nbondj == 1).OR.(nbondj == 2)) THEN 340 341 #if defined key_dynspg_flt 342 DO jk=1,jpkm1 343 DO ji=1,jpi 344 va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)-z2dt * znugdt * laplacv(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 345 END DO 346 END DO 347 348 349 spgv(:,nlcj-2)=0. 350 351 DO jk=1,jpkm1 352 DO ji=1,jpi 353 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 354 END DO 355 END DO 356 357 DO ji=1,jpi 358 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 359 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 360 ENDIF 361 END DO 362 363 #else 364 spgv(:,nlcj-2)=va_b(:,nlcj-2) 365 #endif 366 367 DO jk=1,jpkm1 368 DO ji=i1,i2 369 va(ji,nlcj-2,jk)=0.25*(va(ji,nlcj-3,jk)+2.*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk)) 370 va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 371 END DO 372 END DO 373 374 spgv1(:,nlcj-2)=0. 375 376 DO jk=1,jpkm1 377 DO ji=1,jpi 378 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 379 END DO 380 END DO 381 382 DO ji=1,jpi 383 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 384 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 385 ENDIF 386 END DO 387 388 DO jk=1,jpkm1 389 DO ji=1,jpi 390 va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+spgv(ji,nlcj-2)-spgv1(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 391 END DO 392 END DO 393 394 #if defined key_dynspg_ts 280 !----------------------------------------------------- 281 IF( ln_dynspg_ts ) THEN 282 zub(:,2) = 0._wp 283 DO jk = 1, jpkm1 284 DO ji = 1, jpi 285 zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 286 END DO 287 END DO 288 DO ji = 1, jpi 289 zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 290 END DO 291 292 DO jk = 1, jpkm1 293 DO ji = 1, jpi 294 ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 295 END DO 296 END DO 297 ENDIF 298 299 ! Mask domain edges: 300 !------------------- 301 DO jk = 1, jpkm1 302 DO ji = 1, jpi 303 ua(ji,1,jk) = 0._wp 304 va(ji,1,jk) = 0._wp 305 END DO 306 END DO 307 308 ENDIF 309 310 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 311 ! 312 ! Smoothing 313 ! --------- 314 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 315 va_b(:,nlcj-2) = 0._wp 316 DO jk = 1, jpkm1 317 DO ji = 1, jpi 318 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) 319 END DO 320 END DO 321 DO ji = 1, jpi 322 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 323 END DO 324 ENDIF 325 ! 326 DO jk = 1, jpkm1 ! Smooth 327 DO ji = i1, i2 328 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 329 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 330 END DO 331 END DO 332 ! 333 zvb(:,nlcj-2) = 0._wp ! Correct transport 334 DO jk = 1, jpkm1 335 DO ji = 1, jpi 336 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 337 END DO 338 END DO 339 DO ji = 1, jpi 340 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 341 END DO 342 DO jk = 1, jpkm1 343 DO ji = 1, jpi 344 va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 345 END DO 346 END DO 347 ! 395 348 ! Set tangential velocities to time splitting estimate 396 spgu1(:,nlcj-1)=0._wp 397 DO jk=1,jpkm1 398 DO ji=1,jpi 399 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+e3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk) 400 END DO 401 END DO 402 403 DO ji=1,jpi 404 spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*r1_hu_a(ji,nlcj-1) 405 END DO 406 407 DO jk=1,jpkm1 408 DO ji=1,jpi 409 ua(ji,nlcj-1,jk) = (ua(ji,nlcj-1,jk)+ua_b(ji,nlcj-1)-spgu1(ji,nlcj-1))*umask(ji,nlcj-1,jk) 410 END DO 411 END DO 412 #endif 413 414 ENDIF 415 ! 416 CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 ) 349 !----------------------------------------------------- 350 IF( ln_dynspg_ts ) THEN 351 zub(:,nlcj-1) = 0._wp 352 DO jk = 1, jpkm1 353 DO ji = 1, jpi 354 zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 355 END DO 356 END DO 357 DO ji = 1, jpi 358 zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 359 END DO 360 ! 361 DO jk = 1, jpkm1 362 DO ji = 1, jpi 363 ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 364 END DO 365 END DO 366 ENDIF 367 ! 368 ! Mask domain edges: 369 !------------------- 370 DO jk = 1, jpkm1 371 DO ji = 1, jpi 372 ua(ji,nlcj ,jk) = 0._wp 373 va(ji,nlcj-1,jk) = 0._wp 374 END DO 375 END DO 376 ! 377 ENDIF 378 ! 379 CALL wrk_dealloc( jpi,jpj, zub, zvb ) 417 380 ! 418 381 END SUBROUTINE Agrif_dyn 382 419 383 420 384 SUBROUTINE Agrif_dyn_ts( jn ) … … 427 391 INTEGER :: ji, jj 428 392 !!---------------------------------------------------------------------- 429 393 ! 430 394 IF( Agrif_Root() ) RETURN 431 395 ! 432 396 IF((nbondi == -1).OR.(nbondi == 2)) THEN 433 397 DO jj=1,jpj … … 440 404 END DO 441 405 ENDIF 442 406 ! 443 407 IF((nbondi == 1).OR.(nbondi == 2)) THEN 444 408 DO jj=1,jpj … … 451 415 END DO 452 416 ENDIF 453 417 ! 454 418 IF((nbondj == -1).OR.(nbondj == 2)) THEN 455 419 DO ji=1,jpi … … 462 426 END DO 463 427 ENDIF 464 428 ! 465 429 IF((nbondj == 1).OR.(nbondj == 2)) THEN 466 430 DO ji=1,jpi … … 476 440 END SUBROUTINE Agrif_dyn_ts 477 441 442 478 443 SUBROUTINE Agrif_dta_ts( kt ) 479 444 !!---------------------------------------------------------------------- … … 487 452 REAL(wp) :: zrhot, zt 488 453 !!---------------------------------------------------------------------- 489 454 ! 490 455 IF( Agrif_Root() ) RETURN 491 492 ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in 493 ! the forward case only 494 456 ! 457 ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in the forward case only 458 ! 495 459 zrhot = Agrif_rhot() 496 460 ! 497 461 ! "Central" time index for interpolation: 498 IF (ln_bt_fw) THEN499 zt = REAL( Agrif_NbStepint()+0.5_wp,wp) / zrhot462 IF( ln_bt_fw ) THEN 463 zt = REAL( Agrif_NbStepint()+0.5_wp, wp ) / zrhot 500 464 ELSE 501 zt = REAL( Agrif_NbStepint(),wp) / zrhot502 ENDIF 503 465 zt = REAL( Agrif_NbStepint() , wp ) / zrhot 466 ENDIF 467 ! 504 468 ! Linear interpolation of sea level 505 Agrif_SpecialValue = 0. e0469 Agrif_SpecialValue = 0._wp 506 470 Agrif_UseSpecialValue = .TRUE. 507 CALL Agrif_Bc_variable( sshn_id,calledweight=zt, procname=interpsshn )471 CALL Agrif_Bc_variable( sshn_id, calledweight=zt, procname=interpsshn ) 508 472 Agrif_UseSpecialValue = .FALSE. 509 473 ! 510 474 ! Interpolate barotropic fluxes 511 475 Agrif_SpecialValue=0. 512 476 Agrif_UseSpecialValue = ln_spc_dyn 513 514 IF (ll_int_cons) THEN! Conservative interpolation477 ! 478 IF( ll_int_cons ) THEN ! Conservative interpolation 515 479 ! orders matters here !!!!!! 516 CALL Agrif_Bc_variable( ub2b_interp_id,calledweight=1._wp, procname=interpub2b) ! Time integrated517 CALL Agrif_Bc_variable( vb2b_interp_id,calledweight=1._wp, procname=interpvb2b)480 CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 481 CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 518 482 bdy_tinterp = 1 519 CALL Agrif_Bc_variable( unb_id ,calledweight=1._wp, procname=interpunb) ! After520 CALL Agrif_Bc_variable( vnb_id ,calledweight=1._wp, procname=interpvnb)483 CALL Agrif_Bc_variable( unb_id , calledweight=1._wp, procname=interpunb ) ! After 484 CALL Agrif_Bc_variable( vnb_id , calledweight=1._wp, procname=interpvnb ) 521 485 bdy_tinterp = 2 522 CALL Agrif_Bc_variable( unb_id ,calledweight=0._wp, procname=interpunb) ! Before523 CALL Agrif_Bc_variable( vnb_id ,calledweight=0._wp, procname=interpvnb)486 CALL Agrif_Bc_variable( unb_id , calledweight=0._wp, procname=interpunb ) ! Before 487 CALL Agrif_Bc_variable( vnb_id , calledweight=0._wp, procname=interpvnb ) 524 488 ELSE ! Linear interpolation 525 489 bdy_tinterp = 0 526 ubdy_w(:) = 0. e0 ; vbdy_w(:) = 0.e0527 ubdy_e(:) = 0. e0 ; vbdy_e(:) = 0.e0528 ubdy_n(:) = 0. e0 ; vbdy_n(:) = 0.e0529 ubdy_s(:) = 0. e0 ; vbdy_s(:) = 0.e0530 CALL Agrif_Bc_variable( unb_id,calledweight=zt, procname=interpunb)531 CALL Agrif_Bc_variable( vnb_id,calledweight=zt, procname=interpvnb)490 ubdy_w(:) = 0._wp ; vbdy_w(:) = 0._wp 491 ubdy_e(:) = 0._wp ; vbdy_e(:) = 0._wp 492 ubdy_n(:) = 0._wp ; vbdy_n(:) = 0._wp 493 ubdy_s(:) = 0._wp ; vbdy_s(:) = 0._wp 494 CALL Agrif_Bc_variable( unb_id, calledweight=zt, procname=interpunb ) 495 CALL Agrif_Bc_variable( vnb_id, calledweight=zt, procname=interpvnb ) 532 496 ENDIF 533 497 Agrif_UseSpecialValue = .FALSE. … … 535 499 END SUBROUTINE Agrif_dta_ts 536 500 501 537 502 SUBROUTINE Agrif_ssh( kt ) 538 503 !!---------------------------------------------------------------------- … … 542 507 !! 543 508 !!---------------------------------------------------------------------- 544 509 ! 545 510 IF( Agrif_Root() ) RETURN 546 511 ! 547 512 IF((nbondi == -1).OR.(nbondi == 2)) THEN 548 513 ssha(2,:)=ssha(3,:) 549 514 sshn(2,:)=sshn(3,:) 550 515 ENDIF 551 516 ! 552 517 IF((nbondi == 1).OR.(nbondi == 2)) THEN 553 518 ssha(nlci-1,:)=ssha(nlci-2,:) 554 519 sshn(nlci-1,:)=sshn(nlci-2,:) 555 520 ENDIF 556 521 ! 557 522 IF((nbondj == -1).OR.(nbondj == 2)) THEN 558 523 ssha(:,2)=ssha(:,3) 559 524 sshn(:,2)=sshn(:,3) 560 525 ENDIF 561 526 ! 562 527 IF((nbondj == 1).OR.(nbondj == 2)) THEN 563 528 ssha(:,nlcj-1)=ssha(:,nlcj-2) 564 529 sshn(:,nlcj-1)=sshn(:,nlcj-2) 565 530 ENDIF 566 531 ! 567 532 END SUBROUTINE Agrif_ssh 533 568 534 569 535 SUBROUTINE Agrif_ssh_ts( jn ) … … 575 541 INTEGER :: ji,jj 576 542 !!---------------------------------------------------------------------- 577 543 ! 578 544 IF((nbondi == -1).OR.(nbondi == 2)) THEN 579 DO jj =1,jpj545 DO jj = 1, jpj 580 546 ssha_e(2,jj) = hbdy_w(jj) 581 547 END DO 582 548 ENDIF 583 549 ! 584 550 IF((nbondi == 1).OR.(nbondi == 2)) THEN 585 DO jj =1,jpj551 DO jj = 1, jpj 586 552 ssha_e(nlci-1,jj) = hbdy_e(jj) 587 553 END DO 588 554 ENDIF 589 555 ! 590 556 IF((nbondj == -1).OR.(nbondj == 2)) THEN 591 DO ji =1,jpi557 DO ji = 1, jpi 592 558 ssha_e(ji,2) = hbdy_s(ji) 593 559 END DO 594 560 ENDIF 595 561 ! 596 562 IF((nbondj == 1).OR.(nbondj == 2)) THEN 597 DO ji =1,jpi563 DO ji = 1, jpi 598 564 ssha_e(ji,nlcj-1) = hbdy_n(ji) 599 565 END DO 600 566 ENDIF 601 567 ! 602 568 END SUBROUTINE Agrif_ssh_ts 603 569 604 570 # if defined key_zdftke 571 605 572 SUBROUTINE Agrif_tke 606 573 !!---------------------------------------------------------------------- … … 608 575 !!---------------------------------------------------------------------- 609 576 REAL(wp) :: zalpha 577 !!---------------------------------------------------------------------- 610 578 ! 611 579 zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 612 580 IF( zalpha > 1. ) zalpha = 1. 613 581 ! 614 582 Agrif_SpecialValue = 0.e0 615 583 Agrif_UseSpecialValue = .TRUE. 616 584 ! 617 585 CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm) 618 586 ! 619 587 Agrif_UseSpecialValue = .FALSE. 620 588 ! 621 589 END SUBROUTINE Agrif_tke 590 622 591 # endif 623 592 624 SUBROUTINE interptsn( ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir)625 !!--------------------------------------------- 593 SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 594 !!---------------------------------------------------------------------- 626 595 !! *** ROUTINE interptsn *** 627 !!--------------------------------------------- 628 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab629 INTEGER , INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2630 LOGICAL , INTENT(in) ::before631 INTEGER , INTENT(in) ::nb , ndir596 !!---------------------------------------------------------------------- 597 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 598 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 599 LOGICAL , INTENT(in ) :: before 600 INTEGER , INTENT(in ) :: nb , ndir 632 601 ! 633 602 INTEGER :: ji, jj, jk, jn ! dummy loop indices 634 INTEGER ::imin, imax, jmin, jmax603 INTEGER :: imin, imax, jmin, jmax 635 604 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha3 636 605 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha7 637 LOGICAL :: western_side, eastern_side,northern_side,southern_side 638 606 LOGICAL :: western_side, eastern_side,northern_side,southern_side 607 !!---------------------------------------------------------------------- 608 ! 639 609 IF (before) THEN 640 610 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) … … 669 639 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 670 640 ! 671 IF( eastern_side ) THEN641 IF( eastern_side ) THEN 672 642 DO jn = 1, jpts 673 643 tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 674 644 DO jk = 1, jpkm1 675 645 DO jj = jmin,jmax 676 IF( umask(nlci-2,jj,jk) == 0. e0) THEN646 IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 677 647 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 678 648 ELSE 679 649 tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 680 IF( un(nlci-2,jj,jk) > 0. e0) THEN650 IF( un(nlci-2,jj,jk) > 0._wp ) THEN 681 651 tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 682 652 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) … … 685 655 END DO 686 656 END DO 687 ENDDO 657 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 658 END DO 688 659 ENDIF 689 660 ! … … 693 664 DO jk = 1, jpkm1 694 665 DO ji = imin,imax 695 IF( vmask(ji,nlcj-2,jk) == 0. e0) THEN666 IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 696 667 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 697 668 ELSE 698 669 tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 699 IF (vn(ji,nlcj-2,jk) > 0. e0) THEN670 IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 700 671 tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn) & 701 672 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) … … 704 675 END DO 705 676 END DO 706 ENDDO 707 ENDIF 708 ! 709 IF( western_side) THEN 677 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 678 END DO 679 ENDIF 680 ! 681 IF( western_side ) THEN 710 682 DO jn = 1, jpts 711 683 tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 712 684 DO jk = 1, jpkm1 713 685 DO jj = jmin,jmax 714 IF( umask(2,jj,jk) == 0. e0) THEN686 IF( umask(2,jj,jk) == 0._wp ) THEN 715 687 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 716 688 ELSE 717 689 tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk) 718 IF( un(2,jj,jk) < 0. e0) THEN690 IF( un(2,jj,jk) < 0._wp ) THEN 719 691 tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 720 692 ENDIF … … 722 694 END DO 723 695 END DO 696 tsa(1,j1:j2,k1:k2,jn) = 0._wp 724 697 END DO 725 698 ENDIF … … 728 701 DO jn = 1, jpts 729 702 tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 730 DO jk =1,jpk703 DO jk = 1, jpk 731 704 DO ji=imin,imax 732 IF( vmask(ji,2,jk) == 0. e0) THEN705 IF( vmask(ji,2,jk) == 0._wp ) THEN 733 706 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 734 707 ELSE 735 708 tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 736 IF( vn(ji,2,jk) < 0. e0) THEN709 IF( vn(ji,2,jk) < 0._wp ) THEN 737 710 tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 738 711 ENDIF … … 740 713 END DO 741 714 END DO 742 ENDDO 715 tsa(i1:i2,1,k1:k2,jn) = 0._wp 716 END DO 743 717 ENDIF 744 718 ! … … 766 740 END SUBROUTINE interptsn 767 741 768 SUBROUTINE interpsshn(ptab,i1,i2,j1,j2,before,nb,ndir) 742 743 SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before, nb, ndir ) 769 744 !!---------------------------------------------------------------------- 770 745 !! *** ROUTINE interpsshn *** 771 746 !!---------------------------------------------------------------------- 772 INTEGER, INTENT(in) :: i1,i2,j1,j2 773 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 774 LOGICAL, INTENT(in) :: before 775 INTEGER, INTENT(in) :: nb , ndir 747 INTEGER , INTENT(in ) :: i1, i2, j1, j2 748 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 749 LOGICAL , INTENT(in ) :: before 750 INTEGER , INTENT(in ) :: nb , ndir 751 ! 776 752 LOGICAL :: western_side, eastern_side,northern_side,southern_side 777 753 !!---------------------------------------------------------------------- … … 792 768 END SUBROUTINE interpsshn 793 769 794 SUBROUTINE interpun(ptab,i1,i2,j1,j2,k1,k2, before) 795 !!--------------------------------------------- 770 771 SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, before ) 772 !!---------------------------------------------------------------------- 796 773 !! *** ROUTINE interpun *** 797 !!--------------------------------------------- 798 !! 799 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 800 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 801 LOGICAL, INTENT(in) :: before 802 !! 803 INTEGER :: ji,jj,jk 804 REAL(wp) :: zrhoy 805 !!--------------------------------------------- 806 ! 807 IF (before) THEN 808 DO jk=1,jpk 809 DO jj=j1,j2 810 DO ji=i1,i2 811 ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 812 ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3u_n(ji,jj,jk) 813 END DO 814 END DO 774 !!---------------------------------------------------------------------- 775 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 776 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 777 LOGICAL , INTENT(in ) :: before 778 ! 779 INTEGER :: ji, jj, jk 780 REAL(wp) :: zrhoy 781 !!---------------------------------------------------------------------- 782 ! 783 IF( before ) THEN 784 DO jk = k1, jpk 785 ptab(i1:i2,j1:j2,jk) = e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 815 786 END DO 816 787 ELSE 817 788 zrhoy = Agrif_Rhoy() 818 DO jk =1,jpkm1789 DO jk = 1, jpkm1 819 790 DO jj=j1,j2 820 ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 821 ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / e3u_n(i1:i2,jj,jk) 791 ua(i1:i2,jj,jk) = ptab(i1:i2,jj,jk) / ( zrhoy * e2u(i1:i2,jj) * e3u_n(i1:i2,jj,jk) ) 822 792 END DO 823 793 END DO … … 827 797 828 798 829 SUBROUTINE interpun2d(ptab,i1,i2,j1,j2,before) 830 !!--------------------------------------------- 831 !! *** ROUTINE interpun *** 832 !!--------------------------------------------- 833 ! 834 INTEGER, INTENT(in) :: i1,i2,j1,j2 835 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 836 LOGICAL, INTENT(in) :: before 837 ! 838 INTEGER :: ji,jj 839 REAL(wp) :: ztref 840 REAL(wp) :: zrhoy 841 !!--------------------------------------------- 842 ! 843 ztref = 1. 844 845 IF (before) THEN 846 DO jj=j1,j2 847 DO ji=i1,MIN(i2,nlci-1) 848 ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) 849 END DO 850 END DO 851 ELSE 852 zrhoy = Agrif_Rhoy() 853 DO jj=j1,j2 854 laplacu(i1:i2,jj) = ztref * (ptab(i1:i2,jj)/(zrhoy*e2u(i1:i2,jj))) !*umask(i1:i2,jj,1) 855 END DO 856 ENDIF 857 ! 858 END SUBROUTINE interpun2d 859 860 861 SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2, before) 862 !!--------------------------------------------- 799 SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, before ) 800 !!---------------------------------------------------------------------- 863 801 !! *** ROUTINE interpvn *** 864 !!--------------------------------------------- 865 ! 866 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 867 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 868 LOGICAL, INTENT(in) :: before 869 ! 870 INTEGER :: ji,jj,jk 871 REAL(wp) :: zrhox 872 !!--------------------------------------------- 802 !!---------------------------------------------------------------------- 803 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 804 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 805 LOGICAL , INTENT(in ) :: before 806 ! 807 INTEGER :: ji, jj, jk 808 REAL(wp) :: zrhox 809 !!---------------------------------------------------------------------- 873 810 ! 874 IF (before) THEN 875 !interpv entre 1 et k2 et interpv2d en jpkp1 876 DO jk=k1,jpk 877 DO jj=j1,j2 878 DO ji=i1,i2 879 ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 880 ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3v_n(ji,jj,jk) 881 END DO 882 END DO 811 IF( before ) THEN !interpv entre 1 et k2 et interpv2d en jpkp1 812 DO jk = k1, jpk 813 ptab(i1:i2,j1:j2,jk) = e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) * vn(i1:i2,j1:j2,jk) 883 814 END DO 884 815 ELSE 885 816 zrhox= Agrif_Rhox() 886 DO jk=1,jpkm1 887 DO jj=j1,j2 888 va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 889 va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / e3v_n(i1:i2,jj,jk) 890 END DO 817 DO jk = 1, jpkm1 818 va(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) ) 891 819 END DO 892 820 ENDIF 893 821 ! 894 822 END SUBROUTINE interpvn 895 896 SUBROUTINE interpvn2d(ptab,i1,i2,j1,j2,before) 897 !!--------------------------------------------- 898 !! *** ROUTINE interpvn *** 899 !!--------------------------------------------- 900 ! 901 INTEGER, INTENT(in) :: i1,i2,j1,j2 902 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 903 LOGICAL, INTENT(in) :: before 904 ! 905 INTEGER :: ji,jj 906 REAL(wp) :: zrhox 907 REAL(wp) :: ztref 908 !!--------------------------------------------- 909 ! 910 ztref = 1. 911 IF (before) THEN 912 !interpv entre 1 et k2 et interpv2d en jpkp1 913 DO jj=j1,MIN(j2,nlcj-1) 914 DO ji=i1,i2 915 ptab(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) * vmask(ji,jj,1) 916 END DO 917 END DO 918 ELSE 919 zrhox = Agrif_Rhox() 920 DO ji=i1,i2 921 laplacv(ji,j1:j2) = ztref * (ptab(ji,j1:j2)/(zrhox*e1v(ji,j1:j2))) 922 END DO 923 ENDIF 924 ! 925 END SUBROUTINE interpvn2d 926 927 SUBROUTINE interpunb(ptab,i1,i2,j1,j2,before,nb,ndir) 823 824 825 SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before, nb, ndir ) 928 826 !!---------------------------------------------------------------------- 929 827 !! *** ROUTINE interpunb *** 930 828 !!---------------------------------------------------------------------- 931 INTEGER, INTENT(in) :: i1,i2,j1,j2 932 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 933 LOGICAL, INTENT(in) :: before 934 INTEGER, INTENT(in) :: nb , ndir 935 !! 936 INTEGER :: ji,jj 937 REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff 938 LOGICAL :: western_side, eastern_side,northern_side,southern_side 939 !!---------------------------------------------------------------------- 940 ! 941 IF (before) THEN 942 DO jj=j1,j2 943 DO ji=i1,i2 944 ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu_n(ji,jj) 945 END DO 946 END DO 829 INTEGER , INTENT(in ) :: i1, i2, j1, j2 830 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 831 LOGICAL , INTENT(in ) :: before 832 INTEGER , INTENT(in ) :: nb , ndir 833 ! 834 INTEGER :: ji, jj 835 REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff 836 LOGICAL :: western_side, eastern_side,northern_side,southern_side 837 !!---------------------------------------------------------------------- 838 ! 839 IF( before ) THEN 840 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * un_b(i1:i2,j1:j2) 947 841 ELSE 948 842 western_side = (nb == 1).AND.(ndir == 1) … … 958 852 IF( bdy_tinterp == 1 ) THEN 959 853 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 960 &- zt0**2._wp * ( zt0 - 1._wp) )854 & - zt0**2._wp * ( zt0 - 1._wp) ) 961 855 ELSEIF( bdy_tinterp == 2 ) THEN 962 856 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 963 &- zt0 * ( zt0 - 1._wp)**2._wp )857 & - zt0 * ( zt0 - 1._wp)**2._wp ) 964 858 965 859 ELSE … … 982 876 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 983 877 IF(western_side) THEN 984 ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) & 985 & * umask(i1,j1:j2,1) 878 ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 986 879 ENDIF 987 880 IF(eastern_side) THEN 988 ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) & 989 & * umask(i1,j1:j2,1) 881 ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 990 882 ENDIF 991 883 IF(southern_side) THEN 992 ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) & 993 & * umask(i1:i2,j1,1) 884 ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 994 885 ENDIF 995 886 IF(northern_side) THEN 996 ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) & 997 & * umask(i1:i2,j1,1) 887 ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 998 888 ENDIF 999 889 ENDIF … … 1002 892 END SUBROUTINE interpunb 1003 893 1004 SUBROUTINE interpvnb(ptab,i1,i2,j1,j2,before,nb,ndir) 894 895 SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before, nb, ndir ) 1005 896 !!---------------------------------------------------------------------- 1006 897 !! *** ROUTINE interpvnb *** 1007 898 !!---------------------------------------------------------------------- 1008 INTEGER , INTENT(in) :: i1,i2,j1,j21009 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab1010 LOGICAL , INTENT(in) ::before1011 INTEGER , INTENT(in) ::nb , ndir1012 ! !1013 INTEGER ::ji,jj1014 REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff1015 LOGICAL ::western_side, eastern_side,northern_side,southern_side899 INTEGER , INTENT(in ) :: i1, i2, j1, j2 900 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 901 LOGICAL , INTENT(in ) :: before 902 INTEGER , INTENT(in ) :: nb , ndir 903 ! 904 INTEGER :: ji,jj 905 REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff 906 LOGICAL :: western_side, eastern_side,northern_side,southern_side 1016 907 !!---------------------------------------------------------------------- 1017 908 ! 1018 IF (before) THEN 1019 DO jj=j1,j2 1020 DO ji=i1,i2 1021 ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv_n(ji,jj) 1022 END DO 1023 END DO 909 IF( before ) THEN 910 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vn_b(i1:i2,j1:j2) 1024 911 ELSE 1025 912 western_side = (nb == 1).AND.(ndir == 1) … … 1034 921 IF( bdy_tinterp == 1 ) THEN 1035 922 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 1036 &- zt0**2._wp * ( zt0 - 1._wp) )923 & - zt0**2._wp * ( zt0 - 1._wp) ) 1037 924 ELSEIF( bdy_tinterp == 2 ) THEN 1038 925 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 1039 & - zt0 * ( zt0 - 1._wp)**2._wp ) 1040 926 & - zt0 * ( zt0 - 1._wp)**2._wp ) 1041 927 ELSE 1042 928 ztcoeff = 1 … … 1078 964 END SUBROUTINE interpvnb 1079 965 1080 SUBROUTINE interpub2b(ptab,i1,i2,j1,j2,before,nb,ndir) 966 967 SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before, nb, ndir ) 1081 968 !!---------------------------------------------------------------------- 1082 969 !! *** ROUTINE interpub2b *** 1083 970 !!---------------------------------------------------------------------- 1084 INTEGER , INTENT(in) :: i1,i2,j1,j21085 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab1086 LOGICAL , INTENT(in) ::before1087 INTEGER , INTENT(in) ::nb , ndir1088 ! !1089 INTEGER ::ji,jj1090 REAL(wp) :: zrhot, zt0, zt1,zat1091 LOGICAL ::western_side, eastern_side,northern_side,southern_side971 INTEGER , INTENT(in ) :: i1, i2, j1, j2 972 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 973 LOGICAL , INTENT(in ) :: before 974 INTEGER , INTENT(in ) :: nb , ndir 975 ! 976 INTEGER :: ji,jj 977 REAL(wp) :: zrhot, zt0, zt1,zat 978 LOGICAL :: western_side, eastern_side,northern_side,southern_side 1092 979 !!---------------------------------------------------------------------- 1093 980 IF( before ) THEN 1094 DO jj=j1,j2 1095 DO ji=i1,i2 1096 ptab(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj) 1097 END DO 1098 END DO 981 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 1099 982 ELSE 1100 983 western_side = (nb == 1).AND.(ndir == 1) … … 1107 990 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 1108 991 ! Polynomial interpolation coefficients: 1109 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) 1110 & - zt0**2._wp * (-2._wp*zt0 + 3._wp))992 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 993 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1111 994 ! 1112 995 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2) … … 1117 1000 ! 1118 1001 END SUBROUTINE interpub2b 1119 1120 SUBROUTINE interpvb2b(ptab,i1,i2,j1,j2,before,nb,ndir) 1002 1003 1004 SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before, nb, ndir ) 1121 1005 !!---------------------------------------------------------------------- 1122 1006 !! *** ROUTINE interpvb2b *** 1123 1007 !!---------------------------------------------------------------------- 1124 INTEGER , INTENT(in) :: i1,i2,j1,j21125 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab1126 LOGICAL , INTENT(in) ::before1127 INTEGER , INTENT(in) ::nb , ndir1128 ! !1129 INTEGER :: ji,jj1130 REAL(wp) :: zrhot, zt0, zt1,zat1131 LOGICAL :: western_side, eastern_side,northern_side,southern_side1008 INTEGER , INTENT(in ) :: i1, i2, j1, j2 1009 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1010 LOGICAL , INTENT(in ) :: before 1011 INTEGER , INTENT(in ) :: nb , ndir 1012 ! 1013 INTEGER :: ji,jj 1014 REAL(wp) :: zrhot, zt0, zt1,zat 1015 LOGICAL :: western_side, eastern_side,northern_side,southern_side 1132 1016 !!---------------------------------------------------------------------- 1133 1017 ! 1134 1018 IF( before ) THEN 1135 DO jj=j1,j2 1136 DO ji=i1,i2 1137 ptab(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj) 1138 END DO 1139 END DO 1019 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 1140 1020 ELSE 1141 1021 western_side = (nb == 1).AND.(ndir == 1) … … 1148 1028 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 1149 1029 ! Polynomial interpolation coefficients: 1150 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) 1151 & - zt0**2._wp * (-2._wp*zt0 + 3._wp))1152 ! 1153 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)1154 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)1155 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)1156 IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)1030 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 1031 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1032 ! 1033 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2) 1034 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) 1035 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1) 1036 IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 1157 1037 ENDIF 1158 1038 ! 1159 1039 END SUBROUTINE interpvb2b 1160 1040 1161 SUBROUTINE interpe3t(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 1041 1042 SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 1162 1043 !!---------------------------------------------------------------------- 1163 1044 !! *** ROUTINE interpe3t *** 1164 1045 !!---------------------------------------------------------------------- 1165 ! 1166 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1046 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 1167 1047 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1168 LOGICAL :: before1169 INTEGER , INTENT(in) :: nb , ndir1048 LOGICAL , INTENT(in ) :: before 1049 INTEGER , INTENT(in ) :: nb , ndir 1170 1050 ! 1171 1051 INTEGER :: ji, jj, jk … … 1174 1054 !!---------------------------------------------------------------------- 1175 1055 ! 1176 IF (before) THEN 1177 DO jk=k1,k2 1178 DO jj=j1,j2 1179 DO ji=i1,i2 1180 ptab(ji,jj,jk) = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 1181 END DO 1182 END DO 1183 END DO 1056 IF( before ) THEN 1057 ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2) 1184 1058 ELSE 1185 1059 western_side = (nb == 1).AND.(ndir == 1) … … 1188 1062 northern_side = (nb == 2).AND.(ndir == 2) 1189 1063 1190 DO jk =k1,k21191 DO jj =j1,j21192 DO ji =i1,i21064 DO jk = k1, k2 1065 DO jj = j1, j2 1066 DO ji = i1, i2 1193 1067 ! Get velocity mask at boundary edge points: 1194 IF (western_side)ztmpmsk = umask(ji ,jj ,1)1195 IF (eastern_side)ztmpmsk = umask(nlci-2,jj ,1)1196 IF (northern_side)ztmpmsk = vmask(ji ,nlcj-2,1)1197 IF (southern_side)ztmpmsk = vmask(ji ,2 ,1)1198 1199 IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk))*ztmpmsk > 1.D-2) THEN1068 IF( western_side ) ztmpmsk = umask(ji ,jj ,1) 1069 IF( eastern_side ) ztmpmsk = umask(nlci-2,jj ,1) 1070 IF( northern_side) ztmpmsk = vmask(ji ,nlcj-2,1) 1071 IF( southern_side) ztmpmsk = vmask(ji ,2 ,1) 1072 ! 1073 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN 1200 1074 IF (western_side) THEN 1201 1075 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk … … 1213 1087 END DO 1214 1088 END DO 1215 1089 ! 1216 1090 ENDIF 1217 1091 ! … … 1219 1093 1220 1094 1221 SUBROUTINE interpumsk( ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir)1095 SUBROUTINE interpumsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 1222 1096 !!---------------------------------------------------------------------- 1223 1097 !! *** ROUTINE interpumsk *** 1224 1098 !!---------------------------------------------------------------------- 1225 ! 1226 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1227 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1228 LOGICAL :: before 1229 INTEGER, INTENT(in) :: nb , ndir 1230 ! 1231 INTEGER :: ji, jj, jk 1232 LOGICAL :: western_side, eastern_side 1099 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 1100 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1101 LOGICAL , , INTENT(in ) :: before 1102 INTEGER , INTENT(in ) :: nb , ndir 1103 ! 1104 INTEGER :: ji, jj, jk 1105 LOGICAL :: western_side, eastern_side 1233 1106 !!---------------------------------------------------------------------- 1234 1107 ! 1235 IF (before) THEN 1236 DO jk=k1,k2 1237 DO jj=j1,j2 1238 DO ji=i1,i2 1239 ptab(ji,jj,jk) = umask(ji,jj,jk) 1240 END DO 1241 END DO 1242 END DO 1108 IF( before ) THEN 1109 ptab(i1:i2,j1:j2,k1:k2) = umask(i1:i2,j1:j2,k1:k2) 1243 1110 ELSE 1244 1245 western_side = (nb == 1).AND.(ndir == 1) 1246 eastern_side = (nb == 1).AND.(ndir == 2) 1247 DO jk=k1,k2 1248 DO jj=j1,j2 1249 DO ji=i1,i2 1111 western_side = (nb == 1).AND.(ndir == 1) 1112 eastern_side = (nb == 1).AND.(ndir == 2) 1113 DO jk = k1, k2 1114 DO jj = j1, j2 1115 DO ji = i1, i2 1250 1116 ! Velocity mask at boundary edge points: 1251 1117 IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN … … 1263 1129 END DO 1264 1130 END DO 1265 1131 ! 1266 1132 ENDIF 1267 1133 ! 1268 1134 END SUBROUTINE interpumsk 1269 1135 1270 SUBROUTINE interpvmsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 1136 1137 SUBROUTINE interpvmsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 1271 1138 !!---------------------------------------------------------------------- 1272 1139 !! *** ROUTINE interpvmsk *** 1273 1140 !!---------------------------------------------------------------------- 1274 ! 1275 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1276 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1277 LOGICAL :: before 1278 INTEGER, INTENT(in) :: nb , ndir 1279 ! 1280 INTEGER :: ji, jj, jk 1281 LOGICAL :: northern_side, southern_side 1141 INTEGER , INTENT(in ) :: i1,i2,j1,j2,k1,k2 1142 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1143 LOGICAL , INTENT(in ) :: before 1144 INTEGER , INTENT(in ) :: nb , ndir 1145 ! 1146 INTEGER :: ji, jj, jk 1147 LOGICAL :: northern_side, southern_side 1282 1148 !!---------------------------------------------------------------------- 1283 1149 ! 1284 IF (before) THEN 1285 DO jk=k1,k2 1286 DO jj=j1,j2 1287 DO ji=i1,i2 1288 ptab(ji,jj,jk) = vmask(ji,jj,jk) 1289 END DO 1290 END DO 1291 END DO 1150 IF( before ) THEN 1151 ptab(i1:i2,j1:j2,k1:k2) = vmask(i1:i2,j1:j2,k1:k2) 1292 1152 ELSE 1293 1294 1153 southern_side = (nb == 2).AND.(ndir == 1) 1295 1154 northern_side = (nb == 2).AND.(ndir == 2) 1296 DO jk =k1,k21297 DO jj =j1,j21298 DO ji =i1,i21155 DO jk = k1, k2 1156 DO jj = j1, j2 1157 DO ji = i1, i2 1299 1158 ! Velocity mask at boundary edge points: 1300 1159 IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN … … 1312 1171 END DO 1313 1172 END DO 1314 1173 ! 1315 1174 ENDIF 1316 1175 ! … … 1319 1178 # if defined key_zdftke 1320 1179 1321 SUBROUTINE interpavm( ptab,i1,i2,j1,j2,k1,k2,before)1180 SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before ) 1322 1181 !!---------------------------------------------------------------------- 1323 1182 !! *** ROUTINE interavm *** 1324 1183 !!---------------------------------------------------------------------- 1325 INTEGER , INTENT(in) :: i1,i2,j1,j2,k1,k21326 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab1327 LOGICAL , INTENT(in) ::before1184 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 1185 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1186 LOGICAL , INTENT(in ) :: before 1328 1187 !!---------------------------------------------------------------------- 1329 1188 ! 1330 IF( before ) THEN1189 IF( before ) THEN 1331 1190 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 1332 1191 ELSE -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r5845 r6004 2 2 3 3 MODULE agrif_opa_sponge 4 !!====================================================================== 5 !! *** MODULE agrif_opa_update *** 6 !! AGRIF : 7 !!====================================================================== 8 !! History : 9 !!---------------------------------------------------------------------- 4 10 #if defined key_agrif && ! defined key_offline 5 11 USE par_oce … … 18 24 19 25 !!---------------------------------------------------------------------- 20 !! NEMO/NST 3. 3 , NEMO Consortium (2010)26 !! NEMO/NST 3.7 , NEMO Consortium (2015) 21 27 !! $Id$ 22 28 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 23 29 !!---------------------------------------------------------------------- 24 25 30 CONTAINS 26 31 … … 29 34 !! *** ROUTINE Agrif_Sponge_Tra *** 30 35 !!--------------------------------------------- 31 !!32 36 REAL(wp) :: timecoeff 33 37 !!--------------------------------------------- 38 ! 34 39 #if defined SPONGE 35 40 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() … … 44 49 Agrif_UseSpecialValue = .FALSE. 45 50 #endif 46 51 ! 47 52 END SUBROUTINE Agrif_Sponge_Tra 48 53 54 49 55 SUBROUTINE Agrif_Sponge_dyn 50 56 !!--------------------------------------------- 51 57 !! *** ROUTINE Agrif_Sponge_dyn *** 52 58 !!--------------------------------------------- 53 !!54 59 REAL(wp) :: timecoeff 60 !!--------------------------------------------- 55 61 56 62 #if defined SPONGE … … 70 76 Agrif_UseSpecialValue = .FALSE. 71 77 #endif 72 78 ! 73 79 END SUBROUTINE Agrif_Sponge_dyn 80 74 81 75 82 SUBROUTINE Agrif_Sponge … … 181 188 ! 182 189 #endif 183 190 ! 184 191 END SUBROUTINE Agrif_Sponge 192 185 193 186 194 SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) … … 191 199 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 192 200 LOGICAL, INTENT(in) :: before 193 194 201 ! 195 202 INTEGER :: ji, jj, jk, jn ! dummy loop indices 196 203 INTEGER :: iku, ikv … … 199 206 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 200 207 ! 201 IF (before) THEN208 IF( before ) THEN 202 209 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 203 210 ELSE 204 211 ! 205 212 tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:) 206 213 DO jn = 1, jpts … … 212 219 ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 213 220 ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 214 END DO215 END DO216 221 END DO 222 END DO 223 ! 217 224 IF( ln_zps ) THEN ! set gradient at partial step level 218 225 DO jj = j1,j2-1 … … 221 228 iku = mbku(ji,jj) 222 229 ikv = mbkv(ji,jj) 223 IF( iku == jk ) THEN 224 ztu(ji,jj,jk) = 0._wp 225 ENDIF 226 IF( ikv == jk ) THEN 227 ztv(ji,jj,jk) = 0._wp 228 ENDIF 230 IF( iku == jk ) ztu(ji,jj,jk) = 0._wp 231 IF( ikv == jk ) ztv(ji,jj,jk) = 0._wp 229 232 END DO 230 233 END DO 231 234 ENDIF 232 END DO233 235 END DO 236 ! 234 237 DO jk = 1, jpkm1 235 238 DO jj = j1+1,j2-1 236 239 DO ji = i1+1,i2-1 237 238 240 IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 239 241 zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) … … 243 245 tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 244 246 ENDIF 245 246 ENDDO 247 ENDDO 248 249 ENDDO 250 ENDDO 251 247 END DO 248 END DO 249 END DO 250 ! 251 END DO 252 ! 252 253 tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 253 254 ENDIF 255 254 ! 255 ENDIF 256 ! 256 257 END SUBROUTINE interptsn_sponge 258 257 259 258 260 SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before) … … 271 273 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 272 274 INTEGER :: jmax 273 ! 274 275 276 IF (before) THEN 275 !!--------------------------------------------- 276 ! 277 IF( before ) THEN 277 278 tabres = un(i1:i2,j1:j2,:) 278 279 ELSE 279 280 280 ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:) 281 281 ! 282 282 DO jk = 1, jpkm1 ! Horizontal slab 283 283 ! ! =============== … … 302 302 END DO 303 303 END DO 304 ENDDO 305 306 ! 307 308 309 304 END DO 305 ! 310 306 DO jj = j1+1, j2-1 311 307 DO ji = i1+1, i2-1 ! vector opt. … … 349 345 END DO 350 346 ENDIF 351 352 END DO 353 END DO 354 355 347 ! 348 END DO 349 END DO 350 ! 356 351 tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE. 357 358 ENDIF 359 360 352 ! 353 ENDIF 354 ! 361 355 END SUBROUTINE interpun_sponge 362 356 … … 370 364 LOGICAL, INTENT(in) :: before 371 365 INTEGER, INTENT(in) :: nb , ndir 372 373 INTEGER :: ji,jj,jk 374 375 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 376 366 ! 367 INTEGER :: ji, jj, jk 368 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 377 369 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff 378 370 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 379 371 INTEGER :: imax 380 ! 381 382 IF (before) THEN372 !!--------------------------------------------- 373 374 IF( before ) THEN 383 375 tabres = vn(i1:i2,j1:j2,:) 384 376 ELSE 385 377 ! 386 378 vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:) 387 379 ! 388 380 DO jk = 1, jpkm1 ! Horizontal slab 389 381 ! ! =============== … … 403 395 zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 404 396 rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 405 & -e2v(ji ,jj) * vbdiff(ji ,jj,jk) & 406 & ) * fmask(ji,jj,jk) * zbtr 407 END DO 408 END DO 409 ENDDO 397 & -e2v(ji ,jj) * vbdiff(ji ,jj,jk) ) * fmask(ji,jj,jk) * zbtr 398 END DO 399 END DO 400 END DO 410 401 411 402 ! ! =============== … … 413 404 414 405 imax = i2-1 415 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3)406 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3) 416 407 417 408 DO jj = j1+1, j2 418 409 DO ji = i1+1, imax ! vector opt. 419 IF (.NOT. tabspongedone_u(ji,jj)) THEN 420 DO jk = 1, jpkm1 ! Horizontal slab 421 ze2u = rotdiff (ji,jj,jk) 422 ze1v = hdivdiff(ji,jj,jk) 423 ! horizontal diffusive trends 424 zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 425 / e1u(ji,jj) 426 427 428 ! add it to the general momentum trends 429 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 430 END DO 431 432 ENDIF 433 END DO 434 END DO 435 410 IF( .NOT. tabspongedone_u(ji,jj) ) THEN 411 DO jk = 1, jpkm1 412 ua(ji,jj,jk) = ua(ji,jj,jk) & 413 & - ( rotdiff (ji ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) & 414 & + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj ,jk)) * r1_e1u(ji,jj) 415 END DO 416 ENDIF 417 END DO 418 END DO 419 ! 436 420 tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE. 437 421 ! 438 422 DO jj = j1+1, j2-1 439 423 DO ji = i1+1, i2-1 ! vector opt. 440 IF (.NOT. tabspongedone_v(ji,jj)) THEN 441 DO jk = 1, jpkm1 ! Horizontal slab 442 ze2u = rotdiff (ji,jj,jk) 443 ze1v = hdivdiff(ji,jj,jk) 444 ! horizontal diffusive trends 445 446 zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 447 / e2v(ji,jj) 448 449 ! add it to the general momentum trends 450 va(ji,jj,jk) = va(ji,jj,jk) + zva 424 IF( .NOT. tabspongedone_v(ji,jj) ) THEN 425 DO jk = 1, jpkm1 426 va(ji,jj,jk) = va(ji,jj,jk) & 427 & + ( rotdiff (ji,jj ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) & 428 & + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji ,jj,jk) ) * r1_e2v(ji,jj) 451 429 END DO 452 430 ENDIF … … 455 433 tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE. 456 434 ENDIF 457 435 ! 458 436 END SUBROUTINE interpvn_sponge 459 437 460 438 #else 461 439 CONTAINS 462 463 440 SUBROUTINE agrif_opa_sponge_empty 464 441 !!--------------------------------------------- … … 469 446 #endif 470 447 448 !!====================================================================== 471 449 END MODULE agrif_opa_sponge -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r5845 r6004 11 11 USE lib_mpp 12 12 USE wrk_nemo 13 USE dynspg_oce14 13 USE zdf_oce ! vertical physics: ocean variables 15 14 … … 107 106 # endif 108 107 109 # if defined key_dynspg_ts 110 IF (ln_bt_fw) THEN 108 IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 111 109 ! Update time integrated transports 112 110 IF (mod(nbcline,nbclineupdate) == 0) THEN … … 128 126 ENDIF 129 127 END IF 130 # endif131 128 ! 132 129 nbcline = nbcline + 1 … … 237 234 !! *** ROUTINE updateu *** 238 235 !!--------------------------------------------- 239 INTEGER , INTENT(in) :: i1, i2, j1, j2, k1, k2236 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 240 237 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 241 LOGICAL , INTENT(in) :: before242 ! !243 INTEGER ::ji, jj, jk244 REAL(wp) :: zrhoy245 !!--------------------------------------------- 246 ! 247 IF (before) THEN238 LOGICAL , INTENT(in ) :: before 239 ! 240 INTEGER :: ji, jj, jk 241 REAL(wp) :: zrhoy 242 !!--------------------------------------------- 243 ! 244 IF( before ) THEN 248 245 zrhoy = Agrif_Rhoy() 246 DO jk = k1, k2 247 tabres(i1:i2,j1:j2,jk) = zrhoy * e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 248 END DO 249 ELSE 249 250 DO jk=k1,k2 250 251 DO jj=j1,j2 251 252 DO ji=i1,i2 252 tabres(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) 253 END DO 254 END DO 255 END DO 256 tabres = zrhoy * tabres 257 ELSE 258 DO jk=k1,k2 259 DO jj=j1,j2 260 DO ji=i1,i2 261 tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 253 tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk) 262 254 ! 263 255 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part … … 292 284 DO jj=j1,j2 293 285 DO ji=i1,i2 294 tabres(ji,jj,jk) = e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 295 END DO 296 END DO 297 END DO 298 tabres = zrhox * tabres 286 tabres(ji,jj,jk) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 287 END DO 288 END DO 289 END DO 299 290 ELSE 300 291 DO jk=k1,k2 301 292 DO jj=j1,j2 302 293 DO ji=i1,i2 303 tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e1v(ji,jj) * e3v_n(ji,jj,jk))294 tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk) 304 295 ! 305 296 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part … … 334 325 DO jj=j1,j2 335 326 DO ji=i1,i2 336 tabres(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 337 END DO 338 END DO 339 tabres = zrhoy * tabres 327 tabres(ji,jj) = zrhoy * un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 328 END DO 329 END DO 340 330 ELSE 341 331 DO jj=j1,j2 … … 344 334 ! 345 335 ! Update "now" 3d velocities: 346 spgu(ji,jj) = 0. e0336 spgu(ji,jj) = 0._wp 347 337 DO jk=1,jpkm1 348 338 spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) … … 356 346 ! 357 347 ! Update barotropic velocities: 358 #if defined key_dynspg_ts 359 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part360 zcorr = tabres(ji,jj) - un_b(ji,jj)361 ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1)362 END IF363 #endif348 IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 349 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 350 zcorr = tabres(ji,jj) - un_b(ji,jj) 351 ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 352 END IF 353 ENDIF 364 354 un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1) 365 355 ! … … 400 390 DO jj=j1,j2 401 391 DO ji=i1,i2 402 tabres(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 403 END DO 404 END DO 405 tabres = zrhox * tabres 392 tabres(ji,jj) = zrhox * vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 393 END DO 394 END DO 406 395 ELSE 407 396 DO jj=j1,j2 … … 422 411 ! 423 412 ! Update barotropic velocities: 424 #if defined key_dynspg_ts 425 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part426 zcorr = tabres(ji,jj) - vn_b(ji,jj)427 vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1)428 END IF429 #endif413 IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 414 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 415 zcorr = tabres(ji,jj) - vn_b(ji,jj) 416 vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 417 END IF 418 ENDIF 430 419 vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1) 431 420 ! … … 467 456 END DO 468 457 ELSE 469 #if ! defined key_dynspg_ts 470 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 471 DO jj=j1,j2 472 DO ji=i1,i2 473 sshb(ji,jj) = sshb(ji,jj) & 474 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 475 END DO 476 END DO 458 IF( .NOT.ln_dynspg_ts .OR. ( ln_dynspg_ts .AND. .NOT.ln_bt_fw ) ) THEN 459 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 460 DO jj=j1,j2 461 DO ji=i1,i2 462 sshb(ji,jj) = sshb(ji,jj) & 463 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 464 END DO 465 END DO 466 ENDIF 477 467 ENDIF 478 #endif 468 ! 479 469 DO jj=j1,j2 480 470 DO ji=i1,i2 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
r5845 r6004 4 4 USE oce 5 5 USE dom_oce 6 USE sol_oce7 6 USE agrif_oce 8 7 USE agrif_top_sponge … … 23 22 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 24 23 !!---------------------------------------------------------------------- 25 26 CONTAINS 24 CONTAINS 27 25 28 26 SUBROUTINE Agrif_trc … … 40 38 ! 41 39 END SUBROUTINE Agrif_trc 40 42 41 43 42 SUBROUTINE interptrn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
r5845 r6004 2 2 3 3 MODULE agrif_top_sponge 4 !!====================================================================== 5 !! *** MODULE agrif_top_sponge *** 6 !! AGRIF : define in memory AGRIF variables for sea-ice 7 !!====================================================================== 8 !! History : 2.0 ! 2006-08 (R. Benshila, L. Debreu) Original code 9 !!---------------------------------------------------------------------- 10 11 !!---------------------------------------------------------------------- 12 !! Agrif_Sponge_trc : 13 !! interptrn_sponge : 14 !!---------------------------------------------------------------------- 4 15 #if defined key_agrif && defined key_top 5 16 USE par_oce 6 17 USE par_trc 7 18 USE oce 19 USE trc 8 20 USE dom_oce 9 USE in_out_manager10 21 USE agrif_oce 11 22 USE agrif_opa_sponge 12 USE trc 23 ! 24 USE in_out_manager 13 25 USE lib_mpp 14 26 USE wrk_nemo … … 20 32 21 33 !!---------------------------------------------------------------------- 22 !! NEMO/NST 3. 6 , NEMO Consortium (2010)34 !! NEMO/NST 3.7 , NEMO Consortium (2015) 23 35 !! $Id$ 24 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 25 37 !!---------------------------------------------------------------------- 26 27 38 CONTAINS 28 39 29 40 SUBROUTINE Agrif_Sponge_trc 30 !!--------------------------------------------- 31 !! *** ROUTINE Agrif_Sponge_Trc ***32 !!--------------------------------------------- 33 !!34 REAL(wp) :: timecoeff35 41 !!---------------------------------------------------------------------- 42 !! *** ROUTINE Agrif_Sponge_Trc *** 43 !!---------------------------------------------------------------------- 44 REAL(wp) :: timecoeff 45 !!---------------------------------------------------------------------- 46 ! 36 47 #if defined SPONGE_TOP 37 timecoeff = REAL( Agrif_NbStepint(),wp)/Agrif_rhot()48 timecoeff = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot() 38 49 CALL Agrif_sponge 39 Agrif_SpecialValue =0.50 Agrif_SpecialValue = 0._wp 40 51 Agrif_UseSpecialValue = .TRUE. 41 tabspongedone_trn = .FALSE.42 CALL Agrif_Bc_Variable( trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge)52 tabspongedone_trn = .FALSE. 53 CALL Agrif_Bc_Variable( trn_sponge_id, calledweight=timecoeff, procname=interptrn_sponge ) 43 54 Agrif_UseSpecialValue = .FALSE. 44 45 55 #endif 46 56 ! 47 57 END SUBROUTINE Agrif_Sponge_Trc 48 58 49 SUBROUTINE interptrn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)50 !!---------------------------------------------51 !! *** ROUTINE interptrn_sponge ***52 !!---------------------------------------------53 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n254 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres55 LOGICAL, INTENT(in) :: before56 59 57 60 SUBROUTINE interptrn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 61 !!---------------------------------------------------------------------- 62 !! *** ROUTINE interptrn_sponge *** 63 !!---------------------------------------------------------------------- 64 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 65 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 66 LOGICAL , INTENT(in ) :: before 67 ! 58 68 INTEGER :: ji, jj, jk, jn ! dummy loop indices 59 60 REAL(wp) :: ztra, zabe1, zabe2, zbtr61 REAL(wp), DIMENSION(i1:i2,j1:j2 ) :: ztu, ztv62 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff69 REAL(wp) :: zabe1, zabe2 70 REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv 71 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) :: trbdiff 72 !!---------------------------------------------------------------------- 63 73 ! 64 IF (before) THEN74 IF( before ) THEN 65 75 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 66 76 ELSE 67 77 !!gm line below use of :,: versus i1:i2,j1:j2 .... strange, not wrong. ===>> to be corrected 68 78 trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:) 69 79 DO jn = 1, jptra 70 80 DO jk = 1, jpkm1 71 72 81 DO jj = j1,j2-1 73 82 DO ji = i1,i2-1 74 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)75 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)83 zabe1 = fsaht_spu(ji,jj) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 84 zabe2 = fsaht_spv(ji,jj) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 76 85 ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 77 86 ztv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 78 END DO79 END DO80 87 END DO 88 END DO 89 ! 81 90 DO jj = j1+1,j2-1 82 91 DO ji = i1+1,i2-1 83 84 IF (.NOT. tabspongedone_trn(ji,jj)) THEN 85 zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk) 86 ! horizontal diffusive trends 87 ztra = zbtr * ( ztu(ji,jj) - ztu(ji-1,jj ) + ztv(ji,jj) - ztv(ji ,jj-1) ) 88 ! add it to the general tracer trends 89 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 92 IF( .NOT. tabspongedone_trn(ji,jj) ) THEN 93 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ( ztu(ji,jj) - ztu(ji-1,jj ) & 94 & + ztv(ji,jj) - ztv(ji ,jj-1) ) & 95 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 90 96 ENDIF 91 92 ENDDO 93 ENDDO 94 95 ENDDO 96 ENDDO 97 97 END DO 98 END DO 99 END DO 100 ! 101 END DO 102 ! 98 103 tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 99 104 ENDIF … … 102 107 103 108 #else 109 104 110 CONTAINS 105 106 111 SUBROUTINE agrif_top_sponge_empty 107 !!---------------------------------------------108 !! *** ROUTINE agrif_top_sponge_empty ***109 !!---------------------------------------------110 112 WRITE(*,*) 'agrif_top_sponge : You should not have seen this print! error?' 111 113 END SUBROUTINE agrif_top_sponge_empty 112 114 #endif 113 115 116 !!====================================================================== 114 117 END MODULE agrif_top_sponge -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
r5845 r6004 3 3 4 4 MODULE agrif_top_update 5 !!====================================================================== 6 !! *** MODULE agrif_top_update *** 7 !! AGRIF : 8 !!---------------------------------------------------------------------- 9 !! History : 10 !!---------------------------------------------------------------------- 5 11 6 12 #if defined key_agrif && defined key_top 7 13 USE par_oce 8 14 USE oce 15 USE par_trc 16 USE trc 9 17 USE dom_oce 10 18 USE agrif_oce 11 USE par_trc12 USE trc13 19 USE wrk_nemo 14 20 … … 18 24 PUBLIC Agrif_Update_Trc 19 25 20 INTEGER, PUBLIC :: nbcline_trc = 026 INTEGER, PUBLIC :: nbcline_trc = 0 !: ??? 21 27 22 28 !!---------------------------------------------------------------------- 23 !! NEMO/NST 3. 3 , NEMO Consortium (2010)29 !! NEMO/NST 3.7 , NEMO Consortium (2015) 24 30 !! $Id$ 25 31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 26 32 !!---------------------------------------------------------------------- 27 28 33 CONTAINS 29 34 30 35 SUBROUTINE Agrif_Update_Trc( kt ) 31 !!--------------------------------------------- 32 !! *** ROUTINE Agrif_Update_Trc ***33 !!--------------------------------------------- 34 INTEGER, INTENT(in) :: kt35 !!--------------------------------------------- 36 !!---------------------------------------------------------------------- 37 !! *** ROUTINE Agrif_Update_Trc *** 38 !!---------------------------------------------------------------------- 39 INTEGER, INTENT(in) :: kt 40 !!---------------------------------------------------------------------- 36 41 ! 37 42 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 38 43 #if defined TWO_WAY 39 44 Agrif_UseSpecialValueInUpdate = .TRUE. 40 Agrif_SpecialValueFineGrid = 0.45 Agrif_SpecialValueFineGrid = 0._wp 41 46 ! 42 IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN47 IF( MOD(nbcline_trc,nbclineupdate) == 0 ) THEN 43 48 # if ! defined DECAL_FEEDBACK 44 CALL Agrif_Update_Variable(trn_id, procname=updateTRC )49 CALL Agrif_Update_Variable(trn_id, procname=updateTRC ) 45 50 # else 46 CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC )51 CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC ) 47 52 # endif 48 53 ELSE 49 54 # if ! defined DECAL_FEEDBACK 50 CALL Agrif_Update_Variable( trn_id,locupdate=(/0,2/), procname=updateTRC)55 CALL Agrif_Update_Variable( trn_id, locupdate=(/0,2/), procname=updateTRC ) 51 56 # else 52 CALL Agrif_Update_Variable( trn_id,locupdate=(/1,2/), procname=updateTRC)57 CALL Agrif_Update_Variable( trn_id, locupdate=(/1,2/), procname=updateTRC ) 53 58 # endif 54 59 ENDIF … … 60 65 END SUBROUTINE Agrif_Update_Trc 61 66 67 62 68 SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 63 !!--------------------------------------------- 64 !! *** ROUTINE updateT ***65 !!--------------------------------------------- 66 INTEGER , INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n267 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab68 LOGICAL , INTENT(in) ::before69 !!---------------------------------------------------------------------- 70 !! *** ROUTINE updateT *** 71 !!---------------------------------------------------------------------- 72 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 73 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 74 LOGICAL , INTENT(in ) :: before 69 75 !! 70 INTEGER :: ji,jj,jk,jn71 !!--------------------------------------------- 76 INTEGER :: ji, jj, jk, jn 77 !!---------------------------------------------------------------------- 72 78 ! 73 IF (before) THEN 74 DO jn = n1,n2 75 DO jk=k1,k2 76 DO jj=j1,j2 77 DO ji=i1,i2 78 ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 79 IF( before ) THEN 80 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 81 ELSE 82 IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN 83 ! Add asselin part 84 DO jn = n1,n2 85 DO jk = k1, k2 86 DO jj = j1, j2 87 DO ji = i1, i2 88 IF( ptab(ji,jj,jk,jn) /= 0._wp ) THEN 89 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 90 & + atfp * ( ptab(ji,jj,jk,jn) & 91 & - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 92 ENDIF 93 END DO 79 94 END DO 80 95 END DO 81 96 END DO 82 END DO83 ELSE84 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN85 ! Add asselin part86 DO jn = n1,n287 DO jk=k1,k288 DO jj=j1,j289 DO ji=i1,i290 IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN91 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) &92 & + atfp * ( ptab(ji,jj,jk,jn) &93 & - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)94 ENDIF95 ENDDO96 ENDDO97 ENDDO98 ENDDO99 97 ENDIF 100 DO jn = n1, n2101 DO jk =k1,k2102 DO jj =j1,j2103 DO ji =i1,i2104 IF( ptab(ji,jj,jk,jn) .NE. 0.) THEN98 DO jn = n1, n2 99 DO jk = k1, k2 100 DO jj = j1, j2 101 DO ji = i1, i2 102 IF( ptab(ji,jj,jk,jn) /= 0._wp ) THEN 105 103 trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk) 106 104 END IF … … 122 120 END SUBROUTINE agrif_top_update_empty 123 121 #endif 122 123 !!====================================================================== 124 124 END MODULE agrif_top_update -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r5656 r6004 1 1 #if defined key_agrif 2 2 !!---------------------------------------------------------------------- 3 !! NEMO/NST 3. 4 , NEMO Consortium (2012)3 !! NEMO/NST 3.7 , NEMO Consortium (2015) 4 4 !! $Id$ 5 5 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 104 104 USE dom_oce 105 105 USE nemogcm 106 USE sol_oce107 106 USE in_out_manager 108 107 USE agrif_opa_update … … 172 171 USE dom_oce 173 172 USE nemogcm 174 USE sol_oce175 173 USE lib_mpp 176 174 USE in_out_manager … … 210 208 CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 211 209 212 #if defined key_dynspg_ts213 210 Agrif_UseSpecialValue = .TRUE. 214 211 CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 215 212 216 Agrif_UseSpecialValue = ln_spc_dyn 217 CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 218 CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 219 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 220 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 221 ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 222 ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 223 ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 224 ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 225 #endif 213 IF ( ln_dynspg_ts ) THEN 214 Agrif_UseSpecialValue = ln_spc_dyn 215 CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 216 CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 217 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 218 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 219 ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 220 ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 221 ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 222 ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 223 ENDIF 226 224 227 225 Agrif_UseSpecialValue = .FALSE. … … 278 276 ENDIF 279 277 ENDIF 278 279 ! Check free surface scheme 280 IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 281 & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 282 WRITE(*,*) 'incompatible free surface scheme between grids' 283 WRITE(*,*) 'parent grid ln_dynspg_ts :', Agrif_Parent(ln_dynspg_ts ) 284 WRITE(*,*) 'parent grid ln_dynspg_exp :', Agrif_Parent(ln_dynspg_exp) 285 WRITE(*,*) 'child grid ln_dynspg_ts :', ln_dynspg_ts 286 WRITE(*,*) 'child grid ln_dynspg_exp :', ln_dynspg_exp 287 WRITE(*,*) 'those logicals should be identical' 288 STOP 289 ENDIF 290 280 291 ! check if masks and bathymetries match 281 292 IF(ln_chk_bathy) THEN -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r5845 r6004 458 458 END DO 459 459 ! ! update the horizontal divergence with the runoff inflow 460 IF( ln_dynrnf ) zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / e3t_n(:,:,1)460 IF( ln_dynrnf ) zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / e3t_n(:,:,1) 461 461 ! 462 462 CALL lbc_lnk( zhdiv, 'T', 1. ) ! Lateral boundary conditions on zhdiv -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
r5836 r6004 33 33 USE eosbn2 ! Equation of state (eos_bn2 routine) 34 34 USE zdfmxl ! Mixed layer depth 35 USE dom_oce, ONLY : ndastp 36 USE sol_oce, ONLY : gcx ! Solver variables defined in memory 35 USE dom_oce , ONLY : ndastp 37 36 USE in_out_manager ! I/O manager 38 37 USE iom ! I/O module … … 45 44 USE ice 46 45 #endif 46 47 47 IMPLICIT NONE 48 48 PRIVATE … … 114 114 CALL iom_rstput( kt, nitbkg_r, inum, 'en' , en ) 115 115 #endif 116 CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx )117 116 ! 118 117 CALL iom_close( inum ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r5845 r6004 29 29 USE iom ! IOM library 30 30 USE in_out_manager ! I/O logical units 31 USE dynspg_oce, ONLY: lk_dynspg_ts ! Split-explicit free surface flag32 31 #if defined key_lim2 33 32 USE ice_2 … … 46 45 INTEGER, ALLOCATABLE, DIMENSION(:) :: nb_bdy_fld ! Number of fields to update for each boundary set. 47 46 INTEGER :: nb_bdy_fld_sum ! Total number of fields to update for all boundary sets. 48 49 47 LOGICAL, DIMENSION(jp_bdy) :: ln_full_vel_array ! =T => full velocities in 3D boundary conditions 50 48 ! =F => baroclinic velocities in 3D boundary conditions … … 75 73 !! 76 74 !!---------------------------------------------------------------------- 77 !! 78 INTEGER, INTENT( in ) :: kt ! ocean time-step index 79 INTEGER, INTENT( in ), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option) 80 INTEGER, INTENT( in ), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit 81 ! is present then units = subcycle timesteps. 82 ! time_offset = 0 => get data at "now" time level 83 ! time_offset = -1 => get data at "before" time level 84 ! time_offset = +1 => get data at "after" time level 85 ! etc. 86 !! 87 INTEGER :: ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl ! local indices 75 INTEGER, INTENT(in) :: kt ! ocean time-step index 76 INTEGER, INTENT(in), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option) 77 INTEGER, INTENT(in), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit 78 ! ! is present then units = subcycle timesteps. 79 ! ! time_offset = 0 => get data at "now" time level 80 ! ! time_offset = -1 => get data at "before" time level 81 ! ! time_offset = +1 => get data at "after" time level 82 ! ! etc. 83 ! 84 INTEGER :: ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl ! local indices 88 85 INTEGER, DIMENSION(jpbgrd) :: ilen1 89 86 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts 90 87 TYPE(OBC_DATA), POINTER :: dta ! short cut 91 !!92 88 !!--------------------------------------------------------------------------- 93 ! !94 IF( nn_timing == 1 ) CALL timing_start('bdy_dta')95 89 ! 90 IF( nn_timing == 1 ) CALL timing_start('bdy_dta') 91 ! 96 92 ! Initialise data arrays once for all from initial conditions where required 97 93 !--------------------------------------------------------------------------- 98 IF( kt .eq. nit000 .and. .not.PRESENT(jit) ) THEN94 IF( kt == nit000 .AND. .NOT.PRESENT(jit) ) THEN 99 95 100 96 ! Calculate depth-mean currents … … 102 98 103 99 DO ib_bdy = 1, nb_bdy 104 100 ! 105 101 nblen => idx_bdy(ib_bdy)%nblen 106 102 nblenrim => idx_bdy(ib_bdy)%nblenrim 107 103 dta => dta_bdy(ib_bdy) 108 104 109 IF( nn_dyn2d_dta(ib_bdy) .eq.0 ) THEN105 IF( nn_dyn2d_dta(ib_bdy) == 0 ) THEN 110 106 ilen1(:) = nblen(:) 111 107 IF( dta%ll_ssh ) THEN … … 135 131 ENDIF 136 132 137 IF( nn_dyn3d_dta(ib_bdy) .eq.0 ) THEN133 IF( nn_dyn3d_dta(ib_bdy) == 0 ) THEN 138 134 ilen1(:) = nblen(:) 139 135 IF( dta%ll_u3d ) THEN … … 159 155 ENDIF 160 156 161 IF( nn_tra_dta(ib_bdy) .eq.0 ) THEN157 IF( nn_tra_dta(ib_bdy) == 0 ) THEN 162 158 ilen1(:) = nblen(:) 163 159 IF( dta%ll_tem ) THEN … … 184 180 185 181 #if defined key_lim2 186 IF( nn_ice_lim_dta(ib_bdy) .eq.0 ) THEN182 IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 187 183 ilen1(:) = nblen(:) 188 184 IF( dta%ll_frld ) THEN … … 212 208 ENDIF 213 209 #elif defined key_lim3 214 IF( nn_ice_lim_dta(ib_bdy) .eq.0 ) THEN210 IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 215 211 ilen1(:) = nblen(:) 216 212 IF( dta%ll_a_i ) THEN … … 246 242 ENDIF 247 243 #endif 248 249 ENDDO ! ib_bdy 250 251 252 ENDIF ! kt .eq. nit000 244 END DO ! ib_bdy 245 ! 246 ENDIF ! kt == nit000 253 247 254 248 ! update external data from files … … 258 252 DO ib_bdy = 1, nb_bdy 259 253 dta => dta_bdy(ib_bdy) 260 IF( nn_dta(ib_bdy) .eq.1 ) THEN ! skip this bit if no external data required254 IF( nn_dta(ib_bdy) == 1 ) THEN ! skip this bit if no external data required 261 255 262 256 IF( PRESENT(jit) ) THEN … … 264 258 ! jit is optional argument for fld_read and bdytide_update 265 259 IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 266 IF( nn_dyn2d_dta(ib_bdy) .eq.2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays267 IF( dta%ll_ssh ) dta%ssh(:) = 0. 0268 IF( dta%ll_u2d ) dta%u2d(:) = 0. 0269 IF( dta%ll_u3d ) dta%v2d(:) = 0. 0260 IF( nn_dyn2d_dta(ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 261 IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 262 IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 263 IF( dta%ll_u3d ) dta%v2d(:) = 0._wp 270 264 ENDIF 271 265 IF (cn_tra(ib_bdy) /= 'runoff') THEN 272 IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ.3 ) THEN266 IF( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 ) THEN 273 267 274 268 jend = jstart + dta%nread(2) - 1 … … 278 272 ! If full velocities in boundary data then extract barotropic velocities from 3D fields 279 273 IF( ln_full_vel_array(ib_bdy) .AND. & 280 & ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ.3 .OR. &281 & nn_dyn3d_dta(ib_bdy) .EQ.1 ) )THEN274 & ( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR. & 275 & nn_dyn3d_dta(ib_bdy) == 1 ) )THEN 282 276 283 277 igrd = 2 ! zonal velocity 284 dta%u2d(:) = 0. 0278 dta%u2d(:) = 0._wp 285 279 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 286 280 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 293 287 END DO 294 288 igrd = 3 ! meridional velocity 295 dta%v2d(:) = 0. 0289 dta%v2d(:) = 0._wp 296 290 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 297 291 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 331 325 END DO 332 326 ELSE 333 IF( nn_dyn2d_dta(ib_bdy) .eq.2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays334 IF( dta%ll_ssh ) dta%ssh(:) = 0. 0335 IF( dta%ll_u2d ) dta%u2d(:) = 0. 0336 IF( dta%ll_v2d ) dta%v2d(:) = 0. 0327 IF( nn_dyn2d_dta(ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 328 IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 329 IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 330 IF( dta%ll_v2d ) dta%v2d(:) = 0._wp 337 331 ENDIF 338 332 IF( dta%nread(1) .gt. 0 ) THEN ! update external data … … 343 337 ! If full velocities in boundary data then split into barotropic and baroclinic data 344 338 IF( ln_full_vel_array(ib_bdy) .and. & 345 & ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ.3 .OR. &346 & nn_dyn3d_dta(ib_bdy) .EQ.1 ) ) THEN339 & ( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR. & 340 & nn_dyn3d_dta(ib_bdy) == 1 ) ) THEN 347 341 igrd = 2 ! zonal velocity 348 dta%u2d(:) = 0. 0342 dta%u2d(:) = 0._wp 349 343 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 350 344 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 360 354 END DO 361 355 igrd = 3 ! meridional velocity 362 dta%v2d(:) = 0. 0356 dta%v2d(:) = 0._wp 363 357 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 364 358 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 387 381 END DO ! ib_bdy 388 382 389 ! bg jchanut tschanges390 383 #if defined key_tide 391 ! Add tides if not split-explicit free surface else this is done in ts loop 392 IF (.NOT.lk_dynspg_ts) CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 393 #endif 394 ! end jchanut tschanges 384 IF (ln_dynspg_ts) THEN ! Fill temporary arrays with slow-varying bdy data 385 DO ib_bdy = 1, nb_bdy ! Tidal component added in ts loop 386 IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 387 nblen => idx_bdy(ib_bdy)%nblen 388 nblenrim => idx_bdy(ib_bdy)%nblenrim 389 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 390 IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen1(1)) = dta_bdy(ib_bdy)%ssh(1:ilen1(1)) 391 IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen1(2)) = dta_bdy(ib_bdy)%u2d(1:ilen1(2)) 392 IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen1(3)) = dta_bdy(ib_bdy)%v2d(1:ilen1(3)) 393 ENDIF 394 END DO 395 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 396 ! 397 CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 398 ENDIF 399 #endif 395 400 396 401 IF ( ln_apr_obc ) THEN … … 402 407 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 403 408 dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + ssh_ib(ii,ij) 404 END DO405 ENDIF 406 END DO409 END DO 410 ENDIF 411 END DO 407 412 ENDIF 408 413 ! 409 414 IF( nn_timing == 1 ) CALL timing_stop('bdy_dta') 410 411 412 413 414 415 ! 416 END SUBROUTINE bdy_dta 417 418 419 SUBROUTINE bdy_dta_init 415 420 !!---------------------------------------------------------------------- 416 421 !! *** SUBROUTINE bdy_dta_init *** … … 422 427 !! 423 428 !!---------------------------------------------------------------------- 424 USE dynspg_oce, ONLY: lk_dynspg_ts 425 !! 426 INTEGER :: ib_bdy, jfld, jstart, jend, ierror ! local indices 427 INTEGER :: ios ! Local integer output status for namelist read 428 !! 429 INTEGER :: ib_bdy, jfld, jstart, jend, ierror, ios ! Local integers 430 ! 429 431 CHARACTER(len=100) :: cn_dir ! Root directory for location of data files 430 432 CHARACTER(len=100), DIMENSION(nb_bdy) :: cn_dir_array ! Root directory for location of data files 433 CHARACTER(len = 256):: clname ! temporary file name 431 434 LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data 432 435 ! =F => baroclinic velocities in 3D boundary data … … 458 461 NAMELIST/nambdy_dta/ ln_full_vel 459 462 !!--------------------------------------------------------------------------- 460 461 IF( nn_timing == 1 ) CALL timing_start('bdy_dta_init')462 463 ! 464 IF( nn_timing == 1 ) CALL timing_start('bdy_dta_init') 465 ! 463 466 IF(lwp) WRITE(numout,*) 464 467 IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries' … … 475 478 #endif 476 479 ) 477 IF(nn_dta(ib_bdy) .gt.1) nn_dta(ib_bdy) = 1480 IF(nn_dta(ib_bdy) > 1) nn_dta(ib_bdy) = 1 478 481 END DO 479 482 … … 483 486 nb_bdy_fld(:) = 0 484 487 DO ib_bdy = 1, nb_bdy 485 IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq.3 ) ) THEN488 IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) THEN 486 489 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 487 490 ENDIF 488 IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) .eq.1 ) THEN491 IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) == 1 ) THEN 489 492 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 490 493 ENDIF 491 IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) .eq.1 ) THEN494 IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) == 1 ) THEN 492 495 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 493 496 ENDIF 494 497 #if ( defined key_lim2 || defined key_lim3 ) 495 IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) .eq.1 ) THEN498 IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) == 1 ) THEN 496 499 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 497 500 ENDIF 498 501 #endif 499 502 IF(lwp) WRITE(numout,*) 'Maximum number of files to open =',nb_bdy_fld(ib_bdy) 500 END DO503 END DO 501 504 502 505 nb_bdy_fld_sum = SUM( nb_bdy_fld ) … … 524 527 jfld = 0 525 528 DO ib_bdy = 1, nb_bdy 526 IF( nn_dta(ib_bdy) .eq.1 ) THEN529 IF( nn_dta(ib_bdy) == 1 ) THEN 527 530 READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 528 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp )531 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 529 532 530 533 READ ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 531 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp )532 IF(lwm) WRITE 534 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 535 IF(lwm) WRITE( numond, nambdy_dta ) 533 536 534 537 cn_dir_array(ib_bdy) = cn_dir … … 542 545 ! Only read in necessary fields for this set. 543 546 ! Important that barotropic variables come first. 544 IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq.3 ) THEN547 IF( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN 545 548 546 549 IF( dta%ll_ssh ) THEN … … 581 584 ! read 3D velocities if baroclinic velocities require OR if 582 585 ! barotropic velocities required and ln_full_vel set to .true. 583 IF( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. &584 & ( ln_full_vel_array(ib_bdy) . and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq.3 ) ) ) THEN585 586 IF( dta%ll_u3d . or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN586 IF( nn_dyn3d_dta(ib_bdy) == 1 .OR. & 587 & ( ln_full_vel_array(ib_bdy) .AND. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN 588 589 IF( dta%ll_u3d .OR. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 587 590 if(lwp) write(numout,*) '++++++ reading in u3d field' 588 591 jfld = jfld + 1 … … 595 598 ENDIF 596 599 597 IF( dta%ll_v3d . or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN600 IF( dta%ll_v3d .OR. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 598 601 if(lwp) write(numout,*) '++++++ reading in v3d field' 599 602 jfld = jfld + 1 … … 609 612 610 613 ! temperature and salinity 611 IF( nn_tra_dta(ib_bdy) .eq.1 ) THEN614 IF( nn_tra_dta(ib_bdy) == 1 ) THEN 612 615 613 616 IF( dta%ll_tem ) THEN … … 635 638 #if defined key_lim2 636 639 ! sea ice 637 IF( nn_ice_lim_dta(ib_bdy) .eq.1 ) THEN640 IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 638 641 639 642 IF( dta%ll_frld ) THEN … … 667 670 #elif defined key_lim3 668 671 ! sea ice 669 IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN 670 672 IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 671 673 ! Test for types of ice input (lim2 or lim3) 672 CALL iom_open ( bn_a_i%clname, inum ) 673 id1 = iom_varid ( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 674 ! Build file name to find dimensions 675 clname=TRIM(bn_a_i%clname) 676 IF( .NOT. bn_a_i%ln_clim ) THEN 677 WRITE(clname, '(a,"_y",i4.4)' ) TRIM( bn_a_i%clname ), nyear ! add year 678 IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), nmonth ! add month 679 ELSE 680 IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( bn_a_i%clname ), nmonth ! add month 681 ENDIF 682 IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) & 683 & WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), nday ! add day 684 ! 685 CALL iom_open ( clname, inum ) 686 id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 674 687 CALL iom_close ( inum ) 675 !CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. ) 676 !CALL iom_open ( bn_a_i%clname, inum ) 677 !id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 688 678 689 IF ( zndims == 4 ) THEN 679 690 ll_bdylim3 = .TRUE. ! lim3 input … … 714 725 ! Recalculate field counts 715 726 !------------------------- 716 IF( ib_bdy .eq.1 ) THEN727 IF( ib_bdy == 1 ) THEN 717 728 nb_bdy_fld_sum = 0 718 729 nb_bdy_fld(ib_bdy) = jfld … … 725 736 dta%nread(1) = nb_bdy_fld(ib_bdy) 726 737 727 ENDIF ! nn_dta .eq.1738 ENDIF ! nn_dta == 1 728 739 ENDDO ! ib_bdy 729 740 … … 766 777 endif 767 778 768 IF ( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq.2 ) THEN779 IF ( nn_dyn2d_dta(ib_bdy) == 0 .or. nn_dyn2d_dta(ib_bdy) == 2 ) THEN 769 780 if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 770 781 IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) … … 772 783 IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 773 784 ENDIF 774 IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq.3 ) THEN785 IF ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN 775 786 IF( dta%ll_ssh ) THEN 776 787 if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' … … 800 811 ENDIF 801 812 802 IF ( nn_dyn3d_dta(ib_bdy) .eq.0 ) THEN813 IF ( nn_dyn3d_dta(ib_bdy) == 0 ) THEN 803 814 if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 804 815 IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) ) 805 816 IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) ) 806 817 ENDIF 807 IF ( nn_dyn3d_dta(ib_bdy) .eq.1 .or. &808 & ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq.3 ) ) ) THEN818 IF ( nn_dyn3d_dta(ib_bdy) == 1 .or. & 819 & ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN 809 820 IF ( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 810 821 if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' … … 819 830 ENDIF 820 831 821 IF( nn_tra_dta(ib_bdy) .eq.0 ) THEN832 IF( nn_tra_dta(ib_bdy) == 0 ) THEN 822 833 if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 823 834 IF( dta%ll_tem ) ALLOCATE( dta_bdy(ib_bdy)%tem(nblen(1),jpk) ) … … 838 849 #if defined key_lim2 839 850 IF (cn_ice_lim(ib_bdy) /= 'none') THEN 840 IF( nn_ice_lim_dta(ib_bdy) .eq.0 ) THEN851 IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 841 852 ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) ) 842 853 ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) ) … … 853 864 #elif defined key_lim3 854 865 IF (cn_ice_lim(ib_bdy) /= 'none') THEN 855 IF( nn_ice_lim_dta(ib_bdy) .eq.0 ) THEN866 IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 856 867 ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) ) 857 868 ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) ) … … 873 884 ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) ) 874 885 ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) ) 875 dta_bdy(ib_bdy)%a_i (:,:) = 0. 0876 dta_bdy(ib_bdy)%ht_i(:,:) = 0. 0877 dta_bdy(ib_bdy)%ht_s(:,:) = 0. 0886 dta_bdy(ib_bdy)%a_i (:,:) = 0._wp 887 dta_bdy(ib_bdy)%ht_i(:,:) = 0._wp 888 dta_bdy(ib_bdy)%ht_s(:,:) = 0._wp 878 889 ENDIF 879 890 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r5845 r6004 24 24 USE oce ! ocean dynamics and tracers 25 25 USE dom_oce ! ocean space and time domain 26 USE dynspg_oce27 26 USE bdy_oce ! ocean open boundary conditions 28 27 USE bdydyn2d ! open boundary conditions for barotropic solution … … 35 34 PRIVATE 36 35 37 PUBLIC bdy_dyn ! routine called in dynspg_flt (if lk_dynspg_flt) or 38 ! dyn_nxt (if lk_dynspg_ts or lk_dynspg_exp) 36 PUBLIC bdy_dyn ! routine called in dyn_nxt 39 37 40 38 !!---------------------------------------------------------------------- … … 52 50 !! 53 51 !!---------------------------------------------------------------------- 54 INTEGER, INTENT( in ) :: kt! Main time step counter55 LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only! T => only update baroclinic velocities52 INTEGER, INTENT(in) :: kt ! Main time step counter 53 LOGICAL, INTENT(in), OPTIONAL :: dyn3d_only ! T => only update baroclinic velocities 56 54 ! 57 INTEGER :: jk,ii,ij,ib_bdy,ib,igrd ! Loop counter58 LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski55 INTEGER :: jk, ii, ij, ib_bdy, ib, igrd ! Loop counter 56 LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski 59 57 REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d ! after barotropic velocities 60 58 !!---------------------------------------------------------------------- … … 68 66 IF( dyn3d_only ) ll_dyn2d = .false. 69 67 ENDIF 70 68 ! 71 69 ll_orlanski = .false. 72 70 DO ib_bdy = 1, nb_bdy 73 IF ( cn_dyn2d(ib_bdy) == 'orlanski' . or. cn_dyn2d(ib_bdy) == 'orlanski_npo' &74 & . or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true.71 IF ( cn_dyn2d(ib_bdy) == 'orlanski' .OR. cn_dyn2d(ib_bdy) == 'orlanski_npo' & 72 & .OR. cn_dyn3d(ib_bdy) == 'orlanski' .OR. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true. 75 73 END DO 76 74 … … 135 133 CALL wrk_dealloc( jpi,jpj, pua2d, pva2d ) 136 134 ! 137 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn')135 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') 138 136 ! 139 137 END SUBROUTINE bdy_dyn -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
r5215 r6004 23 23 USE bdy_oce ! ocean open boundary conditions 24 24 USE bdylib ! BDY library routines 25 USE dynspg_oce ! for barotropic variables26 25 USE phycst ! physical constants 27 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
r5845 r6004 43 43 !! 44 44 !!---------------------------------------------------------------------- 45 INTEGER, INTENT( in ) :: kt! Main time step counter46 ! 47 INTEGER :: ib_bdy! loop index45 INTEGER, INTENT(in) :: kt ! Main time step counter 46 ! 47 INTEGER :: ib_bdy ! loop index 48 48 !!---------------------------------------------------------------------- 49 49 ! … … 72 72 !! 73 73 !!---------------------------------------------------------------------- 74 INTEGER , INTENT(in) :: kt 74 INTEGER , INTENT(in) :: kt ! time step index 75 75 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 76 76 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data … … 118 118 !! 119 119 !!---------------------------------------------------------------------- 120 INTEGER , INTENT(in) :: kt 121 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices122 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data120 INTEGER , INTENT(in) :: kt ! time step index 121 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 122 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 123 123 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 124 ! !124 ! 125 125 INTEGER :: ib, ik ! dummy loop indices 126 INTEGER :: ii, ij, igrd , zcoef! local integers126 INTEGER :: ii, ij, igrd ! local integers 127 127 REAL(wp) :: zwgt ! boundary weight 128 128 !!---------------------------------------------------------------------- … … 150 150 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy ) ! Boundary points should be updated 151 151 ! 152 IF( kt == nit000 ) CLOSE( unit = 102 )152 IF( kt == nit000 ) CLOSE( unit = 102 ) 153 153 ! 154 154 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zro') … … 168 168 !! topography. Tellus, 365-382. 169 169 !!---------------------------------------------------------------------- 170 INTEGER , INTENT(in) :: kt 171 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices172 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data170 INTEGER , INTENT(in) :: kt ! time step index 171 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 172 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 173 173 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 174 174 ! … … 204 204 IF( kt == nit000 ) CLOSE( unit = 102 ) 205 205 ! 206 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_frs')206 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_frs') 207 207 ! 208 208 END SUBROUTINE bdy_dyn3d_frs … … 254 254 !! 255 255 !!---------------------------------------------------------------------- 256 INTEGER, INTENT(in) :: kt 256 INTEGER, INTENT(in) :: kt ! time step index 257 257 ! 258 258 INTEGER :: jb, jk ! dummy loop indices 259 INTEGER :: ib_bdy ! loop index 259 260 INTEGER :: ii, ij, igrd ! local integers 260 261 REAL(wp) :: zwgt ! boundary weight 261 INTEGER :: ib_bdy ! loop index 262 !!---------------------------------------------------------------------- 263 ! 264 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_dmp') 262 !!---------------------------------------------------------------------- 263 ! 264 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_dmp') 265 265 ! 266 266 DO ib_bdy=1, nb_bdy … … 288 288 END DO 289 289 ENDIF 290 END DO290 END DO 291 291 ! 292 292 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated 293 293 ! 294 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_dmp')294 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_dmp') 295 295 ! 296 296 END SUBROUTINE bdy_dyn3d_dmp -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r5866 r6004 12 12 !! 3.4 ! 2011 (D. Storkey) rewrite in preparation for OBC-BDY merge 13 13 !! 3.4 ! 2012 (J. Chanut) straight open boundary case update 14 !! 3.5 ! 2012 (S. Mocavero, I. Epicoco) Updates for the 15 !! optimization of BDY communications 14 !! 3.5 ! 2012 (S. Mocavero, I. Epicoco) optimization of BDY communications 16 15 !!---------------------------------------------------------------------- 17 16 #if defined key_bdy … … 19 18 !! 'key_bdy' Unstructured Open Boundary Conditions 20 19 !!---------------------------------------------------------------------- 21 !! bdy_init 20 !! bdy_init : Initialization of unstructured open boundaries 22 21 !!---------------------------------------------------------------------- 23 USE wrk_nemo ! Memory Allocation 24 USE timing ! Timing 25 USE oce ! ocean dynamics and tracers variables 26 USE dom_oce ! ocean space and time domain 27 USE bdy_oce ! unstructured open boundary conditions 28 USE in_out_manager ! I/O units 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 USE lib_mpp ! for mpp_sum 31 USE iom ! I/O 32 USE sbctide, ONLY: lk_tide ! Tidal forcing or not 33 USE phycst, ONLY: rday 22 USE oce ! ocean dynamics and tracers variables 23 USE dom_oce ! ocean space and time domain 24 USE bdy_oce ! unstructured open boundary conditions 25 USE sbctide , ONLY: lk_tide ! Tidal forcing or not 26 USE phycst , ONLY: rday 27 ! 28 USE in_out_manager ! I/O units 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 USE lib_mpp ! for mpp_sum 31 USE iom ! I/O 32 USE wrk_nemo ! Memory Allocation 33 USE timing ! Timing 34 34 35 35 IMPLICIT NONE … … 38 38 PUBLIC bdy_init ! routine called in nemo_init 39 39 40 INTEGER, PARAMETER :: jp_nseg = 10041 INTEGER, PARAMETER :: nrimmax = 20! maximum rimwidth in structured40 INTEGER, PARAMETER :: jp_nseg = 100 ! 41 INTEGER, PARAMETER :: nrimmax = 20 ! maximum rimwidth in structured 42 42 ! open boundary data files 43 43 ! Straight open boundary segment parameters: 44 INTEGER :: nbdysege, nbdysegw, nbdysegn, nbdysegs45 INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft, npckge46 INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft, npckgw47 INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft, npckgn48 INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft, npckgs44 INTEGER :: nbdysege, nbdysegw, nbdysegn, nbdysegs 45 INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft, npckge ! 46 INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft, npckgw ! 47 INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft, npckgn ! 48 INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft, npckgs ! 49 49 !!---------------------------------------------------------------------- 50 !! NEMO/OPA 4.0 , NEMO Consortium (2011)50 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 51 51 !! $Id$ 52 52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 66 66 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 67 67 !!---------------------------------------------------------------------- 68 ! namelist variables69 !-------------------70 CHARACTER(LEN=80),DIMENSION(jpbgrd) :: clfile71 CHARACTER(LEN=1) :: ctypebdy72 INTEGER :: nbdyind, nbdybeg, nbdyend73 68 74 69 ! local variables … … 81 76 INTEGER :: ib_bdy1, ib_bdy2, ib1, ib2 ! - - 82 77 INTEGER :: i_offset, j_offset ! - - 83 INTEGER , POINTER :: nbi, nbj, nbr! short cuts78 INTEGER , POINTER :: nbi, nbj, nbr ! short cuts 84 79 REAL(wp), POINTER :: flagu, flagv ! - - 85 80 REAL(wp), POINTER, DIMENSION(:,:) :: pmask ! pointer to 2D mask fields … … 94 89 INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4) ! Arrays for neighbours coordinates 95 90 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 96 91 !! 92 CHARACTER(LEN=80),DIMENSION(jpbgrd) :: clfile ! Namelist variables 93 CHARACTER(LEN=1) :: ctypebdy ! - - 94 INTEGER :: nbdyind, nbdybeg, nbdyend 97 95 !! 98 96 NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file, & … … 103 101 & rn_ice_tem, rn_ice_sal, rn_ice_age, & 104 102 & ln_vol, nn_volctl, nn_rimwidth 105 !!103 ! 106 104 NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend 107 105 INTEGER :: ios ! Local integer output status for namelist read 108 106 !!---------------------------------------------------------------------- 109 110 IF( nn_timing == 1 ) CALL timing_start('bdy_init')111 107 ! 108 IF( nn_timing == 1 ) CALL timing_start('bdy_init') 109 ! 112 110 IF(lwp) WRITE(numout,*) 113 111 IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries' 114 112 IF(lwp) WRITE(numout,*) '~~~~~~~~' 115 113 ! 116 117 114 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 118 115 & ' and general open boundary condition are not compatible' ) 119 116 120 cgrid = (/'t','u','v'/)117 cgrid = (/'t','u','v'/) 121 118 122 119 ! ------------------------ 123 120 ! Read namelist parameters 124 121 ! ------------------------ 125 126 122 REWIND( numnam_ref ) ! Namelist nambdy in reference namelist :Unstructured open boundaries 127 123 READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 128 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp )129 124 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 125 ! 130 126 REWIND( numnam_cfg ) ! Namelist nambdy in configuration namelist :Unstructured open boundaries 131 127 READ ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 132 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )128 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 133 129 IF(lwm) WRITE ( numond, nambdy ) 134 130 … … 137 133 ! ----------------------------------------- 138 134 ! ! control prints 139 IF(lwp) WRITE(numout,*) ' 140 141 IF( nb_bdy .eq.0 ) THEN135 IF(lwp) WRITE(numout,*) ' nambdy' 136 137 IF( nb_bdy == 0 ) THEN 142 138 IF(lwp) WRITE(numout,*) 'nb_bdy = 0, NO OPEN BOUNDARIES APPLIED.' 143 139 ELSE 144 IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ', nb_bdy140 IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ', nb_bdy 145 141 ENDIF 146 142 … … 158 154 IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution: ' 159 155 SELECT CASE( cn_dyn2d(ib_bdy) ) 160 CASE( 'none')156 CASE( 'none' ) 161 157 IF(lwp) WRITE(numout,*) ' no open boundary condition' 162 158 dta_bdy(ib_bdy)%ll_ssh = .false. 163 159 dta_bdy(ib_bdy)%ll_u2d = .false. 164 160 dta_bdy(ib_bdy)%ll_v2d = .false. 165 CASE( 'frs')161 CASE( 'frs' ) 166 162 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 167 163 dta_bdy(ib_bdy)%ll_ssh = .false. 168 164 dta_bdy(ib_bdy)%ll_u2d = .true. 169 165 dta_bdy(ib_bdy)%ll_v2d = .true. 170 CASE( 'flather')166 CASE( 'flather' ) 171 167 IF(lwp) WRITE(numout,*) ' Flather radiation condition' 172 168 dta_bdy(ib_bdy)%ll_ssh = .true. 173 169 dta_bdy(ib_bdy)%ll_u2d = .true. 174 170 dta_bdy(ib_bdy)%ll_v2d = .true. 175 CASE( 'orlanski')171 CASE( 'orlanski' ) 176 172 IF(lwp) WRITE(numout,*) ' Orlanski (fully oblique) radiation condition with adaptive nudging' 177 173 dta_bdy(ib_bdy)%ll_ssh = .false. 178 174 dta_bdy(ib_bdy)%ll_u2d = .true. 179 175 dta_bdy(ib_bdy)%ll_v2d = .true. 180 CASE( 'orlanski_npo')176 CASE( 'orlanski_npo' ) 181 177 IF(lwp) WRITE(numout,*) ' Orlanski (NPO) radiation condition with adaptive nudging' 182 178 dta_bdy(ib_bdy)%ll_ssh = .false. … … 392 388 REWIND( numnam_cfg ) 393 389 394 !!----------------------------------------------------------------------395 396 397 398 390 nblendta(:,:) = 0 399 391 nbdysege = 0 … … 492 484 nblendta(igrd,ib_bdy) = MAXVAL(kdimsz) 493 485 jpbdtau = MAX(jpbdtau, MAXVAL(kdimsz)) 494 END DO486 END DO 495 487 CALL iom_close( inum ) 496 488 ! 497 489 ENDIF 498 499 END DO ! ib_bdy490 ! 491 END DO ! ib_bdy 500 492 501 493 IF (nb_bdy>0) THEN … … 514 506 ! Now look for crossings in user (namelist) defined open boundary segments: 515 507 !-------------------------------------------------------------------------- 516 IF ( icount>0 )CALL bdy_ctl_seg508 IF( icount>0 ) CALL bdy_ctl_seg 517 509 518 510 ! Calculate global boundary index arrays or read in from file … … 520 512 ! 1. Read global index arrays from boundary coordinates file. 521 513 DO ib_bdy = 1, nb_bdy 522 514 ! 523 515 IF( ln_coords_file(ib_bdy) ) THEN 524 516 ! 525 517 CALL iom_open( cn_coords_file(ib_bdy), inum ) 526 518 DO igrd = 1, jpbgrd … … 537 529 nbrdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 538 530 END DO 539 531 ! 540 532 ibr_max = MAXVAL( nbrdta(:,igrd,ib_bdy) ) 541 533 IF(lwp) WRITE(numout,*) … … 546 538 END DO 547 539 CALL iom_close( inum ) 548 540 ! 549 541 ENDIF 550 551 END DO542 ! 543 END DO 552 544 553 545 ! 2. Now fill indices corresponding to straight open boundary arrays: … … 792 784 793 785 ! Work out dimensions of boundary data on each neighbour process 794 IF(nbondi .eq.0) THEN786 IF(nbondi == 0) THEN 795 787 iw_b(1) = jpizoom + nimppt(nowe+1) 796 788 ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 … … 802 794 is_b(2) = jpjzoom + njmppt(noea+1) 803 795 in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3 804 ELSEIF(nbondi .eq.1) THEN796 ELSEIF(nbondi == 1) THEN 805 797 iw_b(1) = jpizoom + nimppt(nowe+1) 806 798 ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 807 799 is_b(1) = jpjzoom + njmppt(nowe+1) 808 800 in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3 809 ELSEIF(nbondi .eq.-1) THEN801 ELSEIF(nbondi == -1) THEN 810 802 iw_b(2) = jpizoom + nimppt(noea+1) 811 803 ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3 … … 814 806 ENDIF 815 807 816 IF(nbondj .eq.0) THEN808 IF(nbondj == 0) THEN 817 809 iw_b(3) = jpizoom + nimppt(noso+1) 818 810 ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 … … 824 816 is_b(4) = jpjzoom + njmppt(nono+1) 825 817 in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3 826 ELSEIF(nbondj .eq.1) THEN818 ELSEIF(nbondj == 1) THEN 827 819 iw_b(3) = jpizoom + nimppt(noso+1) 828 820 ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 829 821 is_b(3) = jpjzoom + njmppt(noso+1) 830 822 in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3 831 ELSEIF(nbondj .eq.-1) THEN823 ELSEIF(nbondj == -1) THEN 832 824 iw_b(4) = jpizoom + nimppt(nono+1) 833 825 ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3 … … 867 859 ! Allocate index arrays for this boundary set 868 860 !-------------------------------------------- 869 ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:))870 ALLOCATE( idx_bdy(ib_bdy)%nbi (ilen1,jpbgrd) )871 ALLOCATE( idx_bdy(ib_bdy)%nbj (ilen1,jpbgrd) )872 ALLOCATE( idx_bdy(ib_bdy)%nbr (ilen1,jpbgrd) )873 ALLOCATE( idx_bdy(ib_bdy)%nbd (ilen1,jpbgrd) )861 ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:) ) 862 ALLOCATE( idx_bdy(ib_bdy)%nbi (ilen1,jpbgrd) ) 863 ALLOCATE( idx_bdy(ib_bdy)%nbj (ilen1,jpbgrd) ) 864 ALLOCATE( idx_bdy(ib_bdy)%nbr (ilen1,jpbgrd) ) 865 ALLOCATE( idx_bdy(ib_bdy)%nbd (ilen1,jpbgrd) ) 874 866 ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ) 875 ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) )876 ALLOCATE( idx_bdy(ib_bdy)%nbw (ilen1,jpbgrd) )877 ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) )878 ALLOCATE( idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) )867 ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) ) 868 ALLOCATE( idx_bdy(ib_bdy)%nbw (ilen1,jpbgrd) ) 869 ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) ) 870 ALLOCATE( idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) ) 879 871 880 872 ! Dispatch mapping indices and discrete distances on each processor 881 873 ! ----------------------------------------------------------------- 882 874 883 com_east = 0884 com_west = 0875 com_east = 0 876 com_west = 0 885 877 com_south = 0 886 878 com_north = 0 887 879 888 com_east_b = 0889 com_west_b = 0880 com_east_b = 0 881 com_west_b = 0 890 882 com_south_b = 0 891 883 com_north_b = 0 … … 912 904 ii = idx_bdy(ib_bdy)%nbi(icount,igrd) 913 905 ij = idx_bdy(ib_bdy)%nbj(icount,igrd) 914 if((com_east .ne. 1) .and. (ii .eq.(nlci-1)) .and. (nbondi .le. 0)) then906 if((com_east .ne. 1) .and. (ii == (nlci-1)) .and. (nbondi .le. 0)) then 915 907 com_east = 1 916 elseif((com_west .ne. 1) .and. (ii .eq.2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then908 elseif((com_west .ne. 1) .and. (ii == 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then 917 909 com_west = 1 918 910 endif 919 if((com_south .ne. 1) .and. (ij .eq.2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then911 if((com_south .ne. 1) .and. (ij == 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then 920 912 com_south = 1 921 elseif((com_north .ne. 1) .and. (ij .eq.(nlcj-1)) .and. (nbondj .le. 0)) then913 elseif((com_north .ne. 1) .and. (ij == (nlcj-1)) .and. (nbondj .le. 0)) then 922 914 com_north = 1 923 915 endif … … 926 918 ENDIF 927 919 ! check if point has to be received from a neighbour 928 IF(nbondi .eq.0) THEN920 IF(nbondi == 0) THEN 929 921 IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND. & 930 922 & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND. & 931 923 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 932 924 ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 933 if((com_west_b .ne. 1) .and. (ii .eq.(nlcit(nowe+1)-1))) then925 if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then 934 926 ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 935 if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq.1)) then927 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 936 928 com_south = 1 937 elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq.-1)) then929 elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 938 930 com_north = 1 939 931 endif … … 945 937 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 946 938 ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 947 if((com_east_b .ne. 1) .and. (ii .eq.2)) then939 if((com_east_b .ne. 1) .and. (ii == 2)) then 948 940 ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 949 if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq.1)) then941 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 950 942 com_south = 1 951 elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq.-1)) then943 elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 952 944 com_north = 1 953 945 endif … … 955 947 endif 956 948 ENDIF 957 ELSEIF(nbondi .eq.1) THEN949 ELSEIF(nbondi == 1) THEN 958 950 IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND. & 959 951 & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND. & 960 952 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 961 953 ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 962 if((com_west_b .ne. 1) .and. (ii .eq.(nlcit(nowe+1)-1))) then954 if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then 963 955 ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 964 if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq.1)) then956 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 965 957 com_south = 1 966 elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq.-1)) then958 elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 967 959 com_north = 1 968 960 endif … … 970 962 endif 971 963 ENDIF 972 ELSEIF(nbondi .eq.-1) THEN964 ELSEIF(nbondi == -1) THEN 973 965 IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND. & 974 966 & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND. & 975 967 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 976 968 ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 977 if((com_east_b .ne. 1) .and. (ii .eq.2)) then969 if((com_east_b .ne. 1) .and. (ii == 2)) then 978 970 ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 979 if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq.1)) then971 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 980 972 com_south = 1 981 elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq.-1)) then973 elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 982 974 com_north = 1 983 975 endif … … 986 978 ENDIF 987 979 ENDIF 988 IF(nbondj .eq.0) THEN980 IF(nbondj == 0) THEN 989 981 IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1 & 990 982 & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & … … 1001 993 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 1002 994 ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 1003 if((com_south_b .ne. 1) .and. (ij .eq.(nlcjt(noso+1)-1))) then995 if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then 1004 996 com_south_b = 1 1005 997 endif … … 1009 1001 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 1010 1002 ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 1011 if((com_north_b .ne. 1) .and. (ij .eq.2)) then1003 if((com_north_b .ne. 1) .and. (ij == 2)) then 1012 1004 com_north_b = 1 1013 1005 endif 1014 1006 ENDIF 1015 ELSEIF(nbondj .eq.1) THEN1007 ELSEIF(nbondj == 1) THEN 1016 1008 IF( com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1 .OR. & 1017 1009 & nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. & … … 1023 1015 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 1024 1016 ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 1025 if((com_south_b .ne. 1) .and. (ij .eq.(nlcjt(noso+1)-1))) then1017 if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then 1026 1018 com_south_b = 1 1027 1019 endif 1028 1020 ENDIF 1029 ELSEIF(nbondj .eq.-1) THEN1021 ELSEIF(nbondj == -1) THEN 1030 1022 IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1 & 1031 1023 & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & … … 1037 1029 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 1038 1030 ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 1039 if((com_north_b .ne. 1) .and. (ij .eq.2)) then1031 if((com_north_b .ne. 1) .and. (ij == 2)) then 1040 1032 com_north_b = 1 1041 1033 endif … … 1046 1038 ENDDO 1047 1039 1048 ! definition of the i- and j- direction local boundaries arrays 1049 ! used for sending the boudaries 1050 IF((com_east .eq. 1) .and. (com_west .eq. 1)) THEN 1051 nbondi_bdy(ib_bdy) = 0 1052 ELSEIF ((com_east .eq. 1) .and. (com_west .eq. 0)) THEN 1053 nbondi_bdy(ib_bdy) = -1 1054 ELSEIF ((com_east .eq. 0) .and. (com_west .eq. 1)) THEN 1055 nbondi_bdy(ib_bdy) = 1 1040 ! definition of the i- and j- direction local boundaries arrays used for sending the boundaries 1041 IF( (com_east == 1) .and. (com_west == 1) ) THEN ; nbondi_bdy(ib_bdy) = 0 1042 ELSEIF( (com_east == 1) .and. (com_west == 0) ) THEN ; nbondi_bdy(ib_bdy) = -1 1043 ELSEIF( (com_east == 0) .and. (com_west == 1) ) THEN ; nbondi_bdy(ib_bdy) = 1 1056 1044 ENDIF 1057 1058 IF((com_north .eq. 1) .and. (com_south .eq. 1)) THEN 1059 nbondj_bdy(ib_bdy) = 0 1060 ELSEIF ((com_north .eq. 1) .and. (com_south .eq. 0)) THEN 1061 nbondj_bdy(ib_bdy) = -1 1062 ELSEIF ((com_north .eq. 0) .and. (com_south .eq. 1)) THEN 1063 nbondj_bdy(ib_bdy) = 1 1045 IF( (com_north == 1) .and. (com_south == 1) ) THEN ; nbondj_bdy(ib_bdy) = 0 1046 ELSEIF( (com_north == 1) .and. (com_south == 0) ) THEN ; nbondj_bdy(ib_bdy) = -1 1047 ELSEIF( (com_north == 0) .and. (com_south == 1) ) THEN ; nbondj_bdy(ib_bdy) = 1 1064 1048 ENDIF 1065 1049 1066 ! definition of the i- and j- direction local boundaries arrays 1067 ! used for receiving the boudaries 1068 IF((com_east_b .eq. 1) .and. (com_west_b .eq. 1)) THEN 1069 nbondi_bdy_b(ib_bdy) = 0 1070 ELSEIF ((com_east_b .eq. 1) .and. (com_west_b .eq. 0)) THEN 1071 nbondi_bdy_b(ib_bdy) = -1 1072 ELSEIF ((com_east_b .eq. 0) .and. (com_west_b .eq. 1)) THEN 1073 nbondi_bdy_b(ib_bdy) = 1 1050 ! definition of the i- and j- direction local boundaries arrays used for receiving the boundaries 1051 IF( (com_east_b == 1) .and. (com_west_b == 1) ) THEN ; nbondi_bdy_b(ib_bdy) = 0 1052 ELSEIF( (com_east_b == 1) .and. (com_west_b == 0) ) THEN ; nbondi_bdy_b(ib_bdy) = -1 1053 ELSEIF( (com_east_b == 0) .and. (com_west_b == 1) ) THEN ; nbondi_bdy_b(ib_bdy) = 1 1074 1054 ENDIF 1075 1076 IF((com_north_b .eq. 1) .and. (com_south_b .eq. 1)) THEN 1077 nbondj_bdy_b(ib_bdy) = 0 1078 ELSEIF ((com_north_b .eq. 1) .and. (com_south_b .eq. 0)) THEN 1079 nbondj_bdy_b(ib_bdy) = -1 1080 ELSEIF ((com_north_b .eq. 0) .and. (com_south_b .eq. 1)) THEN 1081 nbondj_bdy_b(ib_bdy) = 1 1055 IF( (com_north_b == 1) .and. (com_south_b == 1) ) THEN ; nbondj_bdy_b(ib_bdy) = 0 1056 ELSEIF( (com_north_b == 1) .and. (com_south_b == 0) ) THEN ; nbondj_bdy_b(ib_bdy) = -1 1057 ELSEIF( (com_north_b == 0) .and. (com_south_b == 1) ) THEN ; nbondj_bdy_b(ib_bdy) = 1 1082 1058 ENDIF 1083 1059 … … 1087 1063 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 1088 1064 nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 1089 idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 ) ! tanh formulation1090 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = ( FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2. ! quadratic1091 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)) ! linear1065 idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( REAL( nbr - 1 ) *0.5 ) ! tanh formulation 1066 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = (REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2. ! quadratic 1067 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)) ! linear 1092 1068 END DO 1093 1069 END DO … … 1099 1075 nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 1100 1076 idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) & 1101 & *( FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2. ! quadratic1077 & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2. ! quadratic 1102 1078 idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) & 1103 & *( FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2. ! quadratic1079 & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2. ! quadratic 1104 1080 END DO 1105 1081 END DO … … 1122 1098 1123 1099 ! Derive mask on U and V grid from mask on T grid 1124 bdyumask(:,:) = 0. e01125 bdyvmask(:,:) = 0. e01100 bdyumask(:,:) = 0._wp 1101 bdyvmask(:,:) = 0._wp 1126 1102 DO ij=1, jpjm1 1127 1103 DO ii=1, jpim1 1128 bdyumask(ii,ij) =bdytmask(ii,ij)*bdytmask(ii+1, ij )1129 bdyvmask(ii,ij) =bdytmask(ii,ij)*bdytmask(ii ,ij+1)1104 bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 1105 bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii ,ij+1) 1130 1106 END DO 1131 1107 END DO … … 1141 1117 umask(ii,ij,ik) = umask(ii,ij,ik) * bdyumask(ii,ij) 1142 1118 vmask(ii,ij,ik) = vmask(ii,ij,ik) * bdyvmask(ii,ij) 1143 bmask(ii,ij) = bmask(ii,ij) * bdytmask(ii,ij)1144 1119 END DO 1145 1120 END DO 1146 END DO1147 1148 DO ik = 1, jpkm11149 1121 DO ij = 2, jpjm1 1150 1122 DO ii = 2, jpim1 … … 1154 1126 END DO 1155 1127 END DO 1156 1157 1128 tmask_i (:,:) = ssmask(:,:) * tmask_i(:,:) 1158 1129 ! 1159 1130 ENDIF ! ln_mask_file=.TRUE. 1160 1131 1161 1132 bdytmask(:,:) = ssmask(:,:) 1162 IF( .not. ln_mask_file ) THEN 1163 ! If .not. ln_mask_file then we need to derive mask on U and V grid 1164 ! from mask on T grid here. 1165 bdyumask(:,:) = 0.e0 1166 bdyvmask(:,:) = 0.e0 1167 DO ij=1, jpjm1 1168 DO ii=1, jpim1 1169 bdyumask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii+1, ij ) 1170 bdyvmask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii ,ij+1) 1133 IF( .NOT.ln_mask_file ) THEN 1134 ! If .not. ln_mask_file then we need to derive mask on U and V grid from mask on T grid here. 1135 bdyumask(:,:) = 0._wp 1136 bdyvmask(:,:) = 0._wp 1137 DO ij = 1, jpjm1 1138 DO ii = 1, jpim1 1139 bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 1140 bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii ,ij+1) 1171 1141 END DO 1172 1142 END DO … … 1174 1144 ENDIF 1175 1145 1176 ! bdy masks and bmask are now set to zero on boundary points: 1177 igrd = 1 ! In the free surface case, bmask is at T-points 1178 DO ib_bdy = 1, nb_bdy 1179 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1180 bmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 1181 ENDDO 1182 ENDDO 1146 ! bdy masks are now set to zero on boundary points: 1183 1147 ! 1184 1148 igrd = 1 1185 1149 DO ib_bdy = 1, nb_bdy 1186 1150 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1187 bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0. e01188 END DO1189 END DO1151 bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 1152 END DO 1153 END DO 1190 1154 ! 1191 1155 igrd = 2 1192 1156 DO ib_bdy = 1, nb_bdy 1193 1157 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1194 bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0. e01195 END DO1196 END DO1158 bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 1159 END DO 1160 END DO 1197 1161 ! 1198 1162 igrd = 3 1199 1163 DO ib_bdy = 1, nb_bdy 1200 1164 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1201 bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0. e01165 bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 1202 1166 ENDDO 1203 1167 ENDDO … … 1205 1169 ! For the flagu/flagv calculation below we require a version of fmask without 1206 1170 ! the land boundary condition (shlat) included: 1207 CALL wrk_alloc(jpi,jpj, zfmask)1171 CALL wrk_alloc(jpi,jpj, zfmask ) 1208 1172 DO ij = 2, jpjm1 1209 1173 DO ii = 2, jpim1 … … 1220 1184 DO ib_bdy = 1, nb_bdy ! Indices and directions of rim velocity components 1221 1185 1222 idx_bdy(ib_bdy)%flagu(:,:) = 0. e01223 idx_bdy(ib_bdy)%flagv(:,:) = 0. e01186 idx_bdy(ib_bdy)%flagu(:,:) = 0._wp 1187 idx_bdy(ib_bdy)%flagv(:,:) = 0._wp 1224 1188 icount = 0 1225 1189 … … 1231 1195 DO igrd = 1,jpbgrd 1232 1196 SELECT CASE( igrd ) 1233 CASE( 1 ) 1234 pmask => umask(:,:,1) 1235 i_offset = 0 1236 CASE( 2 ) 1237 pmask => bdytmask 1238 i_offset = 1 1239 CASE( 3 ) 1240 pmask => zfmask(:,:) 1241 i_offset = 0 1197 CASE( 1 ) ; pmask => umask (:,:,1) ; i_offset = 0 1198 CASE( 2 ) ; pmask => bdytmask(:,:) ; i_offset = 1 1199 CASE( 3 ) ; pmask => zfmask (:,:) ; i_offset = 0 1242 1200 END SELECT 1243 1201 icount = 0 … … 1270 1228 ! flagv = 1 : v is normal to the boundary and is direction is inward 1271 1229 1272 DO igrd = 1, jpbgrd1230 DO igrd = 1, jpbgrd 1273 1231 SELECT CASE( igrd ) 1274 CASE( 1 ) 1275 pmask => vmask(:,:,1) 1276 j_offset = 0 1277 CASE( 2 ) 1278 pmask => zfmask(:,:) 1279 j_offset = 0 1280 CASE( 3 ) 1281 pmask => bdytmask 1282 j_offset = 1 1232 CASE( 1 ) ; pmask => vmask (:,:,1) ; j_offset = 0 1233 CASE( 2 ) ; pmask => zfmask(:,:) ; j_offset = 0 1234 CASE( 3 ) ; pmask => bdytmask ; j_offset = 1 1283 1235 END SELECT 1284 1236 icount = 0 … … 1286 1238 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 1287 1239 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1288 znfl = pmask(nbi,nbj+j_offset-1 1289 zsfl = pmask(nbi,nbj+j_offset )1240 znfl = pmask(nbi,nbj+j_offset-1) 1241 zsfl = pmask(nbi,nbj+j_offset ) 1290 1242 ! This error check only works if you are using the bdyXmask arrays 1291 1243 IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN … … 1305 1257 ENDIF 1306 1258 END DO 1307 1259 ! 1308 1260 END DO 1309 1261 … … 1323 1275 & * tmask_i(nbi , nbj) & 1324 1276 & * tmask_i(nbi+1, nbj) 1325 END DO1326 END DO1277 END DO 1278 END DO 1327 1279 1328 1280 igrd=3 ! Add lateral surface at V-points … … 1336 1288 & * tmask_i(nbi, nbj ) & 1337 1289 & * tmask_i(nbi, nbj+1) 1338 END DO1339 END DO1290 END DO 1291 END DO 1340 1292 ! 1341 1293 IF( lk_mpp ) CALL mpp_sum( bdysurftot ) ! sum over the global domain … … 1344 1296 ! Tidy up 1345 1297 !-------- 1346 IF (nb_bdy>0) THEN 1347 DEALLOCATE(nbidta, nbjdta, nbrdta) 1348 ENDIF 1349 1350 CALL wrk_dealloc(jpi,jpj,zfmask) 1351 1352 IF( nn_timing == 1 ) CALL timing_stop('bdy_init') 1353 1298 IF( nb_bdy>0 ) DEALLOCATE( nbidta, nbjdta, nbrdta ) 1299 ! 1300 CALL wrk_dealloc(jpi,jpj, zfmask ) 1301 ! 1302 IF( nn_timing == 1 ) CALL timing_stop('bdy_init') 1303 ! 1354 1304 END SUBROUTINE bdy_init 1305 1355 1306 1356 1307 SUBROUTINE bdy_ctl_seg … … 1743 1694 itest = 0 1744 1695 1745 IF (cn_dyn2d(ib1)/=cn_dyn2d(ib2))itest = itest + 11746 IF (cn_dyn3d(ib1)/=cn_dyn3d(ib2))itest = itest + 11747 IF (cn_tra(ib1)/=cn_tra(ib2))itest = itest + 11748 ! 1749 IF (nn_dyn2d_dta(ib1)/=nn_dyn2d_dta(ib2))itest = itest + 11750 IF (nn_dyn3d_dta(ib1)/=nn_dyn3d_dta(ib2))itest = itest + 11751 IF (nn_tra_dta(ib1)/=nn_tra_dta(ib2))itest = itest + 11752 ! 1753 IF (nn_rimwidth(ib1)/=nn_rimwidth(ib2))itest = itest + 11754 ! 1755 IF 1696 IF( cn_dyn2d(ib1) /= cn_dyn2d(ib2) ) itest = itest + 1 1697 IF( cn_dyn3d(ib1) /= cn_dyn3d(ib2) ) itest = itest + 1 1698 IF( cn_tra (ib1) /= cn_tra (ib2) ) itest = itest + 1 1699 ! 1700 IF( nn_dyn2d_dta(ib1) /= nn_dyn2d_dta(ib2) ) itest = itest + 1 1701 IF( nn_dyn3d_dta(ib1) /= nn_dyn3d_dta(ib2) ) itest = itest + 1 1702 IF( nn_tra_dta (ib1) /= nn_tra_dta (ib2) ) itest = itest + 1 1703 ! 1704 IF( nn_rimwidth(ib1) /= nn_rimwidth(ib2) ) itest = itest + 1 1705 ! 1706 IF( itest>0 ) THEN 1756 1707 IF(lwp) WRITE(numout,*) ' E R R O R : Segments ', ib1, 'and ', ib2 1757 1708 IF(lwp) WRITE(numout,*) ' ========== have different open bdy schemes' -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
r5215 r6004 4 4 !! Unstructured Open Boundary Cond. : Library module of generic boundary algorithms. 5 5 !!====================================================================== 6 !! History : 3.6 ! 2013 (D. Storkey) new module6 !! History : 3.6 ! 2013 (D. Storkey) original code 7 7 !!---------------------------------------------------------------------- 8 8 #if defined key_bdy … … 13 13 !! bdy_orlanski_3d 14 14 !!---------------------------------------------------------------------- 15 USE timing ! Timing 16 USE oce ! ocean dynamics and tracers 17 USE dom_oce ! ocean space and time domain 18 USE bdy_oce ! ocean open boundary conditions 19 USE phycst ! physical constants 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 USE in_out_manager ! 15 USE oce ! ocean dynamics and tracers 16 USE dom_oce ! ocean space and time domain 17 USE bdy_oce ! ocean open boundary conditions 18 USE phycst ! physical constants 19 ! 20 USE in_out_manager ! 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 USE timing ! Timing 22 23 23 24 IMPLICIT NONE … … 45 46 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 46 47 !!---------------------------------------------------------------------- 47 TYPE(OBC_INDEX), INTENT(in):: idx ! BDY indices48 INTEGER , INTENT(in):: igrd ! grid index49 REAL(wp), DIMENSION(:,:), INTENT(in):: phib ! model before 2D field50 REAL(wp), DIMENSION(:,:), INTENT(inout):: phia ! model after 2D field (to be updated)51 REAL(wp), DIMENSION(:) , INTENT(in):: phi_ext ! external forcing data52 LOGICAL , INTENT(in):: ll_npo ! switch for NPO version53 48 TYPE(OBC_INDEX), INTENT(in ) :: idx ! BDY indices 49 INTEGER , INTENT(in ) :: igrd ! grid index 50 REAL(wp), DIMENSION(:,:), INTENT(in ) :: phib ! model before 2D field 51 REAL(wp), DIMENSION(:,:), INTENT(inout) :: phia ! model after 2D field (to be updated) 52 REAL(wp), DIMENSION(:) , INTENT(in ) :: phi_ext ! external forcing data 53 LOGICAL , INTENT(in ) :: ll_npo ! switch for NPO version 54 ! 54 55 INTEGER :: jb ! dummy loop indices 55 56 INTEGER :: ii, ij, iibm1, iibm2, ijbm1, ijbm2 ! 2D addresses … … 70 71 REAL(wp), POINTER, DIMENSION(:,:) :: pe_ydif ! scale factors for y-derivatives 71 72 !!---------------------------------------------------------------------- 72 73 IF( nn_timing == 1 ) CALL timing_start('bdy_orlanski_2d')74 73 ! 74 IF( nn_timing == 1 ) CALL timing_start('bdy_orlanski_2d') 75 ! 75 76 ! ----------------------------------! 76 77 ! Orlanski boundary conditions :! … … 79 80 SELECT CASE(igrd) 80 81 CASE(1) 81 pmask => tmask(:,:,1)82 pmask => tmask(:,:,1) 82 83 pmask_xdif => umask(:,:,1) 83 84 pmask_ydif => vmask(:,:,1) 84 pe_xdif => e1u(:,:)85 pe_ydif => e2v(:,:)85 pe_xdif => e1u(:,:) 86 pe_ydif => e2v(:,:) 86 87 ii_offset = 0 87 88 ij_offset = 0 88 89 CASE(2) 89 pmask => umask(:,:,1)90 pmask => umask(:,:,1) 90 91 pmask_xdif => tmask(:,:,1) 91 92 pmask_ydif => fmask(:,:,1) 92 pe_xdif => e1t(:,:)93 pe_ydif => e2f(:,:)93 pe_xdif => e1t(:,:) 94 pe_ydif => e2f(:,:) 94 95 ii_offset = 1 95 96 ij_offset = 0 96 97 CASE(3) 97 pmask => vmask(:,:,1)98 pmask => vmask(:,:,1) 98 99 pmask_xdif => fmask(:,:,1) 99 100 pmask_ydif => tmask(:,:,1) 100 pe_xdif => e1f(:,:)101 pe_ydif => e2t(:,:)101 pe_xdif => e1f(:,:) 102 pe_ydif => e2t(:,:) 102 103 ii_offset = 0 103 104 ij_offset = 1 … … 188 189 END DO 189 190 ! 190 IF( nn_timing == 1 ) CALL timing_stop('bdy_orlanski_2d')191 191 IF( nn_timing == 1 ) CALL timing_stop('bdy_orlanski_2d') 192 ! 192 193 END SUBROUTINE bdy_orlanski_2d 193 194 … … 204 205 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 205 206 !!---------------------------------------------------------------------- 206 TYPE(OBC_INDEX), INTENT(in ):: idx ! BDY indices207 INTEGER , INTENT(in):: igrd ! grid index208 REAL(wp), DIMENSION(:,:,:), INTENT(in ):: phib ! model before 3D field209 REAL(wp), DIMENSION(:,:,:), INTENT(inout) 210 REAL(wp), DIMENSION(:,:) , INTENT(in):: phi_ext ! external forcing data211 LOGICAL , INTENT(in):: ll_npo ! switch for NPO version212 207 TYPE(OBC_INDEX), INTENT(in ) :: idx ! BDY indices 208 INTEGER , INTENT(in ) :: igrd ! grid index 209 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: phib ! model before 3D field 210 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated) 211 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: phi_ext ! external forcing data 212 LOGICAL , INTENT(in ) :: ll_npo ! switch for NPO version 213 ! 213 214 INTEGER :: jb, jk ! dummy loop indices 214 215 INTEGER :: ii, ij, iibm1, iibm2, ijbm1, ijbm2 ! 2D addresses … … 229 230 REAL(wp), POINTER, DIMENSION(:,:) :: pe_ydif ! scale factors for y-derivatives 230 231 !!---------------------------------------------------------------------- 231 232 IF( nn_timing == 1 ) CALL timing_start('bdy_orlanski_3d')233 232 ! 233 IF( nn_timing == 1 ) CALL timing_start('bdy_orlanski_3d') 234 ! 234 235 ! ----------------------------------! 235 236 ! Orlanski boundary conditions :! 236 237 ! ----------------------------------! 237 238 ! 238 239 SELECT CASE(igrd) 239 240 CASE(1) 240 pmask => tmask(:,:,:)241 pmask => tmask(:,:,:) 241 242 pmask_xdif => umask(:,:,:) 242 243 pmask_ydif => vmask(:,:,:) 243 pe_xdif => e1u(:,:)244 pe_ydif => e2v(:,:)244 pe_xdif => e1u(:,:) 245 pe_ydif => e2v(:,:) 245 246 ii_offset = 0 246 247 ij_offset = 0 247 248 CASE(2) 248 pmask => umask(:,:,:)249 pmask => umask(:,:,:) 249 250 pmask_xdif => tmask(:,:,:) 250 251 pmask_ydif => fmask(:,:,:) 251 pe_xdif => e1t(:,:)252 pe_ydif => e2f(:,:)252 pe_xdif => e1t(:,:) 253 pe_ydif => e2f(:,:) 253 254 ii_offset = 1 254 255 ij_offset = 0 255 256 CASE(3) 256 pmask => vmask(:,:,:)257 pmask => vmask(:,:,:) 257 258 pmask_xdif => fmask(:,:,:) 258 259 pmask_ydif => tmask(:,:,:) 259 pe_xdif => e1f(:,:)260 pe_ydif => e2t(:,:)260 pe_xdif => e1f(:,:) 261 pe_ydif => e2t(:,:) 261 262 ii_offset = 0 262 263 ij_offset = 1 … … 349 350 ! 350 351 END DO 351 352 IF( nn_timing == 1 ) CALL timing_stop('bdy_orlanski_3d')353 352 ! 353 IF( nn_timing == 1 ) CALL timing_stop('bdy_orlanski_3d') 354 ! 354 355 END SUBROUTINE bdy_orlanski_3d 355 356 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r5845 r6004 15 15 !! 'key_bdy' Open Boundary Condition 16 16 !!---------------------------------------------------------------------- 17 !! PUBLIC 18 !! bdytide_init : read of namelist and initialisation of tidal harmonics data 19 !! tide_update : calculation of tidal forcing at each timestep 20 !!---------------------------------------------------------------------- 21 USE timing ! Timing 22 USE oce ! ocean dynamics and tracers 23 USE dom_oce ! ocean space and time domain 24 USE iom 25 USE in_out_manager ! I/O units 26 USE phycst ! physical constants 27 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 28 USE bdy_par ! Unstructured boundary parameters 29 USE bdy_oce ! ocean open boundary conditions 30 USE daymod ! calendar 31 USE wrk_nemo ! Memory allocation 32 USE tideini 33 ! USE tide_mod ! Useless ?? 34 USE fldread 35 USE dynspg_oce, ONLY: lk_dynspg_ts 17 !! bdytide_init : read of namelist and initialisation of tidal harmonics data 18 !! tide_update : calculation of tidal forcing at each timestep 19 !!---------------------------------------------------------------------- 20 USE oce ! ocean dynamics and tracers 21 USE dom_oce ! ocean space and time domain 22 USE phycst ! physical constants 23 USE bdy_par ! Unstructured boundary parameters 24 USE bdy_oce ! ocean open boundary conditions 25 USE tideini ! 26 USE daymod ! calendar 27 ! 28 USE in_out_manager ! I/O units 29 USE iom ! xIO server 30 USE fldread ! 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE wrk_nemo ! Memory allocation 33 USE timing ! timing 36 34 37 35 IMPLICIT NONE … … 43 41 44 42 TYPE, PUBLIC :: TIDES_DATA !: Storage for external tidal harmonics data 45 REAL(wp), POINTER, DIMENSION(:,:,:) :: ssh0 !: Tidal constituents : SSH0 (read in file) 46 REAL(wp), POINTER, DIMENSION(:,:,:) :: u0 !: Tidal constituents : U0 (read in file) 47 REAL(wp), POINTER, DIMENSION(:,:,:) :: v0 !: Tidal constituents : V0 (read in file) 48 REAL(wp), POINTER, DIMENSION(:,:,:) :: ssh !: Tidal constituents : SSH (after nodal cor.) 49 REAL(wp), POINTER, DIMENSION(:,:,:) :: u !: Tidal constituents : U (after nodal cor.) 50 REAL(wp), POINTER, DIMENSION(:,:,:) :: v !: Tidal constituents : V (after nodal cor.) 43 REAL(wp), POINTER, DIMENSION(:,:,:) :: ssh0 !: Tidal constituents : SSH0 (read in file) 44 REAL(wp), POINTER, DIMENSION(:,:,:) :: u0, v0 !: Tidal constituents : U0, V0 (read in file) 45 REAL(wp), POINTER, DIMENSION(:,:,:) :: ssh !: Tidal constituents : SSH (after nodal cor.) 46 REAL(wp), POINTER, DIMENSION(:,:,:) :: u , v !: Tidal constituents : U , V (after nodal cor.) 51 47 END TYPE TIDES_DATA 52 48 … … 54 50 TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides !: External tidal harmonics data 55 51 !$AGRIF_END_DO_NOT_TREAT 56 TYPE(OBC_DATA) , P RIVATE, DIMENSION(jp_bdy) :: dta_bdy_s !: bdy external data (slow component)52 TYPE(OBC_DATA) , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s !: bdy external data (slow component) 57 53 58 54 !!---------------------------------------------------------------------- … … 92 88 NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj 93 89 !!---------------------------------------------------------------------- 94 95 IF( nn_timing == 1 ) CALL timing_start('bdytide_init')96 90 ! 91 IF( nn_timing == 1 ) CALL timing_start('bdytide_init') 92 ! 97 93 IF (nb_bdy>0) THEN 98 94 IF(lwp) WRITE(numout,*) … … 264 260 ENDIF ! ln_bdytide_2ddta=.true. 265 261 ! 266 IF ( ln_bdytide_conj ) THEN! assume complex conjugate in data files262 IF( ln_bdytide_conj ) THEN ! assume complex conjugate in data files 267 263 td%ssh0(:,:,2) = - td%ssh0(:,:,2) 268 264 td%u0 (:,:,2) = - td%u0 (:,:,2) … … 270 266 ENDIF 271 267 ! 272 IF ( lk_dynspg_ts ) THEN ! Allocate arrays to save slowly varying boundary data during 273 ! time splitting integration 274 ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) 275 ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 276 ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 277 dta_bdy_s(ib_bdy)%ssh(:) = 0.e0 278 dta_bdy_s(ib_bdy)%u2d(:) = 0.e0 279 dta_bdy_s(ib_bdy)%v2d(:) = 0.e0 280 ENDIF 268 ! Allocate slow varying data in the case of time splitting: 269 ! Do it anyway because at this stage knowledge of free surface scheme is unknown 270 ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) 271 ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 272 ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 273 dta_bdy_s(ib_bdy)%ssh(:) = 0._wp 274 dta_bdy_s(ib_bdy)%u2d(:) = 0._wp 275 dta_bdy_s(ib_bdy)%v2d(:) = 0._wp 281 276 ! 282 277 ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2 283 278 ! 284 279 END DO ! loop on ib_bdy 285 286 IF( nn_timing == 1 ) CALL timing_stop('bdytide_init')287 280 ! 281 IF( nn_timing == 1 ) CALL timing_stop('bdytide_init') 282 ! 288 283 END SUBROUTINE bdytide_init 289 284 290 285 291 SUBROUTINE bdytide_update 286 SUBROUTINE bdytide_update( kt, idx, dta, td, jit, time_offset ) 292 287 !!---------------------------------------------------------------------- 293 288 !! *** SUBROUTINE bdytide_update *** … … 308 303 ! ! etc. 309 304 ! 310 INTEGER :: itide, igrd, ib! dummy loop indices311 INTEGER :: time_add! time offset in units of timesteps312 INTEGER, DIMENSION(3) :: ilen0 !:length of boundary data (from OBC arrays)313 REAL(wp) :: z_arg, z_sarg, zflag, zramp305 INTEGER :: itide, igrd, ib ! dummy loop indices 306 INTEGER :: time_add ! time offset in units of timesteps 307 INTEGER, DIMENSION(3) :: ilen0 ! length of boundary data (from OBC arrays) 308 REAL(wp) :: z_arg, z_sarg, zflag, zramp ! local scalars 314 309 REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost 315 310 !!---------------------------------------------------------------------- 316 317 IF( nn_timing == 1 ) CALL timing_start('bdytide_update')318 311 ! 312 IF( nn_timing == 1 ) CALL timing_start('bdytide_update') 313 ! 319 314 ilen0(1) = SIZE(td%ssh(:,1,1)) 320 315 ilen0(2) = SIZE(td%u(:,1,1)) … … 377 372 END DO 378 373 ! 379 IF( nn_timing == 1 ) CALL timing_stop('bdytide_update')374 IF( nn_timing == 1 ) CALL timing_stop('bdytide_update') 380 375 ! 381 376 END SUBROUTINE bdytide_update … … 398 393 ! ! etc. 399 394 ! 400 LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step401 INTEGER :: itide, ib_bdy, ib, igrd ! loop indices402 INTEGER :: time_add ! time offset in units of timesteps403 INTEGER, DIMENSION(jpbgrd) ::ilen0404 INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim ! short cuts405 REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist406 !!---------------------------------------------------------------------- 407 408 IF( nn_timing == 1 ) CALL timing_start('bdy_dta_tides')409 395 LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step 396 INTEGER :: itide, ib_bdy, ib, igrd ! loop indices 397 INTEGER :: time_add ! time offset in units of timesteps 398 INTEGER, DIMENSION(jpbgrd) :: ilen0 399 INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim ! short cuts 400 REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist 401 !!---------------------------------------------------------------------- 402 ! 403 IF( nn_timing == 1 ) CALL timing_start('bdy_dta_tides') 404 ! 410 405 lk_first_btstp=.TRUE. 411 406 IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF … … 418 413 ! Absolute time from model initialization: 419 414 IF( PRESENT(kit) ) THEN 420 z_arg = ( kt + (kit+ 0.5_wp*(time_add-1)) / REAL(nn_baro,wp) ) * rdt415 z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt 421 416 ELSE 422 417 z_arg = ( kt + time_add ) * rdt … … 458 453 zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time 459 454 ! 460 ! If time splitting, save data at first barotropic iteration 461 IF ( PRESENT(kit) ) THEN 462 IF ( lk_first_btstp ) THEN ! Save slow varying open boundary data: 463 IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy(ib_bdy)%ssh(1:ilen0(1)) 464 IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy(ib_bdy)%u2d(1:ilen0(2)) 465 IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy(ib_bdy)%v2d(1:ilen0(3)) 466 467 ELSE ! Initialize arrays from slow varying open boundary data: 468 IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 469 IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 470 IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 471 ENDIF 455 ! If time splitting, initialize arrays from slow varying open boundary data: 456 IF ( PRESENT(kit) ) THEN 457 IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 458 IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 459 IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 472 460 ENDIF 473 461 ! … … 525 513 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 526 514 !!---------------------------------------------------------------------- 527 515 ! 528 516 igrd=1 529 517 ! SSH on tracer grid. 530 531 518 ilen0(1) = SIZE(td%ssh0(:,1,1)) 532 533 ALLOCATE( mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd)))534 519 ! 520 ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) ) 521 ! 535 522 DO itide = 1, nb_harmo 536 523 DO ib = 1, ilen0(igrd) … … 547 534 ENDDO 548 535 END DO 549 536 ! 550 537 DEALLOCATE( mod_tide, phi_tide ) 551 538 ! … … 564 551 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 565 552 !!---------------------------------------------------------------------- 566 553 ! 567 554 ilen0(2) = SIZE(td%u0(:,1,1)) 568 555 ilen0(3) = SIZE(td%v0(:,1,1)) 569 556 ! 570 557 igrd=2 ! U grid. 571 558 ! 572 559 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 573 560 ! 574 561 DO itide = 1, nb_harmo 575 562 DO ib = 1, ilen0(igrd) … … 586 573 ENDDO 587 574 END DO 588 575 ! 589 576 DEALLOCATE( mod_tide , phi_tide ) 590 577 ! 591 578 igrd=3 ! V grid. 592 579 ! 593 580 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 594 581 … … 608 595 END DO 609 596 ! 610 DEALLOCATE( mod_tide,phi_tide)597 DEALLOCATE( mod_tide, phi_tide ) 611 598 ! 612 599 END SUBROUTINE tide_init_velocities -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
r4292 r6004 16 16 !! bdy_tra_frs : Apply Flow Relaxation Scheme 17 17 !!---------------------------------------------------------------------- 18 USE timing ! Timing19 USE oce ! ocean dynamics and tracers variables20 USE dom_oce ! ocean space and time domain variables21 USE bdy _oce ! ocean open boundary conditions22 USE bdy lib ! for orlanski library routines23 USE bdydta, ONLY: bf24 USE lbclnk ! ocean lateral boundary conditions (or mpp link)25 USE in_out_manager ! I/O manager26 18 USE oce ! ocean dynamics and tracers variables 19 USE dom_oce ! ocean space and time domain variables 20 USE bdy_oce ! ocean open boundary conditions 21 USE bdylib ! for orlanski library routines 22 USE bdydta , ONLY: bf ! 23 ! 24 USE in_out_manager ! I/O manager 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE timing ! Timing 27 27 28 28 IMPLICIT NONE 29 29 PRIVATE 30 30 31 PUBLIC bdy_tra ! routinecalled in tranxt.F9032 PUBLIC bdy_tra_dmp ! routinecalled in step.F9031 PUBLIC bdy_tra ! called in tranxt.F90 32 PUBLIC bdy_tra_dmp ! called in step.F90 33 33 34 34 !!---------------------------------------------------------------------- … … 46 46 !! 47 47 !!---------------------------------------------------------------------- 48 INTEGER, INTENT( in ) :: kt ! Main time step counter 49 !! 50 INTEGER :: ib_bdy ! Loop index 48 INTEGER, INTENT(in) :: kt ! Main time step counter 49 ! 50 INTEGER :: ib_bdy ! Loop index 51 !!---------------------------------------------------------------------- 51 52 52 53 DO ib_bdy=1, nb_bdy 53 54 ! 54 55 SELECT CASE( cn_tra(ib_bdy) ) 55 CASE('none') 56 CYCLE 57 CASE('frs') 58 CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 59 CASE('specified') 60 CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 61 CASE('neumann') 62 CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 63 CASE('orlanski') 64 CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 65 CASE('orlanski_npo') 66 CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 67 CASE('runoff') 68 CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 69 CASE DEFAULT 70 CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 56 CASE('none' ) ; CYCLE 57 CASE('frs' ) ; CALL bdy_tra_frs ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 58 CASE('specified' ) ; CALL bdy_tra_spe ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 59 CASE('neumann' ) ; CALL bdy_tra_nmn ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 60 CASE('orlanski' ) ; CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 61 CASE('orlanski_npo') ; CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 62 CASE('runoff' ) ; CALL bdy_tra_rnf ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 63 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 71 64 END SELECT 72 65 ! Boundary points should be updated 73 66 CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy ) 74 67 CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy ) 75 ENDDO 76 ! 77 68 END DO 69 ! 78 70 END SUBROUTINE bdy_tra 79 71 72 80 73 SUBROUTINE bdy_tra_frs( idx, dta, kt ) 81 74 !!---------------------------------------------------------------------- … … 86 79 !! Reference : Engedahl H., 1995, Tellus, 365-382. 87 80 !!---------------------------------------------------------------------- 88 INTEGER, INTENT(in) :: kt 89 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices90 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data91 ! !81 INTEGER, INTENT(in) :: kt ! 82 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 83 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 84 ! 92 85 REAL(wp) :: zwgt ! boundary weight 93 86 INTEGER :: ib, ik, igrd ! dummy loop indices … … 95 88 !!---------------------------------------------------------------------- 96 89 ! 97 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_frs')90 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_frs') 98 91 ! 99 92 igrd = 1 ! Everything is at T-points here … … 108 101 END DO 109 102 ! 110 IF( kt .eq. nit000 ) CLOSE( unit = 102 )111 ! 112 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs')103 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 104 ! 105 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs') 113 106 ! 114 107 END SUBROUTINE bdy_tra_frs 115 108 109 116 110 SUBROUTINE bdy_tra_spe( idx, dta, kt ) 117 111 !!---------------------------------------------------------------------- … … 121 115 !! 122 116 !!---------------------------------------------------------------------- 123 INTEGER, INTENT(in) :: kt 124 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices125 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data126 ! !117 INTEGER, INTENT(in) :: kt ! 118 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 119 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 120 ! 127 121 REAL(wp) :: zwgt ! boundary weight 128 122 INTEGER :: ib, ik, igrd ! dummy loop indices … … 142 136 END DO 143 137 ! 144 IF( kt .eq. nit000 )CLOSE( unit = 102 )145 ! 146 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe')138 IF( kt == nit000 ) CLOSE( unit = 102 ) 139 ! 140 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe') 147 141 ! 148 142 END SUBROUTINE bdy_tra_spe 149 143 144 150 145 SUBROUTINE bdy_tra_nmn( idx, dta, kt ) 151 146 !!---------------------------------------------------------------------- … … 155 150 !! 156 151 !!---------------------------------------------------------------------- 157 INTEGER, INTENT(in) :: kt 158 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices159 TYPE(OBC_DATA) , INTENT(in) :: dta! OBC external data160 ! !152 INTEGER, INTENT(in) :: kt ! 153 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 154 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 155 ! 161 156 REAL(wp) :: zwgt ! boundary weight 162 157 INTEGER :: ib, ik, igrd ! dummy loop indices … … 164 159 !!---------------------------------------------------------------------- 165 160 ! 166 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn')161 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn') 167 162 ! 168 163 igrd = 1 ! Everything is at T-points here … … 196 191 END DO 197 192 ! 198 IF( kt .eq. nit000 )CLOSE( unit = 102 )199 ! 200 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn')193 IF( kt == nit000 ) CLOSE( unit = 102 ) 194 ! 195 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn') 201 196 ! 202 197 END SUBROUTINE bdy_tra_nmn … … 213 208 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 214 209 !!---------------------------------------------------------------------- 215 TYPE(OBC_INDEX), INTENT(in) :: idx! OBC indices216 TYPE(OBC_DATA) , INTENT(in) :: dta! OBC external data217 LOGICAL ,INTENT(in) :: ll_npo ! switch for NPO version218 210 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 211 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 212 LOGICAL , INTENT(in) :: ll_npo ! switch for NPO version 213 ! 219 214 INTEGER :: igrd ! grid index 220 215 !!---------------------------------------------------------------------- 221 216 ! 222 217 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 223 218 ! … … 230 225 CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 231 226 ! 232 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski') 233 ! 234 227 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski') 228 ! 235 229 END SUBROUTINE bdy_tra_orlanski 236 230 … … 245 239 !! 246 240 !!---------------------------------------------------------------------- 247 INTEGER , INTENT(in) :: kt248 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices249 TYPE(OBC_DATA) , INTENT(in) :: dta! OBC external data250 ! !241 INTEGER , INTENT(in) :: kt ! 242 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 243 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 244 ! 251 245 REAL(wp) :: zwgt ! boundary weight 252 246 INTEGER :: ib, ik, igrd ! dummy loop indices … … 254 248 !!---------------------------------------------------------------------- 255 249 ! 256 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf')250 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf') 257 251 ! 258 252 igrd = 1 ! Everything is at T-points here … … 268 262 END DO 269 263 ! 270 IF( kt .eq. nit000 )CLOSE( unit = 102 )271 ! 272 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf')264 IF( kt == nit000 ) CLOSE( unit = 102 ) 265 ! 266 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf') 273 267 ! 274 268 END SUBROUTINE bdy_tra_rnf 275 269 270 276 271 SUBROUTINE bdy_tra_dmp( kt ) 277 272 !!---------------------------------------------------------------------- … … 281 276 !! 282 277 !!---------------------------------------------------------------------- 283 INTEGER, INTENT(in) :: kt284 ! !278 INTEGER, INTENT(in) :: kt ! 279 ! 285 280 REAL(wp) :: zwgt ! boundary weight 286 281 REAL(wp) :: zta, zsa, ztime … … 290 285 !!---------------------------------------------------------------------- 291 286 ! 292 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp')293 ! 294 DO ib_bdy =1, nb_bdy295 IF 287 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp') 288 ! 289 DO ib_bdy = 1, nb_bdy 290 IF( ln_tra_dmp(ib_bdy) ) THEN 296 291 igrd = 1 ! Everything is at T-points here 297 292 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) … … 307 302 END DO 308 303 ENDIF 309 END DO310 ! 311 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp')304 END DO 305 ! 306 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp') 312 307 ! 313 308 END SUBROUTINE bdy_tra_dmp … … 325 320 WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt 326 321 END SUBROUTINE bdy_tra_dmp 327 328 322 #endif 329 323 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r5845 r6004 10 10 !! 3.4 ! 2011 (D. Storkey) rewrite in preparation for OBC-BDY merge 11 11 !!---------------------------------------------------------------------- 12 #if defined key_bdy && defined key_dynspg_flt12 #if defined key_bdy 13 13 !!---------------------------------------------------------------------- 14 !! 'key_bdy' AND unstructured open boundary conditions 15 !! 'key_dynspg_flt' filtered free surface 14 !! 'key_bdy' unstructured open boundary conditions 16 15 !!---------------------------------------------------------------------- 17 USE oce 18 USE bdy_oce 19 USE sbc_oce 20 USE dom_oce 21 USE phycst 22 USE sbcisf 16 USE oce ! ocean dynamics and tracers 17 USE bdy_oce ! ocean open boundary conditions 18 USE sbc_oce ! ocean surface boundary conditions 19 USE dom_oce ! ocean space and time domain 20 USE phycst ! physical constants 21 USE sbcisf ! ice shelf 23 22 ! 24 USE in_out_manager 25 USE lib_mpp 26 USE timing 27 USE lib_fortran 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! for mppsum 25 USE timing ! Timing 26 USE lib_fortran ! Fortran routines library 28 27 29 28 IMPLICIT NONE 30 29 PRIVATE 31 30 32 PUBLIC bdy_vol ! routine called by dynspg_flt.h9031 PUBLIC bdy_vol ! called by ??? 33 32 34 33 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3. 6 , NEMO Consortium (2014)34 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 36 35 !! $Id$ 37 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 42 !! *** ROUTINE bdyvol *** 44 43 !! 45 !! ** Purpose : This routine is called in dynspg_flt to control46 !! the volume of the system. A correction velocity is calculated47 !! t o correct the total transport through the unstructured OBC.44 !! ** Purpose : This routine controls the volume of the system. 45 !! A correction velocity is calculated to correct the total transport 46 !! through the unstructured OBC. 48 47 !! The total depth used is constant (H0) to be consistent with the 49 !! linear free surface coded in OPA 8.2 48 !! linear free surface coded in OPA 8.2 <<<=== !!gm ???? true ???? 50 49 !! 51 50 !! ** Method : The correction velocity (zubtpecor here) is defined calculating … … 71 70 !! (set nn_volctl to 1 in tne namelist for this option) 72 71 !!---------------------------------------------------------------------- 73 INTEGER, INTENT( in) :: kt ! ocean time-step index74 ! !72 INTEGER, INTENT(in) :: kt ! ocean time-step index 73 ! 75 74 INTEGER :: ji, jj, jk, jb, jgrd 76 75 INTEGER :: ib_bdy, ii, ij … … 126 125 ! The normal velocity correction 127 126 ! ------------------------------ 128 IF( nn_volctl==1 ) THEN ; zubtpecor = ( zubtpecor - z_cflxemp ) / bdysurftot129 ELSE ; zubtpecor = zubtpecor / bdysurftot127 IF( nn_volctl==1 ) THEN ; zubtpecor = ( zubtpecor - z_cflxemp ) / bdysurftot 128 ELSE ; zubtpecor = zubtpecor / bdysurftot 130 129 END IF 131 130 … … 160 159 ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected 161 160 ! ------------------------------------------------------ 162 IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN161 IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN 163 162 IF(lwp) WRITE(numout,*) 164 163 IF(lwp) WRITE(numout,*)'bdy_vol : time step :', kt … … 170 169 END IF 171 170 ! 172 IF( nn_timing == 1 ) CALL timing_stop('bdy_vol')171 IF( nn_timing == 1 ) CALL timing_stop('bdy_vol') 173 172 ! 174 173 END IF ! ln_vol -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90
r5836 r6004 4 4 !! Ocean domain : 1D configuration 5 5 !!===================================================================== 6 !! History : 7 !! 8 !! 6 !! History : 2.0 ! 2004-09 (C. Ethe) Original code 7 !! 3.0 ! 2008-04 (G. Madec) adaptation to SBC 8 !! 3.5 ! 2013-10 (D. Calvert) add namelist 9 9 !!---------------------------------------------------------------------- 10 10 #if defined key_c1d … … 12 12 !! 'key_c1d' 1D column configuration 13 13 !!---------------------------------------------------------------------- 14 !! c1d_init 14 !! c1d_init : read in the C1D namelist 15 15 !!---------------------------------------------------------------------- 16 USE in_out_manager ! I/O manager 17 USE par_kind ! kind parameters 18 USE lib_mpp 16 USE par_kind ! kind parameters 17 ! 18 USE in_out_manager ! I/O manager 19 USE lib_mpp ! MPP library 19 20 20 21 IMPLICIT NONE 21 22 PRIVATE 22 23 23 PUBLIC c1d_init 24 PUBLIC c1d_init ! called by nemogcm.F90 24 25 25 26 LOGICAL , PUBLIC, PARAMETER :: lk_c1d = .TRUE. ! 1D config. flag 26 27 27 REAL(wp), PUBLIC :: rn_lat1d !Column latitude28 REAL(wp), PUBLIC :: rn_lon1d !Column longitude29 LOGICAL , PUBLIC :: ln_c1d_locpt !Localization (or not) of 1D column in a grid28 REAL(wp), PUBLIC :: rn_lat1d !: Column latitude 29 REAL(wp), PUBLIC :: rn_lon1d !: Column longitude 30 LOGICAL , PUBLIC :: ln_c1d_locpt !: Localization (or not) of 1D column in a grid 30 31 31 32 !!---------------------------------------------------------------------- 32 !! NEMO/C1D 3. 3 , NEMO Consortium (2010)33 !! NEMO/C1D 3.7 , NEMO Consortium (2015) 33 34 !! $Id$ 34 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 44 45 !! ** Method : Read namelist namc1d 45 46 !!---------------------------------------------------------------------- 46 INTEGER :: ios ! Local integer output status for namelist read 47 INTEGER :: ios ! Local integer 48 !! 47 49 NAMELIST/namc1d/ rn_lat1d, rn_lon1d , ln_c1d_locpt 48 50 !!---------------------------------------------------------------------- … … 50 52 REWIND( numnam_ref ) ! Namelist namc1d in reference namelist : Tracer advection scheme 51 53 READ ( numnam_ref, namc1d, IOSTAT = ios, ERR = 901) 52 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in reference namelist', lwp )53 54 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in reference namelist', lwp ) 55 ! 54 56 REWIND( numnam_cfg ) ! Namelist namtra_adv in configuration namelist : Tracer advection scheme 55 57 READ ( numnam_cfg, namc1d, IOSTAT = ios, ERR = 902 ) 56 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp )58 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d in configuration namelist', lwp ) 57 59 IF(lwm) WRITE ( numond, namc1d ) 58 60 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90
r5215 r6004 12 12 !! dom_c1d : Determine jpizoom/jpjzoom from a given lat/lon 13 13 !!---------------------------------------------------------------------- 14 USE phycst ! Physical constants (and par_oce) 15 USE iom ! I/O library (iom_get) 16 USE in_out_manager ! I/O manager (ctmp1) 17 USE dom_oce , ONLY : nimpp, njmpp ! Shared/distributed memory setting (mpp_init routine) 14 USE phycst ! Physical constants (and par_oce) 15 USE dom_oce , ONLY : nimpp, njmpp ! Shared/distributed memory setting 16 ! 17 USE iom ! I/O library (iom_get) 18 USE in_out_manager ! I/O manager (ctmp1) 18 19 USE wrk_nemo ! Memory allocation 19 20 USE timing ! Timing … … 22 23 PRIVATE 23 24 24 PUBLIC dom_c1d ! Routinecalled in domcfg.F9025 26 !!---------------------------------------------------------------------- 27 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)25 PUBLIC dom_c1d ! called in domcfg.F90 26 27 !!---------------------------------------------------------------------- 28 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 28 29 !! $Id$ 29 30 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 44 !! ** Action : Recalculate jpizoom, jpjzoom (indices of C1D zoom) 44 45 !!---------------------------------------------------------------------- 46 REAL(wp), INTENT(in) :: plat, plon ! Column latitude & longitude 47 ! 48 INTEGER :: ji, jj ! Dummy loop indices 49 INTEGER :: inum ! Coordinate file handle (case 0) 50 INTEGER :: ijeq ! Index of equator T point (case 4) 51 INTEGER :: ios ! Local integer output status for namelist read 52 INTEGER , DIMENSION(2) :: iloc ! Minloc returned indices 53 REAL(wp) :: zlon ! Wraparound longitude 54 REAL(wp) :: zti, ztj, zarg ! Local scalars 55 REAL(wp) :: glam0, gphi0 ! Variables corresponding to parameters ppglam0 ppgphi0 set in par_oce 56 REAL(wp) :: zlam1, zcos_alpha, ze1, ze1deg ! Case 5 local scalars 57 REAL(wp) :: zphi1, zsin_alpha, zim05, zjm05 ! 58 REAL(wp) , POINTER, DIMENSION(:,:) :: gphidta, glamdta, zdist ! Global lat/lon 59 !! 45 60 NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, & 46 61 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & … … 50 65 & ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 51 66 & ppa2, ppkth2, ppacr2 52 53 INTEGER :: ji, jj ! Dummy loop indices54 INTEGER :: inum ! Coordinate file handle (case 0)55 INTEGER :: ijeq ! Index of equator T point (case 4)56 INTEGER :: ios ! Local integer output status for namelist read57 58 INTEGER , DIMENSION(2) :: iloc ! Minloc returned indices59 60 REAL(wp), INTENT(in) :: plat ! Column latitude61 REAL(wp), INTENT(in) :: plon ! Column longitude62 63 REAL(wp) :: zlon ! Wraparound longitude64 REAL(wp) :: zti, ztj, zarg ! Local scalars65 REAL(wp) :: glam0, gphi0 ! Variables corresponding to parameters ppglam0 ppgphi0 set in par_oce66 REAL(wp) :: zlam1, zcos_alpha, ze1, ze1deg ! Case 5 local scalars67 REAL(wp) :: zphi1, zsin_alpha, zim05, zjm05 ! "68 69 REAL(wp) , POINTER, DIMENSION(:,:) :: gphidta, glamdta, zdist ! Global lat/lon70 67 !!---------------------------------------------------------------------- 71 68 … … 74 71 REWIND( numnam_ref ) ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep) 75 72 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 901 ) 76 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 77 73 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 78 74 ! 79 75 REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 80 76 READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 902 ) 81 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 82 83 CALL wrk_alloc( jpidta, jpjdta, gphidta, glamdta, zdist ) 84 77 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 78 79 CALL wrk_alloc( jpidta,jpjdta, gphidta, glamdta, zdist ) 85 80 86 81 ! ============================= ! … … 171 166 END SELECT 172 167 173 174 168 ! ============================== ! 175 169 ! Code from dom_ngb: ! … … 192 186 jpjzoom = iloc(2) + njmpp - 2 ! corner index of the zoom domain. 193 187 194 CALL wrk_dealloc( jpidta, jpjdta,gphidta, glamdta, zdist )188 CALL wrk_dealloc( jpidta,jpjdta, gphidta, glamdta, zdist ) 195 189 196 190 IF (lwp) THEN … … 202 196 WRITE(numout,*) 203 197 ENDIF 204 198 ! 205 199 IF( nn_timing == 1 ) CALL timing_stop('dom_c1d') 206 200 ! 207 201 END SUBROUTINE dom_c1d 208 202 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90
r5845 r6004 4 4 !! Ocean data : read ocean U & V current data from gridded data 5 5 !!====================================================================== 6 !! History : 3.5 ! 2013-08 (D. Calvert) Original code 7 !!---------------------------------------------------------------------- 8 9 !!---------------------------------------------------------------------- 10 !! dta_uvd_init : read namelist and allocate data structures 11 !! dta_uvd : read and time-interpolate ocean U & V current data 12 !!---------------------------------------------------------------------- 13 USE oce ! ocean dynamics and tracers 14 USE dom_oce ! ocean space and time domain 15 USE fldread ! read input fields 16 USE in_out_manager ! I/O manager 17 USE phycst ! physical constants 18 USE lib_mpp ! MPP library 19 USE wrk_nemo ! Memory allocation 20 USE timing ! Timing 6 !! History : 3.5 ! 2013-08 (D. Calvert) Original code 7 !!---------------------------------------------------------------------- 8 9 !!---------------------------------------------------------------------- 10 !! dta_uvd_init : read namelist and allocate data structures 11 !! dta_uvd : read and time-interpolate ocean U & V current data 12 !!---------------------------------------------------------------------- 13 USE oce ! ocean dynamics and tracers 14 USE phycst ! physical constants 15 USE dom_oce ! ocean space and time domain 16 ! 17 USE in_out_manager ! I/O manager 18 USE fldread ! read input fields 19 USE lib_mpp ! MPP library 20 USE wrk_nemo ! Memory allocation 21 USE timing ! Timing 21 22 22 23 IMPLICIT NONE … … 26 27 PUBLIC dta_uvd ! called by istate.F90 and dyndmp.90 27 28 28 LOGICAL , PUBLIC :: ln_uvd_init 29 LOGICAL , PUBLIC :: ln_uvd_dyndmp 29 LOGICAL , PUBLIC :: ln_uvd_init ! Flag to initialise with U & V current data 30 LOGICAL , PUBLIC :: ln_uvd_dyndmp ! Flag for Newtonian damping toward U & V current data 30 31 31 32 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_uvd ! structure for input U & V current (file information and data) 32 33 33 34 !!---------------------------------------------------------------------- 34 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)35 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 35 36 !! $Id$ 36 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 48 49 !! - fld_fill data structure with namelist information 49 50 !!---------------------------------------------------------------------- 50 LOGICAL, INTENT(in), OPTIONAL :: ld_dyndmp ! force the initialization when dyndmp is used 51 ! 52 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers 53 ! 54 CHARACTER(len=100) :: cn_dir ! Root directory for location of files to be used 55 TYPE(FLD_N), DIMENSION(2) :: suv_i ! Combined U & V namelist information 56 TYPE(FLD_N) :: sn_ucur, sn_vcur ! U & V data namelist information 51 LOGICAL, INTENT(in), OPTIONAL :: ld_dyndmp ! force the initialization when dyndmp is used 52 ! 53 INTEGER :: ios, ierr0, ierr1, ierr2, ierr3 ! local integers 54 CHARACTER(len=100) :: cn_dir ! Root directory for location of files to be used 55 TYPE(FLD_N), DIMENSION(2) :: suv_i ! Combined U & V namelist information 56 TYPE(FLD_N) :: sn_ucur, sn_vcur ! U & V data namelist information 57 57 !! 58 58 NAMELIST/namc1d_uvd/ ln_uvd_init, ln_uvd_dyndmp, cn_dir, sn_ucur, sn_vcur 59 INTEGER :: ios 60 !!---------------------------------------------------------------------- 61 ! 62 IF( nn_timing == 1 ) CALL timing_start('dta_uvd_init') 63 ! 64 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 59 !!---------------------------------------------------------------------- 60 ! 61 IF( nn_timing == 1 ) CALL timing_start('dta_uvd_init') 62 ! 63 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 65 64 66 65 REWIND( numnam_ref ) ! Namelist namc1d_uvd in reference namelist : 67 66 READ ( numnam_ref, namc1d_uvd, IOSTAT = ios, ERR = 901) 68 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp )69 67 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp ) 68 ! 70 69 REWIND( numnam_cfg ) ! Namelist namc1d_uvd in configuration namelist : Parameters of the run 71 70 READ ( numnam_cfg, namc1d_uvd, IOSTAT = ios, ERR = 902 ) 72 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp )71 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp ) 73 72 IF(lwm) WRITE ( numond, namc1d_uvd ) 74 73 … … 147 146 !!---------------------------------------------------------------------- 148 147 ! 149 IF( nn_timing == 1 ) CALL timing_start('dta_uvd')148 IF( nn_timing == 1 ) CALL timing_start('dta_uvd') 150 149 ! 151 150 CALL fld_read( kt, 1, sf_uvd ) !== read U & V current data at time step kt ==! 152 !153 !154 ! !== ORCA_R2 configuration and U & V current damping ==!155 IF( cp_cfg == "orca" .AND. jp_cfg == 2 .AND. ln_uvd_dyndmp ) THEN ! some hand made alterations156 !!! EMPTY- to be added for running in 3D context !!!157 ENDIF158 151 ! 159 152 puvd(:,:,:,1) = sf_uvd(1)%fnow(:,:,:) ! NO mask … … 162 155 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 163 156 ! 164 CALL wrk_alloc( jpk, zup, zvp )157 CALL wrk_alloc( jpk, zup, zvp ) 165 158 ! 166 159 IF( kt == nit000 .AND. lwp )THEN … … 198 191 END DO 199 192 ! 200 CALL wrk_dealloc( jpk, zup, zvp )193 CALL wrk_dealloc( jpk, zup, zvp ) 201 194 ! 202 195 ELSE !== z- or zps- coordinate ==! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90
r5215 r6004 11 11 !! 'key_c1d' 1D Configuration 12 12 !!---------------------------------------------------------------------- 13 !! cor_c1d : Coriolis factor at T-point (1D configuration)14 !! dyn_cor_c1d : vorticity trend due to Coriolis at T-point13 !! cor_c1d : Coriolis factor at T-point (1D configuration) 14 !! dyn_cor_c1d : vorticity trend due to Coriolis at T-point 15 15 !!---------------------------------------------------------------------- 16 USE oce ! ocean dynamics and tracers 17 USE dom_oce ! ocean space and time domain 18 USE phycst ! physical constants 19 USE in_out_manager ! I/O manager 20 USE prtctl ! Print control 16 USE oce ! ocean dynamics and tracers 17 USE dom_oce ! ocean space and time domain 18 USE phycst ! physical constants 19 ! 20 USE in_out_manager ! I/O manager 21 USE prtctl ! Print control 21 22 22 23 IMPLICIT NONE 23 24 PRIVATE 24 25 25 PUBLIC cor_c1d ! routine called by OPA.F9026 PUBLIC dyn_cor_c1d ! routinecalled by step1d.F9026 PUBLIC cor_c1d ! called by nemogcm.F90 27 PUBLIC dyn_cor_c1d ! called by step1d.F90 27 28 28 29 !! * Substitutions 29 30 # include "vectopt_loop_substitute.h90" 30 31 !!---------------------------------------------------------------------- 31 !! NEMO/C1D 3. 3 , NEMO Consortium (2010)32 !! NEMO/C1D 3.7 , NEMO Consortium (2015) 32 33 !! $Id$ 33 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 41 42 !! ** Purpose : set the Coriolis factor at T-point 42 43 !!---------------------------------------------------------------------- 43 REAL(wp) :: zphi0, zbeta, zf0 ! temporaryscalars44 REAL(wp) :: zphi0, zbeta, zf0 ! local scalars 44 45 !!---------------------------------------------------------------------- 45 46 … … 87 88 INTEGER, INTENT( in ) :: kt ! ocean time-step index 88 89 !! 89 INTEGER :: ji, jj, jk 90 INTEGER :: ji, jj, jk ! dummy loop indices 90 91 !!---------------------------------------------------------------------- 91 92 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
r5845 r6004 23 23 USE dtauvd ! data: U & V current 24 24 USE zdfmxl ! vertical physics: mixed layer depth 25 ! 25 26 USE in_out_manager ! I/O manager 26 27 USE lib_mpp ! MPP library … … 36 37 PUBLIC dyn_dmp ! routine called by step_c1d.F90 37 38 38 LOGICAL, PUBLIC :: ln_dyndmp !Flag for Newtonian damping39 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: utrdmp ! damping U current trend (m/s2)41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vtrdmp ! damping V current trend (m/s2)42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto_uv ! restoring coeff. on U & V current39 LOGICAL, PUBLIC :: ln_dyndmp !: Flag for Newtonian damping 40 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: utrdmp !: damping U current trend (m/s2) 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vtrdmp !: damping V current trend (m/s2) 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto_uv !: restoring coeff. on U & V current 43 44 44 45 !! * Substitutions 45 46 # include "vectopt_loop_substitute.h90" 46 47 !!---------------------------------------------------------------------- 47 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)48 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 48 49 !! $Id$ 49 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 74 75 !! - calculate damping coefficient 75 76 !!---------------------------------------------------------------------- 77 INTEGER :: ios, imask ! local integers 78 !! 76 79 NAMELIST/namc1d_dyndmp/ ln_dyndmp 77 INTEGER :: ios 78 INTEGER :: imask 79 !!---------------------------------------------------------------------- 80 80 !!---------------------------------------------------------------------- 81 ! 81 82 REWIND( numnam_ref ) ! Namelist namc1d_dyndmp in reference namelist : 82 83 READ ( numnam_ref, namc1d_dyndmp, IOSTAT = ios, ERR = 901) 83 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist', lwp )84 84 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist', lwp ) 85 ! 85 86 REWIND( numnam_cfg ) ! Namelist namc1d_dyndmp in configuration namelist : Parameters of the run 86 87 READ ( numnam_cfg, namc1d_dyndmp, IOSTAT = ios, ERR = 902 ) 87 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist', lwp )88 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist', lwp ) 88 89 IF(lwm) WRITE ( numond, namc1d_dyndmp ) 89 90 ! 90 91 IF(lwp) THEN ! control print 91 92 WRITE(numout,*) … … 100 101 WRITE(numout,*) 101 102 ENDIF 102 103 ! 103 104 IF( ln_dyndmp ) THEN 104 105 ! !== allocate the data arrays ==! … … 149 150 !! ** Action : - (ua,va) momentum trends updated with the damping trend 150 151 !!---------------------------------------------------------------------- 151 INTEGER, INTENT(in) :: kt 152 !! 153 INTEGER :: ji, jj, jk 154 REAL(wp) :: zua, zva 155 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuv_dta! Read in data152 INTEGER, INTENT(in) :: kt ! ocean time-step index 153 !! 154 INTEGER :: ji, jj, jk ! dummy loop indices 155 REAL(wp) :: zua, zva ! local scalars 156 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuv_dta ! Read in data 156 157 !!---------------------------------------------------------------------- 157 158 ! 158 159 IF( nn_timing == 1 ) CALL timing_start( 'dyn_dmp' ) 159 160 ! 160 CALL wrk_alloc( jpi, jpj, jpk, 2,zuv_dta )161 CALL wrk_alloc( jpi,jpj,jpk,2, zuv_dta ) 161 162 ! 162 163 ! !== read and interpolate U & V current data at kt ==! … … 220 221 END SELECT 221 222 ! 222 !!gm ! ! Trend diagnostic223 !!gm IF( l_trddyn ) CALL trd_mod( utrdmp, vtrdmp, jpdyn_trd_dat, 'DYN', kt )224 !225 223 ! ! Control print 226 224 IF( ln_ctl ) CALL prt_ctl( tab3d_1=ua(:,:,:), clinfo1=' dmp - Ua: ', mask1=umask, & 227 225 & tab3d_2=va(:,:,:), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 228 226 ! 229 CALL wrk_dealloc( jpi, jpj, jpk, 2,zuv_dta )227 CALL wrk_dealloc( jpi,jpj,jpk,2, zuv_dta ) 230 228 ! 231 229 IF( nn_timing == 1 ) CALL timing_stop( 'dyn_dmp') -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
r5845 r6004 18 18 #endif 19 19 USE dyncor_c1d ! Coriolis term (c1d case) (dyn_cor_1d ) 20 USE dynnxt _c1d! time-stepping (dyn_nxt routine)20 USE dynnxt ! time-stepping (dyn_nxt routine) 21 21 USE dyndmp ! U & V momentum damping (dyn_dmp routine) 22 22 USE restart ! restart … … 30 30 # include "zdfddm_substitute.h90" 31 31 !!---------------------------------------------------------------------- 32 !! NEMO/C1D 3. 3 , NEMO Consortium (2010)32 !! NEMO/C1D 3.7 , NEMO Consortium (2015) 33 33 !! $Id$ 34 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 54 54 !!---------------------------------------------------------------------- 55 55 INTEGER, INTENT(in) :: kstp ! ocean time-step index 56 ! 56 57 INTEGER :: jk ! dummy loop indice 57 58 INTEGER :: indic ! error indicator if < 0 … … 138 139 CALL dyn_cor_c1d( kstp ) ! vorticity term including Coriolis 139 140 CALL dyn_zdf ( kstp ) ! vertical diffusion 140 CALL dyn_nxt _c1d( kstp ) ! lateral velocity at next time step141 CALL dyn_nxt ( kstp ) ! lateral velocity at next time step 141 142 142 143 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
r5845 r6004 354 354 355 355 !!====================================================================== 356 357 356 END MODULE crs 358 357 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
r5845 r6004 342 342 !! History. 4 Jun. Write for WGT and scale factors only 343 343 !!---------------------------------------------------------------- 344 !! 345 !! Arguments 346 CHARACTER(len=1), INTENT(in) :: cd_type ! grid type U,V 347 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in) :: p_mask ! Parent grid U,V mask 348 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e1 ! Parent grid U,V scale factors (e1) 349 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: p_e2 ! Parent grid U,V scale factors (e2) 350 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in) :: p_e3 ! Parent grid vertical level thickness (e3u, e3v) 351 352 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld1_crs ! Coarse grid box 3D quantity 353 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld2_crs ! Coarse grid box 3D quantity 354 355 !! Local variables 356 REAL(wp) :: zdAm 357 INTEGER :: ji, jj, jk , ii, ij, je_2 358 359 REAL(wp), DIMENSION(:,:,:), POINTER :: zvol, zmask 344 CHARACTER(len=1), INTENT(in ) :: cd_type ! grid type U,V 345 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: p_mask ! Parent grid U,V mask 346 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: p_e1 ! Parent grid U,V scale factors (e1) 347 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: p_e2 ! Parent grid U,V scale factors (e2) 348 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: p_e3 ! Parent grid vertical level thickness (e3u, e3v) 349 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( out) :: p_fld1_crs ! Coarse grid box 3D quantity 350 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( out) :: p_fld2_crs ! Coarse grid box 3D quantity 351 ! 352 INTEGER :: ji, jj, jk , ii, ij, je_2 353 REAL(wp) :: zdAm 354 REAL(wp), DIMENSION(:,:,:), POINTER :: zvol, zmask 360 355 !!---------------------------------------------------------------- 361 362 CALL wrk_alloc( jpi, jpj, jpk,zvol, zmask )363 364 p_fld1_crs(:,:,:) = 0. 0365 p_fld2_crs(:,:,:) = 0. 0356 ! 357 CALL wrk_alloc( jpi,jpj,jpk, zvol, zmask ) 358 ! 359 p_fld1_crs(:,:,:) = 0._wp 360 p_fld2_crs(:,:,:) = 0._wp 366 361 367 362 DO jk = 1, jpk 368 363 zvol(:,:,jk) = p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk) 369 END DO370 371 zmask(:,:,:) = 0. 0364 END DO 365 366 zmask(:,:,:) = 0._wp 372 367 IF( cd_type == 'W' ) THEN 373 368 zmask(:,:,1) = p_mask(:,:,1) … … 478 473 !! 5 Jun. Streamline for area-weighted average only ; separate scale factor and weights. 479 474 !!---------------------------------------------------------------- 480 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_fld ! T, U, V or W on parent grid481 CHARACTER(len=3), INTENT(in) :: cd_op ! Operation SUM, MAX or MIN475 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_fld ! T, U, V or W on parent grid 476 CHARACTER(len=3), INTENT(in) :: cd_op ! Operation SUM, MAX or MIN 482 477 CHARACTER(len=1), INTENT(in) :: cd_type ! grid type U,V 483 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T,U,V mask484 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: p_e12 ! Parent grid T,U,V scale factors (e1 or e2)485 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness (e3u, e3v)478 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask ! Parent grid T,U,V mask 479 REAL(wp), DIMENSION(jpi,jpj), INTENT(in), OPTIONAL :: p_e12 ! Parent grid T,U,V scale factors (e1 or e2) 480 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3 ! Parent grid vertical level thickness (e3u, e3v) 486 481 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator 487 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs 488 REAL(wp), INTENT(in) :: psgn ! sign489 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( out) :: p_fld_crs ! Coarse grid box 3D quantity490 ! 491 INTEGER :: ji, jj, jk492 INTEGER :: ii, ij, ijie, ijje, je_2493 REAL(wp) :: zflcrs, zsfcrs494 REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask482 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V maska 483 REAL(wp), INTENT(in) :: psgn ! sign 484 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT( out) :: p_fld_crs ! Coarse grid box 3D quantity 485 ! 486 INTEGER :: ji, jj, jk 487 INTEGER :: ii, ij, ijie, ijje, je_2 488 REAL(wp) :: zflcrs, zsfcrs 489 REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask 495 490 !!---------------------------------------------------------------- 496 491 ! … … 498 493 ! 499 494 SELECT CASE ( cd_op ) 500 501 502 503 CALL wrk_alloc( jpi, jpj, jpk,zsurf, zsurfmsk )504 505 506 507 508 495 ! 496 CASE ( 'VOL' ) 497 ! 498 CALL wrk_alloc( jpi,jpj,jpk, zsurf, zsurfmsk ) 499 ! 500 SELECT CASE ( cd_type ) 501 ! 502 CASE( 'T', 'W' ) 503 IF( cd_type == 'T' ) THEN 509 504 DO jk = 1, jpk 510 505 zsurf (:,:,jk) = p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk) … … 1140 1135 !! 5 Jun. Streamline for area-weighted average only ; separate scale factor and weights. 1141 1136 !!---------------------------------------------------------------- 1142 !!1143 !! Arguments1144 1137 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: p_fld ! T, U, V or W on parent grid 1145 1138 CHARACTER(len=3), INTENT(in) :: cd_op ! Operation SUM, MAX or MIN … … 1151 1144 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs ! Coarse grid T,U,V mask 1152 1145 REAL(wp), INTENT(in) :: psgn 1153 1154 1146 REAL(wp), DIMENSION(jpi_crs,jpj_crs) , INTENT(out) :: p_fld_crs ! Coarse grid box 3D quantity 1155 1156 !! Local variables 1147 ! 1157 1148 INTEGER :: ji, jj, jk ! dummy loop indices 1158 1149 INTEGER :: ijie, ijje, ii, ij, je_2 1159 1150 REAL(wp) :: zflcrs, zsfcrs 1160 1151 REAL(wp), DIMENSION(:,:), POINTER :: zsurfmsk 1161 1162 1152 !!---------------------------------------------------------------- 1163 1164 p_fld_crs(:,:) = 0. 01165 1153 ! 1154 p_fld_crs(:,:) = 0._wp 1155 ! 1166 1156 SELECT CASE ( cd_op ) 1167 1157 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
r5845 r6004 1 1 MODULE crslbclnk 2 3 2 !!====================================================================== 4 3 !! *** MODULE crslbclnk *** … … 8 7 !! History : ! 2012-06 (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code 9 8 !!---------------------------------------------------------------------- 9 USE par_kind, ONLY: wp 10 10 USE dom_oce 11 11 USE crs 12 ! 12 13 USE lbclnk 13 USE par_kind, ONLY: wp14 14 USE in_out_manager 15 15 … … 37 37 !! Upon exiting, switch back to full domain indices. 38 38 !!---------------------------------------------------------------------- 39 CHARACTER(len=1) , INTENT(in ) :: cd_type1 ! grid type 40 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 41 42 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: pt3d1 ! 3D array on which the lbc is applied 43 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! valeur sur les halo 44 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 39 CHARACTER(len=1) , INTENT(in ) :: cd_type1 ! grid type 40 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 41 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: pt3d1 ! 3D array on which the lbc is applied 42 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! valeur sur les halo 43 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! MPP only (here do nothing) 45 44 ! 46 LOGICAL 47 REAL(wp) :: zval! valeur sur les halo45 LOGICAL :: ll_grid_crs 46 REAL(wp) :: zval ! valeur sur les halo 48 47 !!---------------------------------------------------------------------- 49 48 ! 50 49 ll_grid_crs = ( jpi == jpi_crs ) 51 50 ! 52 51 IF( PRESENT(pval) ) THEN ; zval = pval 53 ELSE ; zval = 0. 052 ELSE ; zval = 0._wp 54 53 ENDIF 55 56 IF( .NOT. 57 54 ! 55 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 56 ! 58 57 IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval ) 59 58 ELSE ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval ) 60 59 ENDIF 61 62 IF( .NOT. 63 60 ! 61 IF( .NOT.ll_grid_crs ) CALL dom_grid_glo ! Return to parent grid domain 62 ! 64 63 END SUBROUTINE crs_lbc_lnk_3d 64 65 65 66 66 SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) … … 74 74 !! Upon exiting, switch back to full domain indices. 75 75 !!---------------------------------------------------------------------- 76 !! Arguments 77 CHARACTER(len=1) , INTENT(in ) :: cd_type1,cd_type2 ! grid type 78 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 79 80 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: pt3d1,pt3d2 ! 3D array on which the lbc is applied 81 82 !! local vairables 83 LOGICAL :: ll_grid_crs 76 CHARACTER(len=1) , INTENT(in ) :: cd_type1, cd_type2 ! grid type 77 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 78 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied 79 ! 80 LOGICAL :: ll_grid_crs 84 81 !!---------------------------------------------------------------------- 85 82 ! 86 83 ll_grid_crs = ( jpi == jpi_crs ) 87 88 IF( .NOT. 89 84 ! 85 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 86 ! 90 87 CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 91 92 IF( .NOT. 93 88 ! 89 IF( .NOT.ll_grid_crs ) CALL dom_grid_glo ! Return to parent grid domain 90 ! 94 91 END SUBROUTINE crs_lbc_lnk_3d_gather 95 92 … … 106 103 !! Upon exiting, switch back to full domain indices. 107 104 !!---------------------------------------------------------------------- 108 !! Arguments 109 CHARACTER(len=1) , INTENT(in ) :: cd_type ! grid type 110 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 111 112 REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 113 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! valeur sur les halo 114 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 115 !! local variables 116 117 LOGICAL :: ll_grid_crs 118 REAL(wp) :: zval ! valeur sur les halo 119 105 CHARACTER(len=1) , INTENT(in ) :: cd_type ! grid type 106 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 107 REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 108 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! valeur sur les halo 109 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! MPP only (here do nothing) 110 ! 111 LOGICAL :: ll_grid_crs 112 REAL(wp) :: zval ! valeur sur les halo 120 113 !!---------------------------------------------------------------------- 121 114 ! 122 115 ll_grid_crs = ( jpi == jpi_crs ) 123 116 ! 124 117 IF( PRESENT(pval) ) THEN ; zval = pval 125 ELSE ; zval = 0. 0118 ELSE ; zval = 0._wp 126 119 ENDIF 127 128 IF( .NOT. 129 120 ! 121 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 122 ! 130 123 IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval ) 131 124 ELSE ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval ) 132 125 ENDIF 133 134 IF( .NOT. 135 126 ! 127 IF( .NOT.ll_grid_crs ) CALL dom_grid_glo ! Return to parent grid domain 128 ! 136 129 END SUBROUTINE crs_lbc_lnk_2d 137 130 138 131 !!====================================================================== 139 132 END MODULE crslbclnk -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r5883 r6004 104 104 END DO 105 105 IF( ln_linssh ) THEN 106 IF 106 IF( ln_isfcav ) THEN 107 107 DO ji=1,jpi 108 108 DO jj=1,jpj … … 167 167 END DO 168 168 IF( ln_linssh ) THEN 169 IF 169 IF( ln_isfcav ) THEN 170 170 DO ji=1,jpi 171 171 DO jj=1,jpj -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
r5586 r6004 14 14 USE dom_oce ! ocean space and time domain 15 15 USE phycst 16 USE dynspg_oce17 USE dynspg_ts18 16 USE daymod 19 17 USE tide_mod -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r5866 r6004 110 110 ! 111 111 IF( ln_linssh ) THEN 112 IF 112 IF( ln_isfcav ) THEN 113 113 DO ji=1,jpi 114 114 DO jj=1,jpj 115 115 z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem) 116 116 z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal) 117 END DO118 END DO117 END DO 118 END DO 119 119 ELSE 120 120 z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) … … 146 146 ! heat & salt content variation (associated with ssh) 147 147 IF( ln_linssh ) THEN 148 IF 148 IF( ln_isfcav ) THEN 149 149 DO ji = 1, jpi 150 150 DO jj = 1, jpj … … 163 163 DO jk = 1, jpkm1 164 164 ! volume variation (calculated with scale factors) 165 zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk) &165 zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk) & 166 166 & * ( e3t_n(:,:,jk) - e3t_ini(:,:,jk) ) ) 167 167 ! heat content variation 168 zdiff_hc = zdiff_hc + glob_sum( surf(:,:) * tmask(:,:,jk) &168 zdiff_hc = zdiff_hc + glob_sum( surf(:,:) * tmask(:,:,jk) & 169 169 & * ( e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - hc_loc_ini(:,:,jk) ) ) 170 170 ! salt content variation 171 zdiff_sc = zdiff_sc + glob_sum( surf(:,:) * tmask(:,:,jk) &171 zdiff_sc = zdiff_sc + glob_sum( surf(:,:) * tmask(:,:,jk) & 172 172 & * ( e3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - sc_loc_ini(:,:,jk) ) ) 173 END DO173 END DO 174 174 175 175 ! Substract forcing from heat content, salt content and volume variations … … 199 199 !!gm end 200 200 201 IF( .NOT.ln_linssh ) THEN 202 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C) 203 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity variation (psu) 204 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J) 205 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content variation (psu*km3) 206 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3) 207 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t variation (km3) 208 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 209 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 210 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 211 ELSE 201 IF( ln_linssh ) THEN 212 202 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content variation (C) 213 203 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content variation (psu) … … 220 210 CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C) 221 211 CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu) 212 ELSE 213 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C) 214 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity variation (psu) 215 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J) 216 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content variation (psu*km3) 217 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3) 218 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t variation (km3) 219 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 220 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 221 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 222 222 ENDIF 223 223 ! 224 224 IF( lrst_oce ) CALL dia_hsb_rst( kt, 'WRITE' ) 225 225 ! 226 226 CALL wrk_dealloc( jpi,jpj, z2d0, z2d1 ) 227 227 ! 228 228 IF( nn_timing == 1 ) CALL timing_stop('dia_hsb') 229 229 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r5866 r6004 52 52 !!--------------------------------------------------------------------- 53 53 ! 54 ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc)54 ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc ) 55 55 ! 56 56 IF( lk_mpp ) CALL mpp_sum ( dia_hth_alloc ) … … 108 108 IF( kt == nit000 ) THEN 109 109 ! ! allocate dia_hth array 110 IF( dia_hth_alloc() /= 0 ) CALL ctl_stop( 'STOP', ' lim_sbc_init: unable to allocate standard arrays' )111 112 IF(. not. ALLOCATED(ik20))THEN110 IF( dia_hth_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard arrays' ) 111 112 IF(.NOT. ALLOCATED(ik20) ) THEN 113 113 ALLOCATE(ik20(jpi,jpj), ik28(jpi,jpj), & 114 114 & zabs2(jpi,jpj), & … … 311 311 END DO 312 312 ! surface boundary condition 313 IF( .NOT.ln_linssh ) THEN ; zthick(:,:) = 0._wp ; htc3(:,:) = 0._wp314 ELSE ; zthick(:,:) = sshn(:,:) ; htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1)313 IF( ln_linssh ) THEN ; zthick(:,:) = sshn(:,:) ; htc3(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) * tmask(:,:,1) 314 ELSE ; zthick(:,:) = 0._wp ; htc3(:,:) = 0._wp 315 315 ENDIF 316 316 ! integration down to ilevel … … 323 323 DO jj = 1, jpj 324 324 DO ji = 1, jpi 325 htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( e3t_n(ji,jj,ilevel+1), zthick(ji,jj) )&326 325 htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) & 326 & * MIN( e3t_n(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1) 327 327 END DO 328 328 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r5845 r6004 120 120 zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc 121 121 zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc 122 END DO123 END DO124 END DO122 END DO 123 END DO 124 END DO 125 125 DO jn = 1, nptr 126 126 zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5866 r6004 31 31 USE ldftra ! lateral physics: eddy diffusivity coef. 32 32 USE ldfdyn ! lateral physics: eddy viscosity coef. 33 USE sol_oce ! solver variables34 33 USE sbc_oce ! Surface boundary condition: ocean fields 35 34 USE sbc_ice ! Surface boundary condition: ice fields … … 48 47 USE iom 49 48 USE ioipsl 50 USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities51 49 52 50 #if defined key_lim2 … … 207 205 CALL iom_put( "sbu", z2d ) ! bottom i-current 208 206 ENDIF 209 #if defined key_dynspg_ts210 CALL iom_put( "ubar", un_adv(:,:) ) ! barotropic i-current211 #else212 CALL iom_put( "ubar", un_b(:,:) ) ! barotropic i-current213 #endif214 207 215 208 CALL iom_put( "voce", vn(:,:,:) ) ! 3D j-current … … 224 217 CALL iom_put( "sbv", z2d ) ! bottom j-current 225 218 ENDIF 226 #if defined key_dynspg_ts227 CALL iom_put( "vbar", vn_adv(:,:) ) ! barotropic j-current228 #else229 CALL iom_put( "vbar", vn_b(:,:) ) ! barotropic j-current230 #endif231 219 232 220 CALL iom_put( "woce", wn ) ! vertical velocity -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r5563 r6004 26 26 !! 27 27 !!---------------------------------------------------------------------- 28 USE dom_oce 29 USE phycst 30 USE in_out_manager 31 USE iom 32 USE ioipsl , ONLY : ymds2ju ! for calendar33 USE prtctl 34 USE trc_oce , ONLY : lk_offline ! offline flag35 USE timing 36 USE restart 28 USE dom_oce ! ocean space and time domain 29 USE phycst ! physical constants 30 USE in_out_manager ! I/O manager 31 USE iom ! 32 USE ioipsl , ONLY : ymds2ju ! for calendar 33 USE prtctl ! Print control 34 USE trc_oce , ONLY : lk_offline ! offline flag 35 USE timing ! Timing 36 USE restart ! restart 37 37 38 38 IMPLICIT NONE … … 43 43 PUBLIC day_mth ! Needed by TAM 44 44 45 INTEGER, PUBLIC :: nsecd, nsecd05, ndt, ndt05 !(PUBLIC for TAM)45 INTEGER, PUBLIC :: nsecd, nsecd05, ndt, ndt05 !: (PUBLIC for TAM) 46 46 47 47 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r5866 r6004 46 46 LOGICAL , PUBLIC :: ln_crs !: Apply grid coarsening to dynamical model output or online passive tracers 47 47 48 !! Free surface parameters 49 !! ======================= 50 LOGICAL , PUBLIC :: ln_dynspg_exp !: Explicit free surface flag 51 LOGICAL , PUBLIC :: ln_dynspg_ts !: Split-Explicit free surface flag 52 48 53 !! Time splitting parameters 49 54 !! ========================= 50 55 LOGICAL, PUBLIC :: ln_bt_fw !: Forward integration of barotropic sub-stepping 51 56 LOGICAL, PUBLIC :: ln_bt_av !: Time averaging of barotropic variables 52 LOGICAL, PUBLIC :: ln_bt_ nn_auto!: Set number of barotropic iterations automatically57 LOGICAL, PUBLIC :: ln_bt_auto !: Set number of barotropic iterations automatically 53 58 INTEGER, PUBLIC :: nn_bt_flt !: Filter choice 54 59 INTEGER, PUBLIC :: nn_baro !: Number of barotropic iterations during one baroclinic step (rdt) 55 REAL(wp), PUBLIC :: rn_bt_cmax !: Maximum allowed courant number (used if ln_bt_ nn_auto=T)60 REAL(wp), PUBLIC :: rn_bt_cmax !: Maximum allowed courant number (used if ln_bt_auto=T) 56 61 57 62 !! Horizontal grid parameters for domhgr 58 63 !! ===================================== 59 INTEGER :: jphgr_msh !: type of horizontal mesh64 INTEGER :: jphgr_msh !: type of horizontal mesh 60 65 ! ! = 0 curvilinear coordinate on the sphere read in coordinate.nc 61 66 ! ! = 1 geographical mesh on the sphere with regular grid-spacing … … 64 69 ! ! = 4 Mercator grid with T/U point at the equator 65 70 66 REAL(wp) :: ppglam0 67 REAL(wp) :: ppgphi0 71 REAL(wp) :: ppglam0 !: longitude of first raw and column T-point (jphgr_msh = 1) 72 REAL(wp) :: ppgphi0 !: latitude of first raw and column T-point (jphgr_msh = 1) 68 73 ! ! used for Coriolis & Beta parameters (jphgr_msh = 2 or 3) 69 REAL(wp) :: ppe1_deg 70 REAL(wp) :: ppe2_deg 71 REAL(wp) :: ppe1_m 72 REAL(wp) :: ppe2_m 74 REAL(wp) :: ppe1_deg !: zonal grid-spacing (degrees) 75 REAL(wp) :: ppe2_deg !: meridional grid-spacing (degrees) 76 REAL(wp) :: ppe1_m !: zonal grid-spacing (degrees) 77 REAL(wp) :: ppe2_m !: meridional grid-spacing (degrees) 73 78 74 79 !! Vertical grid parameter for domzgr 75 80 !! ================================== 76 REAL(wp) :: ppsur 77 REAL(wp) :: ppa0 78 REAL(wp) :: ppa1 79 REAL(wp) :: ppkth 80 REAL(wp) :: ppacr 81 REAL(wp) :: ppsur !: ORCA r4, r2 and r05 coefficients 82 REAL(wp) :: ppa0 !: (default coefficients) 83 REAL(wp) :: ppa1 !: 84 REAL(wp) :: ppkth !: 85 REAL(wp) :: ppacr !: 81 86 ! 82 87 ! If both ppa0 ppa1 and ppsur are specified to 0, then 83 88 ! they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr 84 REAL(wp) :: ppdzmin 85 REAL(wp) :: pphmax 89 REAL(wp) :: ppdzmin !: Minimum vertical spacing 90 REAL(wp) :: pphmax !: Maximum depth 86 91 ! 87 LOGICAL :: ldbletanh 88 REAL(wp) :: ppa2 89 REAL(wp) :: ppkth2 90 REAL(wp) :: ppacr2 92 LOGICAL :: ldbletanh !: Use/do not use double tanf function for vertical coordinates 93 REAL(wp) :: ppa2 !: Double tanh function parameters 94 REAL(wp) :: ppkth2 !: 95 REAL(wp) :: ppacr2 !: 91 96 92 97 ! !! old non-DOCTOR names still used in the model … … 102 107 REAL(wp), PUBLIC :: rdth !: depth variation of tracer step 103 108 104 ! !!! associated variables 105 INTEGER , PUBLIC :: neuler !: restart euler forward option (0=Euler) 106 REAL(wp), PUBLIC :: atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 109 ! !!! associated variables 110 INTEGER , PUBLIC :: neuler !: restart euler forward option (0=Euler) 111 REAL(wp), PUBLIC :: atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 112 107 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttra !: vertical profile of tracer time step 108 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: r2dtra !: = 2*rdttra except at nit000 (=rdttra) if neuler=0 … … 211 217 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3tp , e3wp !: ocean bottom level thickness at T and W points 212 218 219 !!gm This should be removed from here.... ==>>> only used in domzgr at initialization phase 213 220 !! s-coordinate and hybrid z-s-coordinate 214 221 !! =----------------======--------------- … … 224 231 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hift , hifu !: and quasi-uniform spacing t--u points (m) 225 232 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rx1 !: Maximum grid stiffness ratio 233 !!gm end 226 234 227 235 !!---------------------------------------------------------------------- … … 229 237 !! --------------------------------------------------------------------- 230 238 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbathy !: number of ocean level (=0, 1, ... , jpk-1) 231 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt !: vertical index of the bottom last T- ocean level 232 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbku, mbkv !: vertical index of the bottom last U- and W- ocean level 233 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bathy !: ocean depth (meters) 239 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt, mbku, mbkv !: vertical index of the bottom last T-, U- & V ocean level 240 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bathy !: ocean depth (meters) 234 241 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i, umask_i, vmask_i, fmask_i !: interior domain T-point mask 235 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bmask !: land/ocean mask of barotropic stream function236 242 237 243 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: misfdep !: top first ocean level (ISF) … … 364 370 ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) , & 365 371 & tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), & 366 & bmask (jpi,jpj) , &367 372 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 368 373 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r5883 r6004 13 13 !! 3.3 ! 2010-11 (G. Madec) initialisation in C1D configuration 14 14 !! 3.6 ! 2013 ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs 15 !! - !2015-11 (G. Madec, A. Coward) time varying zgr by default15 !! 3.7 ! 2015-11 (G. Madec, A. Coward) time varying zgr by default 16 16 !!---------------------------------------------------------------------- 17 17 … … 70 70 !! - 1D configuration, move Coriolis, u and v at T-point 71 71 !!---------------------------------------------------------------------- 72 INTEGER :: jk ! dummy loop argument72 INTEGER :: jk ! dummy loop indices 73 73 INTEGER :: iconf = 0 ! local integers 74 REAL(wp), POINTER, DIMENSION(:,:) ::z1_hu_0, z1_hv_074 REAL(wp), POINTER, DIMENSION(:,:) :: z1_hu_0, z1_hv_0 75 75 !!---------------------------------------------------------------------- 76 76 ! … … 427 427 INTEGER :: ji, jj, jk 428 428 REAL(wp) :: zrxmax 429 REAL(wp), DIMENSION(4) :: zr1429 REAL(wp), DIMENSION(4) :: zr1 430 430 !!---------------------------------------------------------------------- 431 431 rx1(:,:) = 0._wp … … 444 444 & / ( gdepw_0(ji+1,jj,jk )+gdepw_0(ji ,jj,jk ) & 445 445 & -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) + rsmall ) ) * umask(ji ,jj,jk) 446 zr1(3) = ABS( (gdepw_0(ji,jj+1,jk )-gdepw_0(ji,jj ,jk ) &446 zr1(3) = ABS( ( gdepw_0(ji,jj+1,jk )-gdepw_0(ji,jj ,jk ) & 447 447 & +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) ) & 448 448 & / ( gdepw_0(ji,jj+1,jk )+gdepw_0(ji,jj ,jk ) & -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r5845 r6004 391 391 ! 392 392 #if defined key_agrif 393 IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN ! for EEL6 configuration only 394 IF( .NOT. Agrif_Root() ) THEN 395 zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2 )*Agrif_Parent(ppe2_m) & 396 & / (ra * rad) ! CAUTIOn : split in 2 lignes for AGRIF 393 IF( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN ! for EEL6 configuration only 394 IF( .NOT.Agrif_Root() ) THEN 395 zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 397 396 ENDIF 398 397 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r5845 r6004 7 7 !! 6.0 ! 1993-03 (M. Guyon) symetrical conditions (M. Guyon) 8 8 !! 7.0 ! 1996-01 (G. Madec) suppression of common work arrays 9 !! - ! 1996-05 (G. Madec) mask computed from tmask and sup- 10 !! ! pression of the double computation of bmask 9 !! - ! 1996-05 (G. Madec) mask computed from tmask 11 10 !! 8.0 ! 1997-02 (G. Madec) mesh information put in domhgr.F 12 11 !! 8.1 ! 1997-07 (G. Madec) modification of mbathy and fmask … … 25 24 USE oce ! ocean dynamics and tracers 26 25 USE dom_oce ! ocean space and time domain 26 ! 27 27 USE in_out_manager ! I/O manager 28 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 USE lib_mpp 30 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 29 USE lib_mpp ! 31 30 USE wrk_nemo ! Memory allocation 32 31 USE timing ! Timing … … 35 34 PRIVATE 36 35 37 PUBLIC dom_msk 36 PUBLIC dom_msk ! routine called by inidom.F90 38 37 39 38 ! !!* Namelist namlbc : lateral boundary condition * … … 90 89 !! 91 90 !! N.B. If nperio not equal to 0, the land/ocean mask arrays 92 !! are defined with the proper value at lateral domain boundaries, 93 !! but bmask. indeed, bmask defined the domain over which the 94 !! barotropic stream function is computed. this domain cannot 95 !! contain identical columns because the matrix associated with 96 !! the barotropic stream function equation is then no more inverti- 97 !! ble. therefore bmask is set to 0 along lateral domain boundaries 98 !! even IF nperio is not zero. 91 !! are defined with the proper value at lateral domain boundaries. 99 92 !! 100 93 !! In case of open boundaries (lk_bdy=T): 101 94 !! - tmask is set to 1 on the points to be computed bay the open 102 95 !! boundaries routines. 103 !! - bmask is set to 0 on the open boundaries.104 96 !! 105 97 !! ** Action : tmask : land/ocean mask at t-point (=0. or 1.) … … 108 100 !! fmask : land/ocean mask at f-point (=0. or 1.) 109 101 !! =rn_shlat along lateral boundaries 110 !! bmask : land/ocean mask at barotropic stream111 !! function point (=0. or 1.) and set to 0 along lateral boundaries112 102 !! tmask_i : interior ocean mask 113 103 !!---------------------------------------------------------------------- … … 255 245 END DO 256 246 257 ! 4. ocean/land mask for the elliptic equation258 ! --------------------------------------------259 bmask(:,:) = ssmask(:,:) ! elliptic equation is written at t-point260 !261 ! ! Boundary conditions262 ! ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi263 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN264 bmask( 1 ,:) = 0._wp265 bmask(jpi,:) = 0._wp266 ENDIF267 IF( nperio == 2 ) THEN ! south symmetric : bmask must be set to 0. on row 1268 bmask(:, 1 ) = 0._wp269 ENDIF270 ! ! north fold :271 IF( nperio == 3 .OR. nperio == 4 ) THEN ! T-pt pivot : bmask set to 0. on row jpj and on half jpjglo-1 row272 DO ji = 1, jpi273 ii = ji + nimpp - 1274 bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii)275 bmask(ji,jpj ) = 0._wp276 END DO277 ENDIF278 IF( nperio == 5 .OR. nperio == 6 ) THEN ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj279 bmask(:,jpj) = 0._wp280 ENDIF281 !282 IF( lk_mpp ) THEN ! mpp specificities283 ! ! bmask is set to zero on the overlap region284 IF( nbondi /= -1 .AND. nbondi /= 2 ) bmask( 1 :jpreci,:) = 0._wp285 IF( nbondi /= 1 .AND. nbondi /= 2 ) bmask(nlci:jpi ,:) = 0._wp286 IF( nbondj /= -1 .AND. nbondj /= 2 ) bmask(:, 1 :jprecj) = 0._wp287 IF( nbondj /= 1 .AND. nbondj /= 2 ) bmask(:,nlcj:jpj ) = 0._wp288 !289 IF( npolj == 3 .OR. npolj == 4 ) THEN ! north fold : bmask must be set to 0. on rows jpj-1 and jpj290 DO ji = 1, nlci291 ii = ji + nimpp - 1292 bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii)293 bmask(ji,nlcj ) = 0._wp294 END DO295 ENDIF296 IF( npolj == 5 .OR. npolj == 6 ) THEN ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj297 DO ji = 1, nlci298 bmask(ji,nlcj ) = 0._wp299 END DO300 ENDIF301 ENDIF302 303 247 ! Lateral boundary conditions on velocity (modify fmask) 304 248 ! --------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r5883 r6004 64 64 # include "vectopt_loop_substitute.h90" 65 65 !!---------------------------------------------------------------------- 66 !! NEMO/OPA 3. 3 , NEMO-Consortium (2010)66 !! NEMO/OPA 3.7 , NEMO-Consortium (2015) 67 67 !! $Id$ 68 68 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 120 120 !!---------------------------------------------------------------------- 121 121 ! 122 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_init')122 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_init') 123 123 ! 124 124 IF(lwp) WRITE(numout,*) … … 270 270 INTEGER, INTENT( in ), OPTIONAL :: kcall ! optional argument indicating call sequence 271 271 ! 272 INTEGER :: ji, jj, jk ! dummy loop indices 273 INTEGER , DIMENSION(3) :: ijk_max, ijk_min ! temporary integers 274 REAL(wp) :: z2dt ! temporary scalars 275 REAL(wp) :: z_tmin, z_tmax ! temporary scalars 276 LOGICAL :: ll_do_bclinic ! temporary logical 277 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t 278 REAL(wp), POINTER, DIMENSION(:,: ) :: zht, z_scale, zwu, zwv, zhdiv 272 INTEGER :: ji, jj, jk ! dummy loop indices 273 INTEGER , DIMENSION(3) :: ijk_max, ijk_min ! temporary integers 274 REAL(wp) :: z2dt, z_tmin, z_tmax ! local scalars 275 LOGICAL :: ll_do_bclinic ! local logical 276 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t 277 REAL(wp), POINTER, DIMENSION(:,: ) :: zht, z_scale, zwu, zwv, zhdiv 279 278 !!---------------------------------------------------------------------- 280 279 ! 281 280 IF( ln_linssh ) RETURN ! No calculation in linear free surface 282 281 ! 283 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_sf_nxt')282 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_sf_nxt') 284 283 ! 285 284 CALL wrk_alloc( jpi,jpj,zht, z_scale, zwu, zwv, zhdiv ) 286 285 CALL wrk_alloc( jpi,jpj,jpk, ze3t ) 287 286 288 IF( kt == nit000)THEN287 IF( kt == nit000 ) THEN 289 288 IF(lwp) WRITE(numout,*) 290 289 IF(lwp) WRITE(numout,*) 'dom_vvl_sf_nxt : compute after scale factors' … … 312 311 IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate ! 313 312 ! ! ------baroclinic part------ ! 314 315 313 ! I - initialization 316 314 ! ================== … … 638 636 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 639 637 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 640 gdept_n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk)) &641 & + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk))638 gdept_n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk) ) & 639 & + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk) ) 642 640 gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj) 643 641 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r5866 r6004 158 158 ! 159 159 IF( nprint == 1 .AND. lwp ) THEN 160 WRITE(numout,*) ' MIN val mbathy ', MINVAL(mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )160 WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 161 161 WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ), & 162 & ' w ',MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) )163 WRITE(numout,*) ' MIN val e3 t ', MINVAL( e3t_0(:,:,:) ), ' f ', MINVAL(e3f_0(:,:,:) ), &164 & ' u ', MINVAL( e3u_0(:,:,:) ), ' u ', MINVAL(e3v_0(:,:,:) ), &165 & ' uw', MINVAL( e3uw_0(:,:,:)), ' vw', MINVAL(e3vw_0(:,:,:)), &166 & ' w ', MINVAL(e3w_0(:,:,:) )162 & ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) ) 163 WRITE(numout,*) ' MIN val e3 t ', MINVAL( e3t_0(:,:,:) ), ' f ', MINVAL( e3f_0(:,:,:) ), & 164 & ' u ', MINVAL( e3u_0(:,:,:) ), ' u ', MINVAL( e3v_0(:,:,:) ), & 165 & ' uw', MINVAL( e3uw_0(:,:,:) ), ' vw', MINVAL( e3vw_0(:,:,:)), & 166 & ' w ', MINVAL( e3w_0(:,:,:) ) 167 167 168 168 WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ), & 169 & ' w ',MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) )170 WRITE(numout,*) ' MAX val e3 t ', MAXVAL( e3t_0(:,:,:) ), ' f ', MAXVAL(e3f_0(:,:,:) ), &171 & ' u ', MAXVAL( e3u_0(:,:,:) ), ' u ', MAXVAL(e3v_0(:,:,:) ), &172 & ' uw', MAXVAL( e3uw_0(:,:,:)), ' vw', MAXVAL( e3vw_0(:,:,:)),&173 & ' w ', MAXVAL(e3w_0(:,:,:) )169 & ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) ) 170 WRITE(numout,*) ' MAX val e3 t ', MAXVAL( e3t_0(:,:,:) ), ' f ', MAXVAL( e3f_0(:,:,:) ), & 171 & ' u ', MAXVAL( e3u_0(:,:,:) ), ' u ', MAXVAL( e3v_0(:,:,:) ), & 172 & ' uw', MAXVAL( e3uw_0(:,:,:) ), ' vw', MAXVAL( e3vw_0(:,:,:) ), & 173 & ' w ', MAXVAL( e3w_0(:,:,:) ) 174 174 ENDIF 175 175 ! … … 910 910 !! 911 911 !! ** Purpose : the depth and vertical scale factor in partial step 912 !! reference z-coordinate case912 !! reference z-coordinate case 913 913 !! 914 914 !! ** Method : Partial steps : computes the 3D vertical scale factors … … 1180 1180 ! Compute gde3w_0 (vertical sum of e3w) 1181 1181 IF ( ln_isfcav ) THEN ! if cavity 1182 WHERE (misfdep == 0)misfdep = 11182 WHERE( misfdep == 0 ) misfdep = 1 1183 1183 DO jj = 1,jpj 1184 1184 DO ji = 1,jpi … … 1187 1187 gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 1188 1188 END DO 1189 IF (misfdep(ji,jj) .GE. 2)gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj))1189 IF( misfdep(ji,jj) >= 2 ) gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 1190 1190 DO jk = misfdep(ji,jj) + 1, jpk 1191 1191 gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) … … 1235 1235 !!--------------------------------------------------------------------- 1236 1236 ! 1237 IF( nn_timing == 1 ) CALL timing_start('zgr_isf')1237 IF( nn_timing == 1 ) CALL timing_start('zgr_isf') 1238 1238 ! 1239 1239 CALL wrk_alloc( jpi,jpj, zbathy, zmask, zrisfdep) … … 1707 1707 CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy ) 1708 1708 ! 1709 IF( nn_timing == 1 ) CALL timing_stop('zgr_isf')1709 IF( nn_timing == 1 ) CALL timing_stop('zgr_isf') 1710 1710 ! 1711 1711 END SUBROUTINE … … 2029 2029 CALL lbc_lnk( e3uw_0, 'U', 1._wp ) 2030 2030 CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 2031 2032 gdepw_n(:,:,:) = gdepw_0(:,:,:)2033 2031 ! 2034 2032 WHERE( e3t_0 (:,:,:) == 0._wp ) e3t_0 (:,:,:) = 1._wp … … 2562 2560 ! 2563 2561 zn1 = 1._wp / REAL( jpkm1, wp ) 2564 zn2 = 1. - zn12562 zn2 = 1._wp - zn1 2565 2563 ! 2566 2564 za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r5883 r6004 35 35 USE dtauvd ! data: U & V current (dta_uvd routine) 36 36 USE domvvl ! varying vertical mesh 37 USE dynspg_oce ! pressure gradient schemes38 USE dynspg_flt ! filtered free surface39 USE sol_oce ! ocean solver variables40 37 ! 41 38 USE in_out_manager ! I/O manager … … 133 130 ! 134 131 ENDIF 135 !136 IF( lk_agrif ) THEN ! read free surface arrays in restart file137 IF( ln_rstart ) THEN138 IF( lk_dynspg_flt ) THEN ! read or initialize the following fields139 ! ! gcx, gcxb for agrif_opa_init140 IF( sol_oce_alloc() > 0 ) CALL ctl_stop('agrif sol_oce_alloc: allocation of arrays failed')141 CALL flt_rst( nit000, 'READ' )142 ENDIF143 ENDIF ! explicit case not coded yet with AGRIF144 ENDIF145 !146 132 ! 147 133 ! Initialize "now" and "before" barotropic velocities: 148 ! Do it whatever the free surface method, these arrays 149 ! being eventually used 150 ! 134 ! Do it whatever the free surface method, these arrays being eventually used 151 135 ! 152 136 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 153 137 ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 154 138 ! 139 !!gm the use of umsak & vmask is not necessary belox as un, vn, ub, vb are always masked 155 140 DO jk = 1, jpkm1 156 141 DO jj = 1, jpj … … 165 150 END DO 166 151 ! 167 un_b(:,:) = un_b(:,:) * r1_hu_n 168 vn_b(:,:) = vn_b(:,:) * r1_hv_n 152 un_b(:,:) = un_b(:,:) * r1_hu_n(:,:) 153 vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:) 169 154 ! 170 155 ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 171 156 vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 172 !173 157 ! 174 158 IF( nn_timing == 1 ) CALL timing_stop('istate_init') … … 438 422 !! p=integral [ rau*g dz ] 439 423 !!---------------------------------------------------------------------- 440 USE dynspg ! surface pressure gradient (dyn_spg routine)441 424 USE divhor ! hor. divergence (div_hor routine) 442 425 USE lbclnk ! ocean lateral boundary condition (or mpp link) 443 426 ! 444 427 INTEGER :: ji, jj, jk ! dummy loop indices 445 INTEGER :: indic ! ???446 428 REAL(wp) :: zmsv, zphv, zmsu, zphu, zalfg ! temporary scalars 447 429 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprn … … 510 492 vb(:,:,:) = vn(:,:,:) 511 493 512 ! WARNING !!!!!513 ! after initializing u and v, we need to calculate the initial streamfunction bsf.514 ! Otherwise, only the trend will be computed and the model will blow up (inconsistency).515 ! to do that, we call dyn_spg with a special trick:516 ! we fill ua and va with the velocities divided by dt, and the streamfunction will be brought to the517 ! right value assuming the velocities have been set up in one time step.518 ! we then set bsfd to zero (first guess for next step is d(psi)/dt = 0.)519 ! sets up s false trend to calculate the barotropic streamfunction.520 521 ua(:,:,:) = ub(:,:,:) / rdt522 va(:,:,:) = vb(:,:,:) / rdt523 524 ! calls dyn_spg. we assume euler time step, starting from rest.525 indic = 0526 CALL dyn_spg( nit000, indic ) ! surface pressure gradient527 !528 ! the new velocity is ua*rdt529 !530 CALL lbc_lnk( ua, 'U', -1. )531 CALL lbc_lnk( va, 'V', -1. )532 533 ub(:,:,:) = ua(:,:,:) * rdt534 vb(:,:,:) = va(:,:,:) * rdt535 ua(:,:,:) = 0.e0536 va(:,:,:) = 0.e0537 un(:,:,:) = ub(:,:,:)538 vn(:,:,:) = vb(:,:,:)539 494 ! 540 495 !!gm Check here call to div_hor should not be necessary -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
r5845 r6004 97 97 READ ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 98 98 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp ) 99 99 ! 100 100 REWIND( numnam_cfg ) ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme 101 101 READ ( numnam_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r5883 r6004 51 51 ! 52 52 INTEGER :: ji, jj, jk ! dummy loop indices 53 REAL(wp) :: zbu, zbv ! local scalars54 53 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw 55 54 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu, zfv … … 58 57 IF( nn_timing == 1 ) CALL timing_start('dyn_adv_cen2') 59 58 ! 60 CALL wrk_alloc( jpi, jpj, jpk,zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )59 CALL wrk_alloc( jpi,jpj,jpk, zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 61 60 ! 62 61 IF( kt == nit000 .AND. lwp ) THEN … … 74 73 ! 75 74 DO jk = 1, jpkm1 ! horizontal transport 76 zfu(:,:,jk) = 0.25 * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)77 zfv(:,:,jk) = 0.25 * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)75 zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 76 zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 78 77 DO jj = 1, jpjm1 ! horizontal momentum fluxes (at T- and F-point) 79 78 DO ji = 1, fs_jpim1 ! vector opt. … … 86 85 DO jj = 2, jpjm1 ! divergence of horizontal momentum fluxes 87 86 DO ji = fs_2, fs_jpim1 ! vector opt. 88 zbu = e1e2u(ji,jj) * e3u_n(ji,jj,jk)89 zbv = e1e2v(ji,jj) * e3v_n(ji,jj,jk)90 !91 87 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 92 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) / zbu88 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 93 89 va(ji,jj,jk) = va(ji,jj,jk) - ( zfu_f(ji,jj ,jk) - zfu_f(ji-1,jj,jk) & 94 & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) / zbv90 & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 95 91 END DO 96 92 END DO … … 134 130 END DO 135 131 END DO 136 !137 132 DO jk = 1, jpkm1 ! divergence of vertical momentum flux divergence 138 133 DO jj = 2, jpjm1 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r5883 r6004 70 70 !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling. 71 71 !!---------------------------------------------------------------------- 72 INTEGER, INTENT(in) :: kt ! ocean time-step index 73 ! 74 INTEGER :: ji, jj, jk ! dummy loop indices 75 REAL(wp) :: zbu, zbv ! temporary scalars 76 REAL(wp) :: zui, zvj, zfuj, zfvi, zl_u, zl_v ! temporary scalars 72 INTEGER, INTENT(in) :: kt ! ocean time-step index 73 ! 74 INTEGER :: ji, jj, jk ! dummy loop indices 75 REAL(wp) :: zui, zvj, zfuj, zfvi, zl_u, zl_v ! local scalars 77 76 REAL(wp), POINTER, DIMENSION(:,:,: ) :: zfu, zfv 78 77 REAL(wp), POINTER, DIMENSION(:,:,: ) :: zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw … … 82 81 IF( nn_timing == 1 ) CALL timing_start('dyn_adv_ubs') 83 82 ! 84 CALL wrk_alloc( jpi, jpj, jpk,zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )85 CALL wrk_alloc( jpi, jpj, jpk, jpts,zlu_uu, zlv_vv, zlu_uv, zlv_vu )83 CALL wrk_alloc( jpi,jpj,jpk, zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 84 CALL wrk_alloc( jpi,jpj,jpk,jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu ) 86 85 ! 87 86 IF( kt == nit000 ) THEN … … 139 138 DO jk = 1, jpkm1 ! ====================== ! 140 139 ! ! horizontal volume fluxes 141 zfu(:,:,jk) = 0.25 * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)142 zfv(:,:,jk) = 0.25 * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)140 zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 141 zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 143 142 ! 144 143 DO jj = 1, jpjm1 ! horizontal momentum fluxes at T- and F-point … … 178 177 DO jj = 2, jpjm1 ! divergence of horizontal momentum fluxes 179 178 DO ji = fs_2, fs_jpim1 ! vector opt. 180 zbu = e1e2u(ji,jj) * e3u_n(ji,jj,jk) 181 zbv = e1e2v(ji,jj) * e3v_n(ji,jj,jk) 182 ! 183 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_t(ji+1,jj ,jk) - zfu_t(ji ,jj ,jk) & 184 & + zfv_f(ji ,jj ,jk) - zfv_f(ji ,jj-1,jk) ) / zbu 185 va(ji,jj,jk) = va(ji,jj,jk) - ( zfu_f(ji ,jj ,jk) - zfu_f(ji-1,jj ,jk) & 186 & + zfv_t(ji ,jj+1,jk) - zfv_t(ji ,jj ,jk) ) / zbv 179 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 180 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 181 va(ji,jj,jk) = va(ji,jj,jk) - ( zfu_f(ji,jj ,jk) - zfu_f(ji-1,jj,jk) & 182 & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 187 183 END DO 188 184 END DO … … 217 213 DO jj = 2, jpjm1 218 214 DO ji = fs_2, fs_jpim1 219 zfw(ji,jj,jk) = 0.25 * e1e2t(ji,jj) * wn(ji,jj,jk)215 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 220 216 END DO 221 217 END DO … … 245 241 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 246 242 ! 247 CALL wrk_dealloc( jpi, jpj, jpk,zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw )248 CALL wrk_dealloc( jpi, jpj, jpk, jpts,zlu_uu, zlv_vv, zlu_uv, zlv_vu )243 CALL wrk_dealloc( jpi,jpj,jpk, zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 244 CALL wrk_dealloc( jpi,jpj,jpk,jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu ) 249 245 ! 250 246 IF( nn_timing == 1 ) CALL timing_stop('dyn_adv_ubs') -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r5866 r6004 36 36 USE trd_oce ! trends: ocean variables 37 37 USE trddyn ! trend manager: dynamics 38 !jc USE zpshde ! partial step: hor. derivative (zps_hde routine) 38 39 ! 39 40 USE in_out_manager ! I/O manager … … 51 52 PUBLIC dyn_hpg_init ! routine called by opa module 52 53 53 ! !!* Namelist namdyn_hpg : hydrostatic pressure gradient 54 LOGICAL , PUBLIC :: ln_hpg_zco !: z-coordinate - full steps 55 LOGICAL , PUBLIC :: ln_hpg_zps !: z-coordinate - partial steps (interpolation) 56 LOGICAL , PUBLIC :: ln_hpg_sco !: s-coordinate (standard jacobian formulation) 57 LOGICAL , PUBLIC :: ln_hpg_djc !: s-coordinate (Density Jacobian with Cubic polynomial) 58 LOGICAL , PUBLIC :: ln_hpg_prj !: s-coordinate (Pressure Jacobian scheme) 59 LOGICAL , PUBLIC :: ln_hpg_isf !: s-coordinate similar to sco modify for isf 60 LOGICAL , PUBLIC :: ln_dynhpg_imp !: semi-implicite hpg flag 54 ! !!* Namelist namdyn_hpg : hydrostatic pressure gradient 55 LOGICAL , PUBLIC :: ln_hpg_zco !: z-coordinate - full steps 56 LOGICAL , PUBLIC :: ln_hpg_zps !: z-coordinate - partial steps (interpolation) 57 LOGICAL , PUBLIC :: ln_hpg_sco !: s-coordinate (standard jacobian formulation) 58 LOGICAL , PUBLIC :: ln_hpg_djc !: s-coordinate (Density Jacobian with Cubic polynomial) 59 LOGICAL , PUBLIC :: ln_hpg_prj !: s-coordinate (Pressure Jacobian scheme) 60 LOGICAL , PUBLIC :: ln_hpg_isf !: s-coordinate similar to sco modify for isf 61 61 62 62 INTEGER , PUBLIC :: nhpg = 0 ! = 0 to 7, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) (PUBLIC for TAM) … … 131 131 !! 132 132 NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco, & 133 & ln_hpg_djc, ln_hpg_prj, ln_hpg_isf , ln_dynhpg_imp133 & ln_hpg_djc, ln_hpg_prj, ln_hpg_isf 134 134 !!---------------------------------------------------------------------- 135 135 ! 136 136 REWIND( numnam_ref ) ! Namelist namdyn_hpg in reference namelist : Hydrostatic pressure gradient 137 137 READ ( numnam_ref, namdyn_hpg, IOSTAT = ios, ERR = 901) 138 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist', lwp )139 138 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist', lwp ) 139 ! 140 140 REWIND( numnam_cfg ) ! Namelist namdyn_hpg in configuration namelist : Hydrostatic pressure gradient 141 141 READ ( numnam_cfg, namdyn_hpg, IOSTAT = ios, ERR = 902 ) 142 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp )142 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist', lwp ) 143 143 IF(lwm) WRITE ( numond, namdyn_hpg ) 144 144 ! … … 154 154 WRITE(numout,*) ' s-coord. (Density Jacobian: Cubic polynomial) ln_hpg_djc = ', ln_hpg_djc 155 155 WRITE(numout,*) ' s-coord. (Pressure Jacobian: Cubic polynomial) ln_hpg_prj = ', ln_hpg_prj 156 WRITE(numout,*) ' time stepping: centered (F) or semi-implicit (T) ln_dynhpg_imp = ', ln_dynhpg_imp157 156 ENDIF 158 157 ! … … 162 161 & either ln_hpg_sco or ln_hpg_prj instead') 163 162 ! 164 IF( .NOT.ln_linssh .AND. .NOT. (ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) )&163 IF( .NOT.ln_linssh .AND. .NOT.(ln_hpg_sco.OR.ln_hpg_prj.OR.ln_hpg_isf) ) & 165 164 & CALL ctl_stop('dyn_hpg_init : non-linear free surface requires either ', & 166 165 & ' the standard jacobian formulation hpg_sco or ' , & … … 219 218 !!---------------------------------------------------------------------- 220 219 ! 221 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj )220 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 222 221 ! 223 222 IF( kt == nit000 ) THEN … … 250 249 ! hydrostatic pressure gradient 251 250 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) & 252 & + zcoef1 * ( ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) ) &251 & + zcoef1 * ( ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) ) & 253 252 & - ( rhd(ji ,jj,jk)+rhd(ji ,jj,jk-1) ) ) * r1_e1u(ji,jj) 254 253 255 254 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) & 256 & + zcoef1 * ( ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) ) &255 & + zcoef1 * ( ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) ) & 257 256 & - ( rhd(ji,jj, jk)+rhd(ji,jj ,jk-1) ) ) * r1_e2v(ji,jj) 258 257 ! add to the general momentum trend … … 263 262 END DO 264 263 ! 265 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )264 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 266 265 ! 267 266 END SUBROUTINE hpg_zco … … 284 283 !!---------------------------------------------------------------------- 285 284 ! 286 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj )285 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 287 286 ! 288 287 IF( kt == nit000 ) THEN … … 292 291 ENDIF 293 292 293 ! Partial steps: bottom before horizontal gradient of t, s, rd at the last ocean level 294 !jc CALL zps_hde ( kt, jpts, tsn, gtsu, gtsv, rhd, gru , grv ) 294 295 295 296 ! Local constant initialization … … 309 310 END DO 310 311 311 312 312 ! interior value (2=<jk=<jpkm1) 313 313 DO jk = 2, jpkm1 … … 329 329 END DO 330 330 END DO 331 332 331 333 332 ! partial steps correction at the last level (use gru & grv computed in zpshde.F90) … … 353 352 END DO 354 353 ! 355 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )354 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 356 355 ! 357 356 END SUBROUTINE hpg_zps 357 358 358 359 359 SUBROUTINE hpg_sco( kt ) … … 389 389 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ s-coordinate case, OPA original scheme used' 390 390 ENDIF 391 392 ! Local constant initialization 391 ! 393 392 zcoef0 = - grav * 0.5_wp 394 ! To use density and not density anomaly 395 IF ( .NOT.ln_linssh ) THEN ; znad = 1._wp ! Variable volume 396 ELSE ; znad = 0._wp ! Fixed volume 393 IF ( ln_linssh ) THEN ; znad = 0._wp ! Fixed volume: density anomaly 394 ELSE ; znad = 1._wp ! Variable volume: density 397 395 ENDIF 398 396 ! 399 397 ! Surface value 400 398 DO jj = 2, jpjm1 401 399 DO ji = fs_2, fs_jpim1 ! vector opt. 402 400 ! hydrostatic pressure gradient along s-surfaces 403 zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * ( e3w_n(ji+1,jj ,1) * ( znad + rhd(ji+1,jj ,1) )&404 & - e3w_n(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ))405 zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * ( e3w_n(ji ,jj+1,1) * ( znad + rhd(ji ,jj+1,1) )&406 & - e3w_n(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ))401 zhpi(ji,jj,1) = zcoef0 * ( e3w_n(ji+1,jj ,1) * ( znad + rhd(ji+1,jj ,1) ) & 402 & - e3w_n(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) ) * r1_e1u(ji,jj) 403 zhpj(ji,jj,1) = zcoef0 * ( e3w_n(ji ,jj+1,1) * ( znad + rhd(ji ,jj+1,1) ) & 404 & - e3w_n(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) ) * r1_e2v(ji,jj) 407 405 ! s-coordinate pressure gradient correction 408 406 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & … … 443 441 END SUBROUTINE hpg_sco 444 442 443 445 444 SUBROUTINE hpg_isf( kt ) 446 445 !!--------------------------------------------------------------------- … … 471 470 !!---------------------------------------------------------------------- 472 471 ! 473 CALL wrk_alloc( jpi,jpj, 2, ztstop)474 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj, zrhd)475 CALL wrk_alloc( jpi,jpj, ze3w, zp, zrhdtop_isf, zrhdtop_oce, ziceload, zdept, zpshpi, zpshpj)476 ! 477 IF( kt == nit000 ) THEN472 CALL wrk_alloc( jpi,jpj, 2, ztstop ) 473 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj, zrhd) 474 CALL wrk_alloc( jpi,jpj, ze3w, zp, zrhdtop_isf, zrhdtop_oce, ziceload, zdept, zpshpi, zpshpj ) 475 ! 476 IF( kt == nit000 ) THEN 478 477 IF(lwp) WRITE(numout,*) 479 478 IF(lwp) WRITE(numout,*) 'dyn:hpg_isf : hydrostatic pressure gradient trend for ice shelf' 480 479 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ s-coordinate case, OPA original scheme used' 481 480 ENDIF 482 483 ! Local constant initialization 481 ! 484 482 zcoef0 = - grav * 0.5_wp 485 ! To use density and not density anomaly 486 ! IF ( .NOT.ln_linssh ) THEN ; znad = 1._wp ! Variable volume 487 ! ELSE ; znad = 0._wp ! Fixed volume 488 ! ENDIF 489 znad=1._wp 490 ! iniitialised to 0. zhpi zhpi 491 zhpi(:,:,:)=0._wp ; zhpj(:,:,:)=0._wp 483 IF( ln_linssh ) THEN ; znad = 0._wp ! Fixed volume: density anomaly 484 ELSE ; znad = 1._wp ! Variable volume: density 485 ENDIF 486 zhpi(:,:,:) = 0._wp 487 zhpj(:,:,:) = 0._wp 492 488 493 489 !================================================================================== … … 496 492 497 493 ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 498 ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp 494 ztstop(:,:,jp_tem) = -1.9_wp 495 ztstop(:,:,jp_sal) = 34.4_wp 496 497 !!gm I have the feeling that a much simplier and faster computation can be performed... 498 !!gm ====>>>> We have to discuss ! 499 500 !!gm below, faster to compute the ISF density in zrhd and remplace rhd value where tmask=0 501 !!gm furthermore, this calculation does not depends on time : do it at the first time-step only.... 499 502 500 503 ! compute density of the water displaced by the ice shelf 501 zrhd = rhd! save rhd504 zrhd(:,:,:) = rhd(:,:,:) ! save rhd 502 505 DO jk = 1, jpk 503 zdept(:,:)=gdept_1d(jk)504 CALL eos(ztstop(:,:,:),zdept(:,:),rhd(:,:,jk))505 END DO 506 WHERE ( tmask(:,:,:) == 1._wp)506 zdept(:,:) = gdept_1d(jk) 507 CALL eos( ztstop(:,:,:), zdept(:,:), rhd(:,:,jk) ) 508 END DO 509 WHERE( tmask(:,:,:) == 1._wp ) 507 510 rhd(:,:,:) = zrhd(:,:,:) ! replace wet cell by the saved rhd 508 511 END WHERE 509 512 510 513 ! compute rhd at the ice/oce interface (ice shelf side) 511 CALL eos( ztstop,risfdep,zrhdtop_isf)514 CALL eos( ztstop, risfdep, zrhdtop_isf ) 512 515 513 516 ! compute rhd at the ice/oce interface (ocean side) 514 DO ji =1,jpi515 DO jj =1,jpj516 ikt =mikt(ji,jj)517 ztstop(ji,jj, 1)=tsn(ji,jj,ikt,1)518 ztstop(ji,jj, 2)=tsn(ji,jj,ikt,2)517 DO ji = 1, jpi 518 DO jj = 1, jpj 519 ikt = mikt(ji,jj) 520 ztstop(ji,jj,jp_tem) = tsn(ji,jj,ikt,jp_tem) 521 ztstop(ji,jj,jp_sal) = tsn(ji,jj,ikt,jp_sal) 519 522 END DO 520 523 END DO 521 CALL eos( ztstop,risfdep,zrhdtop_oce)524 CALL eos( ztstop, risfdep, zrhdtop_oce ) 522 525 ! 523 526 ! Surface value + ice shelf gradient … … 526 529 DO jj = 1, jpj 527 530 DO ji = 1, jpi ! vector opt. 528 ikt =mikt(ji,jj)531 ikt = mikt(ji,jj) 529 532 ziceload(ji,jj) = ziceload(ji,jj) + (znad + rhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1)) 530 DO jk =2,ikt-1533 DO jk = 2, ikt-1 531 534 ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + rhd(ji,jj,jk-1) + rhd(ji,jj,jk)) * e3w_n(ji,jj,jk) & 532 535 & * (1._wp - tmask(ji,jj,jk)) 533 536 END DO 534 IF (ikt .GE. 2)ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + rhd(ji,jj,ikt-1)) &535 &* ( risfdep(ji,jj) - gdept_1d(ikt-1) )536 END DO 537 END DO 538 riceload(:,:) = 0. 0_wp ; riceload(:,:)=ziceload(:,:)! need to be saved for diaar5537 IF( ikt >= 2 ) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + rhd(ji,jj,ikt-1)) & 538 & * ( risfdep(ji,jj) - gdept_1d(ikt-1) ) 539 END DO 540 END DO 541 riceload(:,:) = 0._wp ; riceload(:,:) = ziceload(:,:) ! need to be saved for diaar5 539 542 ! compute zp from z=0 to first T wet point (correction due to zps not yet applied) 540 543 DO jj = 2, jpjm1 541 544 DO ji = fs_2, fs_jpim1 ! vector opt. 542 ikt=mikt(ji,jj) ; iktp1i=mikt(ji+1,jj); iktp1j=mikt(ji,jj+1) 545 ikt = mikt(ji,jj) 546 iktp1i = mikt(ji+1,jj) 547 iktp1j = mikt(ji,jj+1) 543 548 ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure 544 549 ! we assume ISF is in isostatic equilibrium 545 zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj ,iktp1i) & 546 & * ( 2._wp * znad + rhd(ji+1,jj ,iktp1i) + zrhdtop_oce(ji+1,jj ) ) & 547 & - 0.5_wp * e3w_n(ji ,jj ,ikt ) & 548 & * ( 2._wp * znad + rhd(ji ,jj ,ikt ) + zrhdtop_oce(ji ,jj ) ) & 549 & + ( ziceload(ji+1,jj) - ziceload(ji,jj) ) ) 550 zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * ( 0.5_wp * e3w_n(ji ,jj+1,iktp1j) & 551 & * ( 2._wp * znad + rhd(ji ,jj+1,iktp1j) + zrhdtop_oce(ji ,jj+1) ) & 552 & - 0.5_wp * e3w_n(ji ,jj ,ikt ) & 553 & * ( 2._wp * znad + rhd(ji ,jj ,ikt ) + zrhdtop_oce(ji ,jj ) ) & 554 & + ( ziceload(ji,jj+1) - ziceload(ji,jj) ) ) 550 zhpi(ji,jj,1) = zcoef0 * ( & 551 & 0.5_wp * e3w_n(ji+1,jj,iktp1i) * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) ) & 552 & - 0.5_wp * e3w_n(ji ,jj,ikt ) * ( 2._wp * znad + rhd(ji ,jj,ikt ) + zrhdtop_oce(ji ,jj) ) & 553 & + ( ziceload(ji+1,jj) - ziceload(ji,jj) ) ) * r1_e1u(ji,jj) 554 zhpj(ji,jj,1) = zcoef0 * ( & 555 & 0.5_wp * e3w_n(ji,jj+1,iktp1j) * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) ) & 556 & - 0.5_wp * e3w_n(ji,jj ,ikt ) * ( 2._wp * znad + rhd(ji,jj ,ikt ) + zrhdtop_oce(ji,jj ) ) & 557 & + ( ziceload(ji,jj+1) - ziceload(ji,jj) ) ) * r1_e2v(ji,jj) 555 558 ! s-coordinate pressure gradient correction (=0 if z coordinate) 556 559 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & … … 569 572 DO ji = fs_2, fs_jpim1 ! vector opt. 570 573 iku = miku(ji,jj) 571 zpshpi(ji,jj) = 0._wp ; zpshpj(ji,jj) = 0._wp 574 zpshpi(ji,jj) = 0._wp 575 zpshpj(ji,jj) = 0._wp 572 576 ze3wu = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 573 577 ! u direction 574 IF ( iku .GT.1 ) THEN578 IF( iku > 1 ) THEN 575 579 ! case iku 576 zhpi(ji,jj,iku) = zcoef0 * r1_e1u(ji,jj) * ze3wu&577 & * ( rhd (ji+1,jj,iku) + rhd (ji,jj,iku)&578 &+ SIGN(1._wp,ze3wu) * grui(ji,jj) + 2._wp * znad )580 zhpi(ji,jj,iku) = zcoef0 * r1_e1u(ji,jj) * ze3wu & 581 & * ( rhd(ji+1,jj,iku) + rhd(ji,jj,iku) & 582 & + SIGN(1._wp,ze3wu) * grui(ji,jj) + 2._wp * znad ) 579 583 ! corrective term ( = 0 if z coordinate ) 580 zuap 584 zuap = -zcoef0 * ( arui(ji,jj) + 2._wp * znad ) * gzui(ji,jj) * r1_e1u(ji,jj) 581 585 ! zhpi will be added in interior loop 582 ua(ji,jj,iku) 586 ua(ji,jj,iku) = ua(ji,jj,iku) + zuap 583 587 ! in case of 2 cell water column, need to save the pressure gradient to compute the bottom pressure 584 IF (mbku(ji,jj) == iku + 1) zpshpi(ji,jj)= zhpi(ji,jj,iku)588 IF( mbku(ji,jj) == iku + 1 ) zpshpi(ji,jj) = zhpi(ji,jj,iku) 585 589 586 590 ! case iku + 1 (remove the zphi term added in the interior loop and compute the one corrected for zps) 587 zhpiint = zcoef0 * r1_e1u(ji,jj)&588 & * ( e3w_n(ji+1,jj ,iku+1) * ((rhd(ji+1,jj,iku+1) + znad) &589 & 590 & - e3w_n(ji ,jj ,iku+1) * ((rhd(ji ,jj,iku+1) + znad) &591 & 592 zhpi(ji,jj,iku+1) = 591 zhpiint = zcoef0 * r1_e1u(ji,jj) & 592 & * ( e3w_n(ji+1,jj ,iku+1) * ( (rhd(ji+1,jj,iku+1) + znad) & 593 & + (rhd(ji+1,jj,iku ) + znad) ) * tmask(ji+1,jj,iku) & 594 & - e3w_n(ji ,jj ,iku+1) * ( (rhd(ji ,jj,iku+1) + znad) & 595 & + (rhd(ji ,jj,iku ) + znad) ) * tmask(ji ,jj,iku) ) 596 zhpi(ji,jj,iku+1) = zcoef0 * r1_e1u(ji,jj) * ge3rui(ji,jj) - zhpiint 593 597 END IF 594 598 … … 596 600 ikv = mikv(ji,jj) 597 601 ze3wv = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 598 IF ( ikv .GT.1 ) THEN602 IF( ikv > 1 ) THEN 599 603 ! case ikv 600 zhpj(ji,jj,ikv) = zcoef0 * r1_e2v(ji,jj) * ze3wv&601 & * ( rhd(ji,jj+1,ikv) + rhd (ji,jj,ikv)&602 &+ SIGN(1._wp,ze3wv) * grvi(ji,jj) + 2._wp * znad )604 zhpj(ji,jj,ikv) = zcoef0 * r1_e2v(ji,jj) * ze3wv & 605 & * ( rhd(ji,jj+1,ikv) + rhd(ji,jj,ikv) & 606 & + SIGN(1._wp,ze3wv) * grvi(ji,jj) + 2._wp * znad ) 603 607 ! corrective term ( = 0 if z coordinate ) 604 zvap 608 zvap = -zcoef0 * ( arvi(ji,jj) + 2._wp * znad ) * gzvi(ji,jj) * r1_e2v(ji,jj) 605 609 ! zhpi will be added in interior loop 606 va(ji,jj,ikv) 610 va(ji,jj,ikv) = va(ji,jj,ikv) + zvap 607 611 ! in case of 2 cell water column, need to save the pressure gradient to compute the bottom pressure 608 IF (mbkv(ji,jj) == ikv + 1) zpshpj(ji,jj) =zhpj(ji,jj,ikv)612 IF( mbkv(ji,jj) == ikv + 1 ) zpshpj(ji,jj) = zhpj(ji,jj,ikv) 609 613 610 614 ! case ikv + 1 (remove the zphj term added in the interior loop and compute the one corrected for zps) 611 zhpjint = zcoef0 * r1_e2v(ji,jj)&612 & * ( e3w_n(ji ,jj+1,ikv+1) * ((rhd(ji,jj+1,ikv+1) + znad) &613 & + (rhd(ji,jj+1,ikv ) + znad) ) * tmask(ji,jj+1,ikv)&614 & - e3w_n(ji ,jj ,ikv+1) * ((rhd(ji,jj ,ikv+1) + znad) &615 & 615 zhpjint = zcoef0 * r1_e2v(ji,jj) & 616 & * ( e3w_n(ji ,jj+1,ikv+1) * ( (rhd(ji,jj+1,ikv+1) + znad) & 617 & + (rhd(ji,jj+1,ikv ) + znad) ) * tmask(ji,jj+1,ikv) & 618 & - e3w_n(ji ,jj ,ikv+1) * ( (rhd(ji,jj ,ikv+1) + znad) & 619 & + (rhd(ji,jj ,ikv ) + znad) ) * tmask(ji,jj ,ikv) ) 616 620 zhpj(ji,jj,ikv+1) = zcoef0 * r1_e2v(ji,jj) * ge3rvi(ji,jj) - zhpjint 617 END 621 ENDIF 618 622 END DO 619 623 END DO … … 969 973 ! Local constant initialization 970 974 zcoef0 = - grav 971 znad = 0.0_wp972 IF( .NOT.ln_linssh ) znad = 1._wp975 znad = 1._wp 976 IF( ln_linssh ) znad = 0._wp 973 977 974 978 ! Clean 3-D work arrays … … 1203 1207 zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) ) 1204 1208 IF( .NOT.ln_linssh ) THEN 1205 1206 1209 zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 1210 ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) ) 1207 1211 ELSE 1208 1212 zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 1209 1213 ENDIF 1210 1214 !!gm Since vmask(:,jj,:) = tmask(:,jj,:) * tmask(:,jj+1,:) by definition … … 1234 1238 !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation 1235 1239 !!---------------------------------------------------------------------- 1236 IMPLICIT NONE 1237 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: fsp, xsp ! value and coordinate 1238 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: asp, bsp, csp, dsp ! coefficients of 1239 ! the interpoated function 1240 INTEGER, INTENT(in) :: polynomial_type ! 1: cubic spline 1241 ! 2: Linear 1240 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: fsp, xsp ! value and coordinate 1241 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: asp, bsp, csp, dsp ! coefficients of the interpoated function 1242 INTEGER , INTENT(in ) :: polynomial_type ! 1: cubic spline ; 2: Linear 1242 1243 ! 1243 1244 INTEGER :: ji, jj, jk ! dummy loop indices -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r5845 r6004 36 36 PUBLIC dyn_ldf_init ! called by opa module 37 37 38 ! ! Flagto control the type of lateral viscous operator38 ! ! Parameter to control the type of lateral viscous operator 39 39 INTEGER, PARAMETER, PUBLIC :: np_ERROR =-10 ! error in setting the operator 40 40 INTEGER, PARAMETER, PUBLIC :: np_no_ldf = 00 ! without operator (i.e. no lateral viscous trend) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r5845 r6004 286 286 DO jj = 2, jpjm1 287 287 DO ji = 2, jpim1 !!gm Question vectop possible??? !!bug 288 ua(ji,jj,jk) = ua(ji,jj,jk) + ( ziut(ji+1,jj) - ziut(ji,jj ) &289 & + zjuf(ji ,jj) - zjuf(ji,jj-1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk))290 va(ji,jj,jk) = va(ji,jj,jk) + ( zivf(ji,jj ) - zivf(ji-1,jj) &291 & + zjvt(ji,jj+1) - zjvt(ji,jj ) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk))288 ua(ji,jj,jk) = ua(ji,jj,jk) + ( ziut(ji+1,jj) - ziut(ji,jj ) & 289 & + zjuf(ji ,jj) - zjuf(ji,jj-1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 290 va(ji,jj,jk) = va(ji,jj,jk) + ( zivf(ji,jj ) - zivf(ji-1,jj) & 291 & + zjvt(ji,jj+1) - zjvt(ji,jj ) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 292 292 END DO 293 293 END DO … … 402 402 DO jk = 1, jpkm1 403 403 DO ji = 2, jpim1 404 ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk))405 va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk))404 ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 405 va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 406 406 END DO 407 407 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r5866 r6004 18 18 !! 3.3 ! 2011-03 (P. Oddo) Bug fix for time-splitting+(BDY-OBC) and not VVL 19 19 !! 3.5 ! 2013-07 (J. Chanut) Compliant with time splitting changes 20 !! 3.7 ! 2014-04 (G. Madec) add the diagnostic of the time filter trends 20 !! 3.6 ! 2014-04 (G. Madec) add the diagnostic of the time filter trends 21 !! 3.7 ! 2015-11 (J. Chanut) Free surface simplification 21 22 !!------------------------------------------------------------------------- 22 23 23 24 !!------------------------------------------------------------------------- 24 !! dyn_nxt : obtain the next (after) horizontal velocity25 !! dyn_nxt : obtain the next (after) horizontal velocity 25 26 !!------------------------------------------------------------------------- 26 USE oce 27 USE dom_oce 28 USE sbc_oce 29 USE phycst 30 USE dyn spg_oce ! type of surface pressure gradient31 USE dyn adv ! dynamics: vector invariant versus flux form32 USE domvvl 33 USE bdy_oce 34 USE bdydta 35 USE bdydyn 36 USE bdyvol 37 USE trd_oce 38 USE trddyn 39 USE trdken 27 USE oce ! ocean dynamics and tracers 28 USE dom_oce ! ocean space and time domain 29 USE sbc_oce ! Surface boundary condition: ocean fields 30 USE phycst ! physical constants 31 USE dynadv ! dynamics: vector invariant versus flux form 32 USE dynspg_ts ! surface pressure gradient: split-explicit scheme 33 USE domvvl ! variable volume 34 USE bdy_oce ! ocean open boundary conditions 35 USE bdydta ! ocean open boundary conditions 36 USE bdydyn ! ocean open boundary conditions 37 USE bdyvol ! ocean open boundary condition (bdy_vol routines) 38 USE trd_oce ! trends: ocean variables 39 USE trddyn ! trend manager: dynamics 40 USE trdken ! trend manager: kinetic energy 40 41 ! 41 USE in_out_manager 42 USE iom 43 USE lbclnk 44 USE lib_mpp 45 USE wrk_nemo 46 USE prtctl 47 USE timing 42 USE in_out_manager ! I/O manager 43 USE iom ! I/O manager library 44 USE lbclnk ! lateral boundary condition (or mpp link) 45 USE lib_mpp ! MPP library 46 USE wrk_nemo ! Memory Allocation 47 USE prtctl ! Print control 48 USE timing ! Timing 48 49 #if defined key_agrif 49 50 USE agrif_opa_interp … … 66 67 !! *** ROUTINE dyn_nxt *** 67 68 !! 68 !! ** Purpose : Compute the after horizontal velocity. Apply the boundary69 !! condition on the after velocity, achieve dthe time stepping69 !! ** Purpose : Finalize after horizontal velocity. Apply the boundary 70 !! condition on the after velocity, achieve the time stepping 70 71 !! by applying the Asselin filter on now fields and swapping 71 72 !! the fields. 72 73 !! 73 !! ** Method : * After velocity is compute using a leap-frog scheme: 74 !! (ua,va) = (ub,vb) + 2 rdt (ua,va) 75 !! Note that with flux form advection and non linear free surface, 76 !! the leap-frog is applied on thickness weighted velocity. 77 !! Note also that in filtered free surface (lk_dynspg_flt=T), 78 !! the time stepping has already been done in dynspg module 74 !! ** Method : * Ensure after velocities transport matches time splitting 75 !! estimate (ln_dynspg_ts=T) 79 76 !! 80 77 !! * Apply lateral boundary conditions on after velocity … … 89 86 !! Note that with flux form advection and non linear free surface, 90 87 !! the time filter is applied on thickness weighted velocity. 88 !! As a result, dyn_nxt MUST be called after tra_nxt. 91 89 !! 92 90 !! ** Action : ub,vb filtered before horizontal velocity of next time-step … … 97 95 INTEGER :: ji, jj, jk ! dummy loop indices 98 96 INTEGER :: iku, ikv ! local integers 99 #if ! defined key_dynspg_flt 100 REAL(wp) :: z2dt ! temporary scalar 101 #endif 102 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zec ! local scalars 97 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zcoef ! local scalars 103 98 REAL(wp) :: zve3a, zve3n, zve3b, zvf, z1_2dt ! - - 104 99 REAL(wp), POINTER, DIMENSION(:,:) :: zue, zve … … 108 103 IF( nn_timing == 1 ) CALL timing_start('dyn_nxt') 109 104 ! 110 CALL wrk_alloc( jpi,jpj,jpk, ze3u_f, ze3v_f, zua, zva)111 IF( l k_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zue, zve)105 IF( ln_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zue, zve) 106 IF( l_trddyn ) CALL wrk_alloc( jpi,jpj,jpk, zua, zva) 112 107 ! 113 108 IF( kt == nit000 ) THEN … … 117 112 ENDIF 118 113 119 #if defined key_dynspg_flt 120 ! 121 ! Next velocity : Leap-frog time stepping already done in dynspg_flt.F routine 122 ! ------------- 123 124 ! Update after velocity on domain lateral boundaries (only local domain required) 125 ! -------------------------------------------------- 126 CALL lbc_lnk( ua, 'U', -1. ) ! local domain boundaries 127 CALL lbc_lnk( va, 'V', -1. ) 128 ! 129 #else 130 131 # if defined key_dynspg_exp 132 ! Next velocity : Leap-frog time stepping 133 ! ------------- 134 z2dt = 2. * rdt ! Euler or leap-frog time step 135 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 136 ! 137 IF( ln_dynadv_vec .OR. ln_linssh ) THEN !== applied on velocity ==! 114 IF ( ln_dynspg_ts ) THEN 115 ! Ensure below that barotropic velocities match time splitting estimate 116 ! Compute actual transport and replace it with ts estimate at "after" time step 117 zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 118 zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 119 DO jk = 2, jpkm1 120 zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 121 zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 122 END DO 138 123 DO jk = 1, jpkm1 139 ua(:,:,jk) = ( u b(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk)140 va(:,:,jk) = ( v b(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk)124 ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 125 va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 141 126 END DO 142 ELSE !== applied on thickness weighted velocity ==! 143 DO jk = 1, jpkm1 144 ua(:,:,jk) = ( ub(:,:,jk) * e3u_b(:,:,jk) & 145 & + z2dt * ua(:,:,jk) * e3u_n(:,:,jk) ) / e3u_a(:,:,jk) * umask(:,:,jk) 146 va(:,:,jk) = ( vb(:,:,jk) * e3v_b(:,:,jk) & 147 & + z2dt * va(:,:,jk) * e3v_n(:,:,jk) ) / e3v_a(:,:,jk) * vmask(:,:,jk) 148 END DO 149 ENDIF 150 # endif 151 152 # if defined key_dynspg_ts 153 !!gm IF ( lk_dynspg_ts ) THEN .... 154 ! Ensure below that barotropic velocities match time splitting estimate 155 ! Compute actual transport and replace it with ts estimate at "after" time step 156 zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 157 zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 158 DO jk = 2, jpkm1 159 zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 160 zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 161 END DO 162 DO jk = 1, jpkm1 163 ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 164 va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 165 END DO 166 167 IF (lk_dynspg_ts.AND.(.NOT.ln_bt_fw)) THEN 168 ! Remove advective velocity from "now velocities" 169 ! prior to asselin filtering 170 ! In the forward case, this is done below after asselin filtering 171 ! so that asselin contribution is removed at the same time 172 DO jk = 1, jpkm1 173 un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 174 vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 175 END DO 176 ENDIF 177 !!gm ENDIF 178 # endif 127 ! 128 IF( .NOT.ln_bt_fw ) THEN 129 ! Remove advective velocity from "now velocities" 130 ! prior to asselin filtering 131 ! In the forward case, this is done below after asselin filtering 132 ! so that asselin contribution is removed at the same time 133 DO jk = 1, jpkm1 134 un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 135 vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 136 END DO 137 ENDIF 138 ENDIF 179 139 180 140 ! Update after velocity on domain lateral boundaries 181 141 ! -------------------------------------------------- 182 CALL lbc_lnk( ua, 'U', -1. ) !* local domain boundaries183 CALL lbc_lnk( va, 'V', -1. )184 !185 # if defined key_bdy186 ! !* BDY open boundaries187 IF( lk_bdy .AND. lk_dynspg_exp ) CALL bdy_dyn( kt )188 IF( lk_bdy .AND. lk_dynspg_ts ) CALL bdy_dyn( kt, dyn3d_only=.true. )189 190 !!$ Do we need a call to bdy_vol here??191 !192 # endif193 !194 142 # if defined key_agrif 195 143 CALL Agrif_dyn( kt ) !* AGRIF zoom boundaries 196 144 # endif 197 #endif 198 145 ! 146 CALL lbc_lnk( ua, 'U', -1. ) !* local domain boundaries 147 CALL lbc_lnk( va, 'V', -1. ) 148 ! 149 # if defined key_bdy 150 ! !* BDY open boundaries 151 IF( lk_bdy .AND. ln_dynspg_exp ) CALL bdy_dyn( kt ) 152 IF( lk_bdy .AND. ln_dynspg_ts ) CALL bdy_dyn( kt, dyn3d_only=.true. ) 153 154 !!$ Do we need a call to bdy_vol here?? 155 ! 156 # endif 157 ! 199 158 IF( l_trddyn ) THEN ! prepare the atf trend computation + some diagnostics 200 159 z1_2dt = 1._wp / (2. * rdt) ! Euler or leap-frog time step … … 253 212 ! (used as a now filtered scale factor until the swap) 254 213 ! ---------------------------------------------------- 255 IF (lk_dynspg_ts.AND.ln_bt_fw) THEN 256 ! No asselin filtering on thicknesses if forward time splitting 257 e3t_b(:,:,:) = e3t_n(:,:,:) 214 IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN ! No asselin filtering on thicknesses if forward time splitting 215 e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 258 216 ELSE 259 e3t_b(:,:,:) = e3t_n(:,:,:) + atfp * ( e3t_b(:,:,:) - 2._wp * e3t_n(:,:,:) + e3t_a(:,:,:) ) 217 DO jk = 1, jpkm1 218 e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 219 END DO 260 220 ! Add volume filter correction: compatibility with tracer advection scheme 261 221 ! => time filter + conservation correction (only at the first level) 262 IF ( nn_isf == 0) THEN ! if no ice shelf melting 263 e3t_b(:,:,1) = e3t_b(:,:,1) - atfp * rdt * r1_rau0 * ( emp_b(:,:) - emp(:,:) & 264 & -rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 222 IF( nn_isf == 0) THEN ! if no ice shelf melting 223 zcoef = atfp * rdt * r1_rau0 224 e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 225 & - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 265 226 ELSE ! if ice shelf melting 266 DO jj = 1,jpj 267 DO ji = 1,jpi 227 zcoef = atfp * rdt * r1_rau0 228 DO jj = 1, jpj 229 DO ji = 1, jpi 268 230 jk = mikt(ji,jj) 269 e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - atfp * rdt * r1_rau0 & 270 & * ( (emp_b(ji,jj) - emp(ji,jj) ) & 271 & - (rnf_b(ji,jj) - rnf(ji,jj) ) & 272 & + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) * tmask(ji,jj,jk) 231 e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef * ( emp_b (ji,jj) - emp (ji,jj) & 232 & - rnf_b (ji,jj) + rnf (ji,jj) & 233 & + fwfisf_b(ji,jj) - fwfisf(ji,jj) ) * tmask(ji,jj,jk) 273 234 END DO 274 235 END DO … … 276 237 ENDIF 277 238 ! 278 IF( ln_dynadv_vec ) THEN 279 ! Before scale factor at (u/v)-points 280 ! ----------------------------------- 239 IF( ln_dynadv_vec ) THEN ! Asselin filter applied on velocity 240 ! Before filtered scale factor at (u/v)-points 281 241 CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 282 242 CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 283 ! Leap-Frog - Asselin filter and swap: applied on velocity284 ! -----------------------------------285 243 DO jk = 1, jpkm1 286 244 DO jj = 1, jpj … … 297 255 END DO 298 256 ! 299 ELSE 300 ! Temporary filtered scale factor at (u/v)-points (will become before scale factor) 301 !------------------------------------------------ 257 ELSE ! Asselin filter applied on thickness weighted velocity 258 ! 259 CALL wrk_alloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) 260 ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f 302 261 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 303 262 CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 304 ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity305 ! ----------------------------------- ===========================306 263 DO jk = 1, jpkm1 307 264 DO jj = 1, jpj 308 265 DO ji = 1, jpi 309 zue3a = ua(ji,jj,jk) * e3u_a(ji,jj,jk)310 zve3a = va(ji,jj,jk) * e3v_a(ji,jj,jk)311 zue3n = un(ji,jj,jk) * e3u_n(ji,jj,jk)312 zve3n = vn(ji,jj,jk) * e3v_n(ji,jj,jk)313 zue3b = ub(ji,jj,jk) * e3u_b(ji,jj,jk)314 zve3b = vb(ji,jj,jk) * e3v_b(ji,jj,jk)266 zue3a = e3u_a(ji,jj,jk) * ua(ji,jj,jk) 267 zve3a = e3v_a(ji,jj,jk) * va(ji,jj,jk) 268 zue3n = e3u_n(ji,jj,jk) * un(ji,jj,jk) 269 zve3n = e3v_n(ji,jj,jk) * vn(ji,jj,jk) 270 zue3b = e3u_b(ji,jj,jk) * ub(ji,jj,jk) 271 zve3b = e3v_b(ji,jj,jk) * vb(ji,jj,jk) 315 272 ! 316 273 zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / ze3u_f(ji,jj,jk) … … 324 281 END DO 325 282 END DO 326 e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor283 e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor 327 284 e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 285 ! 286 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) 328 287 ENDIF 329 288 ! 330 289 ENDIF 331 290 ! 332 IF (lk_dynspg_ts.AND.ln_bt_fw) THEN291 IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN 333 292 ! Revert "before" velocities to time split estimate 334 293 ! Doing it here also means that asselin filter contribution is removed … … 364 323 ENDIF 365 324 ! 366 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 367 ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 368 DO jk = 1, jpkm1 369 DO jj = 1, jpj 370 DO ji = 1, jpi 371 un_b(ji,jj) = un_b(ji,jj) + e3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 372 vn_b(ji,jj) = vn_b(ji,jj) + e3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 373 ! 374 ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 375 vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 376 END DO 377 END DO 325 un_b(:,:) = e3u_a(:,:,jk) * un(:,:,1) * umask(:,:,1) 326 ub_b(:,:) = e3u_b(:,:,jk) * ub(:,:,1) * umask(:,:,1) 327 vn_b(:,:) = e3v_a(:,:,jk) * vn(:,:,1) * vmask(:,:,1) 328 vb_b(:,:) = e3v_b(:,:,jk) * vb(:,:,1) * vmask(:,:,1) 329 DO jk = 2, jpkm1 330 un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(ji,jj,jk) 331 ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(ji,jj,jk) 332 vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(ji,jj,jk) 333 vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(ji,jj,jk) 378 334 END DO 379 335 un_b(:,:) = un_b(:,:) * r1_hu_a(:,:) … … 382 338 vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 383 339 ! 340 IF( .NOT.ln_dynspg_ts ) THEN ! output the barotropic currents 341 CALL iom_put( "ubar", un_b(:,:) ) 342 CALL iom_put( "vbar", vn_b(:,:) ) 343 ENDIF 384 344 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 385 345 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt … … 391 351 & tab3d_2=vn, clinfo2=' Vn: ' , mask2=vmask ) 392 352 ! 393 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f, zua, zva)394 IF( l k_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zue, zve)353 IF( ln_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zue, zve ) 354 IF( l_trddyn ) CALL wrk_dealloc( jpi,jpj,jpk, zua, zva ) 395 355 ! 396 356 IF( nn_timing == 1 ) CALL timing_stop('dyn_nxt') -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r5845 r6004 9 9 10 10 !!---------------------------------------------------------------------- 11 !! dyn_spg : update the dynamics trend with the lateral diffusion12 !! dyn_spg_ ctl: initialization, namelist read, and parameters control11 !! dyn_spg : update the dynamics trend with surface pressure gradient 12 !! dyn_spg_init: initialization, namelist read, and parameters control 13 13 !!---------------------------------------------------------------------- 14 14 USE oce ! ocean dynamics and tracers variables … … 18 18 USE sbc_oce ! surface boundary condition: ocean 19 19 USE sbcapr ! surface boundary condition: atmospheric pressure 20 USE dynspg_oce ! surface pressure gradient variables21 20 USE dynspg_exp ! surface pressure gradient (dyn_spg_exp routine) 22 21 USE dynspg_ts ! surface pressure gradient (dyn_spg_ts routine) 23 USE dynspg_flt ! surface pressure gradient (dyn_spg_flt routine) 24 USE dynadv ! dynamics: vector invariant versus flux form 25 USE dynhpg, ONLY: ln_dynhpg_imp 26 USE sbctide 27 USE updtide 22 USE sbctide ! 23 USE updtide ! 28 24 USE trd_oce ! trends: ocean variables 29 25 USE trddyn ! trend manager: dynamics … … 32 28 USE in_out_manager ! I/O manager 33 29 USE lib_mpp ! MPP library 34 USE solver ! solver initialization35 30 USE wrk_nemo ! Memory Allocation 36 31 USE timing ! Timing 37 32 38 39 33 IMPLICIT NONE 40 34 PRIVATE … … 44 38 45 39 INTEGER :: nspg = 0 ! type of surface pressure gradient scheme defined from lk_dynspg_... 40 41 ! ! Parameter to control the surface pressure gradient scheme 42 INTEGER, PARAMETER :: np_TS = 1 ! split-explicit time stepping (Time-Splitting) 43 INTEGER, PARAMETER :: np_EXP = 0 ! explicit time stepping 44 INTEGER, PARAMETER :: np_NO =-1 ! no surface pressure gradient, no scheme 46 45 47 46 !! * Substitutions … … 54 53 CONTAINS 55 54 56 SUBROUTINE dyn_spg( kt , kindic)55 SUBROUTINE dyn_spg( kt ) 57 56 !!---------------------------------------------------------------------- 58 57 !! *** ROUTINE dyn_spg *** 59 58 !! 60 !! ** Purpose : achieve the momentum time stepping by computing the 61 !! last trend, the surface pressure gradient including the 62 !! atmospheric pressure forcing (ln_apr_dyn=T), and performing 63 !! the Leap-Frog integration. 64 !!gm In the current version only the filtered solution provide 65 !!gm the after velocity, in the 2 other (ua,va) are still the trends 59 !! ** Purpose : compute surface pressure gradient including the 60 !! atmospheric pressure forcing (ln_apr_dyn=T). 66 61 !! 67 !! ** Method : Three schemes: 68 !! - explicit computation : the spg is evaluated at now 69 !! - filtered computation : the Roulet & madec (2000) technique is used 70 !! - split-explicit computation: a time splitting technique is used 62 !! ** Method : Two schemes: 63 !! - explicit : the spg is evaluated at now 64 !! - split-explicit : a time splitting technique is used 71 65 !! 72 66 !! ln_apr_dyn=T : the atmospheric pressure forcing is applied … … 78 72 !!---------------------------------------------------------------------- 79 73 INTEGER, INTENT(in ) :: kt ! ocean time-step index 80 INTEGER, INTENT( out) :: kindic ! solver flag81 74 ! 82 75 INTEGER :: ji, jj, jk ! dummy loop indices … … 88 81 IF( nn_timing == 1 ) CALL timing_start('dyn_spg') 89 82 ! 90 91 !!gm NOTA BENE : the dynspg_exp and dynspg_ts should be modified so that92 !!gm they return the after velocity, not the trends (as in trazdf_imp...)93 !!gm In this case, change/simplify dynnxt94 95 96 83 IF( l_trddyn ) THEN ! temporary save of ta and sa trends 97 84 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) … … 99 86 ztrdv(:,:,:) = va(:,:,:) 100 87 ENDIF 101 88 ! 102 89 IF( ln_apr_dyn & ! atmos. pressure 103 .OR. ( .NOT.l k_dynspg_ts .AND. (ln_tide_pot .AND. lk_tide) ) & ! tide potential (no time slitting)90 .OR. ( .NOT.ln_dynspg_ts .AND. (ln_tide_pot .AND. lk_tide) ) & ! tide potential (no time slitting) 104 91 .OR. nn_ice_embd == 2 ) THEN ! embedded sea-ice 105 92 ! … … 111 98 END DO 112 99 ! 113 IF( ln_apr_dyn .AND. (.NOT. lk_dynspg_ts) ) THEN!== Atmospheric pressure gradient (added later in time-split case) ==!100 IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN !== Atmospheric pressure gradient (added later in time-split case) ==! 114 101 zg_2 = grav * 0.5 115 102 DO jj = 2, jpjm1 ! gradient of Patm using inverse barometer ssh … … 124 111 ! 125 112 ! !== tide potential forcing term ==! 126 IF( .NOT.l k_dynspg_ts .AND. ( ln_tide_pot .AND. lk_tide ) ) THEN ! N.B. added directly at sub-time-step in ts-case113 IF( .NOT.ln_dynspg_ts .AND. ( ln_tide_pot .AND. lk_tide ) ) THEN ! N.B. added directly at sub-time-step in ts-case 127 114 ! 128 115 CALL upd_tide( kt ) ! update tide potential … … 152 139 ENDIF 153 140 ! 154 DO jk = 1, jpkm1 141 DO jk = 1, jpkm1 !== Add all terms to the general trend 155 142 DO jj = 2, jpjm1 156 143 DO ji = fs_2, fs_jpim1 ! vector opt. … … 160 147 END DO 161 148 END DO 162 149 ! 163 150 !!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ???? 164 165 ENDIF 166 167 SELECT CASE ( nspg ) ! compute surf. pressure gradient trend and add it to the general trend 168 ! 169 CASE ( 0 ) ; CALL dyn_spg_exp( kt ) ! explicit 170 CASE ( 1 ) ; CALL dyn_spg_ts ( kt ) ! time-splitting 171 CASE ( 2 ) ; CALL dyn_spg_flt( kt, kindic ) ! filtered 172 ! 151 ! 152 ENDIF 153 ! 154 SELECT CASE ( nspg ) !== surface pressure gradient computed and add to the general trend ==! 155 CASE ( np_EXP ) ; CALL dyn_spg_exp( kt ) ! explicit 156 CASE ( np_TS ) ; CALL dyn_spg_ts ( kt ) ! time-splitting 173 157 END SELECT 174 158 ! 175 IF( l_trddyn ) THEN ! save the surface pressure gradient trends for further diagnostics 176 SELECT CASE ( nspg ) 177 CASE ( 0, 1 ) 178 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 179 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 180 CASE( 2 ) 181 z2dt = 2. * rdt 182 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 183 ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / z2dt - ztrdu(:,:,:) 184 ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:) 185 END SELECT 159 IF( l_trddyn ) THEN ! save the surface pressure gradient trends for further diagnostics 160 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 161 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 186 162 CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 187 !188 163 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 189 164 ENDIF 190 ! 165 ! ! print mean trends (used for debugging) 191 166 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' spg - Ua: ', mask1=umask, & 192 167 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) … … 201 176 !! *** ROUTINE dyn_spg_init *** 202 177 !! 203 !! ** Purpose : Control the consistency between cppoptions for178 !! ** Purpose : Control the consistency between namelist options for 204 179 !! surface pressure gradient schemes 205 180 !!---------------------------------------------------------------------- 206 INTEGER :: ioptio 181 INTEGER :: ioptio, ios ! local integers 182 ! 183 NAMELIST/namdyn_spg/ ln_dynspg_exp , ln_dynspg_ts, & 184 & ln_bt_fw, ln_bt_av , ln_bt_auto , & 185 & nn_baro , rn_bt_cmax, nn_bt_flt 207 186 !!---------------------------------------------------------------------- 208 187 ! 209 188 IF( nn_timing == 1 ) CALL timing_start('dyn_spg_init') 210 189 ! 211 IF(lwp) THEN ! Control print 190 REWIND( numnam_ref ) ! Namelist namdyn_spg in reference namelist : Free surface 191 READ ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901) 192 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_spg in reference namelist', lwp ) 193 ! 194 REWIND( numnam_cfg ) ! Namelist namdyn_spg in configuration namelist : Free surface 195 READ ( numnam_cfg, namdyn_spg, IOSTAT = ios, ERR = 902 ) 196 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist', lwp ) 197 IF(lwm) WRITE ( numond, namdyn_spg ) 198 ! 199 IF(lwp) THEN ! Namelist print 212 200 WRITE(numout,*) 213 201 WRITE(numout,*) 'dyn_spg_init : choice of the surface pressure gradient scheme' 214 202 WRITE(numout,*) '~~~~~~~~~~~' 215 WRITE(numout,*) ' Explicit free surface lk_dynspg_exp = ', lk_dynspg_exp 216 WRITE(numout,*) ' Free surface with time splitting lk_dynspg_ts = ', lk_dynspg_ts 217 WRITE(numout,*) ' Filtered free surface cst volume lk_dynspg_flt = ', lk_dynspg_flt 218 ENDIF 219 220 IF( lk_dynspg_ts ) CALL dyn_spg_ts_init( nit000 ) 221 ! (do it now, to set nn_baro, used to allocate some arrays later on) 222 ! ! allocate dyn_spg arrays 223 IF( lk_dynspg_ts ) THEN 224 IF( dynspg_oce_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_oce arrays') 225 IF( dyn_spg_ts_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_ts arrays') 226 IF ((neuler/=0).AND.(ln_bt_fw)) CALL ts_rst( nit000, 'READ' ) 227 ENDIF 228 229 ! ! Control of surface pressure gradient scheme options 230 ioptio = 0 231 IF(lk_dynspg_exp) ioptio = ioptio + 1 232 IF(lk_dynspg_ts ) ioptio = ioptio + 1 233 IF(lk_dynspg_flt) ioptio = ioptio + 1 234 ! 235 IF( ioptio > 1 .OR. ( ioptio == 0 .AND. .NOT. lk_c1d ) ) & 236 & CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' ) 237 IF( ( lk_dynspg_ts .OR. lk_dynspg_exp ) .AND. ln_isfcav ) & 238 & CALL ctl_stop( ' dynspg_ts and dynspg_exp not tested with ice shelf cavity ' ) 239 ! 240 IF( lk_dynspg_exp) nspg = 0 241 IF( lk_dynspg_ts ) nspg = 1 242 IF( lk_dynspg_flt) nspg = 2 203 WRITE(numout,*) ' Explicit free surface ln_dynspg_exp = ', ln_dynspg_exp 204 WRITE(numout,*) ' Free surface with time splitting ln_dynspg_ts = ', ln_dynspg_ts 205 ENDIF 206 ! ! Control of surface pressure gradient scheme options 207 ; nspg = np_NO ; ioptio = 0 208 IF( ln_dynspg_exp ) THEN ; nspg = np_EXP ; ioptio = ioptio + 1 ; ENDIF 209 IF( ln_dynspg_ts ) THEN ; nspg = np_TS ; ioptio = ioptio + 1 ; ENDIF 210 ! 211 IF( ioptio > 1 ) CALL ctl_stop( 'Choose only one surface pressure gradient scheme' ) 212 IF( ioptio == 0 ) CALL ctl_warn( 'NO surface pressure gradient trend in momentum Eqs.' ) 213 ! 214 IF( ln_dynspg_ts .AND. ln_isfcav ) CALL ctl_stop( ' dynspg_ts not tested with ice shelf cavity ' ) 243 215 ! 244 216 IF(lwp) THEN 245 217 WRITE(numout,*) 246 IF( nspg == 0) WRITE(numout,*) ' explicit free surface'247 IF( nspg == 1) WRITE(numout,*) ' free surface with time splitting scheme'248 IF( nspg == 2 ) WRITE(numout,*) ' filtered free surface'249 ENDIF 250 251 #if defined key_dynspg_flt 252 CALL solver_init( nit000 ) ! Elliptic solver initialisation253 #endif 254 ! ! Control of hydrostatic pressure choice255 IF( lk_dynspg_ts .AND. ln_dynhpg_imp ) CALL ctl_stop( 'Semi-implicit hpg not compatible with time splitting' )218 IF( nspg == np_EXP ) WRITE(numout,*) ' explicit free surface' 219 IF( nspg == np_TS ) WRITE(numout,*) ' free surface with time splitting scheme' 220 IF( nspg == np_NO ) WRITE(numout,*) ' No surface surface pressure gradient trend in momentum Eqs.' 221 ENDIF 222 ! 223 IF( nspg == np_TS ) THEN ! split-explicit scheme initialisation 224 CALL dyn_spg_ts_init ! do it first: set nn_baro used to allocate some arrays later on 225 IF( dyn_spg_ts_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_ts arrays' ) 226 IF( neuler/=0 .AND. ln_bt_fw ) CALL ts_rst( nit000, 'READ' ) 227 ENDIF 256 228 ! 257 229 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_init') -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r5866 r6004 2 2 !!====================================================================== 3 3 !! *** MODULE dynspg_exp *** 4 !! Ocean dynamics: surface pressure gradient trend 4 !! Ocean dynamics: surface pressure gradient trend, explicit scheme 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2005-11 (V. Garnier, G. Madec, L. Bessieres) Original code 7 7 !! 3.2 ! 2009-06 (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module 8 8 !!---------------------------------------------------------------------- 9 #if defined key_dynspg_exp 10 !!---------------------------------------------------------------------- 11 !! 'key_dynspg_exp' explicit free surface 9 12 10 !!---------------------------------------------------------------------- 13 11 !! dyn_spg_exp : update the momentum trend with the surface … … 27 25 USE timing ! Timing 28 26 29 30 27 IMPLICIT NONE 31 28 PRIVATE 32 29 33 PUBLIC dyn_spg_exp ! routine called by step.F9030 PUBLIC dyn_spg_exp ! routine called by dynspg.F90 34 31 35 32 !! * Substitutions … … 100 97 END SUBROUTINE dyn_spg_exp 101 98 102 #else103 !!----------------------------------------------------------------------104 !! Default case : Empty module No standart explicit free surface105 !!----------------------------------------------------------------------106 CONTAINS107 SUBROUTINE dyn_spg_exp( kt ) ! Empty routine108 WRITE(*,*) 'dyn_spg_exp: You should not have seen this print! error?', kt109 END SUBROUTINE dyn_spg_exp110 #endif111 112 99 !!====================================================================== 113 100 END MODULE dynspg_exp -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5904 r6004 1 1 MODULE dynspg_ts 2 !!====================================================================== 3 !! *** MODULE dynspg_ts *** 4 !! Ocean dynamics: surface pressure gradient trend, split-explicit scheme 2 5 !!====================================================================== 3 6 !! History : 1.0 ! 2004-12 (L. Bessieres, G. Madec) Original code … … 11 14 !! 3.5 ! 2013-07 (J. Chanut) Switch to Forward-backward time stepping 12 15 !! 3.6 ! 2013-11 (A. Coward) Update for z-tilde compatibility 16 !! 3.7 ! 2015-11 (J. Chanut) free surface simplification 13 17 !!--------------------------------------------------------------------- 14 #if defined key_dynspg_ts 18 15 19 !!---------------------------------------------------------------------- 16 !! 'key_dynspg_ts' split explicit free surface17 !! ----------------------------------------------------------------------18 !! dyn_spg_ts : compute surface pressure gradient trend using a time-19 !! splitting scheme and add to the general trend20 !! dyn_spg_ts : compute surface pressure gradient trend using a time-splitting scheme 21 !! dyn_spg_ts_init: initialisation of the time-splitting scheme 22 !! ts_wgt : set time-splitting weights for temporal averaging (or not) 23 !! ts_rst : read/write time-splitting fields in restart file 20 24 !!---------------------------------------------------------------------- 21 25 USE oce ! ocean dynamics and tracers 22 26 USE dom_oce ! ocean space and time domain 23 27 USE sbc_oce ! surface boundary condition: ocean 28 USE zdf_oce ! Bottom friction coefts 24 29 USE sbcisf ! ice shelf variable (fwfisf) 25 USE dynspg_oce ! surface pressure gradient variables 30 USE sbcapr ! surface boundary condition: atmospheric pressure 31 USE dynadv , ONLY: ln_dynadv_vec 26 32 USE phycst ! physical constants 27 33 USE dynvor ! vorticity term 28 34 USE bdy_par ! for lk_bdy 29 USE bdytides ! open boundary condition data 35 USE bdytides ! open boundary condition data 30 36 USE bdydyn2d ! open boundary conditions on barotropic variables 31 37 USE sbctide ! tides 32 38 USE updtide ! tide potential 39 ! 40 USE in_out_manager ! I/O manager 33 41 USE lib_mpp ! distributed memory computing library 34 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 35 43 USE prtctl ! Print control 36 USE in_out_manager ! I/O manager37 44 USE iom ! IOM library 38 45 USE restart ! only for lrst_oce 39 USE zdf_oce ! Bottom friction coefts40 46 USE wrk_nemo ! Memory Allocation 41 47 USE timing ! Timing 42 USE sbcapr ! surface boundary condition: atmospheric pressure43 USE dynadv, ONLY: ln_dynadv_vec44 48 #if defined key_agrif 45 49 USE agrif_opa_interp ! agrif … … 60 64 REAL(wp),SAVE :: rdtbt ! Barotropic time step 61 65 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: & 63 wgtbtp1, & ! Primary weights used for time filtering of barotropic variables 64 wgtbtp2 ! Secondary weights used for time filtering of barotropic variables 65 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zwz ! ff/h at F points 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftnw, ftne ! triad of coriolis parameter 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse ! (only used with een vorticity scheme) 69 70 ! Arrays below are saved to allow testing of the "no time averaging" option 71 ! If this option is not retained, these could be replaced by temporary arrays 72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshbb_e, sshb_e, & ! Instantaneous barotropic arrays 73 ubb_e, ub_e, & 74 vbb_e, vb_e 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: wgtbtp1, wgtbtp2 !: 1st & 2nd weights used in time filtering of barotropic fields 67 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zwz !: ff/h at F points 69 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftnw, ftne !: triad of coriolis parameter 70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse !: (only used with een vorticity scheme) 71 72 !! Time filtered arrays at baroclinic time step: 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv , vn_adv !: Advection vel. at "now" barocl. step 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b , vb2_b !: Half step fluxes (ln_bt_fw=T) 75 #if defined key_agrif 76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_i_b, vb2_i_b !: Half step time integrated fluxes 77 #endif 78 79 !! Arrays at barotropic time step: ! bef before ! before ! now ! after ! 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubb_e , ub_e , un_e , ua_e !: u-external velocity 81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vbb_e , vb_e , vn_e , va_e !: v-external velocity 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshbb_e , sshb_e , sshn_e , ssha_e !: external ssh 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e !: external u-depth 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_e !: external v-depth 85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur_e !: inverse of u-depth 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hvr_e !: inverse of v-depth 75 87 76 88 !! * Substitutions … … 87 99 !! *** routine dyn_spg_ts_alloc *** 88 100 !!---------------------------------------------------------------------- 89 INTEGER :: ierr( 3)101 INTEGER :: ierr(5) 90 102 !!---------------------------------------------------------------------- 91 103 ierr(:) = 0 92 104 ! 93 ALLOCATE( sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 94 & ub_e(jpi,jpj) , vb_e(jpi,jpj) , & 95 & ubb_e(jpi,jpj) , vbb_e(jpi,jpj) , STAT= ierr(1) ) 96 ! 97 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 98 ! 99 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 100 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 105 ALLOCATE( ssha_e(jpi,jpj), sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 106 & ua_e(jpi,jpj), un_e(jpi,jpj), ub_e(jpi,jpj), ubb_e(jpi,jpj), & 107 & va_e(jpi,jpj), vn_e(jpi,jpj), vb_e(jpi,jpj), vbb_e(jpi,jpj), & 108 & hu_e(jpi,jpj), hur_e(jpi,jpj), hv_e(jpi,jpj), hvr_e(jpi,jpj), STAT=ierr(1) ) 109 ! 110 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj) , STAT=ierr(2) ) 111 ! 112 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 113 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 114 ! 115 ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_adv(jpi,jpj), vn_adv(jpi,jpj) , STAT=ierr(4) ) 116 #if defined key_agrif 117 ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj) , STAT= ierr(5)) 118 #endif 101 119 ! 102 120 dyn_spg_ts_alloc = MAXVAL( ierr(:) ) 121 ! 103 122 IF( lk_mpp ) CALL mpp_sum( dyn_spg_ts_alloc ) 104 IF( dyn_spg_ts_alloc /= 0 ) CALL ctl_warn('dyn spg_oce_alloc: failed to allocate arrays')123 IF( dyn_spg_ts_alloc /= 0 ) CALL ctl_warn('dyn_spg_ts_alloc: failed to allocate arrays') 105 124 ! 106 125 END FUNCTION dyn_spg_ts_alloc … … 110 129 !!---------------------------------------------------------------------- 111 130 !! 112 !! ** Purpose : 113 !! -Compute the now trend due to the explicit time stepping114 !! of the quasi-linear barotropic system.131 !! ** Purpose : - Compute the now trend due to the explicit time stepping 132 !! of the quasi-linear barotropic system, and add it to the 133 !! general momentum trend. 115 134 !! 116 !! ** Method : 135 !! ** Method : - split-explicit schem (time splitting) : 117 136 !! Barotropic variables are advanced from internal time steps 118 137 !! "n" to "n+1" if ln_bt_fw=T … … 128 147 !! continuity equation taken at the baroclinic time steps. This 129 148 !! ensures tracers conservation. 130 !! - Update 3d trend (ua, va)with barotropic component.149 !! - (ua, va) momentum trend updated with barotropic component. 131 150 !! 132 !! References : Shchepetkin, A.F. and J.C. McWilliams, 2005: 133 !! The regional oceanic modeling system (ROMS): 134 !! a split-explicit, free-surface, 135 !! topography-following-coordinate oceanic model. 136 !! Ocean Modelling, 9, 347-404. 151 !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005. 137 152 !!--------------------------------------------------------------------- 138 153 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 149 164 REAL(wp) :: za0, za1, za2, za3 ! - - 150 165 ! 151 REAL(wp), POINTER, DIMENSION(:,:) :: zun_e, zvn_e,zsshp2_e152 REAL(wp), POINTER, DIMENSION(:,:) :: 153 REAL(wp), POINTER, DIMENSION(:,:) :: zu_sum, zv_sum,zwx, zwy, zhdiv154 REAL(wp), POINTER, DIMENSION(:,:) :: 155 REAL(wp), POINTER, DIMENSION(:,:) :: 156 REAL(wp), POINTER, DIMENSION(:,:) :: 166 REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e 167 REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 168 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zhdiv 169 REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 170 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a 171 REAL(wp), POINTER, DIMENSION(:,:) :: zhf 157 172 !!---------------------------------------------------------------------- 158 173 ! 159 174 IF( nn_timing == 1 ) CALL timing_start('dyn_spg_ts') 160 175 ! 176 ! !* Allocate temporary arrays 161 177 CALL wrk_alloc( jpi,jpj, zsshp2_e, zhdiv ) 162 CALL wrk_alloc( jpi,jpj, zu_trd, zv_trd , zun_e, zvn_e)163 CALL wrk_alloc( jpi,jpj, zwx, zwy, z u_sum, zv_sum, zssh_frc, zu_frc, zv_frc)178 CALL wrk_alloc( jpi,jpj, zu_trd, zv_trd) 179 CALL wrk_alloc( jpi,jpj, zwx, zwy, zssh_frc, zu_frc, zv_frc) 164 180 CALL wrk_alloc( jpi,jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e) 165 CALL wrk_alloc( jpi,jpj, zsshu_a, zsshv_a )181 CALL wrk_alloc( jpi,jpj, zsshu_a, zsshv_a ) 166 182 CALL wrk_alloc( jpi,jpj, zhf ) 167 183 ! … … 180 196 ll_fw_start = .FALSE. 181 197 ! ! time offset in steps for bdy data update 182 IF( .NOT.ln_bt_fw ) THEN ; noffset = -2*nn_baro183 ELSE ; noffset = 0198 IF( .NOT.ln_bt_fw ) THEN ; noffset = - nn_baro 199 ELSE ; noffset = 0 184 200 ENDIF 185 201 ! … … 194 210 ! 195 211 IF( ln_bt_fw .OR. neuler == 0 ) THEN 196 ll_fw_start =.TRUE.197 noffset = 0212 ll_fw_start =.TRUE. 213 noffset = 0 198 214 ELSE 199 ll_fw_start =.FALSE.215 ll_fw_start =.FALSE. 200 216 ENDIF 201 217 ! … … 212 228 ! and update depths at T-F points (ht and zhf resp.) at each barotropic time step 213 229 ! 214 IF 215 IF ( ln_dynvor_een ) THEN!== EEN scheme ==!230 IF( kt == nit000 .OR. .NOT.ln_linssh ) THEN 231 IF( ln_dynvor_een ) THEN !== EEN scheme ==! 216 232 SELECT CASE( nn_een_e3f ) !* ff/e3 at F-point 217 233 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) … … 219 235 DO ji = 1, jpim1 220 236 zwz(ji,jj) = ( ht_n(ji ,jj+1) + ht_n(ji+1,jj+1) + & 221 & ht_n(ji ,jj ) + ht_n(ji+1,jj ) ) / 4._wp237 & ht_n(ji ,jj ) + ht_n(ji+1,jj ) ) * 0.25_wp 222 238 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 223 239 END DO … … 407 423 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 408 424 ! 409 IF (ln_bt_fw) THEN ! Add wind forcing425 IF( ln_bt_fw ) THEN ! Add wind forcing 410 426 zu_frc(:,:) = zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 411 427 zv_frc(:,:) = zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) … … 477 493 ! 478 494 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 479 sshn_e(:,:) = sshn(:,:)480 zun_e (:,:) =un_b(:,:)481 zvn_e (:,:) =vn_b(:,:)495 sshn_e(:,:) = sshn(:,:) 496 un_e (:,:) = un_b(:,:) 497 vn_e (:,:) = vn_b(:,:) 482 498 ! 483 499 hu_e (:,:) = hu_n(:,:) … … 486 502 hvr_e (:,:) = r1_hv_n(:,:) 487 503 ELSE ! CENTRED integration: start from BEFORE fields 488 sshn_e(:,:) = sshb(:,:)489 zun_e (:,:) =ub_b(:,:)490 zvn_e (:,:) =vb_b(:,:)504 sshn_e(:,:) = sshb(:,:) 505 un_e (:,:) = ub_b(:,:) 506 vn_e (:,:) = vb_b(:,:) 491 507 ! 492 508 hu_e (:,:) = hu_b(:,:) … … 502 518 va_b (:,:) = 0._wp 503 519 ssha (:,:) = 0._wp ! Sum for after averaged sea level 504 zu_sum(:,:) = 0._wp ! Sum for now transport issued from ts loop505 zv_sum(:,:) = 0._wp520 un_adv(:,:) = 0._wp ! Sum for now transport issued from ts loop 521 vn_adv(:,:) = 0._wp 506 522 ! ! ==================== ! 507 523 DO jn = 1, icycle ! sub-time-step loop ! … … 511 527 ! Update only tidal forcing at open boundaries 512 528 #if defined key_tide 513 IF ( lk_bdy .AND. lk_tide ) CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1))514 IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide ( kt, kit=jn, koffset=noffset)529 IF( lk_bdy .AND. lk_tide ) CALL bdy_dta_tides( kt, kit=jn, time_offset= noffset+1 ) 530 IF( ln_tide_pot .AND. lk_tide ) CALL upd_tide ( kt, kit=jn, time_offset= noffset ) 515 531 #endif 516 532 ! … … 527 543 528 544 ! Extrapolate barotropic velocities at step jit+0.5: 529 ua_e(:,:) = za1 * zun_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:)530 va_e(:,:) = za1 * zvn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:)545 ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 546 va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 531 547 532 548 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) … … 589 605 ! Sum over sub-time-steps to compute advective velocities 590 606 za2 = wgtbtp2(jn) 591 zu_sum(:,:) = zu_sum(:,:) + za2 * zwx(:,:) * r1_e2u(:,:)592 zv_sum(:,:) = zv_sum(:,:) + za2 * zwy(:,:) * r1_e1v(:,:)607 un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 608 vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 593 609 ! 594 610 ! Set next sea level: … … 648 664 ! 649 665 ! Compute associated depths at U and V points: 650 IF( .NOT. ( ln_dynadv_vec .OR. ln_linssh )) THEN !* Vector form666 IF( .NOT.ln_linssh .AND. .NOT.ln_dynadv_vec ) THEN !* Vector form 651 667 ! 652 668 DO jj = 2, jpjm1 … … 671 687 ! zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 672 688 ! 673 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN 689 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN !== energy conserving or mixed scheme ==! 674 690 DO jj = 2, jpjm1 675 691 DO ji = fs_2, fs_jpim1 ! vector opt. … … 683 699 END DO 684 700 ! 685 ELSEIF ( ln_dynvor_ens ) THEN 701 ELSEIF ( ln_dynvor_ens ) THEN !== enstrophy conserving scheme ==! 686 702 DO jj = 2, jpjm1 687 703 DO ji = fs_2, fs_jpim1 ! vector opt. … … 695 711 END DO 696 712 ! 697 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==!713 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==! 698 714 DO jj = 2, jpjm1 699 715 DO ji = fs_2, fs_jpim1 ! vector opt. … … 724 740 ! 725 741 ! Add bottom stresses: 726 zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * zun_e(:,:) * hur_e(:,:)727 zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * zvn_e(:,:) * hvr_e(:,:)742 zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:) 743 zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 728 744 ! 729 745 ! Surface pressure trend: … … 742 758 DO jj = 2, jpjm1 743 759 DO ji = fs_2, fs_jpim1 ! vector opt. 744 ua_e(ji,jj) = ( zun_e(ji,jj) & 745 & + rdtbt * ( zwx(ji,jj) & 746 & + zu_trd(ji,jj) & 747 & + zu_frc(ji,jj) ) & 748 & ) * umask(ji,jj,1) 749 750 va_e(ji,jj) = ( zvn_e(ji,jj) & 751 & + rdtbt * ( zwy(ji,jj) & 752 & + zv_trd(ji,jj) & 753 & + zv_frc(ji,jj) ) & 754 & ) * vmask(ji,jj,1) 755 END DO 756 END DO 757 760 ua_e(ji,jj) = ( un_e(ji,jj) & 761 & + rdtbt * ( zwx(ji,jj) & 762 & + zu_trd(ji,jj) & 763 & + zu_frc(ji,jj) ) ) * umask(ji,jj,1) 764 ! 765 va_e(ji,jj) = ( vn_e(ji,jj) & 766 & + rdtbt * ( zwy(ji,jj) & 767 & + zv_trd(ji,jj) & 768 & + zv_frc(ji,jj) ) ) * vmask(ji,jj,1) 769 END DO 770 END DO 771 ! 758 772 ELSE !* Flux form 759 773 DO jj = 2, jpjm1 760 774 DO ji = fs_2, fs_jpim1 ! vector opt. 761 762 zhura = umask(ji,jj,1)/(hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - umask(ji,jj,1)) 763 zhvra = vmask(ji,jj,1)/(hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - vmask(ji,jj,1)) 764 765 ua_e(ji,jj) = ( hu_e(ji,jj) * zun_e(ji,jj) & 766 & + rdtbt * ( zhust_e(ji,jj) * zwx(ji,jj) & 767 & + zhup2_e(ji,jj) * zu_trd(ji,jj) & 768 & + hu_n(ji,jj) * zu_frc(ji,jj) ) & 769 & ) * zhura 770 771 va_e(ji,jj) = ( hv_e(ji,jj) * zvn_e(ji,jj) & 772 & + rdtbt * ( zhvst_e(ji,jj) * zwy(ji,jj) & 773 & + zhvp2_e(ji,jj) * zv_trd(ji,jj) & 774 & + hv_n(ji,jj) * zv_frc(ji,jj) ) & 775 & ) * zhvra 775 zhura = umask(ji,jj,1) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - umask(ji,jj,1) ) 776 zhvra = vmask(ji,jj,1) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - vmask(ji,jj,1) ) 777 ! 778 ua_e(ji,jj) = ( hu_e(ji,jj) * un_e(ji,jj) & 779 & + rdtbt * ( zhust_e(ji,jj) * zwx(ji,jj) & 780 & + zhup2_e(ji,jj) * zu_trd(ji,jj) & 781 & + hu_n(ji,jj) * zu_frc(ji,jj) ) ) * zhura 782 ! 783 va_e(ji,jj) = ( hv_e(ji,jj) * vn_e(ji,jj) & 784 & + rdtbt * ( zhvst_e(ji,jj) * zwy(ji,jj) & 785 & + zhvp2_e(ji,jj) * zv_trd(ji,jj) & 786 & + hv_n(ji,jj) * zv_frc(ji,jj) ) ) * zhvra 776 787 END DO 777 788 END DO … … 779 790 ! 780 791 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 781 ! ! ----------------------------------------------782 792 hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 783 793 hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) … … 787 797 ENDIF 788 798 ! !* domain lateral boundary 789 ! ! -----------------------790 !791 799 CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp ) 792 800 ! 793 801 #if defined key_bdy 794 802 ! ! open boundaries 795 IF( lk_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, zun_e, zvn_e, hur_e, hvr_e, ssha_e )803 IF( lk_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e ) 796 804 #endif 797 805 #if defined key_agrif … … 801 809 ! ! ---- 802 810 ubb_e (:,:) = ub_e (:,:) 803 ub_e (:,:) = zun_e(:,:)804 zun_e(:,:) = ua_e (:,:)811 ub_e (:,:) = un_e (:,:) 812 un_e (:,:) = ua_e (:,:) 805 813 ! 806 814 vbb_e (:,:) = vb_e (:,:) 807 vb_e (:,:) = zvn_e(:,:)808 zvn_e(:,:) = va_e (:,:)815 vb_e (:,:) = vn_e (:,:) 816 vn_e (:,:) = va_e (:,:) 809 817 ! 810 818 sshbb_e(:,:) = sshb_e(:,:) … … 831 839 ! ----------------------------------------------------------------------------- 832 840 ! 833 ! At this stage ssha holds a time averaged value 834 ! ! Sea Surface Height at u-,v- and f-points 835 IF( .NOT.ln_linssh ) THEN ! (required only in non-linear free surface case) 841 ! Set advection velocity correction: 842 zwx(:,:) = un_adv(:,:) 843 zwy(:,:) = vn_adv(:,:) 844 IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN 845 un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 846 vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 847 ELSE 848 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 849 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 850 END IF 851 852 IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 853 ub2_b(:,:) = zwx(:,:) 854 vb2_b(:,:) = zwy(:,:) 855 ENDIF 856 ! 857 ! Update barotropic trend: 858 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 859 DO jk=1,jpkm1 860 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 861 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b 862 END DO 863 ELSE 864 ! At this stage, ssha has been corrected: compute new depths at velocity points 836 865 DO jj = 1, jpjm1 837 866 DO ji = 1, jpim1 ! NO Vector Opt. … … 845 874 END DO 846 875 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 847 ENDIF 848 ! 849 ! Set advection velocity correction: 850 IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN 851 un_adv(:,:) = zu_sum(:,:) * r1_hu_n(:,:) 852 vn_adv(:,:) = zv_sum(:,:) * r1_hv_n(:,:) 853 ELSE 854 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zu_sum(:,:) ) * r1_hu_n(:,:) 855 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zv_sum(:,:) ) * r1_hv_n(:,:) 856 END IF 857 858 IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 859 ub2_b(:,:) = zu_sum(:,:) 860 vb2_b(:,:) = zv_sum(:,:) 861 ENDIF 862 ! 863 ! Update barotropic trend: 864 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 865 DO jk=1,jpkm1 866 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 867 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b 868 END DO 869 ELSE 876 ! 870 877 DO jk=1,jpkm1 871 878 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b … … 883 890 ! 884 891 END DO 892 ! 893 CALL iom_put( "ubar", un_adv(:,:) ) ! barotropic i-current 894 CALL iom_put( "vbar", vn_adv(:,:) ) ! barotropic i-current 885 895 ! 886 896 #if defined key_agrif … … 898 908 vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 899 909 ENDIF 900 !901 !902 910 #endif 903 !904 911 ! !* write time-spliting arrays in the restart 905 912 IF( lrst_oce .AND.ln_bt_fw ) CALL ts_rst( kt, 'WRITE' ) 906 913 ! 907 914 CALL wrk_dealloc( jpi,jpj, zsshp2_e, zhdiv ) 908 CALL wrk_dealloc( jpi,jpj, zu_trd, zv_trd , zun_e, zvn_e)909 CALL wrk_dealloc( jpi,jpj, zwx, zwy, z u_sum, zv_sum, zssh_frc, zu_frc, zv_frc )915 CALL wrk_dealloc( jpi,jpj, zu_trd, zv_trd ) 916 CALL wrk_dealloc( jpi,jpj, zwx, zwy, zssh_frc, zu_frc, zv_frc ) 910 917 CALL wrk_dealloc( jpi,jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e ) 911 CALL wrk_dealloc( jpi,jpj, zsshu_a, zsshv_a )918 CALL wrk_dealloc( jpi,jpj, zsshu_a, zsshv_a ) 912 919 CALL wrk_dealloc( jpi,jpj, zhf ) 913 920 ! … … 994 1001 END SUBROUTINE ts_wgt 995 1002 1003 996 1004 SUBROUTINE ts_rst( kt, cdrw ) 997 1005 !!--------------------------------------------------------------------- … … 1047 1055 END SUBROUTINE ts_rst 1048 1056 1049 SUBROUTINE dyn_spg_ts_init( kt ) 1057 1058 SUBROUTINE dyn_spg_ts_init 1050 1059 !!--------------------------------------------------------------------- 1051 1060 !! *** ROUTINE dyn_spg_ts_init *** … … 1053 1062 !! ** Purpose : Set time splitting options 1054 1063 !!---------------------------------------------------------------------- 1055 INTEGER , INTENT(in) :: kt ! ocean time-step 1056 ! 1057 INTEGER :: ji ,jj 1058 INTEGER :: ios ! Local integer output status for namelist read 1059 REAL(wp) :: zxr2, zyr2, zcmax 1060 REAL(wp), POINTER, DIMENSION(:,:) :: zcu 1061 !! 1062 NAMELIST/namsplit/ ln_bt_fw, ln_bt_av, ln_bt_nn_auto, & 1063 & nn_baro, rn_bt_cmax, nn_bt_flt 1064 INTEGER :: ji ,jj ! dummy loop indices 1065 REAL(wp) :: zxr2, zyr2, zcmax ! local scalar 1066 REAL(wp), POINTER, DIMENSION(:,:) :: zcu 1064 1067 !!---------------------------------------------------------------------- 1065 1068 ! 1066 REWIND( numnam_ref ) ! Namelist namsplit in reference namelist : time splitting parameters 1067 READ ( numnam_ref, namsplit, IOSTAT = ios, ERR = 901) 1068 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in reference namelist', lwp ) 1069 1070 REWIND( numnam_cfg ) ! Namelist namsplit in configuration namelist : time splitting parameters 1071 READ ( numnam_cfg, namsplit, IOSTAT = ios, ERR = 902 ) 1072 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in configuration namelist', lwp ) 1073 IF(lwm) WRITE ( numond, namsplit ) 1074 ! 1075 ! ! Max courant number for ext. grav. waves 1076 ! 1077 CALL wrk_alloc( jpi, jpj, zcu ) 1078 ! 1079 IF( .NOT.ln_linssh ) THEN 1080 DO jj = 1, jpj 1081 DO ji =1, jpi 1082 zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1083 zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 1084 zcu(ji,jj) = SQRT( grav * ht_0(ji,jj) * (zxr2 + zyr2) ) 1085 END DO 1086 END DO 1087 ELSE 1088 !!gm BUG ?? restartability issue if ssh changes are large.... 1089 !!gm We should just test this with ht_0 only, no? 1090 DO jj = 1, jpj 1091 DO ji =1, jpi 1092 zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1093 zyr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1094 zcu(ji,jj) = SQRT( grav * ht_n(ji,jj) * (zxr2 + zyr2) ) 1095 END DO 1096 END DO 1097 ENDIF 1098 1069 ! Max courant number for ext. grav. waves 1070 ! 1071 CALL wrk_alloc( jpi,jpj, zcu ) 1072 ! 1073 DO jj = 1, jpj 1074 DO ji =1, jpi 1075 zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1076 zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 1077 zcu(ji,jj) = SQRT( grav * ht_0(ji,jj) * (zxr2 + zyr2) ) 1078 END DO 1079 END DO 1080 ! 1099 1081 zcmax = MAXVAL( zcu(:,:) ) 1100 1082 IF( lk_mpp ) CALL mpp_max( zcmax ) 1101 1083 1102 1084 ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax 1103 IF (ln_bt_nn_auto)nn_baro = CEILING( rdt / rn_bt_cmax * zcmax)1085 IF( ln_bt_auto ) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 1104 1086 1105 1087 rdtbt = rdt / REAL( nn_baro , wp ) … … 1109 1091 IF(lwp) WRITE(numout,*) 'dyn_spg_ts : split-explicit free surface' 1110 1092 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 1111 IF( ln_bt_ nn_auto ) THEN1112 IF(lwp) WRITE(numout,*) ' ln_ts_ nn_auto=.true. Automatically set nn_baro '1093 IF( ln_bt_auto ) THEN 1094 IF(lwp) WRITE(numout,*) ' ln_ts_auto=.true. Automatically set nn_baro ' 1113 1095 IF(lwp) WRITE(numout,*) ' Max. courant number allowed: ', rn_bt_cmax 1114 1096 ELSE 1115 IF(lwp) WRITE(numout,*) ' ln_ts_ nn_auto=.false.: Use nn_baro in namelist '1097 IF(lwp) WRITE(numout,*) ' ln_ts_auto=.false.: Use nn_baro in namelist ' 1116 1098 ENDIF 1117 1099 … … 1131 1113 #if defined key_agrif 1132 1114 ! Restrict the use of Agrif to the forward case only 1133 IF ((.NOT.ln_bt_fw ).AND.(.NOT.Agrif_Root()))CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' )1115 IF( .NOT.ln_bt_fw .AND. .NOT.Agrif_Root() ) CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' ) 1134 1116 #endif 1135 1117 ! 1136 1118 IF(lwp) WRITE(numout,*) ' Time filter choice, nn_bt_flt: ', nn_bt_flt 1137 1119 SELECT CASE ( nn_bt_flt ) 1138 CASE( 0 ); IF(lwp) WRITE(numout,*) ' Dirac'1139 CASE( 1 ); IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_baro'1140 CASE( 2 ); IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_baro'1141 1120 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' Dirac' 1121 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_baro' 1122 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_baro' 1123 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' ) 1142 1124 END SELECT 1143 1125 ! … … 1147 1129 IF(lwp) WRITE(numout,*) ' Maximum Courant number is :', zcmax 1148 1130 ! 1149 IF ((.NOT.ln_bt_av).AND.(.NOT.ln_bt_fw)) THEN1131 IF( .NOT.ln_bt_av .AND. .NOT.ln_bt_fw ) THEN 1150 1132 CALL ctl_stop( 'dynspg_ts ERROR: No time averaging => only forward integration is possible' ) 1151 1133 ENDIF 1152 IF 1134 IF( zcmax>0.9_wp ) THEN 1153 1135 CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_baro !' ) 1154 1136 ENDIF 1155 1137 ! 1156 CALL wrk_dealloc( jpi, jpj,zcu )1138 CALL wrk_dealloc( jpi,jpj, zcu ) 1157 1139 ! 1158 1140 END SUBROUTINE dyn_spg_ts_init 1159 1141 1160 #else1161 !!---------------------------------------------------------------------------1162 !! Default case : Empty module No split explicit free surface1163 !!---------------------------------------------------------------------------1164 CONTAINS1165 INTEGER FUNCTION dyn_spg_ts_alloc() ! Dummy function1166 dyn_spg_ts_alloc = 01167 END FUNCTION dyn_spg_ts_alloc1168 SUBROUTINE dyn_spg_ts( kt ) ! Empty routine1169 INTEGER, INTENT(in) :: kt1170 WRITE(*,*) 'dyn_spg_ts: You should not have seen this print! error?', kt1171 END SUBROUTINE dyn_spg_ts1172 SUBROUTINE ts_rst( kt, cdrw ) ! Empty routine1173 INTEGER , INTENT(in) :: kt ! ocean time-step1174 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag1175 WRITE(*,*) 'ts_rst : You should not have seen this print! error?', kt, cdrw1176 END SUBROUTINE ts_rst1177 SUBROUTINE dyn_spg_ts_init( kt ) ! Empty routine1178 INTEGER , INTENT(in) :: kt ! ocean time-step1179 WRITE(*,*) 'dyn_spg_ts_init : You should not have seen this print! error?', kt1180 END SUBROUTINE dyn_spg_ts_init1181 #endif1182 1183 1142 !!====================================================================== 1184 1143 END MODULE dynspg_ts -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r5845 r6004 413 413 DO jj = 2, jpjm1 414 414 DO ji = fs_2, fs_jpim1 ! vector opt. 415 zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1)&416 & + zwy(ji ,jj ) + zwy(ji+1,jj ))417 zvau =-r1_8 * r1_e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1)&418 & + zwx(ji ,jj ) + zwx(ji ,jj+1))415 zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 416 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) 417 zvau =-r1_8 * r1_e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 418 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) 419 419 pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 420 420 pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 481 481 DO jj = 1, jpjm1 482 482 DO ji = 1, fs_jpim1 ! vector opt. 483 ze3 = ( e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) &484 & + e3t_n(ji,jj ,jk)*tmask(ji,jj ,jk) + e3t_n(ji+1,jj ,jk)*tmask(ji+1,jj ,jk))485 IF( ze3 /= 0._wp ) THEN ; z1_e3f(ji,jj) = 4. 0_wp / ze3486 ELSE ; z1_e3f(ji,jj) = 0. 0_wp483 ze3 = ( e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 484 & + e3t_n(ji,jj ,jk)*tmask(ji,jj ,jk) + e3t_n(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 485 IF( ze3 /= 0._wp ) THEN ; z1_e3f(ji,jj) = 4._wp / ze3 486 ELSE ; z1_e3f(ji,jj) = 0._wp 487 487 ENDIF 488 488 END DO … … 491 491 DO jj = 1, jpjm1 492 492 DO ji = 1, fs_jpim1 ! vector opt. 493 ze3 = ( e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) &494 & + e3t_n(ji,jj ,jk)*tmask(ji,jj ,jk) + e3t_n(ji+1,jj ,jk)*tmask(ji+1,jj ,jk))495 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) &496 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk))493 ze3 = ( e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 494 & + e3t_n(ji,jj ,jk)*tmask(ji,jj ,jk) + e3t_n(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 495 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 496 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) 497 497 IF( ze3 /= 0._wp ) THEN ; z1_e3f(ji,jj) = zmsk / ze3 498 ELSE ; z1_e3f(ji,jj) = 0. 0_wp498 ELSE ; z1_e3f(ji,jj) = 0._wp 499 499 ENDIF 500 500 END DO … … 546 546 END SELECT 547 547 ! 548 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 549 DO jj = 1, jpjm1 550 DO ji = 1, fs_jpim1 ! vector opt. 551 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 552 END DO 553 END DO 554 ENDIF 555 ! 548 556 CALL lbc_lnk( zwz, 'F', 1. ) 549 !550 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==!551 DO jj = 1, jpjm1552 DO ji = 1, fs_jpim1 ! vector opt.553 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)554 END DO555 END DO556 ENDIF557 557 ! 558 558 ! !== horizontal fluxes ==! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r5845 r6004 120 120 DO ji = fs_2, fs_jpim1 ! vector opt. 121 121 ! ! vertical momentum advective trends 122 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk))123 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk))122 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 123 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 124 124 ! ! add the trends to the general momentum trends 125 125 ua(ji,jj,jk) = ua(ji,jj,jk) + zua … … 251 251 DO ji = fs_2, fs_jpim1 ! vector opt. 252 252 ! ! vertical momentum advective trends 253 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk))254 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk))253 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 254 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 255 255 zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts 256 256 zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
r5845 r6004 8 8 !! NEMO 0.5 ! 2002-08 (G. Madec) F90: Free form and module 9 9 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) Forcing averaged over 2 time steps 10 !! 3.7 ! 2015-11 (J. Chanut) output velocities instead of trends 10 11 !!---------------------------------------------------------------------- 11 12 12 13 !!---------------------------------------------------------------------- 13 !! dyn_zdf_exp : update the momentum trend with the vertical diffu-14 !! sion using an explicit time-stepping scheme.14 !! dyn_zdf_exp : update the momentum trend with the vertical diffusion using a split-explicit scheme 15 !! and perform the Leap-Frog time integration. 15 16 !!---------------------------------------------------------------------- 16 USE oce 17 USE dom_oce 18 USE phycst 19 USE zdf_oce 20 USE sbc_oce ! surface boundary condition: ocean21 USE lib_mpp ! MPP library22 USE in_out_manager ! I/O manager23 USE lib_mpp ! MPP library24 USE wrk_nemo ! Memory Allocation25 USE timing ! Timing26 17 USE oce ! ocean dynamics and tracers 18 USE dom_oce ! ocean space and time domain 19 USE phycst ! physical constants 20 USE zdf_oce ! ocean vertical physics 21 USE dynadv , ONLY: ln_dynadv_vec ! Momentum advection form 22 USE sbc_oce ! surface boundary condition: ocean 23 ! 24 USE in_out_manager ! I/O manager 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! Memory Allocation 27 USE timing ! Timing 27 28 28 29 IMPLICIT NONE … … 34 35 # include "vectopt_loop_substitute.h90" 35 36 !!---------------------------------------------------------------------- 36 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)37 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 37 38 !! $Id$ 38 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 45 46 !! 46 47 !! ** Purpose : Compute the trend due to the vert. momentum diffusion 48 !! and perform the Leap-Frog time stepping. 47 49 !! 48 !! ** Method : Explicit forward time stepping with a time splitting49 !! technique. The vertical diffusionof momentum is given by:50 !! ** Method : - Split-explicit forward time stepping. 51 !! The vertical mixing of momentum is given by: 50 52 !! diffu = dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ub) ) 51 53 !! Surface boundary conditions: wind stress input (averaged over kt-1/2 & kt+1/2) … … 53 55 !! Add this trend to the general trend ua : 54 56 !! ua = ua + dz( avmu dz(u) ) 57 !! - Leap-Frog time stepping (Asselin filter will be applied in dyn_nxt) 58 !! ua = ub + 2*dt * ua vector form or linear free surf. 59 !! ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a otherwise 55 60 !! 56 !! ** Action : - Update (ua,va) with the vertical diffusive trend61 !! ** Action : - (ua,va) after velocity 57 62 !!--------------------------------------------------------------------- 58 63 INTEGER , INTENT(in) :: kt ! ocean time-step index 59 64 REAL(wp), INTENT(in) :: p2dt ! time-step 60 65 ! 61 INTEGER :: ji, jj, jk, jl ! dummy loop indices66 INTEGER :: ji, jj, jk, jl ! dummy loop indices 62 67 REAL(wp) :: zlavmr, zua, zva ! local scalars 63 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zwy, zwz, zww 64 69 !!---------------------------------------------------------------------- 65 70 ! 66 IF( nn_timing == 1 ) CALL timing_start('dyn_zdf_exp')71 IF( nn_timing == 1 ) CALL timing_start('dyn_zdf_exp') 67 72 ! 68 CALL wrk_alloc( jpi,jpj,jpk, zwx, zwy, zwz, zww )73 CALL wrk_alloc( jpi,jpj,jpk, zwx, zwy, zwz, zww ) 69 74 ! 70 75 IF( kt == nit000 .AND. lwp ) THEN … … 73 78 WRITE(numout,*) '~~~~~~~~~~~ ' 74 79 ENDIF 75 80 ! 81 ! !== vertical mixing trend ==! 82 ! 76 83 zlavmr = 1. / REAL( nn_zdfexp ) 77 78 79 DO jj = 2, jpjm1 ! Surface boundary condition 84 ! 85 DO jj = 2, jpjm1 ! Surface boundary condition 80 86 DO ji = 2, jpim1 81 87 zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * r1_rau0 … … 83 89 END DO 84 90 END DO 85 DO jk = 1, jpk 91 DO jk = 1, jpk ! Initialization of x, z and contingently trends array 86 92 DO jj = 2, jpjm1 87 93 DO ji = 2, jpim1 … … 92 98 END DO 93 99 ! 94 DO jl = 1, nn_zdfexp 100 DO jl = 1, nn_zdfexp ! Time splitting loop 95 101 ! 96 DO jk = 2, jpk 102 DO jk = 2, jpk ! First vertical derivative 97 103 DO jj = 2, jpjm1 98 104 DO ji = 2, jpim1 … … 102 108 END DO 103 109 END DO 104 DO jk = 1, jpkm1 110 DO jk = 1, jpkm1 ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp 105 111 DO jj = 2, jpjm1 106 112 DO ji = 2, jpim1 … … 115 121 END DO 116 122 END DO 117 ! 118 END DO ! End of time splitting 123 END DO ! End of time splitting 119 124 ! 120 CALL wrk_dealloc( jpi,jpj,jpk, zwx, zwy, zwz, zww )121 125 ! 122 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf_exp') 126 ! !== Leap-Frog time integration ==! 127 ! 128 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity 129 DO jk = 1, jpkm1 130 ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 131 va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 132 END DO 133 ELSE ! applied on thickness weighted velocity 134 DO jk = 1, jpkm1 135 ua(:,:,jk) = ( e3u_b(:,:,jk) * ub(:,:,jk) & 136 & + p2dt * e3u_n(:,:,jk) * ua(:,:,jk) ) / e3u_a(:,:,jk) * umask(:,:,jk) 137 va(:,:,jk) = ( e3v_b(:,:,jk) * vb(:,:,jk) & 138 & + p2dt * e3v_n(:,:,jk) * va(:,:,jk) ) / e3v_a(:,:,jk) * vmask(:,:,jk) 139 END DO 140 ENDIF 141 ! 142 CALL wrk_dealloc( jpi,jpj,jpk, zwx, zwy, zwz, zww ) 143 ! 144 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf_exp') 123 145 ! 124 146 END SUBROUTINE dyn_zdf_exp -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r5866 r6004 2 2 !!====================================================================== 3 3 !! *** MODULE dynzdf_imp *** 4 !! Ocean dynamics: vertical component(s) of the momentum mixing trend 4 !! Ocean dynamics: vertical component(s) of the momentum mixing trend, implicit scheme 5 5 !!====================================================================== 6 6 !! History : OPA ! 1990-10 (B. Blanke) Original code … … 12 12 13 13 !!---------------------------------------------------------------------- 14 !! dyn_zdf_imp : update the momentum trend with the vertical diffusion using a implicit time-stepping 15 !!---------------------------------------------------------------------- 16 USE oce ! ocean dynamics and tracers 17 USE dom_oce ! ocean space and time domain 18 USE domvvl ! variable volume 19 USE sbc_oce ! surface boundary condition: ocean 20 USE zdf_oce ! ocean vertical physics 21 USE phycst ! physical constants 22 USE in_out_manager ! I/O manager 23 USE lib_mpp ! MPP library 24 USE zdfbfr ! Bottom friction setup 25 USE wrk_nemo ! Memory Allocation 26 USE timing ! Timing 27 USE dynadv ! dynamics: vector invariant versus flux form 28 USE dynspg_oce, ONLY: lk_dynspg_ts 14 !! dyn_zdf_imp : compute the vertical diffusion using a implicit scheme 15 !! together with the Leap-Frog time integration. 16 !!---------------------------------------------------------------------- 17 USE oce ! ocean dynamics and tracers 18 USE phycst ! physical constants 19 USE dom_oce ! ocean space and time domain 20 USE domvvl ! variable volume 21 USE sbc_oce ! surface boundary condition: ocean 22 USE dynadv , ONLY: ln_dynadv_vec ! Momentum advection form 23 USE zdf_oce ! ocean vertical physics 24 USE zdfbfr ! Bottom friction setup 25 ! 26 USE in_out_manager ! I/O manager 27 USE lib_mpp ! MPP library 28 USE wrk_nemo ! Memory Allocation 29 USE timing ! Timing 29 30 30 31 IMPLICIT NONE … … 33 34 PUBLIC dyn_zdf_imp ! called by step.F90 34 35 35 REAL(wp) :: r_vvl ! variable volume indicator, =1 if ln_linssh=F, =0otherwise36 REAL(wp) :: r_vvl ! non-linear free surface indicator: =0 if ln_linssh=T, =1 otherwise 36 37 37 38 !! * Substitutions … … 49 50 !! 50 51 !! ** Purpose : Compute the trend due to the vert. momentum diffusion 51 !! and the surface forcing, and add it to the general trend of52 !! the momentum equations.52 !! together with the Leap-Frog time stepping using an 53 !! implicit scheme. 53 54 !! 54 !! ** Method : The vertical momentum mixing trend is given by : 55 !! dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ua) ) 56 !! backward time stepping 57 !! Surface boundary conditions: wind stress input (averaged over kt-1/2 & kt+1/2) 58 !! Bottom boundary conditions : bottom stress (cf zdfbfr.F) 59 !! Add this trend to the general trend ua : 60 !! ua = ua + dz( avmu dz(u) ) 55 !! ** Method : - Leap-Frog time stepping on all trends but the vertical mixing 56 !! ua = ub + 2*dt * ua vector form or linear free surf. 57 !! ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a otherwise 58 !! - update the after velocity with the implicit vertical mixing. 59 !! This requires to solver the following system: 60 !! ua = ua + 1/e3u_a dk+1[ avmu / e3uw_a dk[ua] ] 61 !! with the following surface/top/bottom boundary condition: 62 !! surface: wind stress input (averaged over kt-1/2 & kt+1/2) 63 !! top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfbfr.F) 61 64 !! 62 !! ** Action : - Update (ua,va) arrays with the after vertical diffusive mixing trend.65 !! ** Action : (ua,va) after velocity 63 66 !!--------------------------------------------------------------------- 64 67 INTEGER , INTENT(in) :: kt ! ocean time-step index 65 68 REAL(wp), INTENT(in) :: p2dt ! vertical profile of tracer time-step 66 ! !67 INTEGER :: ji, jj, jk ! dummy loop indices68 INTEGER :: ikbu, ikbv ! local integers69 REAL(wp) :: z 1_p2dt, zcoef, zzwi, zzws, zrhs! local scalars70 REAL(wp) :: z e3ua, ze3va69 ! 70 INTEGER :: ji, jj, jk ! dummy loop indices 71 INTEGER :: ikbu, ikbv ! local integers 72 REAL(wp) :: zzwi, ze3ua ! local scalars 73 REAL(wp) :: zzws, ze3va ! - - 71 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwd, zws 72 75 !!---------------------------------------------------------------------- … … 81 84 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 82 85 ! 83 I F( .NOT.ln_linssh ) THEN ; r_vvl = 1._wp ! Variable volume indicator84 ELSE ; r_vvl = 0._wp86 If( ln_linssh ) THEN ; r_vvl = 0._wp ! non-linear free surface indicator 87 ELSE ; r_vvl = 1._wp 85 88 ENDIF 86 89 ENDIF 87 88 ! 0. Local constant initialization 89 ! -------------------------------- 90 z1_p2dt = 1._wp / p2dt ! inverse of the timestep 91 92 ! 1. Apply semi-implicit bottom friction 93 ! -------------------------------------- 90 ! 91 ! !== Time step dynamics ==! 92 ! 93 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity 94 DO jk = 1, jpkm1 95 ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 96 va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 97 END DO 98 ELSE ! applied on thickness weighted velocity 99 DO jk = 1, jpkm1 100 ua(:,:,jk) = ( e3u_b(:,:,jk) * ub(:,:,jk) & 101 & + p2dt * e3u_n(:,:,jk) * ua(:,:,jk) ) / e3u_a(:,:,jk) * umask(:,:,jk) 102 va(:,:,jk) = ( e3v_b(:,:,jk) * vb(:,:,jk) & 103 & + p2dt * e3v_n(:,:,jk) * va(:,:,jk) ) / e3v_a(:,:,jk) * vmask(:,:,jk) 104 END DO 105 ENDIF 106 ! 107 ! !== Apply semi-implicit bottom friction ==! 108 ! 94 109 ! Only needed for semi-implicit bottom friction setup. The explicit 95 110 ! bottom friction has been included in "u(v)a" which act as the R.H.S 96 111 ! column vector of the tri-diagonal matrix equation 97 112 ! 98 99 113 IF( ln_bfrimp ) THEN 100 114 DO jj = 2, jpjm1 … … 111 125 ikbu = miku(ji,jj) ! ocean top level at u- and v-points 112 126 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 113 IF (ikbu .GE. 2)avmu(ji,jj,ikbu) = -tfrua(ji,jj) * e3uw_n(ji,jj,ikbu)114 IF (ikbv .GE. 2)avmv(ji,jj,ikbv) = -tfrva(ji,jj) * e3vw_n(ji,jj,ikbv)127 IF( ikbu >= 2 ) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * e3uw_n(ji,jj,ikbu) 128 IF( ikbv >= 2 ) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * e3vw_n(ji,jj,ikbv) 115 129 END DO 116 130 END DO 117 131 END IF 118 132 ENDIF 119 120 #if defined key_dynspg_ts 121 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity 122 DO jk = 1, jpkm1 123 ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 124 va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 125 END DO 126 ELSE ! applied on thickness weighted velocity 127 DO jk = 1, jpkm1 128 ua(:,:,jk) = ( ub(:,:,jk) * e3u_b(:,:,jk) & 129 & + p2dt * ua(:,:,jk) * e3u_n(:,:,jk) ) / e3u_a(:,:,jk) * umask(:,:,jk) 130 va(:,:,jk) = ( vb(:,:,jk) * e3v_b(:,:,jk) & 131 & + p2dt * va(:,:,jk) * e3v_n(:,:,jk) ) / e3v_a(:,:,jk) * vmask(:,:,jk) 132 END DO 133 ENDIF 134 135 IF ( ln_bfrimp .AND.lk_dynspg_ts ) THEN 136 ! remove barotropic velocities: 137 DO jk = 1, jpkm1 138 ua(:,:,jk) = (ua(:,:,jk) - ua_b(:,:)) * umask(:,:,jk) 139 va(:,:,jk) = (va(:,:,jk) - va_b(:,:)) * vmask(:,:,jk) 140 END DO 141 ! Add bottom/top stress due to barotropic component only: 142 DO jj = 2, jpjm1 133 ! 134 ! With split-explicit free surface, barotropic stress is treated explicitly 135 ! Update velocities at the bottom. 136 ! J. Chanut: The bottom stress is computed considering after barotropic velocities, which does 137 ! not lead to the effective stress seen over the whole barotropic loop. 138 ! G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a 139 IF( ln_bfrimp .AND. ln_dynspg_ts ) THEN 140 DO jk = 1, jpkm1 ! remove barotropic velocities 141 ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk) 142 va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk) 143 END DO 144 DO jj = 2, jpjm1 ! Add bottom/top stress due to barotropic component only 143 145 DO ji = fs_2, fs_jpim1 ! vector opt. 144 146 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 145 147 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 146 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl 147 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl 148 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu) 149 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv) 148 150 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * bfrua(ji,jj) * ua_b(ji,jj) / ze3ua 149 151 va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * bfrva(ji,jj) * va_b(ji,jj) / ze3va 150 152 END DO 151 153 END DO 152 IF ( ln_isfcav ) THEN154 IF( ln_isfcav ) THEN ! Ocean cavities (ISF) 153 155 DO jj = 2, jpjm1 154 156 DO ji = fs_2, fs_jpim1 ! vector opt. 155 157 ikbu = miku(ji,jj) ! top ocean level at u- and v-points 156 158 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 157 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl 158 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl 159 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,ikbu) + r_vvl * e3u_a(ji,jj,ikbu) 160 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikbv) + r_vvl * e3v_a(ji,jj,ikbv) 159 161 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + p2dt * tfrua(ji,jj) * ua_b(ji,jj) / ze3ua 160 162 va(ji,jj,ikbv) = va(ji,jj,ikbv) + p2dt * tfrva(ji,jj) * va_b(ji,jj) / ze3va … … 163 165 END IF 164 166 ENDIF 165 #endif 166 167 ! 2. Vertical diffusion on u 168 ! --------------------------- 167 ! 168 ! !== Vertical diffusion on u ==! 169 ! 169 170 ! Matrix and second member construction 170 171 ! bottom boundary condition: both zwi and zws must be masked as avmu can take … … 174 175 DO jj = 2, jpjm1 175 176 DO ji = fs_2, fs_jpim1 ! vector opt. 176 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk) ! after scale factor at T-point 177 zcoef = - p2dt / ze3ua 178 zzwi = zcoef * avmu(ji,jj,jk ) / e3uw_n(ji,jj,jk ) 179 zzws = zcoef * avmu(ji,jj,jk+1) / e3uw_n(ji,jj,jk+1) 180 zwi(ji,jj,jk) = zzwi * wumask(ji,jj,jk ) 181 zws(ji,jj,jk) = zzws * wumask(ji,jj,jk+1) 177 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk) ! after scale factor at T-point 178 zzwi = - p2dt * avmu(ji,jj,jk ) / ( ze3ua * e3uw_n(ji,jj,jk ) ) 179 zzws = - p2dt * avmu(ji,jj,jk+1) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) 180 zwi(ji,jj,jk) = zzwi * wumask(ji,jj,jk ) 181 zws(ji,jj,jk) = zzws * wumask(ji,jj,jk+1) 182 182 zwd(ji,jj,jk) = 1._wp - zzwi - zzws 183 183 END DO … … 214 214 END DO 215 215 ! 216 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 217 DO ji = fs_2, fs_jpim1 ! vector opt. 218 #if defined key_dynspg_ts 219 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 216 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 217 DO ji = fs_2, fs_jpim1 ! vector opt. 218 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 220 219 ua(ji,jj,1) = ua(ji,jj,1) + p2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 221 220 & / ( ze3ua * rau0 ) * umask(ji,jj,1) 222 #else223 ua(ji,jj,1) = ub(ji,jj,1) &224 & + p2dt *( ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) &225 & / ( e3u_n(ji,jj,1) * rau0 ) * umask(ji,jj,1) )226 #endif227 221 END DO 228 222 END DO … … 230 224 DO jj = 2, jpjm1 231 225 DO ji = fs_2, fs_jpim1 232 #if defined key_dynspg_ts 233 zrhs = ua(ji,jj,jk) ! zrhs=right hand side 234 #else 235 zrhs = ub(ji,jj,jk) + p2dt * ua(ji,jj,jk) 236 #endif 237 ua(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1) 238 END DO 239 END DO 240 END DO 241 ! 242 DO jj = 2, jpjm1 !== thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk == 226 ua(ji,jj,jk) = ua(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1) 227 END DO 228 END DO 229 END DO 230 ! 231 DO jj = 2, jpjm1 !== thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk ==! 243 232 DO ji = fs_2, fs_jpim1 ! vector opt. 244 233 ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) … … 252 241 END DO 253 242 END DO 254 255 #if ! defined key_dynspg_ts 256 ! Normalization to obtain the general momentum trend ua 257 DO jk = 1, jpkm1 258 DO jj = 2, jpjm1 259 DO ji = fs_2, fs_jpim1 ! vector opt. 260 ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_p2dt 261 END DO 262 END DO 263 END DO 264 #endif 265 266 ! 3. Vertical diffusion on v 267 ! --------------------------- 243 ! 244 ! !== Vertical diffusion on v ==! 245 ! 268 246 ! Matrix and second member construction 269 247 ! bottom boundary condition: both zwi and zws must be masked as avmv can take … … 273 251 DO jj = 2, jpjm1 274 252 DO ji = fs_2, fs_jpim1 ! vector opt. 275 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk) ! after scale factor at T-point 276 zcoef = - p2dt / ze3va 277 zzwi = zcoef * avmv (ji,jj,jk ) / e3vw_n(ji,jj,jk ) 278 zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk) 279 zzws = zcoef * avmv (ji,jj,jk+1) / e3vw_n(ji,jj,jk+1) 280 zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) 253 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk) ! after scale factor at T-point 254 zzwi = - p2dt * avmv (ji,jj,jk ) / ( ze3va * e3vw_n(ji,jj,jk ) ) 255 zzws = - p2dt * avmv (ji,jj,jk+1) / ( ze3va * e3vw_n(ji,jj,jk+1) ) 256 zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk ) 257 zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) 281 258 zwd(ji,jj,jk) = 1._wp - zzwi - zzws 282 259 END DO … … 313 290 END DO 314 291 ! 315 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 316 DO ji = fs_2, fs_jpim1 ! vector opt. 317 #if defined key_dynspg_ts 318 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 292 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 293 DO ji = fs_2, fs_jpim1 ! vector opt. 294 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 319 295 va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 320 296 & / ( ze3va * rau0 ) 321 #else322 va(ji,jj,1) = vb(ji,jj,1) &323 & + p2dt *( va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) &324 & / ( e3v_n(ji,jj,1) * rau0 ) )325 #endif326 297 END DO 327 298 END DO … … 329 300 DO jj = 2, jpjm1 330 301 DO ji = fs_2, fs_jpim1 ! vector opt. 331 #if defined key_dynspg_ts 332 zrhs = va(ji,jj,jk) ! zrhs=right hand side 333 #else 334 zrhs = vb(ji,jj,jk) + p2dt * va(ji,jj,jk) 335 #endif 336 va(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1) 337 END DO 338 END DO 339 END DO 340 ! 341 DO jj = 2, jpjm1 !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk == 302 va(ji,jj,jk) = va(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1) 303 END DO 304 END DO 305 END DO 306 ! 307 DO jj = 2, jpjm1 !== third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk ==! 342 308 DO ji = fs_2, fs_jpim1 ! vector opt. 343 309 va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) … … 351 317 END DO 352 318 END DO 353 354 ! Normalization to obtain the general momentum trend va 355 #if ! defined key_dynspg_ts 356 DO jk = 1, jpkm1 357 DO jj = 2, jpjm1 358 DO ji = fs_2, fs_jpim1 ! vector opt. 359 va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_p2dt 360 END DO 361 END DO 362 END DO 363 #endif 364 319 365 320 ! J. Chanut: Lines below are useless ? 366 321 !! restore bottom layer avmu(v) 322 !!gm I almost sure it is !!!! 367 323 IF( ln_bfrimp ) THEN 368 324 DO jj = 2, jpjm1 … … 370 326 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 371 327 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 372 avmu(ji,jj,ikbu+1) = 0. e0373 avmv(ji,jj,ikbv+1) = 0. e0328 avmu(ji,jj,ikbu+1) = 0._wp 329 avmv(ji,jj,ikbv+1) = 0._wp 374 330 END DO 375 331 END DO … … 379 335 ikbu = miku(ji,jj) ! ocean top level at u- and v-points 380 336 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 381 IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0382 IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0337 IF( ikbu > 1 ) avmu(ji,jj,ikbu) = 0._wp 338 IF( ikbv > 1 ) avmv(ji,jj,ikbv) = 0._wp 383 339 END DO 384 340 END DO 385 END 386 ENDIF 387 ! 388 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws)389 ! 390 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf_imp')341 ENDIF 342 ENDIF 343 ! 344 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws) 345 ! 346 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf_imp') 391 347 ! 392 348 END SUBROUTINE dyn_zdf_imp -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r5866 r6004 12 12 13 13 !!---------------------------------------------------------------------- 14 !! ssh_nxt 15 !! ssh_swp 16 !! wzv 17 !!---------------------------------------------------------------------- 18 USE oce 19 USE dom_oce 20 USE sbc_oce 21 USE domvvl 22 USE divhor 23 USE phycst 24 USE bdy_oce 25 USE bdy_par 26 USE bdydyn2d 14 !! ssh_nxt : after ssh 15 !! ssh_swp : filter ans swap the ssh arrays 16 !! wzv : compute now vertical velocity 17 !!---------------------------------------------------------------------- 18 USE oce ! ocean dynamics and tracers variables 19 USE dom_oce ! ocean space and time domain variables 20 USE sbc_oce ! surface boundary condition: ocean 21 USE domvvl ! Variable volume 22 USE divhor ! horizontal divergence 23 USE phycst ! physical constants 24 USE bdy_oce ! 25 USE bdy_par ! 26 USE bdydyn2d ! bdy_ssh routine 27 27 #if defined key_agrif 28 28 USE agrif_opa_interp 29 29 #endif 30 30 #if defined key_asminc 31 USE asminc ! Assimilation increment 32 #endif 33 USE in_out_manager ! I/O manager 34 USE restart ! only for lrst_oce 35 USE prtctl ! Print control 36 USE lbclnk ! ocean lateral boundary condition (or mpp link) 37 USE lib_mpp ! MPP library 38 USE wrk_nemo ! Memory Allocation 39 USE timing ! Timing 31 USE asminc ! Assimilation increment 32 #endif 33 ! 34 USE in_out_manager ! I/O manager 35 USE restart ! only for lrst_oce 36 USE prtctl ! Print control 37 USE lbclnk ! ocean lateral boundary condition (or mpp link) 38 USE lib_mpp ! MPP library 39 USE wrk_nemo ! Memory Allocation 40 USE timing ! Timing 40 41 41 42 IMPLICIT NONE … … 105 106 ssha(:,:) = ( sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * ssmask(:,:) 106 107 107 #if ! defined key_dynspg_ts 108 ! These lines are not necessary with time splitting since109 ! boundary condition on sea level is set during ts loop108 IF ( .NOT.ln_dynspg_ts ) THEN 109 ! These lines are not necessary with time splitting since 110 ! boundary condition on sea level is set during ts loop 110 111 # if defined key_agrif 111 CALL agrif_ssh( kt )112 CALL agrif_ssh( kt ) 112 113 # endif 113 114 # if defined key_bdy 114 IF( lk_bdy ) THEN115 CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary116 CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries117 ENDIF115 IF( lk_bdy ) THEN 116 CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary 117 CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries 118 ENDIF 118 119 # endif 119 #endif 120 ENDIF 120 121 121 122 #if defined key_asminc … … 193 194 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 194 195 ! computation of w 195 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)&196 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )) * tmask(:,:,jk)196 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk) & 197 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 197 198 END DO 198 199 ! IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 … … 201 202 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 202 203 ! computation of w 203 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk)&204 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )) * tmask(:,:,jk)204 wn(:,:,jk) = wn(:,:,jk+1) - ( e3t_n(:,:,jk) * hdivn(:,:,jk) & 205 & + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) ) ) * tmask(:,:,jk) 205 206 END DO 206 207 ENDIF … … 239 240 !!---------------------------------------------------------------------- 240 241 INTEGER, INTENT(in) :: kt ! ocean time-step index 242 ! 243 REAL(wp) :: zcoef ! local scalar 241 244 !!---------------------------------------------------------------------- 242 245 ! … … 248 251 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 249 252 ENDIF 250 251 # if defined key_dynspg_ts 252 IF( ( neuler == 0 .AND. kt == nit000 ) .OR. ln_bt_fw ) THEN !** Euler time-stepping: no filter 253 # else 254 IF ( neuler == 0 .AND. kt == nit000 ) THEN !** Euler time-stepping at first time-step : no filter 255 #endif 256 sshb(:,:) = sshn(:,:) ! before <-- now 257 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) 253 ! !== Euler time-stepping: no filter, just swap ==! 254 IF( ( neuler == 0 .AND. kt == nit000 ) .OR. & 255 & ( ln_bt_fw .AND. ln_dynspg_ts ) ) THEN 256 sshb(:,:) = sshn(:,:) ! before <-- now 257 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) 258 258 ! 259 ELSE !** Leap-Frog time-stepping: Asselin filter + swap 260 sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) ! before <-- now filtered 261 IF( .NOT.ln_linssh ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) & 262 & - rnf_b(:,:) + rnf(:,:) & 263 & + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:) 264 sshn(:,:) = ssha(:,:) ! now <-- after 259 ELSE !== Leap-Frog time-stepping: Asselin filter + swap ==! 260 ! ! before <-- now filtered 261 sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 262 IF( .NOT.ln_linssh ) THEN ! before <-- with forcing removed 263 zcoef = atfp * rdt * r1_rau0 264 sshb(:,:) = sshb(:,:) - zcoef * ( emp_b(:,:) - emp (:,:) & 265 & - rnf_b(:,:) + rnf (:,:) & 266 & + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:) 267 ENDIF 268 sshn(:,:) = ssha(:,:) ! now <-- after 265 269 ENDIF 266 270 ! 267 271 IF(ln_ctl) CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb - : ', mask1=tmask, ovlap=1 ) 268 272 ! 269 IF( nn_timing == 1 ) CALL timing_stop('ssh_swp')273 IF( nn_timing == 1 ) CALL timing_stop('ssh_swp') 270 274 ! 271 275 END SUBROUTINE ssh_swp -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90
r5215 r6004 43 43 PUBLIC icb_alloc ! routine called by icb_init in icbini.F90 module 44 44 45 INTEGER, PUBLIC, PARAMETER :: nclasses = 10 !: Number of icebergs classes45 INTEGER, PUBLIC, PARAMETER :: nclasses = 10 !: Number of icebergs classes 46 46 INTEGER, PUBLIC, PARAMETER :: nkounts = 3 !: Number of integers combined for unique naming 47 47 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r5866 r6004 236 236 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop ) ! now potential density 237 237 ELSE 238 CALL eos 238 CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) ) 239 239 ENDIF 240 240 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r5883 r6004 14 14 !! 'key_mpp_mpi' MPI massively parallel processing library 15 15 !!---------------------------------------------------------------------- 16 !! lbc_lnk : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp17 !! lbc_lnk_e : generic interface for mpp_lnk_2d_e routine defined in lib_mpp18 !! lbc_bdy_lnk : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp19 !!---------------------------------------------------------------------- 20 USE lib_mpp 16 !! lbc_lnk : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 17 !! lbc_lnk_e : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 18 !! lbc_bdy_lnk : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 19 !!---------------------------------------------------------------------- 20 USE lib_mpp ! distributed memory computing library 21 21 22 22 INTERFACE lbc_lnk_multi … … 90 90 91 91 !!---------------------------------------------------------------------- 92 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)92 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 93 93 !! $Id$ 94 94 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r4686 r6004 24 24 MODULE PROCEDURE lbc_nfd_3d, lbc_nfd_2d 25 25 END INTERFACE 26 27 PUBLIC lbc_nfd ! north fold conditions 26 ! 28 27 INTERFACE mpp_lbc_nfd 29 28 MODULE PROCEDURE mpp_lbc_nfd_3d, mpp_lbc_nfd_2d 30 29 END INTERFACE 31 30 32 PUBLIC mpp_lbc_nfd ! north fold conditions in parallel case 33 34 INTEGER, PUBLIC, PARAMETER :: jpmaxngh = 3 35 INTEGER, PUBLIC :: nsndto, nfsloop, nfeloop 36 INTEGER, PUBLIC, DIMENSION (jpmaxngh) :: isendto ! processes to which communicate 37 38 31 PUBLIC lbc_nfd ! north fold conditions 32 PUBLIC mpp_lbc_nfd ! north fold conditions (parallel case) 33 34 INTEGER, PUBLIC, PARAMETER :: jpmaxngh = 3 !: 35 INTEGER, PUBLIC :: nsndto, nfsloop, nfeloop !: 36 INTEGER, PUBLIC, DIMENSION (jpmaxngh) :: isendto !: processes to which communicate 39 37 40 38 !!---------------------------------------------------------------------- … … 391 389 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change 392 390 ! ! = -1. , the sign is changed if north fold boundary 393 ! ! = 1. , the sign is kept if north fold boundary394 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3dl 395 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pt3dr! 3D array on which the boundary condition is applied391 ! ! = 1. , the sign is kept if north fold boundary 392 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3dl ! 3D array on which the boundary condition is applied 393 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pt3dr ! 3D array on which the boundary condition is applied 396 394 ! 397 395 INTEGER :: ji, jk 398 396 INTEGER :: ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 399 397 !!---------------------------------------------------------------------- 400 398 ! 401 399 SELECT CASE ( jpni ) 402 400 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction … … 657 655 ! ! = -1. , the sign is changed if north fold boundary 658 656 ! ! = 1. , the sign is kept if north fold boundary 659 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2dl 660 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pt2dr! 2D array on which the boundary condition is applied657 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2dl ! 2D array on which the boundary condition is applied 658 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pt2dr ! 2D array on which the boundary condition is applied 661 659 ! 662 660 INTEGER :: ji … … 970 968 END SUBROUTINE mpp_lbc_nfd_2d 971 969 970 !!====================================================================== 972 971 END MODULE lbcnfd -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r5883 r6004 27 27 28 28 !!---------------------------------------------------------------------- 29 !! ctl_stop : update momentum and tracer Kz from a tke scheme30 !! ctl_warn : initialization, namelist read, and parameters control31 !! ctl_opn : Open file and check if required file is available.32 !! ctl_nam : Prints informations when an error occurs while reading a namelist33 !! get_unit : give the index of an unused logical unit29 !! ctl_stop : update momentum and tracer Kz from a tke scheme 30 !! ctl_warn : initialization, namelist read, and parameters control 31 !! ctl_opn : Open file and check if required file is available. 32 !! ctl_nam : Prints informations when an error occurs while reading a namelist 33 !! get_unit : give the index of an unused logical unit 34 34 !!---------------------------------------------------------------------- 35 35 #if defined key_mpp_mpi … … 43 43 !! mpp_lnk_e : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 44 44 !! mpp_lnk_icb : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb) 45 !! mpprecv 45 !! mpprecv : 46 46 !! mppsend : SUBROUTINE mpp_ini_znl 47 47 !! mppscatter : … … 94 94 END INTERFACE 95 95 INTERFACE mpp_sum 96 MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, &96 MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, & 97 97 mppsum_realdd, mppsum_a_realdd 98 98 END INTERFACE … … 175 175 !! ** Purpose : Find processor unit 176 176 !!---------------------------------------------------------------------- 177 CHARACTER(len=*),DIMENSION(:), INTENT( out) :: ldtxt 178 CHARACTER(len=*) , INTENT(in ) :: ldname 179 INTEGER , INTENT(in ) :: kumnam_ref 180 INTEGER , INTENT(in ) :: kumnam_cfg 181 INTEGER , INTENT(inout) :: kumond 182 INTEGER , INTENT(inout) :: kstop 183 INTEGER , OPTIONAL , INTENT(in ) :: localComm177 CHARACTER(len=*),DIMENSION(:), INTENT( out) :: ldtxt ! 178 CHARACTER(len=*) , INTENT(in ) :: ldname ! 179 INTEGER , INTENT(in ) :: kumnam_ref ! logical unit for reference namelist 180 INTEGER , INTENT(in ) :: kumnam_cfg ! logical unit for configuration namelist 181 INTEGER , INTENT(inout) :: kumond ! logical unit for namelist output 182 INTEGER , INTENT(inout) :: kstop ! stop indicator 183 INTEGER , OPTIONAL , INTENT(in ) :: localComm ! 184 184 ! 185 185 INTEGER :: mynode, ierr, code, ji, ii, ios … … 190 190 ! 191 191 ii = 1 192 WRITE(ldtxt(ii),*) 193 WRITE(ldtxt(ii),*) 'mynode : mpi initialisation' 194 WRITE(ldtxt(ii),*) '~~~~~~ ' 192 WRITE(ldtxt(ii),*) ; ii = ii + 1 193 WRITE(ldtxt(ii),*) 'mynode : mpi initialisation' ; ii = ii + 1 194 WRITE(ldtxt(ii),*) '~~~~~~ ' ; ii = ii + 1 195 195 ! 196 196 … … 204 204 205 205 ! ! control print 206 WRITE(ldtxt(ii),*) ' Namelist nammpp' 207 WRITE(ldtxt(ii),*) ' mpi send type cn_mpi_send = ', cn_mpi_send; ii = ii + 1208 WRITE(ldtxt(ii),*) ' size in bytes of exported buffer nn_buffer = ', nn_buffer; ii = ii + 1206 WRITE(ldtxt(ii),*) ' Namelist nammpp' ; ii = ii + 1 207 WRITE(ldtxt(ii),*) ' mpi send type cn_mpi_send = ', cn_mpi_send ; ii = ii + 1 208 WRITE(ldtxt(ii),*) ' size exported buffer nn_buffer = ', nn_buffer,' bytes'; ii = ii + 1 209 209 210 210 #if defined key_agrif … … 223 223 224 224 IF( (jpni < 1) .OR. (jpnj < 1) )THEN 225 WRITE(ldtxt(ii),*) ' jpni, jpnj and jpnij will be calculated automatically' ;ii = ii + 1225 WRITE(ldtxt(ii),*) ' jpni, jpnj and jpnij will be calculated automatically' ; ii = ii + 1 226 226 ELSE 227 WRITE(ldtxt(ii),*) ' processor grid extent in i jpni = ',jpni ;ii = ii + 1228 WRITE(ldtxt(ii),*) ' processor grid extent in j jpnj = ',jpnj ;ii = ii + 1229 WRITE(ldtxt(ii),*) ' number of local domains jpnij = ',jpnij ; ii = ii +1227 WRITE(ldtxt(ii),*) ' processor grid extent in i jpni = ',jpni ; ii = ii + 1 228 WRITE(ldtxt(ii),*) ' processor grid extent in j jpnj = ',jpnj ; ii = ii + 1 229 WRITE(ldtxt(ii),*) ' number of local domains jpnij = ',jpnij ; ii = ii + 1 230 230 END IF 231 231 … … 246 246 SELECT CASE ( cn_mpi_send ) 247 247 CASE ( 'S' ) ! Standard mpi send (blocking) 248 WRITE(ldtxt(ii),*) ' Standard blocking mpi send (send)' 248 WRITE(ldtxt(ii),*) ' Standard blocking mpi send (send)' ; ii = ii + 1 249 249 CASE ( 'B' ) ! Buffer mpi send (blocking) 250 WRITE(ldtxt(ii),*) ' Buffer blocking mpi send (bsend)' 250 WRITE(ldtxt(ii),*) ' Buffer blocking mpi send (bsend)' ; ii = ii + 1 251 251 IF( Agrif_Root() ) CALL mpi_init_opa( ldtxt, ii, ierr ) 252 252 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 253 WRITE(ldtxt(ii),*) ' Immediate non-blocking send (isend)' 253 WRITE(ldtxt(ii),*) ' Immediate non-blocking send (isend)' ; ii = ii + 1 254 254 l_isend = .TRUE. 255 255 CASE DEFAULT 256 WRITE(ldtxt(ii),cform_err) 257 WRITE(ldtxt(ii),*) ' bad value for cn_mpi_send = ', cn_mpi_send 256 WRITE(ldtxt(ii),cform_err) ; ii = ii + 1 257 WRITE(ldtxt(ii),*) ' bad value for cn_mpi_send = ', cn_mpi_send ; ii = ii + 1 258 258 kstop = kstop + 1 259 259 END SELECT 260 260 ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 261 WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator ' 262 WRITE(ldtxt(ii),*) ' without calling MPI_Init before ! ' 261 WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator ' ; ii = ii + 1 262 WRITE(ldtxt(ii),*) ' without calling MPI_Init before ! ' ; ii = ii + 1 263 263 kstop = kstop + 1 264 264 ELSE 265 265 SELECT CASE ( cn_mpi_send ) 266 266 CASE ( 'S' ) ! Standard mpi send (blocking) 267 WRITE(ldtxt(ii),*) ' Standard blocking mpi send (send)' 267 WRITE(ldtxt(ii),*) ' Standard blocking mpi send (send)' ; ii = ii + 1 268 268 CALL mpi_init( ierr ) 269 269 CASE ( 'B' ) ! Buffer mpi send (blocking) 270 WRITE(ldtxt(ii),*) ' Buffer blocking mpi send (bsend)' 270 WRITE(ldtxt(ii),*) ' Buffer blocking mpi send (bsend)' ; ii = ii + 1 271 271 IF( Agrif_Root() ) CALL mpi_init_opa( ldtxt, ii, ierr ) 272 272 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 273 WRITE(ldtxt(ii),*) ' Immediate non-blocking send (isend)' 273 WRITE(ldtxt(ii),*) ' Immediate non-blocking send (isend)' ; ii = ii + 1 274 274 l_isend = .TRUE. 275 275 CALL mpi_init( ierr ) 276 276 CASE DEFAULT 277 WRITE(ldtxt(ii),cform_err) 278 WRITE(ldtxt(ii),*) ' bad value for cn_mpi_send = ', cn_mpi_send 277 WRITE(ldtxt(ii),cform_err) ; ii = ii + 1 278 WRITE(ldtxt(ii),*) ' bad value for cn_mpi_send = ', cn_mpi_send ; ii = ii + 1 279 279 kstop = kstop + 1 280 280 END SELECT … … 319 319 END FUNCTION mynode 320 320 321 321 322 SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 322 323 !!---------------------------------------------------------------------- … … 347 348 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 348 349 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 349 ! !350 ! 350 351 INTEGER :: ji, jj, jk, jl ! dummy loop indices 351 352 INTEGER :: imigr, iihom, ijhom ! temporary integers 352 353 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 353 354 REAL(wp) :: zland 354 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 355 ! 355 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 356 356 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 357 357 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 358 359 358 !!---------------------------------------------------------------------- 360 359 … … 364 363 ! 365 364 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 366 ELSE ; zland = 0. e0! zero by default365 ELSE ; zland = 0._wp ! zero by default 367 366 ENDIF 368 367 … … 455 454 END SELECT 456 455 457 458 456 ! 3. North and south directions 459 457 ! ----------------------------- … … 508 506 END SELECT 509 507 510 511 508 ! 4. north fold treatment 512 509 ! ----------------------- … … 524 521 ! 525 522 END SUBROUTINE mpp_lnk_3d 523 526 524 527 525 SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval ) … … 542 540 !! noso : number for local neighboring processors 543 541 !! nono : number for local neighboring processors 544 !! 545 !!---------------------------------------------------------------------- 546 547 INTEGER :: num_fields 548 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 542 !!---------------------------------------------------------------------- 549 543 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points 550 544 ! ! = T , U , V , F , W and I points … … 558 552 INTEGER :: imigr, iihom, ijhom ! temporary integers 559 553 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 560 554 INTEGER :: num_fields 555 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 561 556 REAL(wp) :: zland 562 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 563 ! 557 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 564 558 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 565 559 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 566 560 567 561 !!---------------------------------------------------------------------- 568 562 ! 569 563 ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields), & 570 564 & zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields) ) 571 572 565 ! 573 566 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 574 ELSE ; zland = 0. e0! zero by default567 ELSE ; zland = 0._wp ! zero by default 575 568 ENDIF 576 569 … … 744 737 ! 745 738 END DO 746 739 ! 747 740 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 748 741 ! … … 750 743 751 744 752 SUBROUTINE load_array( pt2d,cd_type,psgn,pt2d_array, type_array, psgn_array,num_fields)745 SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, num_fields ) 753 746 !!--------------------------------------------------------------------- 754 REAL(wp), DIMENSION(jpi,jpj), TARGET ,INTENT(inout) :: pt2d ! Second 2D array on which the boundary condition is applied755 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points756 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary747 REAL(wp), DIMENSION(jpi,jpj), TARGET, INTENT(inout) :: pt2d ! Second 2D array on which the boundary condition is applied 748 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 749 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 757 750 TYPE(arrayptr) , DIMENSION(9) :: pt2d_array 758 751 CHARACTER(len=1) , DIMENSION(9) :: type_array ! define the nature of ptab array grid-points 759 752 REAL(wp) , DIMENSION(9) :: psgn_array ! =-1 the sign change across the north fold boundary 760 INTEGER , INTENT (inout):: num_fields753 INTEGER , INTENT (inout) :: num_fields 761 754 !!--------------------------------------------------------------------- 762 num_fields =num_fields+1763 pt2d_array(num_fields)%pt2d =>pt2d764 type_array(num_fields) =cd_type765 psgn_array(num_fields) =psgn755 num_fields = num_fields + 1 756 pt2d_array(num_fields)%pt2d => pt2d 757 type_array(num_fields) = cd_type 758 psgn_array(num_fields) = psgn 766 759 END SUBROUTINE load_array 767 760 … … 792 785 INTEGER :: num_fields 793 786 !!--------------------------------------------------------------------- 794 787 ! 795 788 num_fields = 0 796 797 !! Load the first array 798 CALL load_array(pt2dA,cd_typeA,psgnA,pt2d_array, type_array, psgn_array,num_fields) 799 800 !! Look if more arrays are added 801 IF(PRESENT (psgnB) )CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields) 802 IF(PRESENT (psgnC) )CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields) 803 IF(PRESENT (psgnD) )CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields) 804 IF(PRESENT (psgnE) )CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields) 805 IF(PRESENT (psgnF) )CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields) 806 IF(PRESENT (psgnG) )CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields) 807 IF(PRESENT (psgnH) )CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields) 808 IF(PRESENT (psgnI) )CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields) 809 810 CALL mpp_lnk_2d_multiple(pt2d_array,type_array,psgn_array,num_fields,cd_mpp,pval) 789 ! 790 ! Load the first array 791 CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, num_fields ) 792 ! 793 ! Look if more arrays are added 794 IF( PRESENT(psgnB) ) CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields) 795 IF( PRESENT(psgnC) ) CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields) 796 IF( PRESENT(psgnD) ) CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields) 797 IF( PRESENT(psgnE) ) CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields) 798 IF( PRESENT(psgnF) ) CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields) 799 IF( PRESENT(psgnG) ) CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields) 800 IF( PRESENT(psgnH) ) CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields) 801 IF( PRESENT(psgnI) ) CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields) 802 ! 803 CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, num_fields, cd_mpp,pval ) 804 ! 811 805 END SUBROUTINE mpp_lnk_2d_9 812 806 … … 843 837 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 844 838 REAL(wp) :: zland 845 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 846 ! 839 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 847 840 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 848 841 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 849 850 !!---------------------------------------------------------------------- 851 842 !!---------------------------------------------------------------------- 843 ! 852 844 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 853 845 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 854 855 846 ! 856 847 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 857 ELSE ; zland = 0. e0! zero by default848 ELSE ; zland = 0._wp ! zero by default 858 849 ENDIF 859 850 … … 1046 1037 INTEGER :: imigr, iihom, ijhom ! temporary integers 1047 1038 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 1048 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 1049 ! 1039 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 1050 1040 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zt4ns, zt4sn ! 2 x 3d for north-south & south-north 1051 1041 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zt4ew, zt4we ! 2 x 3d for east-west & west-east 1052 1053 ! !----------------------------------------------------------------------1042 !!---------------------------------------------------------------------- 1043 ! 1054 1044 ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) , & 1055 1045 & zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) ) 1056 1057 1046 ! 1058 1047 ! 1. standard boundary treatment 1059 1048 ! ------------------------------ … … 1399 1388 END DO 1400 1389 END SELECT 1401 1390 ! 1402 1391 END SUBROUTINE mpp_lnk_2d_e 1403 1392 … … 1449 1438 !!---------------------------------------------------------------------- 1450 1439 ! 1451 1452 1440 ! If a specific process number has been passed to the receive call, 1453 1441 ! use that one. Default is to use mpi_any_source 1454 use_source=mpi_any_source 1455 if(present(ksource)) then 1456 use_source=ksource 1457 end if 1458 1442 use_source = mpi_any_source 1443 IF( PRESENT(ksource) ) use_source = ksource 1444 ! 1459 1445 CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_opa, istatus, iflag ) 1460 1446 ! … … 1470 1456 !! 1471 1457 !!---------------------------------------------------------------------- 1472 REAL(wp), DIMENSION(jpi,jpj) ,INTENT(in ) :: ptab ! subdomain input array1473 INTEGER ,INTENT(in ) :: kp ! record length1458 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: ptab ! subdomain input array 1459 INTEGER , INTENT(in ) :: kp ! record length 1474 1460 REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT( out) :: pio ! subdomain input array 1475 1461 !! … … 1492 1478 !! 1493 1479 !!---------------------------------------------------------------------- 1494 REAL(wp), DIMENSION(jpi,jpj,jpnij) :: pio! output array1495 INTEGER :: kp 1496 REAL(wp), DIMENSION(jpi,jpj) :: ptab! subdomain array input1480 REAL(wp), DIMENSION(jpi,jpj,jpnij) :: pio ! output array 1481 INTEGER :: kp ! Tag (not used with MPI 1482 REAL(wp), DIMENSION(jpi,jpj) :: ptab ! subdomain array input 1497 1483 !! 1498 1484 INTEGER :: itaille, ierror ! temporary integer 1499 1485 !!--------------------------------------------------------------------- 1500 1486 ! 1501 itaille =jpi*jpj1487 itaille = jpi * jpj 1502 1488 ! 1503 1489 CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille , & … … 1517 1503 INTEGER , INTENT(inout), DIMENSION(kdim) :: ktab ! input array 1518 1504 INTEGER , INTENT(in ), OPTIONAL :: kcom ! 1519 ! !1505 ! 1520 1506 INTEGER :: ierror, localcomm ! temporary integer 1521 1507 INTEGER, DIMENSION(kdim) :: iwork … … 1539 1525 !! 1540 1526 !!---------------------------------------------------------------------- 1541 INTEGER, INTENT(inout) :: ktab 1542 INTEGER, INTENT(in ), OPTIONAL :: kcom 1543 ! !1527 INTEGER, INTENT(inout) :: ktab ! ??? 1528 INTEGER, INTENT(in ), OPTIONAL :: kcom ! ??? 1529 ! 1544 1530 INTEGER :: ierror, iwork, localcomm ! temporary integer 1545 1531 !!---------------------------------------------------------------------- … … 1548 1534 IF( PRESENT(kcom) ) localcomm = kcom 1549 1535 ! 1550 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror )1536 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror ) 1551 1537 ! 1552 1538 ktab = iwork … … 1562 1548 !! 1563 1549 !!---------------------------------------------------------------------- 1564 INTEGER , INTENT( in ) :: kdim 1565 INTEGER , INTENT(inout), DIMENSION(kdim) :: ktab 1566 INTEGER , INTENT( in ), OPTIONAL :: kcom 1550 INTEGER , INTENT( in ) :: kdim ! size of array 1551 INTEGER , INTENT(inout), DIMENSION(kdim) :: ktab ! input array 1552 INTEGER , INTENT( in ), OPTIONAL :: kcom ! input array 1567 1553 !! 1568 1554 INTEGER :: ierror, localcomm ! temporary integer … … 1596 1582 IF( PRESENT(kcom) ) localcomm = kcom 1597 1583 ! 1598 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror )1584 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror ) 1599 1585 ! 1600 1586 ktab = iwork … … 1610 1596 !! 1611 1597 !!---------------------------------------------------------------------- 1612 INTEGER, INTENT(in ) :: kdim 1613 INTEGER, INTENT(inout), DIMENSION (kdim) :: ktab 1614 ! !1598 INTEGER, INTENT(in ) :: kdim ! ??? 1599 INTEGER, INTENT(inout), DIMENSION (kdim) :: ktab ! ??? 1600 ! 1615 1601 INTEGER :: ierror 1616 1602 INTEGER, DIMENSION (kdim) :: iwork … … 1653 1639 REAL(wp), INTENT(inout), DIMENSION(kdim) :: ptab 1654 1640 INTEGER , INTENT(in ), OPTIONAL :: kcom 1655 ! !1641 ! 1656 1642 INTEGER :: ierror, localcomm 1657 1643 REAL(wp), DIMENSION(kdim) :: zwork … … 1785 1771 END SUBROUTINE mppsum_real 1786 1772 1773 1787 1774 SUBROUTINE mppsum_realdd( ytab, kcom ) 1788 1775 !!---------------------------------------------------------------------- … … 1793 1780 !! 1794 1781 !!----------------------------------------------------------------------- 1795 COMPLEX(wp), INTENT(inout) ::ytab ! input scalar1796 INTEGER , INTENT( in ), OPTIONAL ::kcom1797 1798 !! * Local variables (MPI version)1799 INTEGER :: ierror1800 INTEGER :: localcomm1801 COMPLEX(wp) :: zwork1802 1782 COMPLEX(wp), INTENT(inout) :: ytab ! input scalar 1783 INTEGER , INTENT(in ), OPTIONAL :: kcom 1784 ! 1785 INTEGER :: ierror 1786 INTEGER :: localcomm 1787 COMPLEX(wp) :: zwork 1788 !!----------------------------------------------------------------------- 1789 ! 1803 1790 localcomm = mpi_comm_opa 1804 IF( PRESENT(kcom) ) localcomm = kcom1805 1791 IF( PRESENT(kcom) ) localcomm = kcom 1792 ! 1806 1793 ! reduce local sums into global sum 1807 CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, & 1808 MPI_SUMDD,localcomm,ierror) 1794 CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror ) 1809 1795 ytab = zwork 1810 1796 ! 1811 1797 END SUBROUTINE mppsum_realdd 1812 1798 … … 1820 1806 !! 1821 1807 !!----------------------------------------------------------------------- 1822 INTEGER , INTENT( in ) :: kdim ! size of ytab 1823 COMPLEX(wp), DIMENSION(kdim), INTENT( inout ) :: ytab ! input array 1824 INTEGER , INTENT( in ), OPTIONAL :: kcom 1825 1826 !! * Local variables (MPI version) 1827 INTEGER :: ierror ! temporary integer 1828 INTEGER :: localcomm 1808 INTEGER , INTENT(in ) :: kdim ! size of ytab 1809 COMPLEX(wp), DIMENSION(kdim), INTENT(inout) :: ytab ! input array 1810 INTEGER , OPTIONAL , INTENT(in ) :: kcom 1811 ! 1812 INTEGER:: ierror, localcomm ! local integer 1829 1813 COMPLEX(wp), DIMENSION(kdim) :: zwork ! temporary workspace 1830 1814 !!----------------------------------------------------------------------- 1815 ! 1831 1816 localcomm = mpi_comm_opa 1832 IF( PRESENT(kcom) ) localcomm = kcom 1833 1834 CALL MPI_ALLREDUCE (ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, & 1835 MPI_SUMDD,localcomm,ierror) 1817 IF( PRESENT(kcom) ) localcomm = kcom 1818 ! 1819 CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror ) 1836 1820 ytab(:) = zwork(:) 1837 1821 ! 1838 1822 END SUBROUTINE mppsum_a_realdd 1823 1839 1824 1840 1825 SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj ) … … 1852 1837 REAL(wp) , INTENT( out) :: pmin ! Global minimum of ptab 1853 1838 INTEGER , INTENT( out) :: ki, kj ! index of minimum in global frame 1854 !! 1839 ! 1840 INTEGER :: ierror 1855 1841 INTEGER , DIMENSION(2) :: ilocs 1856 INTEGER :: ierror1857 1842 REAL(wp) :: zmin ! local minimum 1858 1843 REAL(wp), DIMENSION(2,1) :: zain, zaout … … 2704 2689 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 2705 2690 2706 zland = 0. -WP2691 zland = 0._wp 2707 2692 2708 2693 ! 1. standard boundary treatment -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r5866 r6004 185 185 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 186 186 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 187 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) &188 & + zfi * uslpml(ji,jj) &187 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) & 188 & + zfi * uslpml(ji,jj) & 189 189 & * 0.5_wp * ( gdept_n(ji+1,jj,jk)+gdept_n(ji,jj,jk)-e3u_n(ji,jj,1) ) & 190 190 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 191 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) &192 & + zfj * vslpml(ji,jj) &191 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) & 192 & + zfj * vslpml(ji,jj) & 193 193 & * 0.5_wp * ( gdept_n(ji,jj+1,jk)+gdept_n(ji,jj,jk)-e3v_n(ji,jj,1) ) & 194 194 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r5883 r6004 16 16 USE dom_oce ! ocean space and time domain 17 17 USE phycst ! physical constant 18 USE sbc_oce ! surface boundary conditions : fields 19 USE geo2ocean ! for vector rotation on to model grid 20 ! 18 21 USE in_out_manager ! I/O manager 19 22 USE iom ! I/O manager library 20 USE geo2ocean ! for vector rotation on to model grid23 USE ioipsl , ONLY : ymds2ju, ju2ymds ! for calendar 21 24 USE lib_mpp ! MPP library 22 25 USE wrk_nemo ! work arrays 23 26 USE lbclnk ! ocean lateral boundary conditions (C1D case) 24 USE ioipsl, ONLY : ymds2ju, ju2ymds ! for calendar25 USE sbc_oce26 27 27 28 IMPLICIT NONE … … 134 135 ! ! kt_offset = +1 => fields at "after" time level 135 136 ! ! etc. 136 ! 137 INTEGER :: itmp ! temporary variable 137 INTEGER :: itmp ! local variable 138 138 INTEGER :: imf ! size of the structure sd 139 139 INTEGER :: jf ! dummy indices -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r5883 r6004 113 113 END SELECT 114 114 CASE DEFAULT ; CALL ctl_stop( 'rot_rep: Syntax Error in the definition of cdtodo' ) 115 ! 115 116 END SELECT 116 117 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r5845 r6004 12 12 USE dom_oce ! ocean space and time domain 13 13 USE sbc_oce ! surface boundary condition 14 USE dynspg_oce ! surface pressure gradient variables15 14 USE phycst ! physical constants 15 ! 16 16 USE fldread ! read input fields 17 17 USE in_out_manager ! I/O manager … … 110 110 IF(lwp) WRITE(numout,*) ' Inverse barometer added to OBC ssh data' 111 111 ENDIF 112 IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts ) & 113 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' ) 114 IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn ) & 112 !jc: stop below should rather be a warning 113 IF( ln_apr_obc .AND. .NOT.ln_apr_dyn ) & 115 114 CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 116 115 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r5845 r6004 19 19 20 20 !!---------------------------------------------------------------------- 21 !! sbc_blk_core 22 !! blk_oce_core 23 !! blk_ice_core 24 !! turb_core_2z 25 !! cd_neutral_10m 26 !! psi_m 27 !! psi_h 21 !! sbc_blk_core : bulk formulation as ocean surface boundary condition (forced mode, CORE bulk formulea) 22 !! blk_oce_core : computes momentum, heat and freshwater fluxes over ocean 23 !! blk_ice_core : computes momentum, heat and freshwater fluxes over ice 24 !! turb_core_2z : Computes turbulent transfert coefficients 25 !! cd_neutral_10m: Estimate of the neutral drag coefficient at 10m 26 !! psi_m : universal profile stability function for momentum 27 !! psi_h : universal profile stability function for temperature and humidity 28 28 !!---------------------------------------------------------------------- 29 USE oce ! ocean dynamics and tracers 30 USE dom_oce ! ocean space and time domain 31 USE phycst ! physical constants 32 USE fldread ! read input fields 33 USE sbc_oce ! Surface boundary condition: ocean fields 34 USE cyclone ! Cyclone 10m wind form trac of cyclone centres 35 USE sbcdcy ! surface boundary condition: diurnal cycle 36 USE iom ! I/O manager library 37 USE in_out_manager ! I/O manager 38 USE lib_mpp ! distribued memory computing library 39 USE wrk_nemo ! work arrays 40 USE timing ! Timing 41 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 42 USE prtctl ! Print control 43 USE sbcwave, ONLY : cdn_wave ! wave module 44 USE sbc_ice ! Surface boundary condition: ice fields 45 USE lib_fortran ! to use key_nosignedzero 29 USE oce ! ocean dynamics and tracers 30 USE dom_oce ! ocean space and time domain 31 USE phycst ! physical constants 32 USE fldread ! read input fields 33 USE sbc_oce ! Surface boundary condition: ocean fields 34 USE cyclone ! Cyclone 10m wind form trac of cyclone centres 35 USE sbcdcy ! surface boundary condition: diurnal cycle 36 USE sbcwave , ONLY : cdn_wave ! wave module 37 USE sbc_ice ! Surface boundary condition: ice fields 38 USE lib_fortran ! to use key_nosignedzero 46 39 #if defined key_lim3 47 USE ice , ONLY :u_ice, v_ice, jpl, pfrld, a_i_b48 USE limthd_dh 40 USE ice , ONLY : u_ice, v_ice, jpl, pfrld, a_i_b 41 USE limthd_dh ! for CALL lim_thd_snwblow 49 42 #elif defined key_lim2 50 USE ice_2 , ONLY :u_ice, v_ice51 USE par_ice_2 43 USE ice_2 , ONLY : u_ice, v_ice 44 USE par_ice_2 ! LIM-2 parameters 52 45 #endif 46 ! 47 USE iom ! I/O manager library 48 USE in_out_manager ! I/O manager 49 USE lib_mpp ! distribued memory computing library 50 USE wrk_nemo ! work arrays 51 USE timing ! Timing 52 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 53 USE prtctl ! Print control 53 54 54 55 IMPLICIT NONE … … 84 85 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant 85 86 86 ! 87 ! !!* Namelist namsbc_core : CORE bulk parameters 87 88 LOGICAL :: ln_taudif ! logical flag to use the "mean of stress module - module of mean stress" data 88 89 REAL(wp) :: rn_pfac ! multiplication factor for precipitation … … 148 149 TYPE(FLD_N) :: sn_tdif ! " " 149 150 NAMELIST/namsbc_core/ cn_dir , ln_taudif, rn_pfac, rn_efac, rn_vfac, & 150 & sn_wndi, sn_wndj , sn_humi, sn_qsr , &151 & sn_qlw , sn_tair , sn_prec, sn_snow, &152 & sn_tdif, rn_zqt , rn_zu151 & sn_wndi, sn_wndj , sn_humi, sn_qsr , & 152 & sn_qlw , sn_tair , sn_prec, sn_snow, & 153 & sn_tdif, rn_zqt , rn_zu 153 154 !!--------------------------------------------------------------------- 154 155 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
r5845 r6004 8 8 9 9 !!---------------------------------------------------------------------- 10 !! sbc_blk_mfs : bulk formulation as ocean surface boundary condition10 !! sbc_blk_mfs : bulk formulation as ocean surface boundary condition 11 11 !! (forced mode, mfs bulk formulae) 12 !! blk_oce_mfs : ocean: computes momentum, heat and freshwater fluxes12 !! blk_oce_mfs : ocean: computes momentum, heat and freshwater fluxes 13 13 !!---------------------------------------------------------------------- 14 USE oce ! ocean dynamics and tracers 15 USE dom_oce ! ocean space and time domain 16 USE phycst ! physical constants 17 USE fldread ! read input fields 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE iom ! I/O manager library 20 USE in_out_manager ! I/O manager 21 USE lib_mpp ! distribued memory computing library 22 USE wrk_nemo ! work arrays 23 USE timing ! Timing 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 USE prtctl ! Print control 26 USE sbcwave,ONLY : cdn_wave !wave module 14 USE oce ! ocean dynamics and tracers 15 USE dom_oce ! ocean space and time domain 16 USE phycst ! physical constants 17 USE fldread ! read input fields 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE sbcwave ,ONLY : cdn_wave !wave module 20 ! 21 USE iom ! I/O manager library 22 USE in_out_manager ! I/O manager 23 USE lib_mpp ! distribued memory computing library 24 USE wrk_nemo ! work arrays 25 USE timing ! Timing 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 USE prtctl ! Print control 27 28 28 29 IMPLICIT NONE … … 48 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 49 50 !!---------------------------------------------------------------------- 50 51 51 CONTAINS 52 53 52 54 53 SUBROUTINE sbc_blk_mfs( kt ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5866 r6004 18 18 !! sbc_cpl_snd : send fields to the atmosphere 19 19 !!---------------------------------------------------------------------- 20 USE dom_oce 21 USE sbc_oce 22 USE sbc_ice 23 USE sbcapr 24 USE sbcdcy 25 USE phycst 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE sbcapr ! Stochastic param. : ??? 24 USE sbcdcy ! surface boundary condition: diurnal cycle 25 USE phycst ! physical constants 26 26 #if defined key_lim3 27 USE ice 27 USE ice ! ice variables 28 28 #endif 29 29 #if defined key_lim2 30 USE par_ice_2 31 USE ice_2 30 USE par_ice_2 ! ice parameters 31 USE ice_2 ! ice variables 32 32 #endif 33 USE cpl_oasis3 34 USE geo2ocean 33 USE cpl_oasis3 ! OASIS3 coupling 34 USE geo2ocean ! 35 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 36 USE albedo ! 37 USE in_out_manager ! I/O manager 38 USE iom ! NetCDF library 39 USE lib_mpp ! distribued memory computing library 40 USE wrk_nemo ! work arrays 41 USE timing ! Timing 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 43 USE eosbn2 44 USE sbcrnf , ONLY : l_rnfcpl 36 USE albedo ! 37 USE eosbn2 ! 38 USE sbcrnf , ONLY : l_rnfcpl 45 39 #if defined key_cpl_carbon_cycle 46 40 USE p4zflx, ONLY : oce_co2 … … 50 44 #endif 51 45 #if defined key_lim3 52 USE limthd_dh 46 USE limthd_dh ! for CALL lim_thd_snwblow 53 47 #endif 48 ! 49 USE in_out_manager ! I/O manager 50 USE iom ! NetCDF library 51 USE lib_mpp ! distribued memory computing library 52 USE wrk_nemo ! work arrays 53 USE timing ! Timing 54 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 54 55 55 56 IMPLICIT NONE 56 57 PRIVATE 57 58 58 PUBLIC sbc_cpl_init 59 PUBLIC sbc_cpl_rcv 60 PUBLIC sbc_cpl_snd 61 PUBLIC sbc_cpl_ice_tau 62 PUBLIC sbc_cpl_ice_flx 63 PUBLIC sbc_cpl_alloc 64 65 INTEGER, PARAMETER :: jpr_otx1 = 1 66 INTEGER, PARAMETER :: jpr_oty1 = 2 67 INTEGER, PARAMETER :: jpr_otz1 = 3 68 INTEGER, PARAMETER :: jpr_otx2 = 4 69 INTEGER, PARAMETER :: jpr_oty2 = 5 70 INTEGER, PARAMETER :: jpr_otz2 = 6 71 INTEGER, PARAMETER :: jpr_itx1 = 7 72 INTEGER, PARAMETER :: jpr_ity1 = 8 73 INTEGER, PARAMETER :: jpr_itz1 = 9 74 INTEGER, PARAMETER :: jpr_itx2 = 10 75 INTEGER, PARAMETER :: jpr_ity2 = 11 76 INTEGER, PARAMETER :: jpr_itz2 = 12 77 INTEGER, PARAMETER :: jpr_qsroce = 13 78 INTEGER, PARAMETER :: jpr_qsrice = 14 59 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 60 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 61 PUBLIC sbc_cpl_snd ! routine called by step.F90 62 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F90 63 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F90 64 PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90 65 66 INTEGER, PARAMETER :: jpr_otx1 = 1 ! 3 atmosphere-ocean stress components on grid 1 67 INTEGER, PARAMETER :: jpr_oty1 = 2 ! 68 INTEGER, PARAMETER :: jpr_otz1 = 3 ! 69 INTEGER, PARAMETER :: jpr_otx2 = 4 ! 3 atmosphere-ocean stress components on grid 2 70 INTEGER, PARAMETER :: jpr_oty2 = 5 ! 71 INTEGER, PARAMETER :: jpr_otz2 = 6 ! 72 INTEGER, PARAMETER :: jpr_itx1 = 7 ! 3 atmosphere-ice stress components on grid 1 73 INTEGER, PARAMETER :: jpr_ity1 = 8 ! 74 INTEGER, PARAMETER :: jpr_itz1 = 9 ! 75 INTEGER, PARAMETER :: jpr_itx2 = 10 ! 3 atmosphere-ice stress components on grid 2 76 INTEGER, PARAMETER :: jpr_ity2 = 11 ! 77 INTEGER, PARAMETER :: jpr_itz2 = 12 ! 78 INTEGER, PARAMETER :: jpr_qsroce = 13 ! Qsr above the ocean 79 INTEGER, PARAMETER :: jpr_qsrice = 14 ! Qsr above the ice 79 80 INTEGER, PARAMETER :: jpr_qsrmix = 15 80 INTEGER, PARAMETER :: jpr_qnsoce = 16 81 INTEGER, PARAMETER :: jpr_qnsice = 17 81 INTEGER, PARAMETER :: jpr_qnsoce = 16 ! Qns above the ocean 82 INTEGER, PARAMETER :: jpr_qnsice = 17 ! Qns above the ice 82 83 INTEGER, PARAMETER :: jpr_qnsmix = 18 83 INTEGER, PARAMETER :: jpr_rain = 19 84 INTEGER, PARAMETER :: jpr_snow = 20 85 INTEGER, PARAMETER :: jpr_tevp = 21 86 INTEGER, PARAMETER :: jpr_ievp = 22 87 INTEGER, PARAMETER :: jpr_sbpr = 23 88 INTEGER, PARAMETER :: jpr_semp = 24 89 INTEGER, PARAMETER :: jpr_oemp = 25 90 INTEGER, PARAMETER :: jpr_w10m = 26 91 INTEGER, PARAMETER :: jpr_dqnsdt = 27 92 INTEGER, PARAMETER :: jpr_rnf = 28 93 INTEGER, PARAMETER :: jpr_cal = 29 94 INTEGER, PARAMETER :: jpr_taum = 30 84 INTEGER, PARAMETER :: jpr_rain = 19 ! total liquid precipitation (rain) 85 INTEGER, PARAMETER :: jpr_snow = 20 ! solid precipitation over the ocean (snow) 86 INTEGER, PARAMETER :: jpr_tevp = 21 ! total evaporation 87 INTEGER, PARAMETER :: jpr_ievp = 22 ! solid evaporation (sublimation) 88 INTEGER, PARAMETER :: jpr_sbpr = 23 ! sublimation - liquid precipitation - solid precipitation 89 INTEGER, PARAMETER :: jpr_semp = 24 ! solid freshwater budget (sublimation - snow) 90 INTEGER, PARAMETER :: jpr_oemp = 25 ! ocean freshwater budget (evap - precip) 91 INTEGER, PARAMETER :: jpr_w10m = 26 ! 10m wind 92 INTEGER, PARAMETER :: jpr_dqnsdt = 27 ! d(Q non solar)/d(temperature) 93 INTEGER, PARAMETER :: jpr_rnf = 28 ! runoffs 94 INTEGER, PARAMETER :: jpr_cal = 29 ! calving 95 INTEGER, PARAMETER :: jpr_taum = 30 ! wind stress module 95 96 INTEGER, PARAMETER :: jpr_co2 = 31 96 INTEGER, PARAMETER :: jpr_topm = 32 97 INTEGER, PARAMETER :: jpr_botm = 33 98 INTEGER, PARAMETER :: jpr_sflx = 34 99 INTEGER, PARAMETER :: jpr_toce = 35 100 INTEGER, PARAMETER :: jpr_soce = 36 101 INTEGER, PARAMETER :: jpr_ocx1 = 37 102 INTEGER, PARAMETER :: jpr_ocy1 = 38 103 INTEGER, PARAMETER :: jpr_ssh = 39 104 INTEGER, PARAMETER :: jpr_fice = 40 105 INTEGER, PARAMETER :: jpr_e3t1st = 41 106 INTEGER, PARAMETER :: jpr_fraqsr = 42 107 INTEGER, PARAMETER :: jprcv = 42 108 109 INTEGER, PARAMETER :: jps_fice = 1 110 INTEGER, PARAMETER :: jps_toce = 2 111 INTEGER, PARAMETER :: jps_tice = 3 112 INTEGER, PARAMETER :: jps_tmix = 4 113 INTEGER, PARAMETER :: jps_albice = 5 114 INTEGER, PARAMETER :: jps_albmix = 6 115 INTEGER, PARAMETER :: jps_hice = 7 116 INTEGER, PARAMETER :: jps_hsnw = 8 117 INTEGER, PARAMETER :: jps_ocx1 = 9 118 INTEGER, PARAMETER :: jps_ocy1 = 10 119 INTEGER, PARAMETER :: jps_ocz1 = 11 120 INTEGER, PARAMETER :: jps_ivx1 = 12 121 INTEGER, PARAMETER :: jps_ivy1 = 13 122 INTEGER, PARAMETER :: jps_ivz1 = 14 97 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 98 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 99 INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux 100 INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature 101 INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity 102 INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1 103 INTEGER, PARAMETER :: jpr_ocy1 = 38 ! 104 INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height 105 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 106 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 107 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 108 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 109 110 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere 111 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature 112 INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature 113 INTEGER, PARAMETER :: jps_tmix = 4 ! mixed temperature (ocean+ice) 114 INTEGER, PARAMETER :: jps_albice = 5 ! ice albedo 115 INTEGER, PARAMETER :: jps_albmix = 6 ! mixed albedo 116 INTEGER, PARAMETER :: jps_hice = 7 ! ice thickness 117 INTEGER, PARAMETER :: jps_hsnw = 8 ! snow thickness 118 INTEGER, PARAMETER :: jps_ocx1 = 9 ! ocean current on grid 1 119 INTEGER, PARAMETER :: jps_ocy1 = 10 ! 120 INTEGER, PARAMETER :: jps_ocz1 = 11 ! 121 INTEGER, PARAMETER :: jps_ivx1 = 12 ! ice current on grid 1 122 INTEGER, PARAMETER :: jps_ivy1 = 13 ! 123 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 123 124 INTEGER, PARAMETER :: jps_co2 = 15 124 INTEGER, PARAMETER :: jps_soce = 16 125 INTEGER, PARAMETER :: jps_ssh = 17 126 INTEGER, PARAMETER :: jps_qsroce = 18 127 INTEGER, PARAMETER :: jps_qnsoce = 19 128 INTEGER, PARAMETER :: jps_oemp = 20 129 INTEGER, PARAMETER :: jps_sflx = 21 130 INTEGER, PARAMETER :: jps_otx1 = 22 131 INTEGER, PARAMETER :: jps_oty1 = 23 132 INTEGER, PARAMETER :: jps_rnf = 24 133 INTEGER, PARAMETER :: jps_taum = 25 134 INTEGER, PARAMETER :: jps_fice2 = 26 135 INTEGER, PARAMETER :: jps_e3t1st = 27 136 INTEGER, PARAMETER :: jps_fraqsr = 28 137 INTEGER, PARAMETER :: jpsnd = 28 138 139 ! 140 TYPE :: FLD_C 141 CHARACTER(len = 32) :: cldes 142 CHARACTER(len = 32) :: clcat 143 CHARACTER(len = 32) :: clvref 144 CHARACTER(len = 32) :: clvor 145 CHARACTER(len = 32) :: clvgrd 125 INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity 126 INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height 127 INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean 128 INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean 129 INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip) 130 INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux 131 INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1 132 INTEGER, PARAMETER :: jps_oty1 = 23 ! 133 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 134 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 135 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 136 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 137 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 138 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 139 140 ! !!** namelist namsbc_cpl ** 141 TYPE :: FLD_C ! 142 CHARACTER(len = 32) :: cldes ! desciption of the coupling strategy 143 CHARACTER(len = 32) :: clcat ! multiple ice categories strategy 144 CHARACTER(len = 32) :: clvref ! reference of vector ('spherical' or 'cartesian') 145 CHARACTER(len = 32) :: clvor ! orientation of vector fields ('eastward-northward' or 'local grid') 146 CHARACTER(len = 32) :: clvgrd ! grids on which is located the vector fields 146 147 END TYPE FLD_C 147 ! Send to the atmosphere !148 ! ! Send to the atmosphere 148 149 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 149 ! Received from the atmosphere !150 ! ! Received from the atmosphere 150 151 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 151 152 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 152 ! Other namelist parameters !153 INTEGER :: nn_cplmodel 154 LOGICAL :: ln_usecplmask 155 153 ! ! Other namelist parameters 154 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 155 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 156 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 156 157 TYPE :: DYNARR 157 158 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 158 159 END TYPE DYNARR 159 160 160 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv 161 162 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix 163 164 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo 161 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 162 163 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: albedo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 164 165 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 165 166 166 167 !! Substitution 167 168 # include "vectopt_loop_substitute.h90" 168 169 !!---------------------------------------------------------------------- 169 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)170 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 170 171 !! $Id$ 171 172 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 172 173 !!---------------------------------------------------------------------- 173 174 174 CONTAINS 175 175 … … 208 208 !! * initialise the OASIS coupler 209 209 !!---------------------------------------------------------------------- 210 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 211 !! 212 INTEGER :: jn ! dummy loop index 213 INTEGER :: ios ! Local integer output status for namelist read 214 INTEGER :: inum 210 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 211 ! 212 INTEGER :: jn ! dummy loop index 213 INTEGER :: ios, inum ! Local integer 215 214 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 216 215 !! … … 221 220 !!--------------------------------------------------------------------- 222 221 ! 223 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init')224 ! 225 CALL wrk_alloc( jpi,jpj, zacs, zaos )222 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init') 223 ! 224 CALL wrk_alloc( jpi,jpj, zacs, zaos ) 226 225 227 226 ! ================================ ! 228 227 ! Namelist informations ! 229 228 ! ================================ ! 230 229 ! 231 230 REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling 232 231 READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901) 233 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp )234 232 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in reference namelist', lwp ) 233 ! 235 234 REWIND( numnam_cfg ) ! Namelist namsbc_cpl in configuration namelist : Variables for OASIS coupling 236 235 READ ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 237 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp )236 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp ) 238 237 IF(lwm) WRITE ( numond, namsbc_cpl ) 239 238 ! 240 239 IF(lwp) THEN ! control print 241 240 WRITE(numout,*) … … 373 372 srcv(jpr_ity1)%clgrid = 'V' ! i.e. it is always at U- & V-points for i- & j-comp. resp. 374 373 ENDIF 375 374 ! 376 375 ! ! ------------------------- ! 377 376 ! ! freshwater budget ! E-P … … 395 394 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 396 395 END SELECT 397 396 ! 398 397 ! ! ------------------------- ! 399 398 ! ! Runoffs & Calving ! … … 409 408 ! 410 409 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 411 410 ! 412 411 ! ! ------------------------- ! 413 412 ! ! non solar radiation ! Qns … … 784 783 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 785 784 786 CALL wrk_dealloc( jpi,jpj, zacs, zaos )787 ! 788 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init')785 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 786 ! 787 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init') 789 788 ! 790 789 END SUBROUTINE sbc_cpl_init … … 836 835 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 837 836 !!---------------------------------------------------------------------- 838 INTEGER, INTENT(in) :: kt! ocean model time step index839 INTEGER, INTENT(in) :: k_fsbc! frequency of sbc (-> ice model) computation840 INTEGER, INTENT(in) :: k_ice! ice management in the sbc (=0/1/2/3)837 INTEGER, INTENT(in) :: kt ! ocean model time step index 838 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 839 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 841 840 842 841 !! … … 852 851 !!---------------------------------------------------------------------- 853 852 ! 854 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv')855 ! 856 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )853 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 854 ! 855 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 857 856 ! 858 857 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1103 1102 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1104 1103 ! 1105 1106 ENDIF 1107 ! 1108 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 1109 ! 1110 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') 1104 ENDIF 1105 ! 1106 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 1107 ! 1108 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') 1111 1109 ! 1112 1110 END SUBROUTINE sbc_cpl_rcv … … 1149 1147 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 1150 1148 !! 1151 INTEGER :: ji, jj 1152 INTEGER :: itx 1149 INTEGER :: ji, jj ! dummy loop indices 1150 INTEGER :: itx ! index of taux over ice 1153 1151 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 1154 1152 !!---------------------------------------------------------------------- 1155 1153 ! 1156 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau')1157 ! 1158 CALL wrk_alloc( jpi,jpj, ztx, zty )1154 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_tau') 1155 ! 1156 CALL wrk_alloc( jpi,jpj, ztx, zty ) 1159 1157 1160 1158 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 … … 1164 1162 ! do something only if we just received the stress from atmosphere 1165 1163 IF( nrcvinfo(itx) == OASIS_Rcv ) THEN 1166 1167 1164 ! ! ======================= ! 1168 1165 IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received ! … … 1317 1314 ENDIF 1318 1315 ! 1319 CALL wrk_dealloc( jpi,jpj, ztx, zty )1320 ! 1321 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau')1316 CALL wrk_dealloc( jpi,jpj, ztx, zty ) 1317 ! 1318 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_tau') 1322 1319 ! 1323 1320 END SUBROUTINE sbc_cpl_ice_tau … … 1364 1361 !! sprecip solid precipitation over the ocean 1365 1362 !!---------------------------------------------------------------------- 1366 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction[0 to 1]1363 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1367 1364 ! optional arguments, used only in 'mixed oce-ice' case 1368 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi 1369 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature[Celsius]1370 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature[Kelvin]1371 ! 1372 INTEGER :: jl 1365 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1366 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1367 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1368 ! 1369 INTEGER :: jl ! dummy loop index 1373 1370 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1374 1371 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot … … 1377 1374 !!---------------------------------------------------------------------- 1378 1375 ! 1379 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx')1380 ! 1381 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )1382 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )1376 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1377 ! 1378 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1379 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1383 1380 1384 1381 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1553 1550 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1554 1551 #else 1555 1556 ! clem: this formulation is certainly wrong... but better than it was ...1552 ! 1553 ! clem: this formulation is certainly wrong... but better than it was before... 1557 1554 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1558 1555 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting … … 1570 1567 qns_ice(:,:,:) = zqns_ice(:,:,:) 1571 1568 ENDIF 1572 1569 ! 1573 1570 #endif 1574 1575 1571 ! ! ========================= ! 1576 1572 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) … … 1681 1677 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1682 1678 1683 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot )1684 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice )1685 ! 1686 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx')1679 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1680 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1681 ! 1682 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') 1687 1683 ! 1688 1684 END SUBROUTINE sbc_cpl_ice_flx … … 1707 1703 !!---------------------------------------------------------------------- 1708 1704 ! 1709 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd')1710 ! 1711 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )1712 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 )1705 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_snd') 1706 ! 1707 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 1708 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 1713 1709 1714 1710 isec = ( kt - nit000 ) * NINT(rdttra(1)) ! date of exchanges … … 2019 2015 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2020 2016 2021 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 )2022 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )2023 ! 2024 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd')2017 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2018 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 2019 ! 2020 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_snd') 2025 2021 ! 2026 2022 END SUBROUTINE sbc_cpl_snd -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r5845 r6004 12 12 13 13 !!---------------------------------------------------------------------- 14 !! sbc_fwb : freshwater budget for global ocean configurations15 !! in free surface and forced mode16 !!----------------------------------------------------------------------17 USE oce ! ocean dynamics and tracers18 USE dom_oce ! ocean space and time domain19 USE sbc_oce ! surface ocean boundary condition20 USE phycst ! physical constants21 USE sbc rnf ! ocean runoffs22 USE sbc isf ! ice shelf melting contribution23 USE sbcssr ! SS damping terms24 USE in_out_manager 25 USE lib_mpp 26 USE wrk_nemo 27 USE timing 28 USE lbclnk 29 USE lib_fortran 14 !! sbc_fwb : freshwater budget for global ocean configurations (free surface & forced mode) 15 !!---------------------------------------------------------------------- 16 USE oce ! ocean dynamics and tracers 17 USE dom_oce ! ocean space and time domain 18 USE sbc_oce ! surface ocean boundary condition 19 USE phycst ! physical constants 20 USE sbcrnf ! ocean runoffs 21 USE sbcisf ! ice shelf melting contribution 22 USE sbcssr ! Sea-Surface damping terms 23 ! 24 USE in_out_manager ! I/O manager 25 USE lib_mpp ! distribued memory computing library 26 USE wrk_nemo ! work arrays 27 USE timing ! Timing 28 USE lbclnk ! ocean lateral boundary conditions 29 USE lib_fortran ! 30 30 31 31 IMPLICIT NONE -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5845 r6004 25 25 USE thd_ice ! LIM-3: thermodynamical variables 26 26 USE dom_ice ! LIM-3: ice domain 27 27 ! 28 28 USE sbc_oce ! Surface boundary condition: ocean fields 29 29 USE sbc_ice ! Surface boundary condition: ice fields … … 32 32 USE sbccpl ! Surface boundary condition: coupled interface 33 33 USE albedo ! ocean & ice albedo 34 34 ! 35 35 USE phycst ! Define parameters for the routines 36 36 USE eosbn2 ! equation of state … … 47 47 USE limupdate2 ! update of global variables 48 48 USE limvar ! Ice variables switch 49 49 USE limctl ! 50 50 USE limmsh ! LIM mesh 51 51 USE limistate ! LIM initial state 52 52 USE limthd_sal ! LIM ice thermodynamics: salinity 53 53 ! 54 54 USE c1d ! 1D vertical configuration 55 USE in_out_manager ! I/O manager 56 USE iom ! I/O manager library 57 USE prtctl ! Print control 58 USE lib_fortran ! 55 59 USE lbclnk ! lateral boundary condition - MPP link 56 60 USE lib_mpp ! MPP library 57 61 USE wrk_nemo ! work arrays 58 62 USE timing ! Timing 59 USE iom ! I/O manager library60 USE in_out_manager ! I/O manager61 USE prtctl ! Print control62 USE lib_fortran !63 USE limctl64 63 65 64 #if defined key_bdy … … 81 80 !!---------------------------------------------------------------------- 82 81 CONTAINS 83 84 !!======================================================================85 82 86 83 SUBROUTINE sbc_ice_lim( kt, kblk ) … … 269 266 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 270 267 ! 271 268 ! ! Open the reference and configuration namelist files and namelist output file 272 269 CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 273 270 CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 274 271 IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 275 272 ! 276 273 CALL ice_run ! set some ice run parameters 277 274 ! … … 347 344 REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice 348 345 READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 349 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )350 346 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 347 ! 351 348 REWIND( numnam_ice_cfg ) ! Namelist namicerun in configuration namelist : Parameters for ice 352 349 READ ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 ) 353 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 354 IF(lwm) WRITE ( numoni, namicerun ) 355 ! 350 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 351 IF(lwm) WRITE( numoni, namicerun ) 356 352 ! 357 353 IF(lwp) THEN ! control print … … 404 400 REWIND( numnam_ice_ref ) ! Namelist namiceitd in reference namelist : Parameters for ice 405 401 READ ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903) 406 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )407 402 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 403 ! 408 404 REWIND( numnam_ice_cfg ) ! Namelist namiceitd in configuration namelist : Parameters for ice 409 405 READ ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 ) 410 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 411 IF(lwm) WRITE ( numoni, namiceitd ) 412 ! 406 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 407 IF(lwm) WRITE( numoni, namiceitd ) 413 408 ! 414 409 IF(lwp) THEN ! control print … … 416 411 WRITE(numout,*) 'ice_itd : ice cat distribution' 417 412 WRITE(numout,*) ' ~~~~~~' 418 WRITE(numout,*) ' shape of ice categories distribution 419 WRITE(numout,*) ' mean ice thickness in the domain ( only active if nn_catbnd=2)rn_himean = ', rn_himean413 WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd 414 WRITE(numout,*) ' mean ice thickness in the domain (used if nn_catbnd=2) rn_himean = ', rn_himean 420 415 ENDIF 421 416 ! 422 417 !---------------------------------- 423 418 !- Thickness categories boundaries … … 426 421 IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 427 422 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 428 423 ! 429 424 hi_max(:) = 0._wp 430 431 SELECT CASE ( nn_catbnd ) 432 !---------------------- 433 CASE (1) ! tanh function (CICE) 434 !---------------------- 425 ! 426 SELECT CASE ( nn_catbnd ) ! type of ice categories distribution 427 ! 428 CASE (1) !== tanh function (CICE) ==! 435 429 zc1 = 3._wp / REAL( jpl, wp ) 436 430 zc2 = 10._wp * zc1 437 431 zc3 = 3._wp 438 439 432 DO jl = 1, jpl 440 433 zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 441 434 hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 442 435 END DO 443 444 !---------------------- 445 CASE (2) ! h^(-alpha) function 446 !---------------------- 447 zalpha = 0.05 ! exponent of the transform function 448 449 zhmax = 3.*rn_himean 450 436 ! 437 CASE (2) !== h^(-alpha) function ==! 438 zalpha = 0.05_wp 439 zhmax = 3._wp * rn_himean 451 440 DO jl = 1, jpl 452 441 znum = jpl * ( zhmax+1 )**zalpha 453 zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl442 zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp ) 454 443 hi_max(jl) = ( znum / zden )**(1./zalpha) - 1 455 444 END DO 456 445 ! 457 446 END SELECT 458 459 DO jl = 1, jpl 447 ! 448 DO jl = 1, jpl ! mean thickness by category 460 449 hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 461 450 END DO 462 463 ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl) 464 hi_max(jpl) = 99._wp 465 451 ! 452 hi_max(jpl) = 99._wp ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 453 ! 466 454 IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 467 455 IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) … … 470 458 471 459 472 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 460 SUBROUTINE ice_lim_flx( ptn_ice , palb_ice, pqns_ice , & 461 & pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 473 462 !!--------------------------------------------------------------------- 474 463 !! *** ROUTINE ice_lim_flx *** … … 482 471 !!--------------------------------------------------------------------- 483 472 INTEGER , INTENT(in ) :: k_limflx ! =-1 do nothing; =0 average ; 484 473 ! ! =1 average and redistribute ; =2 redistribute 485 474 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptn_ice ! ice surface temperature 486 475 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb_ice ! ice albedo … … 502 491 REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 503 492 !!---------------------------------------------------------------------- 504 493 ! 505 494 IF( nn_timing == 1 ) CALL timing_start('ice_lim_flx') 506 !507 495 ! 508 496 SELECT CASE( k_limflx ) !== averaged on all ice categories ==! … … 528 516 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 529 517 END SELECT 530 518 ! 531 519 SELECT CASE( k_limflx ) !== redistribution on all ice categories ==! 532 520 CASE( 1 , 2 ) … … 547 535 ! 548 536 END SUBROUTINE ice_lim_flx 537 549 538 550 539 SUBROUTINE sbc_lim_bef … … 563 552 u_ice_b(:,:) = u_ice(:,:) 564 553 v_ice_b(:,:) = v_ice(:,:) 565 554 ! 566 555 END SUBROUTINE sbc_lim_bef 556 567 557 568 558 SUBROUTINE sbc_lim_diag0 … … 579 569 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 580 570 sfx_res(:,:) = 0._wp 581 571 ! 582 572 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp 583 573 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp … … 586 576 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 587 577 wfx_spr(:,:) = 0._wp ; 588 578 ! 589 579 hfx_thd(:,:) = 0._wp ; 590 580 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp … … 595 585 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 596 586 hfx_err_dif(:,:) = 0._wp ; 597 587 ! 598 588 afx_tot(:,:) = 0._wp ; 599 589 afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp 600 590 ! 601 591 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp ; 602 592 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp ; 603 593 ! 604 594 END SUBROUTINE sbc_lim_diag0 605 595 … … 633 623 END FUNCTION fice_ice_ave 634 624 635 636 625 #else 637 626 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r5883 r6004 12 12 13 13 !!---------------------------------------------------------------------- 14 !! sbc_rnf : monthly runoffs read in a NetCDF file15 !! sbc_rnf_init : runoffs initialisation16 !! rnf_mouth : set river mouth mask14 !! sbc_rnf : monthly runoffs read in a NetCDF file 15 !! sbc_rnf_init : runoffs initialisation 16 !! rnf_mouth : set river mouth mask 17 17 !!---------------------------------------------------------------------- 18 USE dom_oce ! ocean space and time domain 19 USE phycst ! physical constants 20 USE sbc_oce ! surface boundary condition variables 21 USE sbcisf ! PM we could remove it I think 22 USE closea ! closed seas 23 USE fldread ! read input field at current time step 24 USE in_out_manager ! I/O manager 25 USE iom ! I/O module 26 USE lib_mpp ! MPP library 27 USE eosbn2 28 USE wrk_nemo ! Memory allocation 18 USE dom_oce ! ocean space and time domain 19 USE phycst ! physical constants 20 USE sbc_oce ! surface boundary condition variables 21 USE sbcisf ! PM we could remove it I think 22 USE closea ! closed seas 23 USE eosbn2 ! Equation Of State 24 ! 25 USE in_out_manager ! I/O manager 26 USE fldread ! read input field at current time step 27 USE iom ! I/O module 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! Memory allocation 29 30 30 31 IMPLICIT NONE 31 32 PRIVATE 32 33 33 PUBLIC sbc_rnf ! routinecalled in sbcmod module34 PUBLIC sbc_rnf_div ! routinecalled in divhor module35 PUBLIC sbc_rnf_alloc ! routinecalled in sbcmod module36 PUBLIC sbc_rnf_init ! routinecalled in sbcmod module34 PUBLIC sbc_rnf ! called in sbcmod module 35 PUBLIC sbc_rnf_div ! called in divhor module 36 PUBLIC sbc_rnf_alloc ! called in sbcmod module 37 PUBLIC sbc_rnf_init ! called in sbcmod module 37 38 38 ! 39 CHARACTER(len=100) :: cn_dir !: Root directory for location of rnf files39 ! !!* namsbc_rnf namelist * 40 CHARACTER(len=100) :: cn_dir !: Root directory for location of rnf files 40 41 LOGICAL :: ln_rnf_depth !: depth river runoffs attribute specified in a file 41 LOGICAL :: ln_rnf_depth_ini !: depth river runoffs computed at the initialisation42 REAL(wp) :: rn_rnf_max !: maximum value of the runoff climatologie ( ln_rnf_depth_ini = .true)43 REAL(wp) :: rn_dep_max !: depth over which runoffs is spread ( ln_rnf_depth_ini = .true)44 INTEGER :: nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0)45 LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file46 LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file47 TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read48 TYPE(FLD_N) :: sn_cnf !: information about the runoff mouth file to be read49 TYPE(FLD_N) :: sn_s_rnf !: information about the salinities of runoff file to be read50 TYPE(FLD_N) :: sn_t_rnf !: information about the temperatures of runoff file to be read51 TYPE(FLD_N) :: sn_dep_rnf !: information about the depth which river inflow affects52 LOGICAL , PUBLIC :: ln_rnf_mouth !: specific treatment in mouths vicinity53 REAL(wp) :: rn_hrnf !: runoffs, depth over which enhanced vertical mixing is used54 REAL(wp) , PUBLIC :: rn_avt_rnf !: runoffs, value of the additional vertical mixing coef. [m2/s]55 REAL(wp) :: rn_rfact !: multiplicative factor for runoff56 57 LOGICAL , PUBLIC :: l_rnfcpl = .false. !runoffs recieved from oasis58 59 INTEGER , PUBLIC :: nkrnf = 0 !: nb of levels over which Kz is increased at river mouths42 LOGICAL :: ln_rnf_depth_ini !: depth river runoffs computed at the initialisation 43 REAL(wp) :: rn_rnf_max !: maximum value of the runoff climatologie (ln_rnf_depth_ini =T) 44 REAL(wp) :: rn_dep_max !: depth over which runoffs is spread (ln_rnf_depth_ini =T) 45 INTEGER :: nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 46 LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file 47 LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file 48 TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read 49 TYPE(FLD_N) :: sn_cnf !: information about the runoff mouth file to be read 50 TYPE(FLD_N) :: sn_s_rnf !: information about the salinities of runoff file to be read 51 TYPE(FLD_N) :: sn_t_rnf !: information about the temperatures of runoff file to be read 52 TYPE(FLD_N) :: sn_dep_rnf !: information about the depth which river inflow affects 53 LOGICAL , PUBLIC :: ln_rnf_mouth !: specific treatment in mouths vicinity 54 REAL(wp) :: rn_hrnf !: runoffs, depth over which enhanced vertical mixing is used 55 REAL(wp) , PUBLIC :: rn_avt_rnf !: runoffs, value of the additional vertical mixing coef. [m2/s] 56 REAL(wp) :: rn_rfact !: multiplicative factor for runoff 57 58 LOGICAL , PUBLIC :: l_rnfcpl = .false. !: runoffs recieved from oasis 59 INTEGER , PUBLIC :: nkrnf = 0 !: nb of levels over which Kz is increased at river mouths 60 60 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnfmsk !: river mouth mask (hori.) 61 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rnfmsk_z !: river mouth mask (vert.) … … 211 212 ! 212 213 IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==! 213 IF( .NOT.ln_linssh ) THEN ! variable volume case 214 IF( ln_linssh ) THEN !* constant volume case : just apply the runoff input flow 215 DO jj = 1, jpj 216 DO ji = 1, jpi 217 DO jk = 1, nk_rnf(ji,jj) 218 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj) 219 END DO 220 END DO 221 END DO 222 ELSE !* variable volume case 214 223 DO jj = 1, jpj ! update the depth over which runoffs are distributed 215 224 DO ji = 1, jpi … … 224 233 END DO 225 234 END DO 226 ELSE ! constant volume case : just apply the runoff input flow227 DO jj = 1, jpj228 DO ji = 1, jpi229 DO jk = 1, nk_rnf(ji,jj)230 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)231 END DO232 END DO233 END DO234 235 ENDIF 235 236 ELSE !== runoff put only at the surface ==! 236 IF( .NOT.ln_linssh ) THEN ! variable volume case 237 h_rnf(:,:) = e3t_n(:,:,1) ! recalculate h_rnf to be depth of top box 238 ENDIF 237 h_rnf (:,:) = e3t_n (:,:,1) ! update h_rnf to be depth of top box 239 238 phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1) 240 239 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r5866 r6004 6 6 !! History : 9.0 ! 2006-07 (G. Madec) Original code 7 7 !! 3.3 ! 2010-10 (C. Bricaud, G. Madec) add the Patm forcing for sea-ice 8 !!---------------------------------------------------------------------- 9 10 !!---------------------------------------------------------------------- 11 !! sbc_ssm : calculate sea surface mean currents, temperature, 12 !! and salinity over nn_fsbc time-step 13 !!---------------------------------------------------------------------- 14 USE oce ! ocean dynamics and tracers 15 USE dom_oce ! ocean space and time domain 16 USE sbc_oce ! surface boundary condition: ocean fields 17 USE sbcapr ! surface boundary condition: atmospheric pressure 18 USE eosbn2 ! equation of state and related derivatives 8 !! 3.7 ! 2015-11 (G. Madec) non linear free surface by default: e3t_m always computed 9 !!---------------------------------------------------------------------- 10 11 !!---------------------------------------------------------------------- 12 !! sbc_ssm : calculate sea surface mean currents, temperature, 13 !! and salinity over nn_fsbc time-step 14 !!---------------------------------------------------------------------- 15 USE oce ! ocean dynamics and tracers 16 USE dom_oce ! ocean space and time domain 17 USE sbc_oce ! surface boundary condition: ocean fields 18 USE sbcapr ! surface boundary condition: atmospheric pressure 19 USE eosbn2 ! equation of state and related derivatives 19 20 ! 20 USE in_out_manager 21 USE prtctl 22 USE iom 21 USE in_out_manager ! I/O manager 22 USE prtctl ! Print control 23 USE iom ! IOM library 23 24 24 25 IMPLICIT NONE 25 26 PRIVATE 26 27 27 PUBLIC sbc_ssm 28 PUBLIC sbc_ssm_init 29 30 LOGICAL, SAVE :: l_ssm_mean = .FALSE.! keep track of whether means have been read from restart file28 PUBLIC sbc_ssm ! routine called by step.F90 29 PUBLIC sbc_ssm_init ! routine called by sbcmod.F90 30 31 LOGICAL, SAVE :: l_ssm_mean = .FALSE. ! keep track of whether means have been read from restart file 31 32 32 33 !!---------------------------------------------------------------------- … … 56 57 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 57 58 !!--------------------------------------------------------------------- 58 59 ! 59 60 ! !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 60 61 DO jj = 1, jpj … … 78 79 ENDIF 79 80 ! 80 IF( .NOT.ln_linssh )e3t_m(:,:) = e3t_n(:,:,1)81 e3t_m(:,:) = e3t_n(:,:,1) 81 82 ! 82 83 frq_m(:,:) = fraqsr_1lev(:,:) … … 100 101 ENDIF 101 102 ! 102 IF( .NOT.ln_linssh )e3t_m(:,:) = zcoef * e3t_n(:,:,1)103 e3t_m(:,:) = zcoef * e3t_n(:,:,1) 103 104 ! 104 105 frq_m(:,:) = zcoef * fraqsr_1lev(:,:) … … 111 112 sss_m(:,:) = 0._wp 112 113 ssh_m(:,:) = 0._wp 113 IF( .NOT.ln_linssh )e3t_m(:,:) = 0._wp114 e3t_m(:,:) = 0._wp 114 115 frq_m(:,:) = 0._wp 115 116 ENDIF … … 128 129 ENDIF 129 130 ! 130 IF( .NOT.ln_linssh )e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1)131 ! 132 frq_m(:,:) = 131 e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 132 ! 133 frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 133 134 134 135 ! ! ---------------------------------------- ! … … 136 137 ! ! ---------------------------------------- ! 137 138 zcoef = 1. / REAL( nn_fsbc, wp ) 138 sst_m(:,:) = sst_m(:,:) * zcoef 139 sss_m(:,:) = sss_m(:,:) * zcoef 140 ssu_m(:,:) = ssu_m(:,:) * zcoef 141 ssv_m(:,:) = ssv_m(:,:) * zcoef 142 ssh_m(:,:) = ssh_m(:,:) * zcoef 143 IF( .NOT.ln_linssh ) e3t_m(:,:) = e3t_m(:,:) * zcoef! mean vertical scale factor [m]144 frq_m(:,:) = frq_m(:,:) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-]139 sst_m(:,:) = sst_m(:,:) * zcoef ! mean SST [Celcius] 140 sss_m(:,:) = sss_m(:,:) * zcoef ! mean SSS [psu] 141 ssu_m(:,:) = ssu_m(:,:) * zcoef ! mean suface current [m/s] 142 ssv_m(:,:) = ssv_m(:,:) * zcoef ! 143 ssh_m(:,:) = ssh_m(:,:) * zcoef ! mean SSH [m] 144 e3t_m(:,:) = e3t_m(:,:) * zcoef ! mean vertical scale factor [m] 145 frq_m(:,:) = frq_m(:,:) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-] 145 146 ! 146 147 ENDIF … … 159 160 CALL iom_rstput( kt, nitrst, numrow, 'sss_m' , sss_m ) 160 161 CALL iom_rstput( kt, nitrst, numrow, 'ssh_m' , ssh_m ) 161 IF( .NOT.ln_linssh )CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m )162 CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m ) 162 163 CALL iom_rstput( kt, nitrst, numrow, 'frq_m' , frq_m ) 163 164 ! … … 172 173 CALL iom_put( 'sss_m', sss_m ) 173 174 CALL iom_put( 'ssh_m', ssh_m ) 174 IF( .NOT.ln_linssh )CALL iom_put( 'e3t_m', e3t_m )175 CALL iom_put( 'e3t_m', e3t_m ) 175 176 CALL iom_put( 'frq_m', frq_m ) 176 177 ENDIF 177 178 ! 178 179 END SUBROUTINE sbc_ssm 180 179 181 180 182 SUBROUTINE sbc_ssm_init … … 186 188 !! ** Action : - read parameters 187 189 !!---------------------------------------------------------------------- 188 REAL(wp) :: zcoef, zf_sbc 190 REAL(wp) :: zcoef, zf_sbc ! local scalar 189 191 !!---------------------------------------------------------------------- 190 192 ! 191 193 IF( nn_fsbc == 1 ) THEN 192 194 ! … … 203 205 IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 204 206 l_ssm_mean = .TRUE. 205 CALL iom_get( numror , 'nn_fsbc', zf_sbc ) ! sbc frequency of previous run206 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m ) ! sea surface mean velocity (T-point)207 CALL iom_get( numror, jpdom_autoglo, 'ssv_m' , ssv_m ) ! " " velocity (V-point)208 CALL iom_get( numror, jpdom_autoglo, 'sst_m' , sst_m ) ! " " temperature (T-point)209 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point)210 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point)211 IF( .NOT.ln_linssh ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m)207 CALL iom_get( numror , 'nn_fsbc', zf_sbc ) ! sbc frequency of previous run 208 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m ) ! sea surface mean velocity (U-point) 209 CALL iom_get( numror, jpdom_autoglo, 'ssv_m' , ssv_m ) ! " " velocity (V-point) 210 CALL iom_get( numror, jpdom_autoglo, 'sst_m' , sst_m ) ! " " temperature (T-point) 211 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point) 212 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point) 213 CALL iom_get( numror, jpdom_autoglo, 'e3t_m' , e3t_m ) ! 1st level thickness (T-point) 212 214 ! fraction of solar net radiation absorbed in 1st T level 213 215 IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN … … 226 228 sss_m(:,:) = zcoef * sss_m(:,:) 227 229 ssh_m(:,:) = zcoef * ssh_m(:,:) 228 IF( .NOT.ln_linssh )e3t_m(:,:) = zcoef * e3t_m(:,:)230 e3t_m(:,:) = zcoef * e3t_m(:,:) 229 231 frq_m(:,:) = zcoef * frq_m(:,:) 230 232 ELSE … … 242 244 ELSE ; sst_m(:,:) = tsn(:,:,1,jp_tem) 243 245 ENDIF 244 sss_m(:,:) = tsn (:,:,1,jp_sal)245 ssh_m(:,:) = sshn (:,:)246 IF( .NOT.ln_linssh )e3t_m(:,:) = e3t_n(:,:,1)246 sss_m(:,:) = tsn (:,:,1,jp_sal) 247 ssh_m(:,:) = sshn (:,:) 248 e3t_m(:,:) = e3t_n(:,:,1) 247 249 frq_m(:,:) = 1._wp 248 250 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r5845 r6004 19 19 ! 20 20 USE fldread ! read input fields 21 USE in_out_manager ! I/O manager 21 22 USE iom ! I/O manager 22 USE in_out_manager ! I/O manager23 23 USE lib_mpp ! distribued memory computing library 24 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
r5215 r6004 6 6 !! History : 9.0 ! 2007 (O. Le Galloudec) Original code 7 7 !!---------------------------------------------------------------------- 8 USE oce ! ocean dynamics and tracers variables 9 USE dom_oce ! ocean space and time domain 10 USE phycst 11 USE daymod 12 USE dynspg_oce 13 USE tideini 8 USE oce ! ocean dynamics and tracers variables 9 USE dom_oce ! ocean space and time domain 10 USE phycst ! physical constant 11 USE daymod ! calandar 12 USE tideini ! 14 13 ! 15 USE i om16 USE i n_out_manager ! I/O units17 USE ioipsl 18 USE lbclnk 14 USE in_out_manager ! I/O units 15 USE iom ! xIOs server 16 USE ioipsl ! NetCDF IPSL library 17 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 19 18 20 19 IMPLICIT NONE -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90
r5215 r6004 6 6 !! History : 1.0 ! 2007 (O. Le Galloudec) Original code 7 7 !!---------------------------------------------------------------------- 8 USE oce ! ocean dynamics and tracers variables 9 USE dom_oce ! ocean space and time domain 10 USE phycst 11 USE daymod 12 USE dynspg_oce 13 USE tide_mod 8 USE oce ! ocean dynamics and tracers variables 9 USE dom_oce ! ocean space and time domain 10 USE phycst ! physical constant 11 USE daymod ! calandar 12 USE tide_mod ! 14 13 ! 15 USE i om16 USE i n_out_manager ! I/O units17 USE ioipsl 18 USE lbclnk 14 USE in_out_manager ! I/O units 15 USE iom ! xIOs server 16 USE ioipsl ! NetCDF IPSL library 17 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 19 18 20 19 IMPLICIT NONE … … 28 27 LOGICAL , PUBLIC :: ln_tide_pot !: 29 28 LOGICAL , PUBLIC :: ln_tide_ramp !: 30 INTEGER , PUBLIC :: nb_harmo 31 INTEGER , PUBLIC :: kt_tide 32 REAL(wp), PUBLIC :: rdttideramp 29 INTEGER , PUBLIC :: nb_harmo !: 30 INTEGER , PUBLIC :: kt_tide !: 31 REAL(wp), PUBLIC :: rdttideramp !: 33 32 34 33 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntide !: … … 41 40 CONTAINS 42 41 43 SUBROUTINE tide_init ( kt ) 44 !!---------------------------------------------------------------------- 45 !! *** ROUTINE tide_init *** 46 !!---------------------------------------------------------------------- 47 !! * Local declarations 48 INTEGER :: ji, jk 49 INTEGER, INTENT( in ) :: kt ! ocean time-step 50 CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname 51 INTEGER :: ios ! Local integer output status for namelist read 52 ! 53 NAMELIST/nam_tide/ln_tide_pot, ln_tide_ramp, rdttideramp, clname 54 !!---------------------------------------------------------------------- 55 56 IF ( kt == nit000 ) THEN 57 ! 58 IF(lwp) THEN 59 WRITE(numout,*) 60 WRITE(numout,*) 'tide_init : Initialization of the tidal components' 61 WRITE(numout,*) '~~~~~~~~~ ' 62 ENDIF 63 ! 64 CALL tide_init_Wave 65 ! 66 ! Read Namelist nam_tide 67 REWIND( numnam_ref ) ! Namelist nam_tide in reference namelist : Tides 68 READ ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901) 69 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in reference namelist', lwp ) 70 71 REWIND( numnam_cfg ) ! Namelist nam_tide in configuration namelist : Tides 72 READ ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 ) 73 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp ) 74 IF(lwm) WRITE ( numond, nam_tide ) 75 ! 76 nb_harmo=0 77 DO jk = 1, jpmax_harmo 78 DO ji = 1,jpmax_harmo 79 IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) nb_harmo = nb_harmo + 1 80 END DO 81 END DO 82 ! 83 ! Ensure that tidal components have been set in namelist_cfg 84 IF( nb_harmo .EQ. 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 85 ! 86 IF(lwp) THEN 87 WRITE(numout,*) ' Namelist nam_tide' 88 WRITE(numout,*) ' Apply astronomical potential : ln_tide_pot =', ln_tide_pot 89 WRITE(numout,*) ' nb_harmo = ', nb_harmo 90 WRITE(numout,*) ' ln_tide_ramp = ', ln_tide_ramp 91 WRITE(numout,*) ' rdttideramp = ', rdttideramp 92 ENDIF 93 IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) ) & 94 & CALL ctl_stop('rdttideramp must be lower than run duration') 95 IF( ln_tide_ramp.AND.(rdttideramp<0.) ) & 96 & CALL ctl_stop('rdttideramp must be positive') 97 ! 98 IF( .NOT. lk_dynspg_ts ) CALL ctl_warn( 'sbc_tide : use of time splitting is recommended' ) 99 ! 100 ALLOCATE( ntide(nb_harmo) ) 101 DO jk = 1, nb_harmo 102 DO ji = 1, jpmax_harmo 103 IF( TRIM(clname(jk)) .eq. Wave(ji)%cname_tide ) THEN 104 ntide(jk) = ji 105 EXIT 106 END IF 107 END DO 108 END DO 109 ! 110 ALLOCATE( omega_tide(nb_harmo), v0tide (nb_harmo), & 111 & utide (nb_harmo), ftide (nb_harmo) ) 112 kt_tide = kt 113 ! 42 SUBROUTINE tide_init 43 !!---------------------------------------------------------------------- 44 !! *** ROUTINE tide_init *** 45 !!---------------------------------------------------------------------- 46 INTEGER :: ji, jk 47 CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname 48 INTEGER :: ios ! Local integer output status for namelist read 49 ! 50 NAMELIST/nam_tide/ln_tide_pot, ln_tide_ramp, rdttideramp, clname 51 !!---------------------------------------------------------------------- 52 ! 53 IF(lwp) THEN 54 WRITE(numout,*) 55 WRITE(numout,*) 'tide_init : Initialization of the tidal components' 56 WRITE(numout,*) '~~~~~~~~~ ' 114 57 ENDIF 58 ! 59 CALL tide_init_Wave 60 ! 61 ! Read Namelist nam_tide 62 REWIND( numnam_ref ) ! Namelist nam_tide in reference namelist : Tides 63 READ ( numnam_ref, nam_tide, IOSTAT = ios, ERR = 901) 64 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in reference namelist', lwp ) 65 ! 66 REWIND( numnam_cfg ) ! Namelist nam_tide in configuration namelist : Tides 67 READ ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 ) 68 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp ) 69 IF(lwm) WRITE ( numond, nam_tide ) 70 ! 71 nb_harmo=0 72 DO jk = 1, jpmax_harmo 73 DO ji = 1,jpmax_harmo 74 IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) nb_harmo = nb_harmo + 1 75 END DO 76 END DO 77 ! 78 ! Ensure that tidal components have been set in namelist_cfg 79 IF( nb_harmo == 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 80 ! 81 IF(lwp) THEN 82 WRITE(numout,*) ' Namelist nam_tide' 83 WRITE(numout,*) ' Apply astronomical potential : ln_tide_pot =', ln_tide_pot 84 WRITE(numout,*) ' nb_harmo = ', nb_harmo 85 WRITE(numout,*) ' ln_tide_ramp = ', ln_tide_ramp 86 WRITE(numout,*) ' rdttideramp = ', rdttideramp 87 ENDIF 88 IF( ln_tide_ramp.AND.((nitend-nit000+1)*rdt/rday < rdttideramp) ) & 89 & CALL ctl_stop('rdttideramp must be lower than run duration') 90 IF( ln_tide_ramp.AND.(rdttideramp<0.) ) & 91 & CALL ctl_stop('rdttideramp must be positive') 92 ! 93 ALLOCATE( ntide(nb_harmo) ) 94 DO jk = 1, nb_harmo 95 DO ji = 1, jpmax_harmo 96 IF( TRIM(clname(jk)) == Wave(ji)%cname_tide ) THEN 97 ntide(jk) = ji 98 EXIT 99 ENDIF 100 END DO 101 END DO 102 ! 103 ALLOCATE( omega_tide(nb_harmo), v0tide (nb_harmo), & 104 & utide (nb_harmo), ftide (nb_harmo) ) 105 kt_tide = nit000 115 106 ! 116 107 END SUBROUTINE tide_init -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
r5215 r6004 4 4 !! Initialization of tidal forcing 5 5 !!====================================================================== 6 !! History : 9.0 ! 07 (O. Le Galloudec) Original code6 !! History : 9.0 ! 2007 (O. Le Galloudec) Original code 7 7 !!---------------------------------------------------------------------- 8 8 #if defined key_tide … … 10 10 !! 'key_tide' : tidal potential 11 11 !!---------------------------------------------------------------------- 12 !! upd_tide 12 !! upd_tide : update tidal potential 13 13 !!---------------------------------------------------------------------- 14 USE oce 15 USE dom_oce 16 USE in_out_manager 17 USE phycst 18 USE sbctide 19 USE tideini , ONLY:ln_tide_ramp, rdttideramp14 USE oce ! ocean dynamics and tracers variables 15 USE dom_oce ! ocean space and time domain 16 USE in_out_manager ! I/O units 17 USE phycst ! physical constant 18 USE sbctide ! tide potential variable 19 USE tideini , ONLY: ln_tide_ramp, rdttideramp 20 20 21 21 IMPLICIT NONE … … 45 45 INTEGER, INTENT(in), OPTIONAL :: kbaro ! number of sub-time-step (lk_dynspg_ts=T only) 46 46 INTEGER, INTENT(in), OPTIONAL :: koffset ! time offset in number 47 47 ! ! of sub-time-steps (lk_dynspg_ts=T only) 48 48 ! 49 49 INTEGER :: joffset ! local integer … … 93 93 WRITE(*,*) 'upd_tide: You should not have seen this print! error?', kt 94 94 END SUBROUTINE upd_tide 95 96 95 #endif 97 96 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r5845 r6004 2 2 !!============================================================================== 3 3 !! *** MODULE eosbn2 *** 4 !! Ocean diagnostic variable : equation of state - in situ and potential density 5 !! - Brunt-Vaisala frequency 4 !! Equation Of Seawater : in situ density - Brunt-Vaisala frequency 6 5 !!============================================================================== 7 6 !! History : OPA ! 1989-03 (O. Marti) Original code … … 26 25 27 26 !!---------------------------------------------------------------------- 28 !! eos 29 !! eos_insitu 30 !! eos_insitu_pot 31 !! eos_insitu_2d 32 !! bn2 33 !! eos_rab 34 !! eos_rab_3d 35 !! eos_rab_2d 36 !! eos_fzp_2d 37 !! eos_fzp_0d 38 !! eos_init 27 !! eos : generic interface of the equation of state 28 !! eos_insitu : Compute the in situ density 29 !! eos_insitu_pot: Compute the insitu and surface referenced potential volumic mass 30 !! eos_insitu_2d : Compute the in situ density for 2d fields 31 !! bn2 : Compute the Brunt-Vaisala frequency 32 !! eos_rab : generic interface of in situ thermal/haline expansion ratio 33 !! eos_rab_3d : compute in situ thermal/haline expansion ratio 34 !! eos_rab_2d : compute in situ thermal/haline expansion ratio for 2d fields 35 !! eos_fzp_2d : freezing temperature for 2d fields 36 !! eos_fzp_0d : freezing temperature for scalar 37 !! eos_init : set eos parameters (namelist) 39 38 !!---------------------------------------------------------------------- 40 USE dom_oce ! ocean space and time domain 41 USE phycst ! physical constants 39 USE dom_oce ! ocean space and time domain 40 USE phycst ! physical constants 41 USE stopar ! Stochastic T/S fluctuations 42 USE stopts ! Stochastic T/S fluctuations 42 43 ! 43 USE in_out_manager 44 USE lib_mpp 45 USE lib_fortran 46 USE prtctl 47 USE wrk_nemo 44 USE in_out_manager ! I/O manager 45 USE lib_mpp ! MPP library 46 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 47 USE prtctl ! Print control 48 USE wrk_nemo ! Memory Allocation 48 49 USE lbclnk ! ocean lateral boundary conditions 49 USE timing ! Timing 50 USE stopar ! Stochastic T/S fluctuations 51 USE stopts ! Stochastic T/S fluctuations 50 USE timing ! Timing 52 51 53 52 IMPLICIT NONE 54 53 PRIVATE 55 54 56 ! 55 ! !! * Interface 57 56 INTERFACE eos 58 57 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d … … 75 74 PUBLIC eos_init ! called by istate module 76 75 77 ! !!* Namelist (nameos)*76 ! !!** Namelist nameos ** 78 77 INTEGER , PUBLIC :: nn_eos ! = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 79 78 LOGICAL , PUBLIC :: ln_useCT ! determine if eos_pt_from_ct is used to compute sst_m 80 79 81 ! !!! simplified eos coefficients 82 ! default value: Vallis 2006 80 ! !!! simplified eos coefficients (default value: Vallis 2006) 83 81 REAL(wp) :: rn_a0 = 1.6550e-1_wp ! thermal expansion coeff. 84 82 REAL(wp) :: rn_b0 = 7.6554e-1_wp ! saline expansion coeff. -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90
r5883 r6004 8 8 9 9 !!---------------------------------------------------------------------- 10 !! tra_adv_cen : update the tracer trend with the advection trends using a centered or scheme (2nd or 4th order)11 !! NB: on the vertical it is actually a 4th order COMPACT scheme which is used12 !!---------------------------------------------------------------------- 13 USE oce , ONLY: tsn! now ocean temperature and salinity14 USE dom_oce 15 USE eosbn2 16 USE traadv_fct 17 USE trd_oce 18 USE trdtra 19 USE diaptr 10 !! tra_adv_cen : update the tracer trend with the advection trends using a centered or scheme (2nd or 4th order) 11 !! NB: on the vertical it is actually a 4th order COMPACT scheme which is used 12 !!---------------------------------------------------------------------- 13 USE oce , ONLY: tsn ! now ocean temperature and salinity 14 USE dom_oce ! ocean space and time domain 15 USE eosbn2 ! equation of state 16 USE traadv_fct ! acces to routine interp_4th_cpt 17 USE trd_oce ! trends: ocean variables 18 USE trdtra ! trends manager: tracers 19 USE diaptr ! poleward transport diagnostics 20 20 ! 21 USE in_out_manager 22 USE iom 23 USE trc_oce 24 USE lib_mpp 25 USE wrk_nemo 26 USE timing 21 USE in_out_manager ! I/O manager 22 USE iom ! IOM library 23 USE trc_oce ! share passive tracers/Ocean variables 24 USE lib_mpp ! MPP library 25 USE wrk_nemo ! Memory Allocation 26 USE timing ! Timing 27 27 28 28 IMPLICIT NONE … … 191 191 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 192 192 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 193 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) )194 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) )193 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 194 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 195 195 ENDIF 196 196 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r5883 r6004 19 19 USE trd_oce ! trends: ocean variables 20 20 USE trdtra ! tracers trends 21 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient22 21 USE diaptr ! poleward transport diagnostics 23 22 ! … … 290 289 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 291 290 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) & 292 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))291 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 293 292 END DO 294 293 END DO … … 308 307 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 309 308 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 310 IF( jn == jp_tem ) htr_adv(:) = htr_adv(:) + ptr_sj( zwy(:,:,:) )311 IF( jn == jp_sal ) str_adv(:) = str_adv(:) + ptr_sj( zwy(:,:,:) )309 IF( jn == jp_tem ) htr_adv(:) = htr_adv(:) + ptr_sj( zwy(:,:,:) ) 310 IF( jn == jp_sal ) str_adv(:) = str_adv(:) + ptr_sj( zwy(:,:,:) ) 312 311 ENDIF 313 312 ! … … 536 535 ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb) & 537 536 & - zts(jk) * ( zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) & 538 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))537 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 539 538 END DO 540 539 END DO … … 565 564 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ( zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 566 565 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) & 567 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))566 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 568 567 END DO 569 568 END DO … … 668 667 669 668 ! up & down beta terms 670 zbt = e1 t(ji,jj) *e2t(ji,jj) * e3t_n(ji,jj,jk) / z2dtt669 zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / z2dtt 671 670 zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 672 671 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / ( zneg + zrtrn ) * zbt -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
r5883 r6004 21 21 USE trd_oce ! trends: ocean variables 22 22 USE trdtra ! tracers trends manager 23 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient24 23 USE sbcrnf ! river runoffs 25 24 USE diaptr ! poleward transport diagnostics … … 122 121 ! 123 122 ! !-- first guess of the slopes 124 zwx(:,:,jpk) = 0. e0! bottom values123 zwx(:,:,jpk) = 0._wp ! bottom values 125 124 zwy(:,:,jpk) = 0._wp 126 125 DO jk = 1, jpkm1 ! interior values … … 135 134 CALL lbc_lnk( zwy, 'V', -1. ) 136 135 ! !-- Slopes of tracer 137 zslpx(:,:,jpk) = 0._wp 136 zslpx(:,:,jpk) = 0._wp ! bottom values 138 137 zslpy(:,:,jpk) = 0._wp 139 DO jk = 1, jpkm1 138 DO jk = 1, jpkm1 ! interior values 140 139 DO jj = 2, jpj 141 140 DO ji = fs_2, jpi ! vector opt. … … 168 167 z0u = SIGN( 0.5, pun(ji,jj,jk) ) 169 168 zalpha = 0.5 - z0u 170 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * e3u_n(ji,jj,jk))169 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 171 170 zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 172 171 zzwy = ptb(ji ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji ,jj,jk) … … 175 174 z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 176 175 zalpha = 0.5 - z0v 177 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * e3v_n(ji,jj,jk))176 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt * r1_e1e2v(ji,jj) * e3v_n(ji,jj,jk) 178 177 zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 179 178 zzwy = ptb(ji,jj ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj ,jk) … … 189 188 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 190 189 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) & 191 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))190 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 192 191 END DO 193 192 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r5883 r6004 20 20 USE trd_oce ! trends: ocean variables 21 21 USE trdtra ! trends manager: tracers 22 USE dynspg_oce ! surface pressure gradient variables23 22 USE diaptr ! poleward transport diagnostics 24 23 ! … … 217 216 DO jj = 2, jpjm1 218 217 DO ji = fs_2, fs_jpim1 ! vector opt. 219 zbtr = 1. / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))218 zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 220 219 ! horizontal advective trends 221 220 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) … … 341 340 DO jj = 2, jpjm1 342 341 DO ji = fs_2, fs_jpim1 ! vector opt. 343 zbtr = 1. / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))342 zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 344 343 ! horizontal advective trends 345 344 ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) … … 412 411 DO ji = fs_2, fs_jpim1 ! vector opt. 413 412 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) & 414 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))413 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 415 414 END DO 416 415 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r5883 r6004 18 18 USE traadv_fct ! acces to routine interp_4th_cpt 19 19 USE trdtra ! trends manager: tracers 20 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient21 20 USE diaptr ! poleward transport diagnostics 22 21 ! … … 164 163 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) & 165 164 & - ( ztu(ji,jj,jk) - ztu(ji-1,jj ,jk) & 166 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))165 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 167 166 END DO 168 167 END DO … … 217 216 DO jj = 2, jpjm1 218 217 DO ji = fs_2, fs_jpim1 ! vector opt. 219 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))218 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 220 219 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztak 221 220 zti(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) … … 255 254 DO jj = 2, jpjm1 256 255 DO ji = fs_2, fs_jpim1 ! vector opt. 257 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))256 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 258 257 END DO 259 258 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r5883 r6004 136 136 REWIND( numnam_ref ) ! Namelist nambbc in reference namelist : Bottom momentum boundary condition 137 137 READ ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901) 138 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )138 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp ) 139 139 ! 140 140 REWIND( numnam_cfg ) ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition 141 141 READ ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 ) 142 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )142 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp ) 143 143 IF(lwm) WRITE ( numond, nambbc ) 144 144 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r5883 r6004 210 210 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 211 211 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) & 212 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,ik))212 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik) 213 213 END DO 214 214 END DO … … 506 506 REWIND( numnam_ref ) ! Namelist nambbl in reference namelist : Bottom boundary layer scheme 507 507 READ ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901) 508 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp )509 508 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in reference namelist', lwp ) 509 ! 510 510 REWIND( numnam_cfg ) ! Namelist nambbl in configuration namelist : Bottom boundary layer scheme 511 511 READ ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 ) 512 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp )512 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in configuration namelist', lwp ) 513 513 IF(lwm) WRITE ( numond, nambbl ) 514 514 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r5883 r6004 146 146 DO ji = fs_2, fs_jpim1 ! vector opt. 147 147 ! 148 zmsku = tmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) &148 zmsku = wmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & 149 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) &150 zmskv = wmask(ji,jj,jk) / MAX( vmask(ji,jj ,jk-1) + vmask(ji,jj-1,jk) & 151 151 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj ,jk) , 1._wp ) 152 152 ! … … 290 290 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) & 291 291 & + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) & 292 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))292 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 293 293 END DO 294 294 END DO … … 310 310 DO ji = fs_2, fs_jpim1 ! vector opt. 311 311 ! 312 zmsku = tmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) &312 zmsku = wmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & 313 313 & + umask(ji-1,jj,jk-1) + umask(ji ,jj,jk) , 1._wp ) 314 zmskv = tmask(ji,jj,jk) / MAX( vmask(ji,jj ,jk-1) + vmask(ji,jj-1,jk) &314 zmskv = wmask(ji,jj,jk) / MAX( vmask(ji,jj ,jk-1) + vmask(ji,jj-1,jk) & 315 315 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj ,jk) , 1._wp ) 316 316 ! … … 335 335 DO jj = 1, jpjm1 336 336 DO ji = fs_2, fs_jpim1 337 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) &337 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk) & 338 338 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & 339 339 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) … … 350 350 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) & 351 351 & + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj) & 352 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) / e3w_n(ji,jj,jk)352 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk) 353 353 END DO 354 354 END DO … … 358 358 DO jj = 1, jpjm1 359 359 DO ji = fs_2, fs_jpim1 360 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) &360 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk) & 361 361 & * ( ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) ) & 362 362 & + akz (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) ) ) … … 371 371 DO ji = fs_2, fs_jpim1 ! vector opt. 372 372 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1) ) & 373 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk))373 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 374 374 END DO 375 375 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r5916 r6004 31 31 USE zdf_oce ! ocean vertical mixing 32 32 USE domvvl ! variable volume 33 USE dynspg_oce ! surface pressure gradient variables34 USE dynhpg ! hydrostatic pressure gradient35 33 USE trd_oce ! trends: ocean variables 36 34 USE trdtra ! trends manager: tracers … … 50 48 USE agrif_opa_interp 51 49 #endif 52 # include "vectopt_loop_substitute.h90"53 50 54 51 IMPLICIT NONE … … 59 56 PUBLIC tra_nxt_vvl ! to be used in trcnxt 60 57 61 REAL(wp) :: rbcp ! Brown & Campana parameters for semi-implicit hpg62 58 !! * Substitutions 59 # include "vectopt_loop_substitute.h90" 63 60 !!---------------------------------------------------------------------- 64 61 !! NEMO/OPA 3.3 , NEMO-Consortium (2010) … … 88 85 !! domains (lk_agrif=T) 89 86 !! 90 !! ** Action : - (tb,sb) and (tn,sn) ready for the next time step 91 !! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T) 87 !! ** Action : - tsb & tsn ready for the next time step 92 88 !!---------------------------------------------------------------------- 93 89 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 104 100 IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap' 105 101 IF(lwp) WRITE(numout,*) '~~~~~~~' 106 !107 rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp) ! Brown & Campana parameter for semi-implicit hpg108 102 ENDIF 109 103 … … 154 148 CALL lbc_lnk( tsb(:,:,:,jn), 'T', 1._wp ) 155 149 CALL lbc_lnk( tsn(:,:,:,jn), 'T', 1._wp ) 156 CALL lbc_lnk( tsa(:,:,:,jn), 'T', 1._wp )157 150 END DO 158 151 ENDIF 159 152 ! 160 ! trends computation161 153 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 162 154 DO jk = 1, jpkm1 … … 187 179 !! 188 180 !! ** Method : - Apply a Asselin time filter on now fields. 189 !! - save in (ta,sa) an average over the three time levels190 !! which will be used to compute rdn and thus the semi-implicit191 !! hydrostatic pressure gradient (ln_dynhpg_imp = T)192 181 !! - swap tracer fields to prepare the next time_step. 193 !! This can be summurized for tempearture as: 194 !! ztm = tn + rbcp * [ta -2 tn + tb ] ln_dynhpg_imp = T 195 !! ztm = 0 otherwise 196 !! with rbcp=1/4 * (1-atfp^4) / (1-atfp) 197 !! tb = tn + atfp*[ tb - 2 tn + ta ] 198 !! tn = ta 199 !! ta = ztm (NB: reset to 0 after eos_bn2 call) 200 !! 201 !! ** Action : - (tb,sb) and (tn,sn) ready for the next time step 202 !! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T) 203 !!---------------------------------------------------------------------- 204 INTEGER , INTENT(in ) :: kt ! ocean time-step index 205 INTEGER , INTENT(in ) :: kit000 ! first time step index 206 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 207 INTEGER , INTENT(in ) :: kjpt ! number of tracers 208 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields 209 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields 210 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 182 !! 183 !! ** Action : - tsb & tsn ready for the next time step 184 !!---------------------------------------------------------------------- 185 INTEGER , INTENT(in ) :: kt ! ocean time-step index 186 INTEGER , INTENT(in ) :: kit000 ! first time step index 187 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 188 INTEGER , INTENT(in ) :: kjpt ! number of tracers 189 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptb ! before tracer fields 190 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptn ! now tracer fields 191 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 211 192 ! 212 193 INTEGER :: ji, jj, jk, jn ! dummy loop indices 213 LOGICAL :: ll_tra_hpg ! local logical214 194 REAL(wp) :: ztn, ztd ! local scalars 215 195 !!---------------------------------------------------------------------- … … 221 201 ENDIF 222 202 ! 223 IF( cdtype == 'TRA' ) THEN ; ll_tra_hpg = ln_dynhpg_imp ! active tracers case and semi-implicit hpg224 ELSE ; ll_tra_hpg = .FALSE. ! passive tracers case or NO semi-implicit hpg225 ENDIF226 !227 203 DO jn = 1, kjpt 228 204 ! … … 231 207 DO ji = fs_2, fs_jpim1 232 208 ztn = ptn(ji,jj,jk,jn) 233 ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn) ! time laplacian on tracers 234 ! 235 ptb(ji,jj,jk,jn) = ztn + atfp * ztd ! ptb <-- filtered ptn 236 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 237 ! 238 IF( ll_tra_hpg ) pta(ji,jj,jk,jn) = ztn + rbcp * ztd ! pta <-- Brown & Campana average 209 ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn) ! time laplacian on tracers 210 ! 211 ptb(ji,jj,jk,jn) = ztn + atfp * ztd ! ptb <-- filtered ptn 212 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 239 213 END DO 240 214 END DO … … 254 228 !! 255 229 !! ** Method : - Apply a thickness weighted Asselin time filter on now fields. 256 !! - save in (ta,sa) a thickness weighted average over the three257 !! time levels which will be used to compute rdn and thus the semi-258 !! implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)259 230 !! - swap tracer fields to prepare the next time_step. 260 !! This can be summurized for tempearture as:261 !! ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) ln_dynhpg_imp = T262 !! /( e3t_n + rbcp*[ e3t_b - 2 e3t_n + e3t_a ] )263 !! ztm = 0 otherwise264 231 !! tb = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 265 232 !! /( e3t_n + atfp*[ e3t_b - 2 e3t_n + e3t_a ] ) 266 233 !! tn = ta 267 !! ta = zt (NB: reset to 0 after eos_bn2 call) 268 !! 269 !! ** Action : - (tb,sb) and (tn,sn) ready for the next time step 270 !! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T) 271 !!---------------------------------------------------------------------- 272 INTEGER , INTENT(in ) :: kt ! ocean time-step index 273 INTEGER , INTENT(in ) :: kit000 ! first time step index 274 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! time-step 275 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 276 INTEGER , INTENT(in ) :: kjpt ! number of tracers 277 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields 278 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields 279 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 280 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt) :: psbc_tc ! surface tracer content 281 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt) :: psbc_tc_b ! before surface tracer content 282 ! 283 LOGICAL :: ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf ! local logical 234 !! 235 !! ** Action : - tsb & tsn ready for the next time step 236 !!---------------------------------------------------------------------- 237 INTEGER , INTENT(in ) :: kt ! ocean time-step index 238 INTEGER , INTENT(in ) :: kit000 ! first time step index 239 REAL(wp), DIMENSION(jpk) , INTENT(in ) :: p2dt ! time-step 240 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 241 INTEGER , INTENT(in ) :: kjpt ! number of tracers 242 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptb ! before tracer fields 243 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptn ! now tracer fields 244 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 245 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: psbc_tc ! surface tracer content 246 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: psbc_tc_b ! before surface tracer content 247 ! 248 LOGICAL :: ll_traqsr, ll_rnf, ll_isf ! local logical 284 249 INTEGER :: ji, jj, jk, jn ! dummy loop indices 285 250 REAL(wp) :: zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar … … 293 258 ENDIF 294 259 ! 295 IF( cdtype == 'TRA' ) THEN 296 ll_tra_hpg = ln_dynhpg_imp ! active tracers case and semi-implicit hpg 297 ll_traqsr = ln_traqsr ! active tracers case and solar penetration 298 ll_rnf = ln_rnf ! active tracers case and river runoffs 260 IF( cdtype == 'TRA' ) THEN ! active tracers case 261 ll_traqsr = ln_traqsr ! solar penetration 262 ll_rnf = ln_rnf ! river runoffs 299 263 IF( nn_isf >= 1 ) THEN 300 ll_isf = .TRUE. ! active tracers case andice shelf melting/freezing264 ll_isf = .TRUE. ! ice shelf melting/freezing 301 265 ELSE 302 266 ll_isf = .FALSE. 303 267 END IF 304 ELSE 305 ll_tra_hpg = .FALSE. ! passive tracers case or NO semi-implicit hpg 306 ll_traqsr = .FALSE. ! active tracers case and NO solar penetration 307 ll_rnf = .FALSE. ! passive tracers or NO river runoffs 308 ll_isf = .FALSE. ! passive tracers or NO ice shelf melting/freezing 268 ELSE ! passive tracers case 269 ll_traqsr = .FALSE. ! NO solar penetration 270 ll_rnf = .FALSE. ! NO river runoffs ???? !!gm BUG ? 271 ll_isf = .FALSE. ! NO ice shelf melting/freezing !!gm BUG ?? 309 272 ENDIF 310 273 ! … … 312 275 DO jk = 1, jpkm1 313 276 zfact1 = atfp * p2dt(jk) 314 zfact2 = zfact1 /rau0277 zfact2 = zfact1 * r1_rau0 315 278 DO jj = 2, jpjm1 316 279 DO ji = fs_2, fs_jpim1 … … 335 298 ztc_f = ztc_f - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 336 299 ENDIF 337 300 ! 338 301 ! solar penetration (temperature only) 339 302 IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) & 340 303 & ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 341 304 ! 342 305 ! river runoff 343 306 IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) & 344 307 & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 345 308 & * e3t_n(ji,jj,jk) / h_rnf(ji,jj) 346 309 ! 347 310 ! ice shelf 348 311 IF( ll_isf ) THEN … … 356 319 & * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 357 320 END IF 358 321 ! 359 322 ze3t_f = 1.e0 / ze3t_f 360 323 ptb(ji,jj,jk,jn) = ztc_f * ze3t_f ! ptb <-- ptn filtered 361 324 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 362 325 ! 363 IF( ll_tra_hpg ) THEN ! semi-implicit hpg (T & S only)364 ze3t_d = 1.e0 / ( ze3t_n + rbcp * ze3t_d )365 pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n + rbcp * ztc_d ) ! ta <-- Brown & Campana average366 ENDIF367 326 END DO 368 327 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r5916 r6004 11 11 !! 3.2 ! 2009-04 (G. Madec & NEMO team) 12 12 !! 3.6 ! 2012-05 (C. Rousset) store attenuation coef for use in ice model 13 !! 3.7 ! 2015-11 (G. Madec ) remove optimisation for fix volume13 !! 3.7 ! 2015-11 (G. Madec, A. Coward) remove optimisation for fix volume 14 14 !!---------------------------------------------------------------------- 15 15 … … 105 105 INTEGER :: ji, jj, jk ! dummy loop indices 106 106 INTEGER :: irgb ! local integers 107 REAL(wp) :: zchl, zcoef, z1_2 ! local scalars107 REAL(wp) :: zchl, zcoef, z1_2 ! local scalars 108 108 REAL(wp) :: zc0 , zc1 , zc2 , zc3 ! - - 109 109 REAL(wp) :: zzc0, zzc1, zzc2, zzc3 ! - - -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r5883 r6004 18 18 USE zdf_oce ! ocean vertical physics variables 19 19 USE sbc_oce ! surface boundary condition: ocean 20 USE dynspg_oce21 20 USE ldftra ! lateral diffusion: eddy diffusivity 22 21 USE ldfslp ! lateral diffusion: iso-neutral slope -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
r5883 r6004 29 29 USE zdfddm ! ocean vertical physics: double diffusion 30 30 USE trc_oce ! share passive tracers/Ocean variables 31 ! 31 32 USE in_out_manager ! I/O manager 32 33 USE lib_mpp ! MPP library … … 49 50 CONTAINS 50 51 51 SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, kst p, &52 SUBROUTINE tra_zdf_exp( kt, kit000, cdtype, p2dt, ksts, & 52 53 & ptb , pta , kjpt ) 53 54 !!---------------------------------------------------------------------- … … 75 76 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 76 77 INTEGER , INTENT(in ) :: kjpt ! number of tracers 77 INTEGER , INTENT(in ) :: kst p! number of sub-time step78 INTEGER , INTENT(in ) :: ksts ! number of sub-time step 78 79 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 79 80 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields … … 81 82 ! 82 83 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 83 REAL(wp) :: z1_kst p, ze3tr ! local scalars84 REAL(wp) :: z1_ksts, ze3tr ! local scalars 84 85 REAL(wp) :: ztra, ze3tb, z2dt ! - - 85 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztb, zwf … … 98 99 ! Initializations 99 100 ! --------------- 100 z1_kst p = 1._wp / REAL( kstp, wp )101 z1_ksts = 1._wp / REAL( ksts, wp ) 101 102 zwf(:,:, 1 ) = 0._wp ! no flux at the surface and at bottom level 102 103 zwf(:,:,jpk) = 0._wp … … 107 108 ztb(:,:,:) = ptb(:,:,:,jn) ! initial before value for tracer 108 109 ! 109 DO jl = 1, kst p!== Split-explicit loop ==!110 DO jl = 1, ksts !== Split-explicit loop ==! 110 111 ! 111 112 DO jk = 2, jpk ! 1st vertical derivative (w-flux) … … 122 123 ! 123 124 DO jk = 1, jpkm1 ! 2nd vertical derivative ==> tracer at kt+l*2*rdt/nn_zdfexp 124 z2dt = z1_kst p* p2dt(jk)125 z2dt = z1_ksts * p2dt(jk) 125 126 DO jj = 2, jpjm1 126 127 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r5883 r6004 16 16 !! 3.3 ! 2010-06 (C. Ethe, G. Madec) Merge TRA-TRC 17 17 !! - ! 2011-02 (A. Coward, C. Ethe, G. Madec) improvment of surface boundary condition 18 !! 3.7 ! 2015-11 (G. Madec, A. Coward) non linear free surface by default 18 19 !!---------------------------------------------------------------------- 19 20 … … 134 135 DO jj = 2, jpjm1 135 136 DO ji = fs_2, fs_jpim1 ! vector opt. 137 !!gm BUG I think, use e3w_a instead of e3w_n 136 138 zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk ) / e3w_n(ji,jj,jk ) 137 139 zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r5845 r6004 110 110 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 111 111 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 112 !!gm BUG ? when applied to before fields, e3w_b should be used.... 112 113 ze3wu = e3w_n(ji+1,jj ,iku) - e3w_n(ji,jj,iku) 113 114 ze3wv = e3w_n(ji ,jj+1,ikv) - e3w_n(ji,jj,ikv) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
r5215 r6004 71 71 INTEGER, PUBLIC, PARAMETER :: jpdyn_bfri = 12 !: implicit bottom friction (ln_bfrimp=.TRUE.) 72 72 INTEGER, PUBLIC, PARAMETER :: jpdyn_ken = 13 !: use for calculation of KE 73 INTEGER, PUBLIC, PARAMETER :: jpdyn_spgflt = 14 !: filter contribution to surface pressure gradient (spg_flt)74 INTEGER, PUBLIC, PARAMETER :: jpdyn_spgexp = 15 !: explicit contribution to surface pressure gradient (spg_flt)75 73 ! 76 74 !!---------------------------------------------------------------------- 77 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)75 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 78 76 !! $Id$ 79 77 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
r5845 r6004 112 112 CASE( jpdyn_spg ) ; CALL iom_put( "utrd_spg", putrd ) ! surface pressure gradient 113 113 CALL iom_put( "vtrd_spg", pvtrd ) 114 CASE( jpdyn_spgexp ); CALL iom_put( "utrd_spgexp", putrd ) ! surface pressure gradient (explicit)115 CALL iom_put( "vtrd_spgexp", pvtrd )116 CASE( jpdyn_spgflt ); CALL iom_put( "utrd_spgflt", putrd ) ! surface pressure gradient (filtered)117 CALL iom_put( "vtrd_spgflt", pvtrd )118 114 CASE( jpdyn_pvo ) ; CALL iom_put( "utrd_pvo", putrd ) ! planetary vorticity 119 115 CALL iom_put( "vtrd_pvo", pvtrd ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r5866 r6004 93 93 CALL lbc_lnk( putrd, 'U', -1. ) ; CALL lbc_lnk( pvtrd, 'V', -1. ) ! lateral boundary conditions 94 94 ! 95 IF( .NOT.ln_linssh .AND. kt /= nkstp ) THEN ! Variable volume: set box volume at the 1st call of kt time step 96 nkstp = kt 97 DO jk = 1, jpkm1 98 bu (:,:,jk) = e1e2u(:,:) * e3u_n(:,:,jk) 99 bv (:,:,jk) = e1e2v(:,:) * e3v_n(:,:,jk) 100 r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * e3t_n(:,:,jk) ) * tmask(:,:,jk) 101 END DO 102 ENDIF 95 nkstp = kt 96 DO jk = 1, jpkm1 97 bu (:,:,jk) = e1e2u(:,:) * e3u_n(:,:,jk) 98 bv (:,:,jk) = e1e2v(:,:) * e3v_n(:,:,jk) 99 r1_bt(:,:,jk) = r1_e1e2t(:,:) / e3t_n(:,:,jk) * tmask(:,:,jk) 100 END DO 103 101 ! 104 102 zke(:,:,jpk) = 0._wp … … 117 115 ! 118 116 SELECT CASE( ktrd ) 119 CASE( jpdyn_hpg ) ; CALL iom_put( "ketrd_hpg", zke ) ! hydrostatic pressure gradient 120 CASE( jpdyn_spg ) ; CALL iom_put( "ketrd_spg", zke ) ! surface pressure gradient 121 CASE( jpdyn_spgexp ); CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit) 122 CASE( jpdyn_spgflt ); CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter) 123 CASE( jpdyn_pvo ) ; CALL iom_put( "ketrd_pvo", zke ) ! planetary vorticity 124 CASE( jpdyn_rvo ) ; CALL iom_put( "ketrd_rvo", zke ) ! relative vorticity (or metric term) 125 CASE( jpdyn_keg ) ; CALL iom_put( "ketrd_keg", zke ) ! Kinetic Energy gradient (or had) 126 CASE( jpdyn_zad ) ; CALL iom_put( "ketrd_zad", zke ) ! vertical advection 127 CASE( jpdyn_ldf ) ; CALL iom_put( "ketrd_ldf", zke ) ! lateral diffusion 128 CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf", zke ) ! vertical diffusion 129 ! ! wind stress trends 117 CASE( jpdyn_hpg ) ; CALL iom_put( "ketrd_hpg" , zke ) ! hydrostatic pressure gradient 118 CASE( jpdyn_spg ) ; CALL iom_put( "ketrd_spg" , zke ) ! surface pressure gradient 119 CASE( jpdyn_pvo ) ; CALL iom_put( "ketrd_pvo" , zke ) ! planetary vorticity 120 CASE( jpdyn_rvo ) ; CALL iom_put( "ketrd_rvo" , zke ) ! relative vorticity (or metric term) 121 CASE( jpdyn_keg ) ; CALL iom_put( "ketrd_keg" , zke ) ! Kinetic Energy gradient (or had) 122 CASE( jpdyn_zad ) ; CALL iom_put( "ketrd_zad" , zke ) ! vertical advection 123 CASE( jpdyn_ldf ) ; CALL iom_put( "ketrd_ldf" , zke ) ! lateral diffusion 124 CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf" , zke ) ! vertical diffusion 125 ! ! ! wind stress trends 130 126 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 131 z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1 u(:,:) *e2u(:,:) * umask(:,:,1)132 z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1 v(:,:) *e2v(:,:) * vmask(:,:,1)127 z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1e2u(:,:) * umask(:,:,1) 128 z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1e2v(:,:) * vmask(:,:,1) 133 129 zke2d(1,:) = 0._wp ; zke2d(:,1) = 0._wp 134 130 DO jj = 2, jpj 135 131 DO ji = 2, jpi 136 zke2d(ji,jj) = 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) &137 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1)132 zke2d(ji,jj) = r1_rau0 * 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) & 133 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1) 138 134 END DO 139 135 END DO 140 CALL iom_put( "ketrd_tau" , zke2d )136 CALL iom_put( "ketrd_tau" , zke2d ) ! 141 137 CALL wrk_dealloc( jpi, jpj , z2dx, z2dy, zke2d ) 142 CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr" , zke ) ! bottom friction (explicit case)138 CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr" , zke ) ! bottom friction (explicit case) 143 139 !!gm TO BE DONE properly 144 140 !!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... … … 159 155 ! END DO 160 156 ! END DO 161 ! CALL iom_put( "ketrd_bfr", zke2d )! bottom friction (explicit case)157 ! CALL iom_put( "ketrd_bfr" , zke2d ) ! bottom friction (explicit case) 162 158 ! ENDIF 163 159 !!gm end 164 CASE( jpdyn_atf ) ; CALL iom_put( "ketrd_atf" , zke ) ! asselin filter trends160 CASE( jpdyn_atf ) ; CALL iom_put( "ketrd_atf" , zke ) ! asselin filter trends 165 161 !! a faire !!!! idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!! 166 162 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... … … 184 180 ! CALL iom_put( "ketrd_bfri", zke2d ) 185 181 ! ENDIF 186 CASE( jpdyn_ken ) ; ! kinetic energy 187 ! called in dynnxt.F90 before asselin time filter 188 ! with putrd=ua and pvtrd=va 189 zke(:,:,:) = 0.5_wp * zke(:,:,:) 190 CALL iom_put( "KE", zke ) 191 ! 192 CALL ken_p2k( kt , zke ) 193 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 182 CASE( jpdyn_ken ) ; ! kinetic energy 183 ! called in dynnxt.F90 before asselin time filter with putrd=ua and pvtrd=va 184 zke(:,:,:) = 0.5_wp * zke(:,:,:) 185 CALL iom_put( "KE", zke ) 186 ! 187 CALL ken_p2k( kt , zke ) 188 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 194 189 ! 195 190 END SELECT … … 265 260 IF( trd_ken_alloc() /= 0 ) CALL ctl_stop('trd_ken_alloc: failed to allocate arrays') 266 261 ! 267 !!gm IF( .NOT. (ln_hpg_zco.OR.ln_hpg_zps) ) &268 !!gm & CALL ctl_stop('trd_ken_init : only full and partial cells are coded for conversion rate')269 !270 IF( ln_linssh ) THEN ! constant volume: bu, bv, 1/bt computed one for all271 DO jk = 1, jpkm1272 bu (:,:,jk) = e1e2u(:,:) * e3u_n(:,:,jk)273 bv (:,:,jk) = e1e2v(:,:) * e3v_n(:,:,jk)274 r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * e3t_n(:,:,jk) )275 END DO276 ENDIF277 !278 262 END SUBROUTINE trd_ken_init 279 263 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
r5866 r6004 78 78 zpe(:,:,:) = 0._wp 79 79 ! 80 IF ( kt /= nkstp ) THEN! full eos: set partial derivatives at the 1st call of kt time step80 IF( kt /= nkstp ) THEN ! full eos: set partial derivatives at the 1st call of kt time step 81 81 nkstp = kt 82 82 CALL eos_pen( tsn, rab_PE, zpe ) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r5866 r6004 206 206 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 207 207 & - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk) ) & 208 & / ( e1t(ji,jj) * e2t(ji,jj) * e3t_n(ji,jj,jk) )* tmask(ji,jj,jk)208 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 209 209 END DO 210 210 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r5866 r6004 127 127 ikbt = mikt(ji,jj) 128 128 ! JC: possible WAD implementation should modify line below if layers vanish 129 ztmp = (1 -tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp129 ztmp = (1.-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * e3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 130 130 ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 131 131 ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max) … … 133 133 END DO 134 134 END IF 135 !135 ! 136 136 ELSE 137 137 zbfrt(:,:) = bfrcoef2d(:,:) … … 157 157 ! in case of 2 cell water column, we assume each cell feels the top and bottom friction 158 158 IF ( ln_isfcav ) THEN 159 IF ( miku(ji,jj) + 1 .GE.mbku(ji,jj) ) THEN159 IF ( miku(ji,jj) + 1 >= mbku(ji,jj) ) THEN 160 160 bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) & 161 161 & + ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) ) & 162 162 & * zecu * (1._wp - umask(ji,jj,1)) 163 END 164 IF ( mikv(ji,jj) + 1 .GE.mbkv(ji,jj) ) THEN163 ENDIF 164 IF( mikv(ji,jj) + 1 >= mbkv(ji,jj) ) THEN 165 165 bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) & 166 166 & + ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) ) & 167 167 & * zecv * (1._wp - vmask(ji,jj,1)) 168 END 169 END 168 ENDIF 169 ENDIF 170 170 END DO 171 171 END DO 172 172 CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition 173 173 174 IF 174 IF( ln_isfcav ) THEN 175 175 DO jj = 2, jpjm1 176 176 DO ji = 2, jpim1 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5836 r6004 36 36 37 37 !!---------------------------------------------------------------------- 38 !! nemo_gcm 39 !! nemo_init 40 !! nemo_ctl 41 !! nemo_closefile 42 !! nemo_alloc 43 !! nemo_partition 44 !! factorise 38 !! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 39 !! nemo_init : initialization of the NEMO system 40 !! nemo_ctl : initialisation of the contol print 41 !! nemo_closefile: close remaining open files 42 !! nemo_alloc : dynamical allocation 43 !! nemo_partition: calculate MPP domain decomposition 44 !! factorise : calculate the factors of the no. of MPI processes 45 45 !!---------------------------------------------------------------------- 46 USE step_oce 47 USE domcfg 48 USE mppini 49 USE domain 46 USE step_oce ! module used in the ocean time stepping module (step.F90) 47 USE domcfg ! domain configuration (dom_cfg routine) 48 USE mppini ! shared/distributed memory setting (mpp_init routine) 49 USE domain ! domain initialization (dom_init routine) 50 50 #if defined key_nemocice_decomp 51 51 USE ice_domain_size, only: nx_global, ny_global 52 52 #endif 53 USE tideini ! tidal components initialization (tide_ini routine) 54 USE bdyini ! open boundary cond. setting (bdy_init routine) 55 USE bdydta ! open boundary cond. setting (bdy_dta_init routine) 56 USE bdytides ! open boundary cond. setting (bdytide_init routine) 57 USE istate ! initial state setting (istate_init routine) 58 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) 59 USE ldftra ! lateral diffusivity setting (ldftra_init routine) 60 USE zdfini ! vertical physics setting (zdf_init routine) 61 USE phycst ! physical constant (par_cst routine) 62 USE trdini ! dyn/tra trends initialization (trd_init routine) 63 USE asminc ! assimilation increments 64 USE asmbkg ! writing out state trajectory 65 USE diaptr ! poleward transports (dia_ptr_init routine) 66 USE diadct ! sections transports (dia_dct_init routine) 67 USE diaobs ! Observation diagnostics (dia_obs_init routine) 68 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 69 USE step ! NEMO time-stepping (stp routine) 70 USE icbini ! handle bergs, initialisation 71 USE icbstp ! handle bergs, calving, themodynamics and transport 72 USE cpl_oasis3 ! OASIS3 coupling 73 USE c1d ! 1D configuration 74 USE step_c1d ! Time stepping loop for the 1D configuration 75 USE dyndmp ! Momentum damping 53 USE tideini ! tidal components initialization (tide_ini routine) 54 USE bdyini ! open boundary cond. setting (bdy_init routine) 55 USE bdydta ! open boundary cond. setting (bdy_dta_init routine) 56 USE bdytides ! open boundary cond. setting (bdytide_init routine) 57 USE sbctide, ONLY : lk_tide 58 USE istate ! initial state setting (istate_init routine) 59 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) 60 USE ldftra ! lateral diffusivity setting (ldftra_init routine) 61 USE zdfini ! vertical physics setting (zdf_init routine) 62 USE phycst ! physical constant (par_cst routine) 63 USE trdini ! dyn/tra trends initialization (trd_init routine) 64 USE asminc ! assimilation increments 65 USE asmbkg ! writing out state trajectory 66 USE diaptr ! poleward transports (dia_ptr_init routine) 67 USE diadct ! sections transports (dia_dct_init routine) 68 USE diaobs ! Observation diagnostics (dia_obs_init routine) 69 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 70 USE step ! NEMO time-stepping (stp routine) 71 USE icbini ! handle bergs, initialisation 72 USE icbstp ! handle bergs, calving, themodynamics and transport 73 USE cpl_oasis3 ! OASIS3 coupling 74 USE c1d ! 1D configuration 75 USE step_c1d ! Time stepping loop for the 1D configuration 76 USE dyndmp ! Momentum damping 77 USE stopar ! Stochastic param.: ??? 78 USE stopts ! Stochastic param.: ??? 76 79 #if defined key_top 77 USE trcini 78 #endif 79 USE lib_mpp 80 USE trcini ! passive tracer initialisation 81 #endif 82 USE lib_mpp ! distributed memory computing 80 83 #if defined key_iomput 81 USE xios ! xIOserver 82 #endif 83 USE sbctide, ONLY : lk_tide 84 USE crsini ! initialise grid coarsening utility 85 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 86 USE sbc_oce, ONLY : lk_oasis 87 USE stopar 88 USE stopts 84 USE xios ! xIOserver 85 #endif 86 USE crsini ! initialise grid coarsening utility 87 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 88 USE sbc_oce, ONLY : lk_oasis 89 89 90 90 IMPLICIT NONE … … 402 402 ! ! external forcing 403 403 !!gm to be added : creation and call of sbc_apr_init 404 IF( lk_tide ) CALL tide_init ( nit000 )! tidal harmonics404 IF( lk_tide ) CALL tide_init ! tidal harmonics 405 405 CALL sbc_init ! surface boundary conditions (including sea-ice) 406 406 !!gm ==>> bdy_init should call bdy_dta_init and bdytide_init NOT in nemogcm !!! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/oce.F90
r5836 r6004 21 21 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ub , un , ua !: i-horizontal velocity [m/s] 22 22 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vb , vn , va !: j-horizontal velocity [m/s] 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ua_sv, va_sv !: Saved trends (time spliting) [m/s2]24 23 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wn !: vertical velocity [m/s] 25 24 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdivn !: horizontal divergence [s-1] … … 85 84 ! 86 85 ALLOCATE( ub (jpi,jpj,jpk) , un (jpi,jpj,jpk) , ua(jpi,jpj,jpk) , & 87 & vb (jpi,jpj,jpk) , vn (jpi,jpj,jpk) , va(jpi,jpj,jpk) , & 88 & ua_sv(jpi,jpj,jpk) , va_sv(jpi,jpj,jpk) , & 86 & vb (jpi,jpj,jpk) , vn (jpi,jpj,jpk) , va(jpi,jpj,jpk) , & 89 87 & wn (jpi,jpj,jpk) , hdivn(jpi,jpj,jpk) , & 90 88 & tsb (jpi,jpj,jpk,jpts) , tsn (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) , & -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/step.F90
r5883 r6004 2 2 !!====================================================================== 3 3 !! *** MODULE step *** 4 !! Time-stepping 4 !! Time-stepping : manager of the ocean, tracer and ice time stepping 5 5 !!====================================================================== 6 6 !! History : OPA ! 1991-03 (G. Madec) Original code … … 28 28 !! 3.7 ! 2014-10 (G. Madec) LDF simplication 29 29 !! - ! 2014-12 (G. Madec) remove KPP scheme 30 !! - ! 2015-11 (J. Chanut) free surface simplification 30 31 !!---------------------------------------------------------------------- 31 32 … … 34 35 !!---------------------------------------------------------------------- 35 36 USE step_oce ! time stepping definition modules 36 USE iom 37 ! 38 USE iom ! xIOs server 37 39 38 40 IMPLICIT NONE … … 176 178 177 179 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 178 ! Ocean dynamics : hdiv, ssh, e3, wn 179 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 180 CALL ssh_nxt ( kstp ) ! after ssh (includes call to div_hor) 181 CALL dom_vvl_sf_nxt( kstp ) ! after vertical scale factors 182 CALL wzv ( kstp ) ! now cross-level velocity 183 184 IF( lk_dynspg_ts ) THEN 185 ! In case the time splitting case, update almost all momentum trends here: 186 ! Note that the computation of vertical velocity above, hence "after" sea level 187 ! is necessary to compute momentum advection for the rhs of barotropic loop: 180 ! Ocean dynamics : hdiv, ssh, e3, u, v, w 181 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 182 183 CALL ssh_nxt ( kstp ) ! after ssh (includes call to div_hor) 184 IF(.NOT.ln_linssh ) CALL dom_vvl_sf_nxt( kstp ) ! after vertical scale factors 185 CALL wzv ( kstp ) ! now cross-level velocity 186 188 187 !!gm : why also here ???? 189 IF(ln_sto_eos )CALL sto_pts( tsn ) ! Random T/S fluctuations188 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 190 189 !!gm 191 190 CALL eos ( tsn, rhd, rhop, gdept_n(:,:,:) ) ! now in situ density for hpg computation 192 191 192 !!jc: fs simplification 193 !!jc: lines below are useless if ln_linssh=F. Keep them here (which maintains a bug if ln_linssh=T and ln_zps=T, cf ticket #1636) 194 !! but ensures reproductible results 195 !! with previous versions using split-explicit free surface 193 196 IF( ln_zps .AND. .NOT. ln_isfcav) & ! Partial steps: bottom before horizontal gradient 194 197 & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! of t, s, rd at the last ocean level … … 198 201 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 199 202 & grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) 200 201 ua(:,:,:) = 0._wp ! set dynamics trends to zero 202 va(:,:,:) = 0._wp 203 IF( lk_asminc .AND. ln_asmiau .AND. & 204 & ln_dyninc ) CALL dyn_asm_inc ( kstp ) ! apply dynamics assimilation increment 205 IF( lk_bdy ) CALL bdy_dyn3d_dmp( kstp ) ! bdy damping trends 206 CALL dyn_adv ( kstp ) ! advection (vector or flux form) 207 CALL dyn_vor ( kstp ) ! vorticity term including Coriolis 208 CALL dyn_ldf ( kstp ) ! lateral mixing 209 #if defined key_agrif 210 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn ! momentum sponge 211 #endif 212 CALL dyn_hpg( kstp ) ! horizontal gradient of Hydrostatic pressure 213 CALL dyn_spg( kstp, indic ) ! surface pressure gradient 214 215 ua_sv(:,:,:) = ua(:,:,:) ! Save trends (barotropic trend has been fully updated at this stage) 216 va_sv(:,:,:) = va(:,:,:) 217 218 CALL div_hor( kstp ) ! Horizontal divergence (2nd call in time-split case) 219 CALL dom_vvl_sf_nxt( kstp, kcall=2 ) ! after vertical scale factors (update depth average component) 220 CALL wzv ( kstp ) ! now cross-level velocity 221 ENDIF 222 223 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 224 ! diagnostics and outputs (ua, va, tsa used as workspace) 225 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 226 IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats 227 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth) 228 IF(.NOT.ln_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 229 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports 230 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag 231 IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis 232 CALL dia_wri( kstp ) ! ocean model: outputs 233 ! 234 IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output 203 !!jc: fs simplification 204 205 ua(:,:,:) = 0._wp ! set dynamics trends to zero 206 va(:,:,:) = 0._wp 207 208 IF( lk_asminc .AND. ln_asmiau .AND. ln_dyninc ) & 209 CALL dyn_asm_inc ( kstp ) ! apply dynamics assimilation increment 210 IF( lk_bdy ) CALL bdy_dyn3d_dmp ( kstp ) ! bdy damping trends 211 #if defined key_agrif 212 IF(.NOT. Agrif_Root()) & 213 & CALL Agrif_Sponge_dyn ! momentum sponge 214 #endif 215 CALL dyn_adv ( kstp ) ! advection (vector or flux form) 216 CALL dyn_vor ( kstp ) ! vorticity term including Coriolis 217 CALL dyn_ldf ( kstp ) ! lateral mixing 218 CALL dyn_hpg ( kstp ) ! horizontal gradient of Hydrostatic pressure 219 CALL dyn_spg ( kstp ) ! surface pressure gradient 220 221 ! With split-explicit free surface, since now transports have been updated and ssha as well 222 IF( ln_dynspg_ts ) THEN ! vertical scale factors and vertical velocity need to be updated 223 CALL div_hor ( kstp ) ! Horizontal divergence (2nd call in time-split case) 224 IF(.NOT.ln_linssh) CALL dom_vvl_sf_nxt( kstp, kcall=2 ) ! after vertical scale factors (update depth average component) 225 CALL wzv ( kstp ) ! now cross-level velocity 226 ENDIF 227 228 CALL dyn_bfr ( kstp ) ! bottom friction 229 CALL dyn_zdf ( kstp ) ! vertical diffusion 230 231 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 232 ! diagnostics and outputs 233 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 234 IF( lk_floats ) CALL flo_stp ( kstp ) ! drifting Floats 235 IF( lk_diahth ) CALL dia_hth ( kstp ) ! Thermocline depth (20 degres isotherm depth) 236 IF(.NOT.ln_cpl ) CALL dia_fwb ( kstp ) ! Fresh water budget diagnostics 237 IF( lk_diadct ) CALL dia_dct ( kstp ) ! Transports 238 IF( lk_diaar5 ) CALL dia_ar5 ( kstp ) ! ar5 diag 239 IF( lk_diaharm ) CALL dia_harm ( kstp ) ! Tidal harmonic analysis 240 CALL dia_wri ( kstp ) ! ocean model: outputs 241 ! 242 IF( ln_crs ) CALL crs_fld ( kstp ) ! ocean model: online field coarsening & output 235 243 236 244 #if defined key_top … … 238 246 ! Passive Tracer Model 239 247 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 240 CALL trc_stp ( kstp )! time-stepping241 #endif 242 243 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 244 ! Active tracers (ua, va used as workspace)245 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 246 tsa(:,:,:,:) = 0._wp! set tracer trends to zero248 CALL trc_stp ( kstp ) ! time-stepping 249 #endif 250 251 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 252 ! Active tracers 253 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 254 tsa(:,:,:,:) = 0._wp ! set tracer trends to zero 247 255 248 256 IF( lk_asminc .AND. ln_asmiau .AND. & 249 & ln_trainc ) CALL tra_asm_inc( kstp ) ! apply tracer assimilation increment 250 CALL tra_sbc ( kstp ) ! surface boundary condition 251 IF( ln_traqsr ) CALL tra_qsr ( kstp ) ! penetrative solar radiation qsr 252 IF( ln_trabbc ) CALL tra_bbc ( kstp ) ! bottom heat flux 253 IF( lk_trabbl ) CALL tra_bbl ( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 254 IF( ln_tradmp ) CALL tra_dmp ( kstp ) ! internal damping trends 255 IF( lk_bdy ) CALL bdy_tra_dmp( kstp ) ! bdy damping trends 256 CALL tra_adv ( kstp ) ! horizontal & vertical advection 257 CALL tra_ldf ( kstp ) ! lateral mixing 257 & ln_trainc ) CALL tra_asm_inc ( kstp ) ! apply tracer assimilation increment 258 CALL tra_sbc ( kstp ) ! surface boundary condition 259 IF( ln_traqsr ) CALL tra_qsr ( kstp ) ! penetrative solar radiation qsr 260 IF( ln_trabbc ) CALL tra_bbc ( kstp ) ! bottom heat flux 261 IF( lk_trabbl ) CALL tra_bbl ( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 262 IF( ln_tradmp ) CALL tra_dmp ( kstp ) ! internal damping trends 263 IF( lk_bdy ) CALL bdy_tra_dmp ( kstp ) ! bdy damping trends 264 #if defined key_agrif 265 IF(.NOT. Agrif_Root()) & 266 & CALL Agrif_Sponge_tra ! tracers sponge 267 #endif 268 CALL tra_adv ( kstp ) ! horizontal & vertical advection 269 CALL tra_ldf ( kstp ) ! lateral mixing 258 270 259 271 !!gm : why CALL to dia_ptr has been moved here??? (use trends info?) 260 IF( ln_diaptr ) CALL dia_ptr! Poleward adv/ldf TRansports diagnostics272 IF( ln_diaptr ) CALL dia_ptr ! Poleward adv/ldf TRansports diagnostics 261 273 !!gm 262 263 #if defined key_agrif 264 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra ! tracers sponge 265 #endif 266 CALL tra_zdf ( kstp ) ! vertical mixing and after tracer fields 267 268 IF( ln_dynhpg_imp ) THEN ! semi-implicit hpg (time stepping then eos) 269 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 270 CALL tra_nxt( kstp ) ! tracer fields at next time step 271 !!gm : why again a call to sto_pts ??? 272 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 273 !!gm 274 CALL eos ( tsa, rhd, rhop, gdept_n(:,:,:) ) ! Time-filtered in situ density for hpg computation 275 IF( ln_zps .AND. .NOT. ln_isfcav) & 276 & CALL zps_hde ( kstp, jpts, tsa, gtsu, gtsv, & ! Partial steps: before horizontal gradient 277 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 278 IF( ln_zps .AND. ln_isfcav) & 279 & CALL zps_hde_isf( kstp, jpts, tsa, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top/bottom cells 280 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 281 & grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) 282 ELSE ! centered hpg (eos then time stepping) 283 IF ( .NOT. lk_dynspg_ts ) THEN ! eos already called in time-split case 284 !!gm : why again a call to sto_pts ??? 285 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 286 !!gm 287 CALL eos ( tsn, rhd, rhop, gdept_n(:,:,:) ) ! now in situ density for hpg computation 288 IF( ln_zps .AND. .NOT. ln_isfcav) & 289 & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: bottom before horizontal gradient 290 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 291 IF( ln_zps .AND. ln_isfcav) & 292 & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top/bottom cells 293 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 294 & grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level 295 ENDIF 296 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 297 CALL tra_nxt( kstp ) ! tracer fields at next time step 298 ENDIF 299 300 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 301 ! Dynamics (tsa used as workspace) 302 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 303 IF( lk_dynspg_ts ) THEN 304 ! revert to previously computed momentum tendencies 305 ! (not using ua, va as temporary arrays during tracers' update could avoid that) 306 ua(:,:,:) = ua_sv(:,:,:) 307 va(:,:,:) = va_sv(:,:,:) 308 309 CALL dyn_bfr( kstp ) ! bottom friction 310 CALL dyn_zdf( kstp ) ! vertical diffusion 311 ELSE 312 ua(:,:,:) = 0._wp ! set dynamics trends to zero 313 va(:,:,:) = 0._wp 314 315 IF( lk_asminc .AND. ln_asmiau .AND. & 316 & ln_dyninc ) CALL dyn_asm_inc( kstp ) ! apply dynamics assimilation increment 317 IF( ln_bkgwri ) CALL asm_bkg_wri( kstp ) ! output background fields 318 IF( lk_bdy ) CALL bdy_dyn3d_dmp(kstp ) ! bdy damping trends 319 CALL dyn_adv( kstp ) ! advection (vector or flux form) 320 CALL dyn_vor( kstp ) ! vorticity term including Coriolis 321 CALL dyn_ldf( kstp ) ! lateral mixing 322 #if defined key_agrif 323 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn ! momemtum sponge 324 #endif 325 CALL dyn_hpg( kstp ) ! horizontal gradient of Hydrostatic pressure 326 CALL dyn_bfr( kstp ) ! bottom friction 327 CALL dyn_zdf( kstp ) ! vertical diffusion 328 CALL dyn_spg( kstp, indic ) ! surface pressure gradient 329 ENDIF 330 CALL dyn_nxt( kstp ) ! lateral velocity at next time step 331 332 CALL ssh_swp( kstp ) ! swap of sea surface height 333 CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors 274 CALL tra_zdf ( kstp ) ! vertical mixing and after tracer fields 275 IF( ln_zdfnpc ) CALL tra_npc ( kstp ) ! update after fields by non-penetrative convection 276 277 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 278 ! Set boundary conditions and Swap 279 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 280 !!jc1: For agrif, it would be much better to finalize tracers/momentum here (e.g. bdy conditions) and move the swap 281 !! (and time filtering) after Agrif update. Then restart would be done after and would contain updated fields. 282 !! If so: 283 !! (i) no need to call agrif update at initialization time 284 !! (ii) no need to update "before" fields 285 !! 286 !! Apart from creating new tra_swp/dyn_swp routines, this however: 287 !! (i) makes boundary conditions at initialization time computed from updated fields which is not the case between 288 !! two restarts => restartability issue. One can circumvent this, maybe, by assuming "interface separation", 289 !! e.g. a shift of the feedback interface inside child domain. 290 !! (ii) requires that all restart outputs of updated variables by agrif (e.g. passive tracers/tke/barotropic arrays) are done at the same 291 !! place. 292 !! 293 !!jc2: dynnxt must be the latest call. fse3t_b are indeed updated in that routine 294 CALL tra_nxt ( kstp ) ! finalize (bcs) tracer fields at next time step and swap 295 CALL dyn_nxt ( kstp ) ! finalize (bcs) velocities at next time step and swap 296 CALL ssh_swp ( kstp ) ! swap of sea surface height 297 IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors 334 298 ! 335 299 336 300 !!gm : This does not only concern the dynamics ==>>> add a new title 337 301 !!gm2: why ouput restart before AGRIF update? 338 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 302 !! 303 !!jc: That would be better, but see comment above 304 !! 305 IF( lrst_oce ) CALL rst_write ( kstp ) ! write output ocean restart file 339 306 340 307 #if defined key_agrif … … 342 309 ! AGRIF 343 310 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 344 CALL Agrif_Integrate_ChildGrids( stp ) 345 346 IF ( Agrif_NbStepint().EQ.0 ) THEN 347 CALL Agrif_Update_Tra() ! Update active tracers 348 CALL Agrif_Update_Dyn() ! Update momentum 349 ENDIF 350 #endif 351 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics 352 IF( lk_diaobs ) CALL dia_obs( kstp ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 311 CALL Agrif_Integrate_ChildGrids( stp ) 312 313 IF( Agrif_NbStepint() == 0 ) THEN ! AGRIF Update 314 !!jc in fact update is useless at last time step, but do it for global diagnostics 315 CALL Agrif_Update_Tra() ! Update active tracers 316 CALL Agrif_Update_Dyn() ! Update momentum 317 ENDIF 318 #endif 319 IF( ln_diahsb ) CALL dia_hsb ( kstp ) ! - ML - global conservation diagnostics 320 IF( lk_diaobs ) CALL dia_obs ( kstp ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 353 321 354 322 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 355 323 ! Control 356 324 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 357 CALL stp_ctl( kstp, indic )358 IF( indic < 0 )THEN359 360 361 ENDIF 362 IF( kstp == nit000 )THEN325 CALL stp_ctl ( kstp, indic ) 326 IF( indic < 0 ) THEN 327 CALL ctl_stop( 'step: indic < 0' ) 328 CALL dia_wri_state( 'output.abort', kstp ) 329 ENDIF 330 IF( kstp == nit000 ) THEN 363 331 CALL iom_close( numror ) ! close input ocean restart file 364 332 IF(lwm) CALL FLUSH ( numond ) ! flush output namelist oce … … 371 339 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 372 340 !!gm why lk_oasis and not lk_cpl ???? 373 IF( lk_oasis 341 IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges 374 342 ! 375 343 #if defined key_iomput -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r5836 r6004 40 40 USE dynldf ! lateral momentum diffusion (dyn_ldf routine) 41 41 USE dynzdf ! vertical diffusion (dyn_zdf routine) 42 USE dynspg_oce ! surface pressure gradient (dyn_spg routine)43 42 USE dynspg ! surface pressure gradient (dyn_spg routine) 44 43 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
r3294 r6004 16 16 USE oce ! ocean dynamics and tracers variables 17 17 USE dom_oce ! ocean space and time domain variables 18 USE sol_oce ! ocean space and time domain variables 18 USE c1d ! 1D vertical configuration 19 ! 19 20 USE in_out_manager ! I/O manager 20 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 22 USE lib_mpp ! distributed memory computing 22 USE dynspg_oce ! pressure gradient schemes23 USE c1d ! 1D vertical configuration24 23 25 24 IMPLICIT NONE … … 32 31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 32 !!---------------------------------------------------------------------- 34 35 33 CONTAINS 36 34 … … 43 41 !! ** Method : - Save the time step in numstp 44 42 !! - Print it each 50 time steps 45 !! - Print solver statistics in numsol 46 !! - Stop the run IF problem for the solver ( indec < 0 ) 43 !! - Stop the run IF problem ( indic < 0 ) 47 44 !! 48 45 !! ** Actions : 'time.step' file containing the last ocean time-step 49 46 !! 50 47 !!---------------------------------------------------------------------- 51 INTEGER, INTENT( in ) :: kt! ocean time-step index52 INTEGER, INTENT( inout ) :: kindic ! indicator of solver convergence48 INTEGER, INTENT(in ) :: kt ! ocean time-step index 49 INTEGER, INTENT(inout) :: kindic ! error indicator 53 50 !! 54 INTEGER :: ji, jj, jk 55 INTEGER :: ii, ij, ik ! temporaryintegers56 REAL(wp) :: zumax, zsmin, zssh2 ! temporaryscalars57 INTEGER, DIMENSION(3) :: ilocu 58 INTEGER, DIMENSION(2) :: ilocs 51 INTEGER :: ji, jj, jk ! dummy loop indices 52 INTEGER :: ii, ij, ik ! local integers 53 REAL(wp) :: zumax, zsmin, zssh2 ! local scalars 54 INTEGER, DIMENSION(3) :: ilocu ! 55 INTEGER, DIMENSION(2) :: ilocs ! 59 56 !!---------------------------------------------------------------------- 60 57 ! 61 58 IF( kt == nit000 .AND. lwp ) THEN 62 59 WRITE(numout,*) … … 66 63 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 67 64 ENDIF 68 65 ! 69 66 IF(lwp) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp 70 67 IF(lwp) REWIND( numstp ) ! -------------------------- 71 68 ! 72 69 ! !* Test maximum of velocity (zonal only) 73 70 ! ! ------------------------ … … 105 102 ENDIF 106 103 9400 FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5) 107 104 ! 108 105 ! !* Test minimum of salinity 109 106 ! ! ------------------------ 110 107 !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 ) slower than the following loop on NEC SX5 111 zsmin = 100. e0108 zsmin = 100._wp 112 109 DO jj = 2, jpjm1 113 110 DO ji = 1, jpi … … 139 136 ENDIF 140 137 9500 FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5) 141 142 138 ! 139 ! 143 140 IF( lk_c1d ) RETURN ! No log file in case of 1D vertical configuration 144 141 145 ! log file (solver or ssh statistics) 146 ! -------- 147 IF( lk_dynspg_flt ) THEN ! elliptic solver statistics (if required) 148 ! 149 IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps ! Solver 150 ! 151 IF( kindic < 0 .AND. zsmin > 0.e0 .AND. zumax <= 20.e0 ) THEN ! create a abort file if problem found 152 IF(lwp) THEN 153 WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode' 154 WRITE(numout,*) ' ====== ' 155 WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps 156 WRITE(numout,*) 157 WRITE(numout,*) ' stpctl: output of last fields' 158 WRITE(numout,*) ' ====== ' 159 ENDIF 160 ENDIF 161 ! 162 ELSE !* ssh statistics (and others...) 163 IF( kt == nit000 .AND. lwp ) THEN ! open ssh statistics file (put in solver.stat file) 164 CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 165 ENDIF 166 ! 167 zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) ) 168 IF( lk_mpp ) CALL mpp_sum( zssh2 ) ! sum over the global domain 169 ! 170 IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin ! ssh statistics 171 ! 142 ! log file (ssh statistics) 143 ! -------- !* ssh statistics (and others...) 144 IF( kt == nit000 .AND. lwp ) THEN ! open ssh statistics file (put in solver.stat file) 145 CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 172 146 ENDIF 173 147 ! 148 zssh2 = SUM( sshn(:,:) * sshn(:,:) * tmask_i(:,:) ) 149 IF( lk_mpp ) CALL mpp_sum( zssh2 ) ! sum over the global domain 150 ! 151 IF(lwp) WRITE(numsol,9300) kt, zssh2, zumax, zsmin ! ssh statistics 152 ! 174 153 9200 FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 ) 175 154 9300 FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
r5845 r6004 8 8 9 9 !!---------------------------------------------------------------------- 10 !! trc_oce_rgb : tabulated attenuation coefficients for RGB light penetration 11 !!---------------------------------------------------------------------- 12 USE par_oce 13 USE in_out_manager ! I/O manager 14 USE dom_oce ! ocean space and time domain 15 USE lib_mpp ! MPP library 10 !! trc_oce_rgb : tabulated attenuation coefficients for RGB light penetration 11 !!---------------------------------------------------------------------- 12 USE par_oce ! ocean parameters 13 USE dom_oce ! ocean space and time domain 14 ! 15 USE in_out_manager ! I/O manager 16 USE lib_mpp ! MPP library 16 17 17 18 IMPLICIT NONE … … 41 42 LOGICAL, PUBLIC, PARAMETER :: lk_qsr_bio = .FALSE. !: bio-model light absorption flag 42 43 #endif 43 44 44 #if defined key_offline 45 45 !!---------------------------------------------------------------------- … … 64 64 LOGICAL, PUBLIC, PARAMETER :: lk_degrad = .FALSE. !: degradation flag 65 65 #endif 66 67 66 !!---------------------------------------------------------------------- 68 67 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/SAS_SRC/diawri.F90
r5845 r6004 26 26 USE dom_oce ! ocean space and time domain 27 27 USE zdf_oce ! ocean vertical physics 28 USE sol_oce ! solver variables29 28 USE sbc_oce ! Surface boundary condition: ocean fields 30 29 USE sbc_ice ! Surface boundary condition: ice fields … … 105 104 !! ** Method : use iom_put 106 105 !!---------------------------------------------------------------------- 107 INTEGER, INTENT( in ) :: kt! ocean time-step index106 INTEGER, INTENT(in) :: kt ! ocean time-step index 108 107 !!---------------------------------------------------------------------- 109 108 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/SAS_SRC/step.F90
r5845 r6004 16 16 USE oce ! ocean dynamics and tracers variables 17 17 USE dom_oce ! ocean space and time domain variables 18 USE sbc_oce19 USE sbccpl20 18 USE daymod ! calendar (day routine) 19 USE sbc_oce ! surface boundary condition: fields 21 20 USE sbcmod ! surface boundary condition (sbc routine) 22 21 USE sbcrnf ! surface boundary condition: runoff variables 22 USE sbccpl ! surface boundary condition: coupled interface 23 23 USE eosbn2 ! equation of state (eos_bn2 routine) 24 24 USE diawri ! Standard run outputs (dia_wri routine) … … 28 28 #endif 29 29 USE stpctl ! time stepping control (stp_ctl routine) 30 USE prtctl ! Print control (prt_ctl routine)31 30 ! 32 31 USE in_out_manager ! I/O manager 32 USE prtctl ! Print control (prt_ctl routine) 33 USE iom ! 34 USE lbclnk ! 33 35 USE timing ! Timing 34 USE iom !35 USE lbclnk36 36 #if defined key_iomput 37 37 USE xios -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r5845 r6004 73 73 !! CFC concentration in pico-mol/m3 74 74 !!---------------------------------------------------------------------- 75 !76 75 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 76 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r5845 r6004 240 240 IF( ln_diatrc .OR. lk_iomput ) THEN 241 241 ! convert fluxes in per day 242 ze3t = e3t_n(ji,jj,jk) * 86400. 242 ze3t = e3t_n(ji,jj,jk) * 86400._wp 243 243 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 244 244 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t … … 361 361 IF( ln_diatrc .OR. lk_iomput ) THEN 362 362 ! convert fluxes in per day 363 ze3t = e3t_n(ji,jj,jk) * 86400. 363 ze3t = e3t_n(ji,jj,jk) * 86400._wp 364 364 zw2d(ji,jj,1) = zw2d(ji,jj,1) + zno3phy * ze3t 365 365 zw2d(ji,jj,2) = zw2d(ji,jj,2) + znh4phy * ze3t … … 380 380 zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 381 381 ! 382 zw3d(ji,jj,jk,1) = zno3phy * 86400 383 zw3d(ji,jj,jk,2) = znh4phy * 86400 384 zw3d(ji,jj,jk,3) = znh4no3 * 86400 382 zw3d(ji,jj,jk,1) = zno3phy * 86400._wp 383 zw3d(ji,jj,jk,2) = znh4phy * 86400._wp 384 zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp 385 385 ! 386 386 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
r5845 r6004 48 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- 50 51 50 CONTAINS 52 51 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
r5845 r6004 109 109 IF( iom_use( "TDETSED" ) ) THEN 110 110 CALL wrk_alloc( jpi, jpj, zw2d ) 111 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400. 111 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 112 112 DO jk = 2, jpkm1 113 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400. 113 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 114 114 END DO 115 115 CALL iom_put( "TDETSED", zw2d ) … … 119 119 IF( ln_diatrc ) THEN 120 120 CALL wrk_alloc( jpi, jpj, zw2d ) 121 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400. 121 zw2d(:,:) = ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 122 122 DO jk = 2, jpkm1 123 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400. 123 zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 124 124 END DO 125 125 trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r5845 r6004 39 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 40 !!---------------------------------------------------------------------- 41 42 41 CONTAINS 43 42 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r5845 r6004 83 83 INTEGER, INTENT(in) :: kt ! ocean time-step index 84 84 ! 85 INTEGER 86 CHARACTER (len=22) :: charout85 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 86 CHARACTER (len=22) :: charout 87 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace88 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 89 89 !!---------------------------------------------------------------------- 90 90 ! … … 176 176 !! called by trc_dmp at the first timestep (nittrc000) 177 177 !!---------------------------------------------------------------------- 178 ! 179 INTEGER :: ios ! Local integer output status for namelist read 180 INTEGER :: imask !local file handle 181 ! 178 INTEGER :: ios, imask ! local integers 179 !! 182 180 NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 183 181 !!---------------------------------------------------------------------- 184 182 ! 185 183 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init') 186 184 ! 187 188 185 REWIND( numnat_ref ) ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 189 186 READ ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) … … 229 226 END SUBROUTINE trc_dmp_ini 230 227 228 231 229 SUBROUTINE trc_dmp_clo( kt ) 232 230 !!--------------------------------------------------------------------- … … 241 239 !! nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 242 240 !!---------------------------------------------------------------------- 243 INTEGER, INTENT( in ) :: kt ! ocean time-step index 244 ! 245 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 246 INTEGER :: isrow ! local index 247 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 248 249 !!---------------------------------------------------------------------- 250 241 INTEGER, INTENT( in ) :: kt ! ocean time-step index 242 ! 243 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 244 INTEGER :: isrow ! local index 245 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 246 !!---------------------------------------------------------------------- 247 ! 251 248 IF( kt == nit000 ) THEN 252 249 ! initial values … … 360 357 END SUBROUTINE trc_dmp_clo 361 358 362 363 359 #else 364 360 !!---------------------------------------------------------------------- … … 372 368 #endif 373 369 374 375 370 !!====================================================================== 376 371 END MODULE trcdmp -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r5883 r6004 22 22 USE traldf_triad ! lateral diffusion: laplacian iso-neutral triad operator (tra_ldf_ triad routine) 23 23 USE trd_oce ! trends: ocean variables 24 USE trdtra ! trends manager: tracers 24 USE trdtra ! trends manager: tracers 25 ! 25 26 USE prtctl_trc ! Print control 26 27 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r5845 r6004 47 47 CONTAINS 48 48 49 SUBROUTINE trc_bc_init( ntrc)49 SUBROUTINE trc_bc_init( ntrc ) 50 50 !!---------------------------------------------------------------------- 51 51 !! *** ROUTINE trc_bc_init *** … … 56 56 !! - allocates passive tracer BC data structure 57 57 !!---------------------------------------------------------------------- 58 INTEGER,INTENT(IN) :: ntrc ! number of tracers 59 INTEGER :: jl, jn ! dummy loop indices 60 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers 61 INTEGER :: ios ! Local integer output status for namelist read 58 INTEGER,INTENT(IN) :: ntrc ! number of tracers 59 ! 60 INTEGER :: jl, jn ! dummy loop indices 61 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers 62 INTEGER :: ios ! Local integer output status for namelist read 62 63 CHARACTER(len=100) :: clndta, clntrc 63 ! 64 !! 64 65 CHARACTER(len=100) :: cn_dir 65 66 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! local array of namelist informations on the fields to read … … 257 258 USE fldread 258 259 ! 259 INTEGER, INTENT( in ) :: kt! ocean time-step index260 INTEGER, INTENT(in) :: kt ! ocean time-step index 260 261 !!--------------------------------------------------------------------- 261 262 ! -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r5866 r6004 240 240 ! 241 241 END SUBROUTINE trc_dta 242 242 243 #else 243 244 !!---------------------------------------------------------------------- … … 249 250 END SUBROUTINE trc_dta 250 251 #endif 252 251 253 !!====================================================================== 252 254 END MODULE trcdta -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r5866 r6004 596 596 WRITE(*,*) 'trc_sub_ini: You should not have seen this print! error?', kt 597 597 END SUBROUTINE trc_sub_ini 598 599 598 #endif 600 599
Note: See TracChangeset
for help on using the changeset viewer.