- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DOM/domvvl.F90 (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/DOM/domvvl.F90
r13237 r13899 202 202 gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 203 203 gdepw(:,:,1,Kbb) = 0.0_wp 204 DO_3D _11_11( 2, jpk )204 DO_3D( 1, 1, 1, 1, 2, jpk ) ! vertical sum 205 205 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 206 206 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) … … 250 250 ENDIF 251 251 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 252 DO_2D _11_11252 DO_2D( 1, 1, 1, 1 ) 253 253 !!gm case |gphi| >= 6 degrees is useless initialized just above by default 254 254 IF( ABS(gphit(ji,jj)) >= 6.) THEN … … 273 273 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 274 274 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 275 ii0 = 103 ; ii1 = 111276 ij0 = 128 ; ij1 = 135 ;275 ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1 276 ij0 = 128 + nn_hls ; ij1 = 135 + nn_hls 277 277 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 278 278 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rn_Dt … … 334 334 LOGICAL :: ll_do_bclinic ! local logical 335 335 REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv 336 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t 336 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ze3t 337 LOGICAL , DIMENSION(:,:,:), ALLOCATABLE :: llmsk 337 338 !!---------------------------------------------------------------------- 338 339 ! … … 419 420 zwu(:,:) = 0._wp 420 421 zwv(:,:) = 0._wp 421 DO_3D _10_10( 1, jpkm1 )422 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) ! a - first derivative: diffusive fluxes 422 423 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 423 424 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) … … 427 428 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 428 429 END_3D 429 DO_2D _11_11430 DO_2D( 1, 1, 1, 1 ) ! b - correction for last oceanic u-v points 430 431 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 431 432 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 432 433 END_2D 433 DO_3D _00_00( 1, jpkm1 )434 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! c - second derivative: divergence of diffusive fluxes 434 435 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 435 436 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 436 437 & ) * r1_e1e2t(ji,jj) 437 438 END_3D 438 ! ! d - thickness diffusion transport: boundary conditions439 ! ! d - thickness diffusion transport: boundary conditions 439 440 ! (stored for tracer advction and continuity equation) 440 441 CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) … … 447 448 ! Maximum deformation control 448 449 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 449 ze3t(:,:,jpk) = 0._wp 450 DO jk = 1, jpkm1 451 ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 452 END DO 453 z_tmax = MAXVAL( ze3t(:,:,:) ) 454 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 455 z_tmin = MINVAL( ze3t(:,:,:) ) 456 CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 450 ALLOCATE( ze3t(jpi,jpj,jpk), llmsk(jpi,jpj,jpk) ) 451 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 452 ze3t(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) / e3t_0(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 453 END_3D 454 ! 455 llmsk( 1:Nis1,:,:) = .FALSE. ! exclude halos from the checked region 456 llmsk(Nie1: jpi,:,:) = .FALSE. 457 llmsk(:, 1:Njs1,:) = .FALSE. 458 llmsk(:,Nje1: jpj,:) = .FALSE. 459 ! 460 llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 461 z_tmax = MAXVAL( ze3t(:,:,:), mask = llmsk ) ; CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 462 z_tmin = MINVAL( ze3t(:,:,:), mask = llmsk ) ; CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 457 463 ! - ML - test: for the moment, stop simulation for too large e3_t variations 458 464 IF( ( z_tmax > rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 459 IF( lk_mpp ) THEN 460 CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 461 CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 462 ELSE 463 ijk_max = MAXLOC( ze3t(:,:,:) ) 464 ijk_max(1) = ijk_max(1) + nimpp - 1 465 ijk_max(2) = ijk_max(2) + njmpp - 1 466 ijk_min = MINLOC( ze3t(:,:,:) ) 467 ijk_min(1) = ijk_min(1) + nimpp - 1 468 ijk_min(2) = ijk_min(2) + njmpp - 1 469 ENDIF 465 CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 466 CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 470 467 IF (lwp) THEN 471 468 WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax … … 476 473 ENDIF 477 474 ENDIF 475 DEALLOCATE( ze3t, llmsk ) 478 476 ! - ML - end test 479 477 ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below … … 659 657 gdepw(:,:,1,Kmm) = 0.0_wp 660 658 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 661 DO_3D _11_11(2, jpk )659 DO_3D( 1, 1, 1, 1, 2, jpk ) 662 660 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 663 661 ! 1 for jk = mikt … … 714 712 ! 715 713 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean 716 DO_3D _10_10(1, jpk )714 DO_3D( 1, 0, 1, 0, 1, jpk ) 717 715 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 718 716 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & … … 723 721 ! 724 722 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean 725 DO_3D _10_10(1, jpk )723 DO_3D( 1, 0, 1, 0, 1, jpk ) 726 724 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 727 725 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & … … 732 730 ! 733 731 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 734 DO_3D _10_10(1, jpk )732 DO_3D( 1, 0, 1, 0, 1, jpk ) 735 733 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 736 734 & * r1_e1e2f(ji,jj) & … … 805 803 IF( ln_rstart ) THEN !* Read the restart file 806 804 CALL rst_read_open ! open the restart file if necessary 807 CALL iom_get( numror, jpdom_auto glo, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios )805 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 808 806 ! 809 807 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 818 816 ! 819 817 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 820 CALL iom_get( numror, jpdom_auto glo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )821 CALL iom_get( numror, jpdom_auto glo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )818 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 819 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 822 820 ! needed to restart if land processor not computed 823 821 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 833 831 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 834 832 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 835 CALL iom_get( numror, jpdom_auto glo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios )833 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 836 834 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 837 835 l_1st_euler = .true. … … 840 838 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 841 839 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 842 CALL iom_get( numror, jpdom_auto glo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios )840 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 843 841 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 844 842 l_1st_euler = .true. … … 865 863 ! ! ----------------------- ! 866 864 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 867 CALL iom_get( numror, jpdom_auto glo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios )868 CALL iom_get( numror, jpdom_auto glo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios )865 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 866 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 869 867 ELSE ! one at least array is missing 870 868 tilde_e3t_b(:,:,:) = 0.0_wp … … 875 873 ! ! ------------ ! 876 874 IF( id5 > 0 ) THEN ! required array exists 877 CALL iom_get( numror, jpdom_auto glo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios )875 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 878 876 ELSE ! array is missing 879 877 hdiv_lf(:,:,:) = 0.0_wp … … 899 897 ssh(:,:,Kbb) = -ssh_ref 900 898 901 DO_2D _11_11899 DO_2D( 1, 1, 1, 1 ) 902 900 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 903 901 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) … … 915 913 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 916 914 917 DO_2D _11_11915 DO_2D( 1, 1, 1, 1 ) 918 916 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 919 917 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' )
Note: See TracChangeset
for help on using the changeset viewer.
