- Timestamp:
- 2020-03-20T18:43:12+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqe.F90
r12492 r12579 17 17 !! dom_vvl_sf_update : Swap vertical scale factors and update the vertical grid 18 18 !! dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 19 !! dom_vvl_r3c : Compute ssh/h_0 ratioat t-, u-, v-, and optionally f-points 19 20 !! dom_vvl_rst : read/write restart file 20 21 !! dom_vvl_ctl : Check the vvl options … … 245 246 LOGICAL :: ll_do_bclinic ! local logical 246 247 REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv 247 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t248 248 !!---------------------------------------------------------------------- 249 249 ! … … 258 258 ENDIF 259 259 260 ! ll_do_bclinic = .TRUE. 261 ! IF( PRESENT(kcall) ) THEN 262 ! IF( kcall == 2 .AND. ln_vvl_ztilde ) ll_do_bclinic = .FALSE. 263 ! ENDIF 260 IF( PRESENT(kcall) ) THEN 261 IF( kcall == 2 ) THEN 262 CALL dom_qe_r3c( ssh(:,:,Kaa), r3t(:,:,Kaa), r3u(:,:,Kaa), r3v(:,:,Kaa), r3f(:,:) ) 263 ELSE 264 CALL dom_qe_r3c( ssh(:,:,Kaa), r3t(:,:,Kaa), r3u(:,:,Kaa), r3v(:,:,Kaa) ) 265 ENDIF 266 ENDIF 264 267 265 268 ! ******************************* ! … … 274 277 ! After scale factors at u- v- points ! 275 278 ! *********************************** ! 276 !277 CALL dom_qe_r3c( ssh(:,:,Kaa), r3t(:,:,Kaa), r3u(:,:,Kaa), r3v(:,:,Kaa) )278 279 ! 279 280 DO jk = 1, jpkm1 … … 342 343 ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 343 344 ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 344 !!st ! r3t/u/v should be unchanged 345 CALL dom_qe_r3c( ssh(:,:,Kmm), r3t_f(:,:), r3u_f(:,:), r3v_f(:,:), r3f(:,:) ) 346 ! 347 DO jk = 1, jpkm1 ! Horizontal interpolation of e3t 348 e3f(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:) * fmask(:,:,jk) ) ! Kmm time level 345 346 347 ! Scale factor computation 348 DO jk = 1, jpk ! Horizontal interpolation 349 e3f(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:) * fmask(:,:,jk) ) ! Kmm time level 350 ! ! Vertical interpolation 351 ! ! The ratio does not have to be masked at w-level 352 e3w (:,:,jk,Kmm) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) ! Kmm time level 353 e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 354 e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 355 e3w (:,:,jk,Kbb) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) ! Kbb time level 356 e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 357 e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 349 358 END DO 350 !CALL dom_qe_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 351 352 ! Vertical scale factor interpolations 353 ! DO jk = 1, jpk ! Vertical interpolation of e3t,u,v 354 ! ! ! The ratio does not have to be masked at w-level 355 ! e3w (:,:,jk,Kmm) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) ! Kmm time level 356 ! e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 357 ! e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 358 ! END DO 359 CALL dom_qe_interpol( e3t(:,:,:,Kmm), e3w(:,:,:,Kmm), 'W' ) 360 CALL dom_qe_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 361 CALL dom_qe_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 362 CALL dom_qe_interpol( e3t(:,:,:,Kbb), e3w(:,:,:,Kbb), 'W' ) 363 CALL dom_qe_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 364 CALL dom_qe_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 365 366 ! t- and w- points depth (set the isf depth as it is in the initial step) 367 gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 368 gdepw(:,:,1,Kmm) = 0.0_wp 369 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 370 DO_3D_11_11( 2, jpk ) 371 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 372 ! 1 for jk = mikt 373 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 374 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 375 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 376 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 377 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 378 END_3D 379 ! IF( ln_isf ) THEN !** IceShelF cavities 380 ! ! ! to be created depending of the new names in isf 381 ! ! ! it should be something like that : (with h_isf = thickness of iceshelf) 382 ! ! ! in fact currently, h_isf(:,:) is called : risfdep(:,:) 383 ! !!gm - depth idea 0 : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 384 ! gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 385 ! gdepw(:,:,1,Kmm) = 0._wp ! Initialized to zero one for all 386 ! gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) ! reference to a common level z=0 for hpg 387 ! DO jk = 2, jpk 388 ! gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) & 389 ! + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 390 ! gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) & 391 ! + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 392 ! gde3w(:,:,jk) = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 393 ! END DO 394 ! ! 395 ! ELSE !** No cavities (all depth rescaled, even inside topography: no mask) 396 ! ! 397 ! !!gm idea 0 : just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 398 ! DO jk = 1, jpk 399 ! gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 400 ! gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 401 ! gde3w(:,:,jk) = gdept (:,:,jk,Kmm) - ssh(:,:,Kmm) 402 ! END DO 403 ! ! 404 ! ENDIF 359 360 361 IF( ln_isf ) THEN !** IceShelF cavities 362 ! ! to be created depending of the new names in isf 363 ! ! it should be something like that : (with h_isf = thickness of iceshelf) 364 ! ! in fact currently, h_isf(:,:) is called : risfdep(:,:) 365 !!gm - depth idea 0 : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 366 gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 367 gdepw(:,:,1,Kmm) = 0._wp ! Initialized to zero one for all 368 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) ! reference to a common level z=0 for hpg 369 DO jk = 2, jpk 370 gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) & 371 + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 372 gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) & 373 + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 374 gde3w(:,:,jk) = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 375 END DO 376 ! 377 ELSE !** No cavities (all depth rescaled, even inside topography: no mask) 378 ! 379 !!gm idea 0 : just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 380 DO jk = 1, jpk 381 gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 382 gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 383 gde3w(:,:,jk) = gdept (:,:,jk,Kmm) - ssh(:,:,Kmm) 384 END DO 385 ! 386 ENDIF 405 387 406 388 ! Local depth and Inverse of the local depth of the water … … 475 457 CASE( 'W' ) !* from T- to W-point : vertical simple mean 476 458 ! 459 !zlnwd = 1.0_wp 477 460 pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1) 478 461 ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing … … 487 470 CASE( 'UW' ) !* from U- to UW-point : vertical simple mean 488 471 ! 472 !zlnwd = 1.0_wp 489 473 pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1) 490 474 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing … … 499 483 CASE( 'VW' ) !* from V- to VW-point : vertical simple mean 500 484 ! 485 !zlnwd = 1.0_wp 501 486 pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1) 502 487 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing … … 676 661 ! Adjust vertical metrics for all wad 677 662 DO jk = 1, jpk 678 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 679 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 680 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 663 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) * tmask(:,:,jk) ) 681 664 END DO 682 665 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)
Note: See TracChangeset
for help on using the changeset viewer.