Changeset 13334 for NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/tests/VORTEX/MY_SRC/domvvl.F90
- Timestamp:
- 2020-07-22T16:20:32+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/tests/VORTEX/MY_SRC/domvvl.F90
r13295 r13334 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 … … 33 26 USE timing ! Timing 34 27 28 USE agrif_oce ! initial state interpolation 29 USE agrif_oce_interp 30 35 31 IMPLICIT NONE 36 32 PRIVATE 37 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 33 44 34 ! !!* Namelist nam_vvl … … 63 53 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 64 54 55 #if defined key_qco 56 !!---------------------------------------------------------------------- 57 !! 'key_qco' EMPTY MODULE Quasi-Eulerian vertical coordonate 58 !!---------------------------------------------------------------------- 59 #else 60 !!---------------------------------------------------------------------- 61 !! Default key Old management of time varying vertical coordinate 62 !!---------------------------------------------------------------------- 63 64 !!---------------------------------------------------------------------- 65 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness 66 !! dom_vvl_sf_nxt : Compute next vertical scale factors 67 !! dom_vvl_sf_update : Swap vertical scale factors and update the vertical grid 68 !! dom_vvl_interpol : Interpolate vertical scale factors from one grid point to another 69 !! dom_vvl_rst : read/write restart file 70 !! dom_vvl_ctl : Check the vvl options 71 !!---------------------------------------------------------------------- 72 73 PUBLIC dom_vvl_init ! called by domain.F90 74 PUBLIC dom_vvl_zgr ! called by isfcpl.F90 75 PUBLIC dom_vvl_sf_nxt ! called by step.F90 76 PUBLIC dom_vvl_sf_update ! called by step.F90 77 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 78 65 79 !! * Substitutions 66 80 # include "do_loop_substitute.h90" … … 135 149 ! 136 150 END SUBROUTINE dom_vvl_init 137 ! 151 152 138 153 SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 139 154 !!---------------------------------------------------------------------- … … 261 276 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 262 277 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 263 ii0 = 103 ; ii1 = 111264 ij0 = 128 ; ij1 = 135 ;278 ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1 279 ij0 = 128 + nn_hls ; ij1 = 135 + nn_hls 265 280 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 266 281 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rn_Dt … … 450 465 ELSE 451 466 ijk_max = MAXLOC( ze3t(:,:,:) ) 452 ijk_max(1) = mig0_oldcmp(ijk_max(1))453 ijk_max(2) = mjg0_oldcmp(ijk_max(2))467 ijk_max(1) = ijk_max(1) + nimpp - 1 468 ijk_max(2) = ijk_max(2) + njmpp - 1 454 469 ijk_min = MINLOC( ze3t(:,:,:) ) 455 ijk_min(1) = mig0_oldcmp(ijk_min(1))456 ijk_min(2) = mjg0_oldcmp(ijk_min(2))470 ijk_min(1) = ijk_min(1) + nimpp - 1 471 ijk_min(2) = ijk_min(2) + njmpp - 1 457 472 ENDIF 458 473 IF (lwp) THEN … … 792 807 ! ! =============== 793 808 IF( ln_rstart ) THEN !* Read the restart file 794 CALL rst_read_open ! open the restart file if necessary 795 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 796 ! 797 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 798 id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 799 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 800 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 801 id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 802 ! 809 #if defined key_agrif 810 IF ( (.NOT.Agrif_root()).AND.(ln_init_chfrpar) ) THEN 811 ! skip reading restart if initialized from parent: 812 id1 = -1 ; id2 = -1 ; id3 = -1 ; id4 = -1 ; id5 = -1 813 ELSE 814 #endif 815 CALL rst_read_open ! open the restart file if necessary 816 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 817 ! 818 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 819 id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 820 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 821 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 822 id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 823 #if defined key_agrif 824 ENDIF 825 #endif 803 826 ! ! --------- ! 804 827 ! ! all cases ! … … 837 860 DO jk = 1, jpk 838 861 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 839 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) &840 & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk))862 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 863 & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk)) 841 864 END DO 842 865 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) … … 911 934 ELSE 912 935 ! 913 ! usr_def_istate called here only to get ssh(Kbb) needed to initialize e3t(Kbb) and e3t(Kmm) 914 ! 915 CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 916 ! 917 ! usr_def_istate will be called again in istate_init to initialize ts, ssh, u and v 936 ! Just to read set ssh in fact, called latter once vertical grid 937 ! is set up: 938 CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 918 939 ! 919 940 DO jk=1,jpk 920 941 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 921 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)&922 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) ! make sure e3t(:,:,:,Kbb) != 0 on land points942 & / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) & 943 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 923 944 END DO 924 945 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 925 ssh(:,:,Kmm) = ssh(:,:,Kbb) ! needed later for gde3w 946 ! ssh(:,:,Kmm)=0._wp 947 ! e3t(:,:,:,Kmm)=e3t_0(:,:,:) 948 ! e3t(:,:,:,Kbb)=e3t_0(:,:,:) 926 949 ! 927 950 END IF ! end of ll_wd edits … … 933 956 END IF 934 957 ENDIF 958 959 #if defined key_agrif 960 IF ( .NOT.Agrif_root().AND.(ln_init_chfrpar) ) THEN 961 ! Interpolate initial ssh from parent: 962 CALL Agrif_istate_ssh( Kbb, Kmm ) 963 ! 964 DO jk = 1, jpk 965 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 966 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 967 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 968 END DO 969 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 970 ENDIF 971 #endif 935 972 ! 936 973 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file … … 1030 1067 END SUBROUTINE dom_vvl_ctl 1031 1068 1069 #endif 1070 1032 1071 !!====================================================================== 1033 1072 END MODULE domvvl
Note: See TracChangeset
for help on using the changeset viewer.
