Changeset 12644 for NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src
- Timestamp:
- 2020-04-02T14:22:49+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src
- Files:
-
- 3 edited
-
ICE/iceistate.F90 (modified) (1 diff)
-
OCE/DOM/domqe.F90 (modified) (2 diffs)
-
OCE/stepLF.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/iceistate.F90
r12583 r12644 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
r12624 r12644 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.F90 47 48 PUBLIC dom_qe_r3c ! called by steplf.F90 48 49 … … 440 441 ! 441 442 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 factors 450 !! compute all depths and related variables for next time step 451 !! write outputs and restart file 452 !! 453 !! ** Method : - reconstruct scale factor at other grid points (interpolate) 454 !! - recompute depths and water height fields 455 !! 456 !! ** Action : - Recompute: 457 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 458 !! h(u/v) and h(u/v)r 459 !! 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 step 464 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 465 ! 466 INTEGER :: ji, jj, jk ! dummy loop indices 467 REAL(wp) :: zcoef ! local scalar 468 !!---------------------------------------------------------------------- 469 ! 470 IF( ln_linssh ) RETURN ! No calculation in linear free surface 471 ! 472 IF( ln_timing ) CALL timing_start('dom_qe_sf_update') 473 ! 474 IF( kt == nit000 ) THEN 475 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 ENDIF 479 ! 480 ! Compute all missing vertical scale factor and depths 481 ! ==================================================== 482 ! Horizontal scale factor interpolations 483 ! -------------------------------------- 484 ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 485 486 IF( ln_isf ) THEN !** IceShelF cavities 487 ! ! to be created depending of the new names in isf 488 ! ! 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 all 493 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) ! reference to a common level z=0 for hpg 494 DO jk = 2, jpk 495 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 DO 505 ! 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, jpk 510 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 DO 516 ! 517 ENDIF 518 519 ! Local depth and Inverse of the local depth of the water 520 ! ------------------------------------------------------- 521 ! 522 ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm) 523 524 ! write restart file 525 ! ================== 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_update 442 531 443 532 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stepLF.F90
r12624 r12644 55 55 !!---------------------------------------------------------------------- 56 56 INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs !! used by nemo_init 57 57 # include "domzgr_substitute.h90" 58 58 !!---------------------------------------------------------------------- 59 59 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 212 212 ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) as well 213 213 IF( ln_dynspg_ts ) THEN ! vertical scale factors and vertical velocity need to be updated 214 CALL div_hor 215 IF(.NOT.ln_linssh) CALL dom_qe_r3c 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)214 CALL div_hor ( kstp, Nbb, Nnn ) ! Horizontal divergence (2nd call in time-split case) 215 IF(.NOT.ln_linssh) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) 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) 218 218 ENDIF 219 219 CALL dyn_zdf ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa ) ! vertical diffusion … … 294 294 !! 295 295 !!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 296 CALL zdyn_ts ( Nnn, Naa, e3u, e3v,uu, vv ) ! barotrope ajustment296 CALL zdyn_ts ( Nnn, Naa, uu, vv ) ! barotrope ajustment 297 297 CALL finalize_sbc ( kstp, Nbb, Naa, uu, vv, ts ) ! boundary condifions 298 298 CALL ssh_atf ( kstp, Nbb, Nnn, Naa, ssh ) ! time filtering of "now" sea surface height … … 311 311 Naa = Nrhs 312 312 ! 313 IF(.NOT.ln_linssh) CALL dom_qe_sf_update( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors 313 !IF(.NOT.ln_linssh) CALL dom_qe_sf_update( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors 314 IF(.NOT.ln_linssh) CALL dom_h_update ( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors 314 315 ! 315 316 IF( ln_diahsb ) CALL dia_hsb ( kstp, Nbb, Nnn ) ! - ML - global conservation diagnostics … … 366 367 367 368 368 SUBROUTINE zdyn_ts (Kmm, Kaa, p e3u, pe3v, puu, pvv)369 SUBROUTINE zdyn_ts (Kmm, Kaa, puu, pvv) 369 370 !!---------------------------------------------------------------------- 370 371 !! *** ROUTINE zdyn_ts *** … … 379 380 INTEGER , INTENT(in ) :: Kmm, Kaa ! before and after time level indices 380 381 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocities 381 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(in ) :: pe3u, pe3v ! scale factors382 382 ! 383 383 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve … … 390 390 ! Ensure below that barotropic velocities match time splitting estimate 391 391 ! Compute actual transport and replace it with ts estimate at "after" time step 392 zue(:,:) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1)393 zve(:,:) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1)392 zue(:,:) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 393 zve(:,:) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 394 394 DO jk = 2, jpkm1 395 zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)396 zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)395 zue(:,:) = zue(:,:) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 396 zve(:,:) = zve(:,:) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 397 397 END DO 398 398 DO jk = 1, jpkm1
Note: See TracChangeset
for help on using the changeset viewer.
