- Timestamp:
- 2020-03-29T12:55:27+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE
- Files:
-
- 8 edited
- 3 moved
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ASM/asminc.F90
r12616 r12624 760 760 ! 761 761 ssh(:,:,Kbb) = ssh(:,:,Kmm) ! Update before fields 762 #if ! defined key_ LF762 #if ! defined key_QCO 763 763 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 764 764 #endif -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/CRS/crsini.F90
r12616 r12624 176 176 177 177 ! 178 #if ! defined key_LF179 ze3t(:,:,:) = e3t(:,:,:,Kmm)180 ze3u(:,:,:) = e3u(:,:,:,Kmm)181 ze3v(:,:,:) = e3v(:,:,:,Kmm)182 ze3w(:,:,:) = e3w(:,:,:,Kmm)183 #else184 178 DO jk = 1, jpk 185 179 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) … … 187 181 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 188 182 ze3w(:,:,jk) = e3w(:,:,jk,Kmm) 189 END DO 190 #endif 183 END DO 191 184 192 185 ! 3.d.2 Surfaces -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqe.F90
r12584 r12624 44 44 PUBLIC dom_qe_sf_nxt ! called by steplf.F90 45 45 PUBLIC dom_qe_sf_update ! called by steplf.F90 46 PUBLIC dom_ qe_interpol ! called by dynnxt.F9046 PUBLIC dom_h_nxt ! called by steplf.F90 47 47 PUBLIC dom_qe_r3c ! called by steplf.F90 48 48 … … 292 292 293 293 294 SUBROUTINE dom_h_nxt( kt, Kbb, Kmm, Kaa, kcall ) 295 !!---------------------------------------------------------------------- 296 !! *** ROUTINE dom_qe_sf_nxt *** 297 !! 298 !! ** Purpose : - compute the after water heigh used in tra_zdf, dynnxt, 299 !! tranxt and dynspg routines 300 !! 301 !! ** Method : - z_star case: Proportionnaly to the water column thickness. 302 !! 303 !! ** Action : - h(u/v) update wrt ssh/h(u/v)_0 304 !! 305 !!---------------------------------------------------------------------- 306 INTEGER, INTENT( in ) :: kt ! time step 307 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time step 308 INTEGER, INTENT( in ), OPTIONAL :: kcall ! optional argument indicating call sequence 309 ! 310 !!---------------------------------------------------------------------- 311 ! 312 IF( ln_linssh ) RETURN ! No calculation in linear free surface 313 ! 314 IF( ln_timing ) CALL timing_start('dom_h_nxt') 315 ! 316 IF( kt == nit000 ) THEN 317 IF(lwp) WRITE(numout,*) 318 IF(lwp) WRITE(numout,*) 'dom_h_nxt : compute after scale factors' 319 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 320 ENDIF 321 ! 322 ! *********************************** ! 323 ! After depths at u- v points ! 324 ! *********************************** ! 325 hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) ) 326 hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) ) 327 ! ! Inverse of the local depth 328 r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 329 r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 330 ! 331 IF( ln_timing ) CALL timing_stop('dom_h_nxt') 332 ! 333 END SUBROUTINE dom_h_nxt 334 335 294 336 SUBROUTINE dom_qe_sf_update( kt, Kbb, Kmm, Kaa ) 295 337 !!---------------------------------------------------------------------- … … 398 440 ! 399 441 END SUBROUTINE dom_qe_sf_update 400 401 402 SUBROUTINE dom_qe_interpol( pe3_in, pe3_out, pout )403 !!---------------------------------------------------------------------404 !! *** ROUTINE dom_qe_interpol ***405 !!406 !! ** Purpose : interpolate scale factors from one grid point to another407 !!408 !! ** Method : e3_out = e3_0 + interpolation(e3_in - e3_0)409 !! - horizontal interpolation: grid cell surface averaging410 !! - vertical interpolation: simple averaging411 !!----------------------------------------------------------------------412 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pe3_in ! input e3 to be interpolated413 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3_out ! output interpolated e3414 CHARACTER(LEN=*) , INTENT(in ) :: pout ! grid point of out scale factors415 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW'416 !417 INTEGER :: ji, jj, jk ! dummy loop indices418 REAL(wp) :: zlnwd ! =1./0. when ln_wd_il = T/F419 !!----------------------------------------------------------------------420 !421 IF(ln_wd_il) THEN422 zlnwd = 1.0_wp423 ELSE424 zlnwd = 0.0_wp425 END IF426 !427 SELECT CASE ( pout ) !== type of interpolation ==!428 !429 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean430 DO_3D_10_10( 1, jpk )431 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) &432 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &433 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )434 END_3D435 CALL lbc_lnk( 'domqe', pe3_out(:,:,:), 'U', 1._wp )436 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:)437 !438 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean439 DO_3D_10_10( 1, jpk )440 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) &441 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &442 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )443 END_3D444 CALL lbc_lnk( 'domqe', pe3_out(:,:,:), 'V', 1._wp )445 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:)446 !447 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean448 DO_3D_10_10( 1, jpk )449 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) &450 & * r1_e1e2f(ji,jj) &451 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) &452 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )453 END_3D454 CALL lbc_lnk( 'domqe', pe3_out(:,:,:), 'F', 1._wp )455 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:)456 !457 CASE( 'W' ) !* from T- to W-point : vertical simple mean458 !459 !zlnwd = 1.0_wp460 pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1)461 ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing462 !!gm BUG? use here wmask in case of ISF ? to be checked463 DO jk = 2, jpk464 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) ) &465 & * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) &466 & + 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) &467 & * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) )468 END DO469 !470 CASE( 'UW' ) !* from U- to UW-point : vertical simple mean471 !472 !zlnwd = 1.0_wp473 pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1)474 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing475 !!gm BUG? use here wumask in case of ISF ? to be checked476 DO jk = 2, jpk477 pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) ) &478 & * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) ) &479 & + 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) &480 & * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) )481 END DO482 !483 CASE( 'VW' ) !* from V- to VW-point : vertical simple mean484 !485 !zlnwd = 1.0_wp486 pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1)487 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing488 !!gm BUG? use here wvmask in case of ISF ? to be checked489 DO jk = 2, jpk490 pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) ) &491 & * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) ) &492 & + 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) &493 & * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) )494 END DO495 END SELECT496 !497 END SUBROUTINE dom_qe_interpol498 442 499 443 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domzgr_substitute.h90
r12616 r12624 11 11 !! Software governed by the CeCILL license (see ./LICENSE) 12 12 !!---------------------------------------------------------------------- 13 #if defined key_ LF13 #if defined key_QCO 14 14 # define e3t(i,j,k,t) (e3t_0(i,j,k)*(1.+r3t(i,j,t)*tmask(i,j,k))) 15 15 # define e3u(i,j,k,t) (e3u_0(i,j,k)*(1.+r3u(i,j,t)*umask(i,j,k))) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatfQCO.F90
r12623 r12624 1 MODULE dynatf LF1 MODULE dynatfqco 2 2 !!========================================================================= 3 !! *** MODULE dynatf LF***3 !! *** MODULE dynatfqco *** 4 4 !! Ocean dynamics: time filtering 5 5 !!========================================================================= … … 24 24 25 25 !!---------------------------------------------------------------------------------------------- 26 !! dyn_atf LF: apply Asselin time filtering to "now" velocities and vertical scale factors26 !! dyn_atf_qco : apply Asselin time filtering to "now" velocities and vertical scale factors 27 27 !!---------------------------------------------------------------------------------------------- 28 28 USE oce ! ocean dynamics and tracers … … 57 57 PRIVATE 58 58 59 PUBLIC dyn_atf_ lf! routine called by step.F9059 PUBLIC dyn_atf_qco ! routine called by step.F90 60 60 61 61 !! * Substitutions 62 62 # include "do_loop_substitute.h90" 63 # include "domzgr_substitute.h90" 63 64 !!---------------------------------------------------------------------- 64 65 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 68 69 CONTAINS 69 70 70 SUBROUTINE dyn_atf_ lf( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v )71 SUBROUTINE dyn_atf_qco ( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v ) 71 72 !!---------------------------------------------------------------------- 72 !! *** ROUTINE dyn_atf_ lf***73 !! *** ROUTINE dyn_atf_qco *** 73 74 !! 74 75 !! ** Purpose : Finalize after horizontal velocity. Apply the boundary … … 106 107 !!---------------------------------------------------------------------- 107 108 ! 108 IF( ln_timing ) CALL timing_start('dyn_atf_ lf')109 IF( ln_timing ) CALL timing_start('dyn_atf_qco') 109 110 IF( ln_dynspg_ts ) ALLOCATE( zue(jpi,jpj) , zve(jpi,jpj) ) 110 111 IF( l_trddyn ) ALLOCATE( zua(jpi,jpj,jpk) , zva(jpi,jpj,jpk) ) … … 112 113 IF( kt == nit000 ) THEN 113 114 IF(lwp) WRITE(numout,*) 114 IF(lwp) WRITE(numout,*) 'dyn_atf_ lf: Asselin time filtering'115 IF(lwp) WRITE(numout,*) 'dyn_atf_qco : Asselin time filtering' 115 116 IF(lwp) WRITE(numout,*) '~~~~~~~' 116 117 ENDIF 117 118 ! IF ( ln_dynspg_ts ) THEN119 ! ! Ensure below that barotropic velocities match time splitting estimate120 ! ! Compute actual transport and replace it with ts estimate at "after" time step121 ! zue(:,:) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1)122 ! zve(:,:) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1)123 ! DO jk = 2, jpkm1124 ! zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)125 ! zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)126 ! END DO127 ! DO jk = 1, jpkm1128 ! puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) - zue(:,:) * r1_hu(:,:,Kaa) + uu_b(:,:,Kaa) ) * umask(:,:,jk)129 ! pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) - zve(:,:) * r1_hv(:,:,Kaa) + vv_b(:,:,Kaa) ) * vmask(:,:,jk)130 ! END DO131 ! !132 ! IF( .NOT.ln_bt_fw ) THEN133 ! ! Remove advective velocity from "now velocities"134 ! ! prior to asselin filtering135 ! ! In the forward case, this is done below after asselin filtering136 ! ! so that asselin contribution is removed at the same time137 ! DO jk = 1, jpkm1138 ! puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm) + uu_b(:,:,Kmm) )*umask(:,:,jk)139 ! pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm) + vv_b(:,:,Kmm) )*vmask(:,:,jk)140 ! END DO141 ! ENDIF142 ! ENDIF143 !144 ! ! Update after velocity on domain lateral boundaries145 ! ! --------------------------------------------------146 ! # if defined key_agrif147 ! CALL Agrif_dyn( kt ) !* AGRIF zoom boundaries148 ! # endif149 ! !150 ! CALL lbc_lnk_multi( 'dynatfLF', puu(:,:,:,Kaa), 'U', -1., pvv(:,:,:,Kaa), 'V', -1. ) !* local domain boundaries151 ! !152 ! ! !* BDY open boundaries153 ! IF( ln_bdy .AND. ln_dynspg_exp ) CALL bdy_dyn( kt, Kbb, puu, pvv, Kaa )154 ! IF( ln_bdy .AND. ln_dynspg_ts ) CALL bdy_dyn( kt, Kbb, puu, pvv, Kaa, dyn3d_only=.true. )155 156 !!$ Do we need a call to bdy_vol here??157 118 ! 158 119 IF( l_trddyn ) THEN ! prepare the atf trend computation + some diagnostics … … 191 152 ! Time-filtered scale factor at t-points 192 153 ! ---------------------------------------------------- 193 DO jk = 1, jpk ! filtered scale factor at T-points194 pe3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t_f(:,:) * tmask(:,:,jk) )195 END DO154 ! DO jk = 1, jpk ! filtered scale factor at T-points 155 ! pe3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t_f(:,:) * tmask(:,:,jk) ) 156 ! END DO 196 157 ! 197 158 ! 198 159 IF( ln_dynadv_vec ) THEN ! Asselin filter applied on velocity 199 160 ! Before filtered scale factor at (u/v)-points 200 DO jk = 1, jpk201 pe3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u_f(:,:) * umask(:,:,jk) )202 pe3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v_f(:,:) * vmask(:,:,jk) )203 END DO161 ! DO jk = 1, jpk 162 ! pe3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u_f(:,:) * umask(:,:,jk) ) 163 ! pe3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v_f(:,:) * vmask(:,:,jk) ) 164 ! END DO 204 165 ! 205 166 DO_3D_11_11( 1, jpkm1 ) … … 211 172 ! 212 173 DO_3D_11_11( 1, jpkm1 ) 213 zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 214 zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) 215 zue3n = pe3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm) 216 zve3n = pe3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm) 217 zue3b = pe3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb) 218 zve3b = pe3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb) 174 ! zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 175 ! zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) 176 ! zue3n = pe3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm) 177 ! zve3n = pe3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm) 178 ! zue3b = pe3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb) 179 ! zve3b = pe3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb) 180 ! 181 zue3a = ( 1._wp + r3u(ji,jj,Kaa) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kaa) 182 zve3a = ( 1._wp + r3v(ji,jj,Kaa) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kaa) 183 zue3n = ( 1._wp + r3u(ji,jj,Kmm) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kmm) 184 zve3n = ( 1._wp + r3v(ji,jj,Kmm) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kmm) 185 zue3b = ( 1._wp + r3u(ji,jj,Kbb) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kbb) 186 zve3b = ( 1._wp + r3v(ji,jj,Kbb) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kbb) 219 187 ! ! filtered scale factor at U-,V-points 220 pe3u(ji,jj,jk,Kmm) = e3u_0(ji,jj,jk) * ( 1._wp + r3u_f(ji,jj) * umask(ji,jj,jk) )221 pe3v(ji,jj,jk,Kmm) = e3v_0(ji,jj,jk) * ( 1._wp + r3v_f(ji,jj) * vmask(ji,jj,jk) )188 ! pe3u(ji,jj,jk,Kmm) = e3u_0(ji,jj,jk) * ( 1._wp + r3u_f(ji,jj) * umask(ji,jj,jk) ) 189 ! pe3v(ji,jj,jk,Kmm) = e3v_0(ji,jj,jk) * ( 1._wp + r3v_f(ji,jj) * vmask(ji,jj,jk) ) 222 190 ! 223 puu(ji,jj,jk,Kmm) = ( zue3n + atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / pe3u(ji,jj,jk,Kmm) !!st ze3u_f(ji,jj,jk)224 pvv(ji,jj,jk,Kmm) = ( zve3n + atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / pe3v(ji,jj,jk,Kmm) !!st ze3v_f(ji,jj,jk)191 puu(ji,jj,jk,Kmm) = ( zue3n + atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / ( 1._wp + r3u_f(ji,jj)*umask(ji,jj,jk) ) !!st ze3u_f(ji,jj,jk) 192 pvv(ji,jj,jk,Kmm) = ( zve3n + atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / ( 1._wp + r3v_f(ji,jj)*vmask(ji,jj,jk) ) !!st ze3v_f(ji,jj,jk) 225 193 END_3D 226 194 ! … … 232 200 ! Revert filtered "now" velocities to time split estimate 233 201 ! Doing it here also means that asselin filter contribution is removed 234 zue(:,:) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 235 zve(:,:) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 202 ! zue(:,:) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 203 ! zve(:,:) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 204 ! DO jk = 2, jpkm1 205 ! zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 206 ! zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 207 ! END DO 208 zue(:,:) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 209 zve(:,:) = e3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 236 210 DO jk = 2, jpkm1 237 zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk)238 zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk)211 zue(:,:) = zue(:,:) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 212 zve(:,:) = zve(:,:) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 239 213 END DO 240 214 DO jk = 1, jpkm1 … … 251 225 ! 252 226 IF(.NOT.ln_linssh ) THEN 253 hu(:,:,Kmm) = pe3u(:,:,1,Kmm ) * umask(:,:,1)254 hv(:,:,Kmm) = pe3v(:,:,1,Kmm ) * vmask(:,:,1)227 hu(:,:,Kmm) = e3u(:,:,1,Kmm ) * umask(:,:,1) 228 hv(:,:,Kmm) = e3v(:,:,1,Kmm ) * vmask(:,:,1) 255 229 DO jk = 2, jpkm1 256 hu(:,:,Kmm) = hu(:,:,Kmm) + pe3u(:,:,jk,Kmm ) * umask(:,:,jk)257 hv(:,:,Kmm) = hv(:,:,Kmm) + pe3v(:,:,jk,Kmm ) * vmask(:,:,jk)230 hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm ) * umask(:,:,jk) 231 hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm ) * vmask(:,:,jk) 258 232 END DO 259 233 r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) … … 261 235 ENDIF 262 236 ! 263 uu_b(:,:,Kaa) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1)264 uu_b(:,:,Kmm) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1)265 vv_b(:,:,Kaa) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1)266 vv_b(:,:,Kmm) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1)237 uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 238 uu_b(:,:,Kmm) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 239 vv_b(:,:,Kaa) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 240 vv_b(:,:,Kmm) = e3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 267 241 DO jk = 2, jpkm1 268 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)269 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk)270 vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)271 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk)242 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 243 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 244 vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 245 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 272 246 END DO 273 247 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) * r1_hu(:,:,Kaa) … … 291 265 IF( ln_dynspg_ts ) DEALLOCATE( zue, zve ) 292 266 IF( l_trddyn ) DEALLOCATE( zua, zva ) 293 IF( ln_timing ) CALL timing_stop('dyn_atf_ lf')294 ! 295 END SUBROUTINE dyn_atf_ lf267 IF( ln_timing ) CALL timing_stop('dyn_atf_qco') 268 ! 269 END SUBROUTINE dyn_atf_qco 296 270 297 271 !!========================================================================= 298 END MODULE dynatf LF272 END MODULE dynatfqco -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfcpl.F90
r12622 r12624 15 15 USE isfutils, ONLY : debug 16 16 USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine 17 #if ! defined key_ LF17 #if ! defined key_QCO 18 18 USE domvvl , ONLY: dom_vvl_zgr ! vertical scale factor interpolation 19 19 #else … … 117 117 vv (:,:,:,Kbb) = vv (:,:,:,Kmm) 118 118 ssh (:,:,Kbb) = ssh (:,:,Kmm) 119 #if ! defined key_ LF119 #if ! defined key_QCO 120 120 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 121 121 #endif … … 224 224 IF(lwp) write(numout,*) 'isfcpl_ssh : recompute scale factor from ssh (new wet cell,Kmm)' 225 225 IF(lwp) write(numout,*) '~~~~~~~~~~~' 226 #if ! defined key_ LF226 #if ! defined key_QCO 227 227 DO jk = 1, jpk 228 228 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbcice_cice.F90
r12616 r12624 233 233 !!gm This should be put elsewhere.... (same remark for limsbc) 234 234 !!gm especially here it is assumed zstar coordinate, but it can be ztilde.... 235 #if defined key_ LF235 #if defined key_QCO 236 236 IF( .NOT.ln_linssh ) CALL dom_qe_zgr( Kbb, Kmm, Kaa ) ! interpolation scale factor, depth and water column 237 237 #else -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA/traadv.F90
r12377 r12624 65 65 INTEGER, PARAMETER :: np_UBS = 4 ! 3rd order Upstream Biased Scheme 66 66 INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme 67 67 68 # include "domzgr_substitute.h90" 68 69 !!---------------------------------------------------------------------- 69 70 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 103 104 IF( ln_wave .AND. ln_sdw ) THEN 104 105 DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift 105 zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 106 zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 107 zww(:,:,jk) = e1e2t(:,:) * ( ww(:,:,jk) + wsd(:,:,jk) ) 106 zuu(:,:,jk) = & 107 & e2u (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 108 zvv(:,:,jk) = & 109 & e1v (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 110 zww(:,:,jk) = & 111 & e1e2t(:,:) * ( ww(:,:,jk) + wsd(:,:,jk) ) 108 112 END DO 109 113 ELSE -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA/traatfQCO.F90
r12623 r12624 1 MODULE traatf LF1 MODULE traatfqco 2 2 !!====================================================================== 3 !! *** MODULE traatf LF***3 !! *** MODULE traatfqco *** 4 4 !! Ocean active tracers: Asselin time filtering for temperature and salinity 5 5 !!====================================================================== … … 52 52 PRIVATE 53 53 54 PUBLIC tra_atf_ lf! routine called by step.F9054 PUBLIC tra_atf_qco ! routine called by step.F90 55 55 PUBLIC tra_atf_fix_lf ! to be used in trcnxt !!st WARNING discrepancy here interpol is used 56 PUBLIC tra_atf_q e_lf ! to be used in trcnxt !!st WARNING discrepancy here interpol is used56 PUBLIC tra_atf_qco_lf ! to be used in trcnxt !!st WARNING discrepancy here interpol is used 57 57 58 58 !! * Substitutions 59 59 # include "do_loop_substitute.h90" 60 # include "domzgr_substitute.h90" 60 61 !!---------------------------------------------------------------------- 61 62 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 65 66 CONTAINS 66 67 67 SUBROUTINE tra_atf_ lf( kt, Kbb, Kmm, Kaa, pts )68 SUBROUTINE tra_atf_qco( kt, Kbb, Kmm, Kaa, pts ) 68 69 !!---------------------------------------------------------------------- 69 70 !! *** ROUTINE traatfLF *** … … 95 96 !!---------------------------------------------------------------------- 96 97 ! 97 IF( ln_timing ) CALL timing_start( 'tra_atf_ lf')98 IF( ln_timing ) CALL timing_start( 'tra_atf_qco') 98 99 ! 99 100 IF( kt == nit000 ) THEN 100 101 IF(lwp) WRITE(numout,*) 101 IF(lwp) WRITE(numout,*) 'tra_atf_ lf: apply Asselin time filter to "now" fields'102 IF(lwp) WRITE(numout,*) 'tra_atf_qco : apply Asselin time filter to "now" fields' 102 103 IF(lwp) WRITE(numout,*) '~~~~~~~' 103 104 ENDIF … … 131 132 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from pts(Kmm) terms 132 133 DO jk = 1, jpkm1 133 ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_tem,Kmm)) * zfact 134 ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_sal,Kmm)) * zfact 134 ! ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_tem,Kmm)) * zfact 135 ! ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_sal,Kmm)) * zfact 136 ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa) * (1._wp + r3t(:,:,Kaa) * tmask(:,:,jk))/(1._wp + r3t(:,:,Kmm) * tmask(:,:,jk)) & 137 & - pts(:,:,jk,jp_tem,Kmm) ) * zfact 138 ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa) * (1._wp + r3t(:,:,Kaa) * tmask(:,:,jk))/(1._wp + r3t(:,:,Kmm) * tmask(:,:,jk)) & 139 & - pts(:,:,jk,jp_sal,Kmm) ) * zfact 135 140 END DO 136 141 CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_tot, ztrdt ) … … 156 161 ELSE ! Leap-Frog + Asselin filter time stepping 157 162 ! 158 IF ( ln_linssh ) THEN ; CALL tra_atf_fix_lf( kt, Kbb, Kmm, Kaa, nit000, 'TRA', pts, jpts ) ! linear free surface159 ELSE ; CALL tra_atf_qe_lf( kt, Kbb, Kmm, Kaa, nit000, rdt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface160 ENDIF 161 ! 162 CALL lbc_lnk_multi( 'traatf LF', pts(:,:,:,jp_tem,Kbb) , 'T', 1., pts(:,:,:,jp_sal,Kbb) , 'T', 1., &163 IF ( ln_linssh ) THEN ; CALL tra_atf_fix_lf( kt, Kbb, Kmm, Kaa, nit000, 'TRA', pts, jpts ) ! linear free surface 164 ELSE ; CALL tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, nit000, rdt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts ) ! non-linear free surface 165 ENDIF 166 ! 167 CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kbb) , 'T', 1., pts(:,:,:,jp_sal,Kbb) , 'T', 1., & 163 168 & pts(:,:,:,jp_tem,Kmm) , 'T', 1., pts(:,:,:,jp_sal,Kmm) , 'T', 1., & 164 169 & pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. ) … … 181 186 & tab3d_2=pts(:,:,:,jp_sal,Kmm), clinfo2= ' Sn: ', mask2=tmask ) 182 187 ! 183 IF( ln_timing ) CALL timing_stop('tra_atf_ lf')184 ! 185 END SUBROUTINE tra_atf_ lf188 IF( ln_timing ) CALL timing_stop('tra_atf_qco') 189 ! 190 END SUBROUTINE tra_atf_qco 186 191 187 192 … … 227 232 228 233 229 SUBROUTINE tra_atf_q e_lf( kt, Kbb, Kmm, Kaa, kit000, p2dt, cdtype, pt, psbc_tc, psbc_tc_b, kjpt )234 SUBROUTINE tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, kit000, p2dt, cdtype, pt, psbc_tc, psbc_tc_b, kjpt ) 230 235 !!---------------------------------------------------------------------- 231 236 !! *** ROUTINE tra_atf_vvl *** … … 234 239 !! 235 240 !! ** Method : - Apply a thickness weighted Asselin time filter on now fields. 236 !! pt(Kmm) = ( e3t (Kmm)*pt(Kmm) + atfp*[ e3t(Kbb)*pt(Kbb) - 2 e3t(Kmm)*pt(Kmm) + e3t_a*pt(Kaa) ] )237 !! /( e3t (Kmm) + atfp*[ e3t(Kbb) - 2 e3t(Kmm) + e3t(Kaa)] )241 !! pt(Kmm) = ( e3t_m*pt(Kmm) + atfp*[ e3t_b*pt(Kbb) - 2 e3t_m*pt(Kmm) + e3t_a*pt(Kaa) ] ) 242 !! /( e3t_m + atfp*[ e3t_b - 2 e3t_m + e3t_a ] ) 238 243 !! 239 244 !! ** Action : - pt(Kmm) ready for the next time step … … 258 263 IF( kt == kit000 ) THEN 259 264 IF(lwp) WRITE(numout,*) 260 IF(lwp) WRITE(numout,*) 'tra_atf_ vvl: time filtering', cdtype265 IF(lwp) WRITE(numout,*) 'tra_atf_qco : time filtering', cdtype 261 266 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 262 267 ENDIF … … 325 330 IF ( jk == misfkb_cav(ji,jj) ) THEN 326 331 ztc_f = ztc_f - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) ) & 327 & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) * rfrac_tbl_cav(ji,jj) 332 & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) & 333 & * rfrac_tbl_cav(ji,jj) 328 334 END IF 329 335 END IF … … 339 345 IF ( jk == misfkb_par(ji,jj) ) THEN 340 346 ztc_f = ztc_f - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) ) & 341 & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) * rfrac_tbl_par(ji,jj) 347 & * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) & 348 & * rfrac_tbl_par(ji,jj) 342 349 END IF 343 350 END IF … … 380 387 ENDIF 381 388 ! 382 END SUBROUTINE tra_atf_q e_lf389 END SUBROUTINE tra_atf_qco_lf 383 390 384 391 !!====================================================================== 385 END MODULE traatf LF392 END MODULE traatfqco -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ZDF/zdfmxl.F90
r12622 r12624 38 38 !! * Substitutions 39 39 # include "do_loop_substitute.h90" 40 # include "domzgr_substitute.h90" 40 41 !!---------------------------------------------------------------------- 41 42 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stepLF.F90
r12623 r12624 41 41 USE iom ! xIOs server 42 42 USE domqe 43 USE traatf LF ! time filtering (tra_atf_lfroutine)44 USE dynatf LF ! time filtering (dyn_atf_lfroutine)43 USE traatfqco ! time filtering (tra_atf_qco routine) 44 USE dynatfqco ! time filtering (dyn_atf_qco routine) 45 45 USE dynspg_ts ! surface pressure gradient: split-explicit scheme (define un_adv) 46 46 USE bdydyn ! ocean open boundary conditions (define bdy_dyn) … … 186 186 CALL ssh_nxt ( kstp, Nbb, Nnn, ssh, Naa ) ! after ssh (includes call to div_hor) 187 187 IF( .NOT.ln_linssh ) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa) ) 188 IF( .NOT.ln_linssh ) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 188 IF( .NOT.ln_linssh ) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 189 !IF( .NOT.ln_linssh ) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 189 190 CALL wzv ( kstp, Nbb, Nnn, ww, Naa ) ! now cross-level velocity 190 191 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning … … 214 215 IF(.NOT.ln_linssh) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) 215 216 IF(.NOT.ln_linssh) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component) 217 !IF(.NOT.ln_linssh) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component) 216 218 ENDIF 217 219 CALL dyn_zdf ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa ) ! vertical diffusion … … 296 298 CALL ssh_atf ( kstp, Nbb, Nnn, Naa, ssh ) ! time filtering of "now" sea surface height 297 299 CALL dom_qe_r3c ( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f ) ! "now" ssh/h_0 ratio from filtrered ssh 298 CALL tra_atf_ lf( kstp, Nbb, Nnn, Naa, ts ) ! time filtering of "now" tracer arrays299 CALL dyn_atf_ lf( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v ) ! time filtering of "now" velocities and scale factors300 CALL tra_atf_qco ( kstp, Nbb, Nnn, Naa, ts ) ! time filtering of "now" tracer arrays 301 CALL dyn_atf_qco ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v ) ! time filtering of "now" velocities and scale factors 300 302 r3t(:,:,Nnn) = r3t_f(:,:) 301 303 r3u(:,:,Nnn) = r3u_f(:,:)
Note: See TracChangeset
for help on using the changeset viewer.