Changeset 14037 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/tests/VORTEX/MY_SRC/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)
-
tests/VORTEX/MY_SRC/domvvl.F90 (modified) (17 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/tests/VORTEX/MY_SRC/domvvl.F90
r13295 r14037 9 9 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 10 10 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 11 !! 4.x ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio 11 12 !!---------------------------------------------------------------------- 12 13 13 !!----------------------------------------------------------------------14 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness15 !! dom_vvl_sf_nxt : Compute next vertical scale factors16 !! dom_vvl_sf_update : Swap vertical scale factors and update the vertical grid17 !! dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another18 !! dom_vvl_rst : read/write restart file19 !! dom_vvl_ctl : Check the vvl options20 !!----------------------------------------------------------------------21 14 USE oce ! ocean dynamics and tracers 22 15 USE phycst ! physical constant … … 36 29 PRIVATE 37 30 38 PUBLIC dom_vvl_init ! called by domain.F9039 PUBLIC dom_vvl_zgr ! called by isfcpl.F9040 PUBLIC dom_vvl_sf_nxt ! called by step.F9041 PUBLIC dom_vvl_sf_update ! called by step.F9042 PUBLIC dom_vvl_interpol ! called by dynnxt.F9043 44 31 ! !!* Namelist nam_vvl 45 32 LOGICAL , PUBLIC :: ln_vvl_zstar = .FALSE. ! zstar vertical coordinate … … 63 50 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 64 51 52 #if defined key_qco 53 !!---------------------------------------------------------------------- 54 !! 'key_qco' EMPTY MODULE Quasi-Eulerian vertical coordonate 55 !!---------------------------------------------------------------------- 56 #else 57 !!---------------------------------------------------------------------- 58 !! Default key Old management of time varying vertical coordinate 59 !!---------------------------------------------------------------------- 60 61 !!---------------------------------------------------------------------- 62 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness 63 !! dom_vvl_sf_nxt : Compute next vertical scale factors 64 !! dom_vvl_sf_update : Swap vertical scale factors and update the vertical grid 65 !! dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 66 !! dom_vvl_rst : read/write restart file 67 !! dom_vvl_ctl : Check the vvl options 68 !!---------------------------------------------------------------------- 69 70 PUBLIC dom_vvl_init ! called by domain.F90 71 PUBLIC dom_vvl_zgr ! called by isfcpl.F90 72 PUBLIC dom_vvl_sf_nxt ! called by step.F90 73 PUBLIC dom_vvl_sf_update ! called by step.F90 74 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 75 65 76 !! * Substitutions 66 77 # include "do_loop_substitute.h90" … … 135 146 ! 136 147 END SUBROUTINE dom_vvl_init 137 ! 148 149 138 150 SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 139 151 !!---------------------------------------------------------------------- … … 261 273 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 262 274 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 263 ii0 = 103 ; ii1 = 111264 ij0 = 128 ; ij1 = 135 ;275 ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1 276 ij0 = 128 + nn_hls ; ij1 = 135 + nn_hls 265 277 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 266 278 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rn_Dt … … 268 280 ENDIF 269 281 ENDIF 270 ENDIF271 !272 IF(lwxios) THEN273 ! define variables in restart file when writing with XIOS274 CALL iom_set_rstw_var_active('e3t_b')275 CALL iom_set_rstw_var_active('e3t_n')276 ! ! ----------------------- !277 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases !278 ! ! ----------------------- !279 CALL iom_set_rstw_var_active('tilde_e3t_b')280 CALL iom_set_rstw_var_active('tilde_e3t_n')281 END IF282 ! ! -------------!283 IF( ln_vvl_ztilde ) THEN ! z_tilde case !284 ! ! ------------ !285 CALL iom_set_rstw_var_active('hdiv_lf')286 ENDIF287 !288 282 ENDIF 289 283 ! … … 322 316 LOGICAL :: ll_do_bclinic ! local logical 323 317 REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv 324 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t 318 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ze3t 319 LOGICAL , DIMENSION(:,:,:), ALLOCATABLE :: llmsk 325 320 !!---------------------------------------------------------------------- 326 321 ! … … 435 430 ! Maximum deformation control 436 431 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 437 ze3t(:,:,jpk) = 0._wp 438 DO jk = 1, jpkm1 439 ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 440 END DO 441 z_tmax = MAXVAL( ze3t(:,:,:) ) 442 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 443 z_tmin = MINVAL( ze3t(:,:,:) ) 444 CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 432 ALLOCATE( ze3t(jpi,jpj,jpk), llmsk(jpi,jpj,jpk) ) 433 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 434 ze3t(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) / e3t_0(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 435 END_3D 436 ! 437 llmsk( 1:Nis1,:,:) = .FALSE. ! exclude halos from the checked region 438 llmsk(Nie1: jpi,:,:) = .FALSE. 439 llmsk(:, 1:Njs1,:) = .FALSE. 440 llmsk(:,Nje1: jpj,:) = .FALSE. 441 ! 442 llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 443 z_tmax = MAXVAL( ze3t(:,:,:), mask = llmsk ) ; CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 444 z_tmin = MINVAL( ze3t(:,:,:), mask = llmsk ) ; CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 445 445 ! - ML - test: for the moment, stop simulation for too large e3_t variations 446 446 IF( ( z_tmax > rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 447 IF( lk_mpp ) THEN 448 CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 449 CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 450 ELSE 451 ijk_max = MAXLOC( ze3t(:,:,:) ) 452 ijk_max(1) = mig0_oldcmp(ijk_max(1)) 453 ijk_max(2) = mjg0_oldcmp(ijk_max(2)) 454 ijk_min = MINLOC( ze3t(:,:,:) ) 455 ijk_min(1) = mig0_oldcmp(ijk_min(1)) 456 ijk_min(2) = mjg0_oldcmp(ijk_min(2)) 457 ENDIF 447 CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 448 CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 458 449 IF (lwp) THEN 459 450 WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax … … 464 455 ENDIF 465 456 ENDIF 457 DEALLOCATE( ze3t, llmsk ) 466 458 ! - ML - end test 467 459 ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below … … 793 785 IF( ln_rstart ) THEN !* Read the restart file 794 786 CALL rst_read_open ! open the restart file if necessary 795 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) , ldxios = lrxios)787 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) ) 796 788 ! 797 789 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 806 798 ! 807 799 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 808 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)809 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)800 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 801 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 810 802 ! needed to restart if land processor not computed 811 803 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 821 813 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 822 814 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 823 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)815 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 824 816 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 825 817 l_1st_euler = .true. … … 828 820 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 829 821 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 830 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)822 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 831 823 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 832 824 l_1st_euler = .true. … … 853 845 ! ! ----------------------- ! 854 846 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 855 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lrxios)856 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lrxios)847 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 848 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 857 849 ELSE ! one at least array is missing 858 850 tilde_e3t_b(:,:,:) = 0.0_wp … … 863 855 ! ! ------------ ! 864 856 IF( id5 > 0 ) THEN ! required array exists 865 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lrxios)857 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 866 858 ELSE ! array is missing 867 859 hdiv_lf(:,:,:) = 0.0_wp … … 937 929 ! ! =================== 938 930 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 939 IF( lwxios ) CALL iom_swap( cwxios_context )940 931 ! ! --------- ! 941 932 ! ! all cases ! 942 933 ! ! --------- ! 943 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lwxios)944 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lwxios)934 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 935 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 945 936 ! ! ----------------------- ! 946 937 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 947 938 ! ! ----------------------- ! 948 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lwxios)949 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lwxios)939 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 940 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 950 941 END IF 951 942 ! ! -------------! 952 943 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 953 944 ! ! ------------ ! 954 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lwxios)945 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 955 946 ENDIF 956 947 ! 957 IF( lwxios ) CALL iom_swap( cxios_context )958 948 ENDIF 959 949 ! … … 1030 1020 END SUBROUTINE dom_vvl_ctl 1031 1021 1022 #endif 1023 1032 1024 !!====================================================================== 1033 1025 END MODULE domvvl
Note: See TracChangeset
for help on using the changeset viewer.
