- Timestamp:
- 2018-07-29T11:23:51+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OFF/dtadyn.F90
r9939 r10009 142 142 emp_b (:,:) = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1) ! E-P 143 143 zemp (:,:) = ( 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr ) * tmask(:,:,1) 144 CALL dta_dyn_ssh( kt, zhdivtr, sshb, zemp, ssha, e3t_a(:,:,:) ) != ssh, vertical scale factor & vertical transport 144 CALL dta_dyn_ssh( kt, zhdivtr, ssh(:,:,Nbb), zemp, ssh(:,:,Naa) ) != ssh, vertical scale factor & vertical transport 145 !! 146 !!gm BUG ? ssh after computed but no swap so, not used in the restart.... 147 !! 145 148 DEALLOCATE( zemp , zhdivtr ) 146 149 ! Write in the tracer restart file … … 148 151 IF( lrst_trc ) THEN 149 152 IF(lwp) WRITE(numout,*) 150 IF(lwp) WRITE(numout,*) 'dta_dyn _ssh: ssh field written in tracer restart file at it= ', kt,' date= ', ndastp151 IF(lwp) WRITE(numout,*) '~~~~~~~ ~~~~'152 CALL iom_rstput( kt, nitrst, numrtw, 'sshn', ssh a)153 CALL iom_rstput( kt, nitrst, numrtw, 'sshb', ssh n)153 IF(lwp) WRITE(numout,*) 'dta_dyn : ssh field written in tracer restart file at it= ', kt,' date= ', ndastp 154 IF(lwp) WRITE(numout,*) '~~~~~~~' 155 CALL iom_rstput( kt, nitrst, numrtw, 'sshn', ssh(:,:,Nnn) ) 156 CALL iom_rstput( kt, nitrst, numrtw, 'sshb', ssh(:,:,Nbb) ) 154 157 ENDIF 155 158 ENDIF … … 313 316 ! 314 317 IF( .NOT.ln_linssh ) THEN 315 IF( .NOT. sf_dyn(jf_uwd)%ln_clim .AND. ln_rsttr .AND. & ! Restart: read in restart file 316 iom_varid( numrtr, 'sshn', ldstop = .FALSE. ) > 0 ) THEN 317 IF(lwp) WRITE(numout,*) ' sshn forcing fields read in the restart file for initialisation' 318 CALL iom_get( numrtr, jpdom_autoglo, 'sshn', sshn(:,:) ) 319 CALL iom_get( numrtr, jpdom_autoglo, 'sshb', sshb(:,:) ) 320 ELSE 321 IF(lwp) WRITE(numout,*) ' sshn forcing fields read in the restart file for initialisation' 322 CALL iom_open( 'restart', inum ) 323 CALL iom_get( inum, jpdom_autoglo, 'sshn', sshn(:,:) ) 324 CALL iom_get( inum, jpdom_autoglo, 'sshb', sshb(:,:) ) 325 CALL iom_close( inum ) ! close file 326 ENDIF 327 ! 328 DO jk = 1, jpkm1 329 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + sshn(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) ) 330 ENDDO 331 e3t_a(:,:,jpk) = e3t_0(:,:,jpk) 332 333 ! Horizontal scale factor interpolations 334 ! -------------------------------------- 335 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 336 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 337 338 ! Vertical scale factor interpolations 339 ! ------------------------------------ 340 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n(:,:,:), 'W' ) 341 342 e3t_b(:,:,:) = e3t_n(:,:,:) 343 e3u_b(:,:,:) = e3u_n(:,:,:) 344 e3v_b(:,:,:) = e3v_n(:,:,:) 345 346 ! t- and w- points depth 347 ! ---------------------- 348 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 349 gdepw_n(:,:,1) = 0.0_wp 350 351 DO jk = 2, jpk 352 DO jj = 1,jpj 353 DO ji = 1,jpi 354 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere 355 ! tmask = wmask, ie everywhere expect at jk = mikt 356 ! 1 for jk = 357 ! mikt 358 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 359 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 360 gdept_n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk)) & 361 & + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)) 362 END DO 363 END DO 364 END DO 365 366 gdept_b(:,:,:) = gdept_n(:,:,:) 367 gdepw_b(:,:,:) = gdepw_n(:,:,:) 368 ! 318 IF( .NOT. sf_dyn(jf_uwd)%ln_clim .AND. ln_rsttr .AND. & ! Restart: read in restart file 319 iom_varid( numrtr, 'sshn', ldstop = .FALSE. ) > 0 ) THEN 320 IF(lwp) WRITE(numout,*) ' ssh forcing fields read in the restart file for initialisation' 321 CALL iom_get( numrtr, jpdom_autoglo, 'sshn', ssh(:,:,Nnn) ) 322 CALL iom_get( numrtr, jpdom_autoglo, 'sshb', ssh(:,:,Nbb) ) 323 ELSE 324 IF(lwp) WRITE(numout,*) ' ssh forcing fields read in the restart file for initialisation' 325 CALL iom_open( 'restart', inum ) 326 CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh(:,:,Nnn) ) 327 CALL iom_get( inum, jpdom_autoglo, 'sshb', ssh(:,:,Nbb) ) 328 CALL iom_close( inum ) ! close file 329 ENDIF 330 ! 331 ! !== Set of all other vertical mesh fields ==! (now and before) 332 ! 333 ! !* BEFORE fields : 334 CALL ssh2e3_before ! set: hu , hv , r1_hu, r1_hv 335 ! ! e3t, e3w, e3u, e3uw, e3v, e3vw (from 1 to jpkm1) 336 ! 337 ! ! set jpk level one to the e3._0 values 338 e3t_b(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_b(:,:,jpk) = e3w_0(:,:,jpk) ; e3v_b(:,:,jpk) = e3v_0(:,:,jpk) 339 e3w_b(:,:,jpk) = e3w_0(:,:,jpk) ; e3uw_b(:,:,jpk) = e3uw_0(:,:,jpk) ; e3vw_b(:,:,jpk) = e3vw_0(:,:,jpk) 340 ! 341 ! !* NOW fields : 342 CALL ssh2e3_now ! set: ht , hu , hv , r1_hu, r1_hv 343 ! ! e3t, e3w, e3u, e3uw, e3v, e3vw, e3f (from 1 to jpkm1) 344 ! ! gdept_n, gdepw_n, gde3w_n 345 !!gm issue? gdept_n, gdepw_n, gde3w_n never defined at jpk 346 ! 347 ! ! set one for all last level to the e3._0 value 348 e3t_n(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_n(:,:,jpk) = e3w_0(:,:,jpk) ; e3v_n(:,:,jpk) = e3v_0(:,:,jpk) 349 e3w_n(:,:,jpk) = e3w_0(:,:,jpk) ; e3uw_n(:,:,jpk) = e3uw_0(:,:,jpk) ; e3vw_n(:,:,jpk) = e3vw_0(:,:,jpk) 350 e3f_n(:,:,jpk) = e3f_0(:,:,jpk) 351 ! 352 ! !* AFTER fields : (last level for OPA, 3D required for AGRIF initialisation) 353 e3t_a(:,:,:) = e3t_n(:,:,:) ; e3u_a(:,:,:) = e3u_n(:,:,:) ; e3v_a(:,:,:) = e3v_n(:,:,:) 354 ! 369 355 ENDIF 370 356 ! … … 430 416 INTEGER :: ji, jj, jk 431 417 REAL(wp) :: zcoef 418 REAL(wp), DIMENSION(jpi,jpj) :: zssht_h, zsshu_h, zsshv_h 432 419 !!--------------------------------------------------------------------- 433 420 … … 438 425 ENDIF 439 426 440 sshb(:,:) = sshn(:,:) + rn_atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) ! before <-- now filtered 441 sshn(:,:) = ssha(:,:) 442 443 e3t_n(:,:,:) = e3t_a(:,:,:) 427 ssh(:,:,Nbb) = ssh(:,:,Nnn) + rn_atfp * ( ssh(:,:,Nbb) - 2 * ssh(:,:,Nnn) + ssh(:,:,Naa) ) ! before <-- now filtered 428 ssh(:,:,Nnn) = ssh(:,:,Naa) 444 429 445 430 ! Reconstruction of all vertical scale factors at now and before time steps 446 431 ! ============================================================================= 447 448 ! Horizontal scale factor interpolations 449 ! -------------------------------------- 450 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 451 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 452 453 ! Vertical scale factor interpolations 454 ! ------------------------------------ 455 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 456 432 ! 433 ! !== now ssh ==! (u- and v-points) 434 DO jj = 2, jpjm1 ; DO ji = 2, jpim1 435 zsshu_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nnn) + ssh(ji+1,jj,Nnn) ) * ssumask(ji,jj) 436 zsshv_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nnn) + ssh(ji,jj+1,Nnn) ) * ssvmask(ji,jj) 437 END DO ; END DO 438 CALL lbc_lnk_multi( zsshu_h(:,:), 'U', 1._wp , zsshv_h(:,:), 'V', 1._wp ) 439 ! 440 ! !== after depths and its inverse ==! 441 hu_n(:,:) = hu_0(:,:) + zsshu_h(:,:) 442 hv_n(:,:) = hv_0(:,:) + zsshv_h(:,:) 443 r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) 444 r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) 445 ! 446 ! !== now scale factors ==! (e3t , e3u , e3v) 447 zssht_h(:,:) = ssh (:,:,Nnn) * r1_ht_0(:,:) ! t-point 448 zsshu_h(:,:) = zsshu_h(:,:) * r1_hu_0(:,:) ! u-point 449 zsshv_h(:,:) = zsshv_h(:,:) * r1_hv_0(:,:) ! v-point 450 DO jk = 1, jpkm1 451 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 452 e3u_n(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 453 e3v_n(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 454 e3w_n(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) 455 END DO 456 ! 457 457 e3t_b(:,:,:) = e3t_n(:,:,:) 458 458 e3u_b(:,:,:) = e3u_n(:,:,:) … … 475 475 END DO 476 476 ! 477 zssht_h(:,:) = 1._wp + zssht_h(:,:) ! t-point 478 ! 479 IF( ln_isfcav ) THEN ! ISF cavities : ssh scaling not applied over the iceshelf thickness 480 DO jk = 1, jpkm1 481 gdept_n(:,:,jk) = ( gdept_0(:,:,jk) - risfdep(:,:) ) * zssht_h(:,:) + risfdep(:,:) 482 gdepw_n(:,:,jk) = ( gdepw_0(:,:,jk) - risfdep(:,:) ) * zssht_h(:,:) + risfdep(:,:) 483 gde3w_n(:,:,jk) = gdept_n(:,:,jk) - ssh (:,:,Nnn) 484 END DO 485 ELSE ! no ISF cavities 486 DO jk = 1, jpkm1 487 gdept_n(:,:,jk) = gdept_0(:,:,jk) * zssht_h(:,:) 488 gdepw_n(:,:,jk) = gdepw_0(:,:,jk) * zssht_h(:,:) 489 gde3w_n(:,:,jk) = gdept_n(:,:,jk) - ssh (:,:,Nnn) 490 END DO 491 ENDIF 492 ! 477 493 gdept_b(:,:,:) = gdept_n(:,:,:) 478 494 gdepw_b(:,:,:) = gdepw_n(:,:,:) … … 481 497 482 498 483 SUBROUTINE dta_dyn_ssh( kt, phdivtr, psshb, pemp, pssha , pe3ta)499 SUBROUTINE dta_dyn_ssh( kt, phdivtr, psshb, pemp, pssha ) 484 500 !!---------------------------------------------------------------------- 485 501 !! *** ROUTINE dta_dyn_wzv *** … … 502 518 !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. 503 519 !!---------------------------------------------------------------------- 504 INTEGER, INTENT(in) :: kt ! time-step505 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: phdivtr ! horizontal divergence transport506 REAL(wp), DIMENSION(jpi,jpj) , OPTIONAL, INTENT(in ) :: psshb ! now ssh507 REAL(wp), DIMENSION(jpi,jpj) , OPTIONAL, INTENT(in ) :: pemp ! evaporation minus precipitation520 INTEGER, INTENT(in ) :: kt ! time-step 521 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: phdivtr ! horizontal divergence transport 522 REAL(wp), DIMENSION(jpi,jpj) , OPTIONAL, INTENT(in ) :: psshb ! now ssh 523 REAL(wp), DIMENSION(jpi,jpj) , OPTIONAL, INTENT(in ) :: pemp ! evaporation minus precipitation 508 524 REAL(wp), DIMENSION(jpi,jpj) , OPTIONAL, INTENT(inout) :: pssha ! after ssh 509 REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL, INTENT(out) :: pe3ta ! after vertical scale factor510 525 ! 511 526 INTEGER :: jk … … 518 533 END DO 519 534 ! ! Sea surface elevation time-stepping 520 pssha(:,:) = ( psshb(:,:) - rDt * ( r1_rho0 * pemp(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 521 ! ! 522 ! ! After acale factors at t-points ( z_star coordinate ) 523 DO jk = 1, jpkm1 524 pe3ta(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + pssha(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) ) 525 END DO 535 pssha(:,:) = ( psshb(:,:) - rDt * ( r1_rho0 * pemp(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 526 536 ! 527 537 END SUBROUTINE dta_dyn_ssh
Note: See TracChangeset
for help on using the changeset viewer.
