Changeset 12679 for NEMO/branches
- Timestamp:
- 2020-04-03T18:22:05+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/iceistate.F90
r12644 r12679 60 60 INTEGER , PARAMETER :: jp_hpd = 9 ! index of pnd depth (m) 61 61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 62 62 ! 63 63 !! * Substitutions 64 64 # include "do_loop_substitute.h90" -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqe.F90
r12644 r12679 45 45 PUBLIC dom_qe_sf_update ! called by steplf.F90 46 46 PUBLIC dom_h_nxt ! called by steplf.F90 47 PUBLIC dom_h_update ! called by steplf.F9048 47 PUBLIC dom_qe_r3c ! called by steplf.F90 49 48 … … 441 440 ! 442 441 END SUBROUTINE dom_qe_sf_update 443 444 445 SUBROUTINE dom_h_update( kt, Kbb, Kmm, Kaa )446 !!----------------------------------------------------------------------447 !! *** ROUTINE dom_qe_sf_update ***448 !!449 !! ** Purpose : for z tilde case: compute time filter and swap of scale factors450 !! compute all depths and related variables for next time step451 !! write outputs and restart file452 !!453 !! ** Method : - reconstruct scale factor at other grid points (interpolate)454 !! - recompute depths and water height fields455 !!456 !! ** Action : - Recompute:457 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w458 !! h(u/v) and h(u/v)r459 !!460 !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling.461 !! Leclair, M., and G. Madec, 2011, Ocean Modelling.462 !!----------------------------------------------------------------------463 INTEGER, INTENT( in ) :: kt ! time step464 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices465 !466 INTEGER :: ji, jj, jk ! dummy loop indices467 REAL(wp) :: zcoef ! local scalar468 !!----------------------------------------------------------------------469 !470 IF( ln_linssh ) RETURN ! No calculation in linear free surface471 !472 IF( ln_timing ) CALL timing_start('dom_qe_sf_update')473 !474 IF( kt == nit000 ) THEN475 IF(lwp) WRITE(numout,*)476 IF(lwp) WRITE(numout,*) 'dom_qe_sf_update : - interpolate scale factors and compute depths for next time step'477 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'478 ENDIF479 !480 ! Compute all missing vertical scale factor and depths481 ! ====================================================482 ! Horizontal scale factor interpolations483 ! --------------------------------------484 ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also485 486 IF( ln_isf ) THEN !** IceShelF cavities487 ! ! to be created depending of the new names in isf488 ! ! it should be something like that : (with h_isf = thickness of iceshelf)489 ! ! in fact currently, h_isf(:,:) is called : risfdep(:,:)490 !!gm - depth idea 0 : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask !491 gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) )492 gdepw(:,:,1,Kmm) = 0._wp ! Initialized to zero one for all493 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) ! reference to a common level z=0 for hpg494 DO jk = 2, jpk495 gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) &496 + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) )497 gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) &498 + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) )499 gde3w(:,:,jk) = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm)500 gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) &501 + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) )502 gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) &503 + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) )504 END DO505 !506 ELSE !** No cavities (all depth rescaled, even inside topography: no mask)507 !508 !!gm idea 0 : just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask !509 DO jk = 1, jpk510 gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )511 gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )512 gde3w(:,:,jk) = gdept (:,:,jk,Kmm) - ssh(:,:,Kmm)513 gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )514 gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )515 END DO516 !517 ENDIF518 519 ! Local depth and Inverse of the local depth of the water520 ! -------------------------------------------------------521 !522 ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm)523 524 ! write restart file525 ! ==================526 IF( lrst_oce ) CALL dom_qe_rst( kt, Kbb, Kmm, 'WRITE' )527 !528 IF( ln_timing ) CALL timing_stop('dom_qe_sf_update')529 !530 END SUBROUTINE dom_h_update531 442 532 443 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stepLF.F90
r12656 r12679 55 55 !!---------------------------------------------------------------------- 56 56 INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs !! used by nemo_init 57 # include "domzgr_substitute.h90" 57 58 58 # include "domzgr_substitute.h90" 59 59 !!---------------------------------------------------------------------- … … 213 213 ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) as well 214 214 IF( ln_dynspg_ts ) THEN ! vertical scale factors and vertical velocity need to be updated 215 CALL div_hor ( kstp, Nbb, Nnn ) ! Horizontal divergence (2nd call in time-split case)216 IF(.NOT.ln_linssh) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) )217 !IF(.NOT.ln_linssh) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component)218 IF(.NOT.ln_linssh) CALL dom_h_nxt( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component)215 CALL div_hor ( kstp, Nbb, Nnn ) ! Horizontal divergence (2nd call in time-split case) 216 IF(.NOT.ln_linssh) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) 217 IF(.NOT.ln_linssh) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component) 218 !IF(.NOT.ln_linssh) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component) 219 219 ENDIF 220 220 CALL dyn_zdf ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa ) ! vertical diffusion … … 295 295 !! 296 296 !!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 297 CALL zdyn_ts ( Nnn, Naa, uu, vv ) ! barotrope ajustment297 CALL zdyn_ts ( Nnn, Naa, e3u, e3v, uu, vv ) ! barotrope ajustment 298 298 CALL finalize_sbc ( kstp, Nbb, Naa, uu, vv, ts ) ! boundary condifions 299 299 CALL ssh_atf ( kstp, Nbb, Nnn, Naa, ssh ) ! time filtering of "now" sea surface height … … 312 312 Naa = Nrhs 313 313 ! 314 !IF(.NOT.ln_linssh) CALL dom_qe_sf_update( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors 315 IF(.NOT.ln_linssh) CALL dom_h_update ( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors 314 IF(.NOT.ln_linssh) CALL dom_qe_sf_update( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors 316 315 ! 317 316 IF( ln_diahsb ) CALL dia_hsb ( kstp, Nbb, Nnn ) ! - ML - global conservation diagnostics … … 368 367 369 368 370 SUBROUTINE zdyn_ts (Kmm, Kaa, p uu, pvv)369 SUBROUTINE zdyn_ts (Kmm, Kaa, pe3u, pe3v, puu, pvv) 371 370 !!---------------------------------------------------------------------- 372 371 !! *** ROUTINE zdyn_ts *** … … 381 380 INTEGER , INTENT(in ) :: Kmm, Kaa ! before and after time level indices 382 381 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocities 382 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(in ) :: pe3u, pe3v ! scale factors 383 383 ! 384 384 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve … … 391 391 ! Ensure below that barotropic velocities match time splitting estimate 392 392 ! Compute actual transport and replace it with ts estimate at "after" time step 393 zue(:,:) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1)394 zve(:,:) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1)393 zue(:,:) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 394 zve(:,:) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 395 395 DO jk = 2, jpkm1 396 zue(:,:) = zue(:,:) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)397 zve(:,:) = zve(:,:) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)396 zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 397 zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 398 398 END DO 399 399 DO jk = 1, jpkm1
Note: See TracChangeset
for help on using the changeset viewer.