Changeset 14037 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DOM/domvvl.F90
- Timestamp:
- 2020-12-03T12:20:38+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DOM/domvvl.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette @13292sette10 ^/utils/CI/sette_wave@13990 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DOM/domvvl.F90
r13295 r14037 202 202 gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 203 203 gdepw(:,:,1,Kbb) = 0.0_wp 204 DO_3D( 1, 1, 1, 1, 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) … … 282 282 ENDIF 283 283 ! 284 IF(lwxios) THEN285 ! define variables in restart file when writing with XIOS286 CALL iom_set_rstw_var_active('e3t_b')287 CALL iom_set_rstw_var_active('e3t_n')288 ! ! ----------------------- !289 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases !290 ! ! ----------------------- !291 CALL iom_set_rstw_var_active('tilde_e3t_b')292 CALL iom_set_rstw_var_active('tilde_e3t_n')293 END IF294 ! ! -------------!295 IF( ln_vvl_ztilde ) THEN ! z_tilde case !296 ! ! ------------ !297 CALL iom_set_rstw_var_active('hdiv_lf')298 ENDIF299 !300 ENDIF301 !302 284 END SUBROUTINE dom_vvl_zgr 303 285 … … 334 316 LOGICAL :: ll_do_bclinic ! local logical 335 317 REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv 336 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t 318 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ze3t 319 LOGICAL , DIMENSION(:,:,:), ALLOCATABLE :: llmsk 337 320 !!---------------------------------------------------------------------- 338 321 ! … … 419 402 zwu(:,:) = 0._wp 420 403 zwv(:,:) = 0._wp 421 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 404 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) ! a - first derivative: diffusive fluxes 422 405 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 423 406 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) … … 427 410 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 428 411 END_3D 429 DO_2D( 1, 1, 1, 1 ) 412 DO_2D( 1, 1, 1, 1 ) ! b - correction for last oceanic u-v points 430 413 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 431 414 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 432 415 END_2D 433 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 416 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! c - second derivative: divergence of diffusive fluxes 434 417 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 435 418 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 436 419 & ) * r1_e1e2t(ji,jj) 437 420 END_3D 438 ! ! d - thickness diffusion transport: boundary conditions421 ! ! d - thickness diffusion transport: boundary conditions 439 422 ! (stored for tracer advction and continuity equation) 440 423 CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 441 442 424 ! 4 - Time stepping of baroclinic scale factors 443 425 ! --------------------------------------------- … … 447 429 ! Maximum deformation control 448 430 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 431 ALLOCATE( ze3t(jpi,jpj,jpk), llmsk(jpi,jpj,jpk) ) 432 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 433 ze3t(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) / e3t_0(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 434 END_3D 435 ! 436 llmsk( 1:Nis1,:,:) = .FALSE. ! exclude halos from the checked region 437 llmsk(Nie1: jpi,:,:) = .FALSE. 438 llmsk(:, 1:Njs1,:) = .FALSE. 439 llmsk(:,Nje1: jpj,:) = .FALSE. 440 ! 441 llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 442 z_tmax = MAXVAL( ze3t(:,:,:), mask = llmsk ) ; CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 443 z_tmin = MINVAL( ze3t(:,:,:), mask = llmsk ) ; CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 457 444 ! - ML - test: for the moment, stop simulation for too large e3_t variations 458 445 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 446 CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 447 CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 470 448 IF (lwp) THEN 471 449 WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax … … 476 454 ENDIF 477 455 ENDIF 456 DEALLOCATE( ze3t, llmsk ) 478 457 ! - ML - end test 479 458 ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below … … 805 784 IF( ln_rstart ) THEN !* Read the restart file 806 785 CALL rst_read_open ! open the restart file if necessary 807 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) , ldxios = lrxios)786 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) ) 808 787 ! 809 788 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 818 797 ! 819 798 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 820 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)821 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)799 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 800 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 822 801 ! needed to restart if land processor not computed 823 802 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 833 812 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 834 813 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 835 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)814 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 836 815 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 837 816 l_1st_euler = .true. … … 840 819 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 841 820 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 842 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)821 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 843 822 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 844 823 l_1st_euler = .true. … … 865 844 ! ! ----------------------- ! 866 845 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 867 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lrxios)868 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lrxios)846 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 847 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 869 848 ELSE ! one at least array is missing 870 849 tilde_e3t_b(:,:,:) = 0.0_wp … … 875 854 ! ! ------------ ! 876 855 IF( id5 > 0 ) THEN ! required array exists 877 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lrxios)856 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 878 857 ELSE ! array is missing 879 858 hdiv_lf(:,:,:) = 0.0_wp … … 948 927 ! ! =================== 949 928 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 950 IF( lwxios ) CALL iom_swap( cwxios_context )951 929 ! ! --------- ! 952 930 ! ! all cases ! 953 931 ! ! --------- ! 954 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lwxios)955 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lwxios)932 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 933 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 956 934 ! ! ----------------------- ! 957 935 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 958 936 ! ! ----------------------- ! 959 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lwxios)960 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lwxios)937 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 938 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 961 939 END IF 962 940 ! ! -------------! 963 941 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 964 942 ! ! ------------ ! 965 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lwxios)943 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 966 944 ENDIF 967 945 ! 968 IF( lwxios ) CALL iom_swap( cxios_context )969 946 ENDIF 970 947 !
Note: See TracChangeset
for help on using the changeset viewer.
