- Timestamp:
- 2020-03-29T12:55:27+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.