- Timestamp:
- 2020-06-24T14:38:26+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/DOM/domvvl.F90
r12489 r13151 2 2 !!====================================================================== 3 3 !! *** MODULE domvvl *** 4 !! Ocean : 4 !! Ocean : 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2006-06 (B. Levier, L. Marie) original code … … 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 … … 35 28 IMPLICIT NONE 36 29 PRIVATE 37 38 PUBLIC dom_vvl_init ! called by domain.F90 39 PUBLIC dom_vvl_zgr ! called by isfcpl.F90 40 PUBLIC dom_vvl_sf_nxt ! called by step.F90 41 PUBLIC dom_vvl_sf_update ! called by step.F90 42 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 43 30 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" … … 98 109 !!---------------------------------------------------------------------- 99 110 !! *** ROUTINE dom_vvl_init *** 100 !! 111 !! 101 112 !! ** Purpose : Initialization of all scale factors, depths 102 113 !! and water column heights … … 107 118 !! ** Action : - e3t_(n/b) and tilde_e3t_(n/b) 108 119 !! - Regrid: e3[u/v](:,:,:,Kmm) 109 !! e3[u/v](:,:,:,Kmm) 110 !! e3w(:,:,:,Kmm) 120 !! e3[u/v](:,:,:,Kmm) 121 !! e3w(:,:,:,Kmm) 111 122 !! e3[u/v]w_b 112 !! e3[u/v]w_n 123 !! e3[u/v]w_n 113 124 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 114 125 !! - h(t/u/v)_0 … … 135 146 ! 136 147 END SUBROUTINE dom_vvl_init 137 ! 148 149 138 150 SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 139 151 !!---------------------------------------------------------------------- 140 152 !! *** ROUTINE dom_vvl_init *** 141 !! 142 !! ** Purpose : Interpolation of all scale factors, 153 !! 154 !! ** Purpose : Interpolation of all scale factors, 143 155 !! depths and water column heights 144 156 !! … … 147 159 !! ** Action : - e3t_(n/b) and tilde_e3t_(n/b) 148 160 !! - Regrid: e3(u/v)_n 149 !! e3(u/v)_b 150 !! e3w_n 151 !! e3(u/v)w_b 152 !! e3(u/v)w_n 161 !! e3(u/v)_b 162 !! e3w_n 163 !! e3(u/v)w_b 164 !! e3(u/v)w_n 153 165 !! gdept_n, gdepw_n and gde3w_n 154 166 !! - h(t/u/v)_0 … … 168 180 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) ! from T to U 169 181 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 170 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) ! from T to V 182 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) ! from T to V 171 183 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 172 184 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) ! from U to F 173 ! ! Vertical interpolation of e3t,u,v 185 ! ! Vertical interpolation of e3t,u,v 174 186 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) ! from T to W 175 187 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3w (:,:,:,Kbb), 'W' ) … … 193 205 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 194 206 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 195 ! ! 0.5 where jk = mikt 207 ! ! 0.5 where jk = mikt 196 208 !!gm ??????? BUG ? gdept(:,:,:,Kmm) as well as gde3w does not include the thickness of ISF ?? 197 209 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 198 210 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 199 211 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 200 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 212 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 201 213 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 202 214 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 203 215 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 204 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 216 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 205 217 END_3D 206 218 ! … … 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 = 111 264 ij0 = 128 ; ij1 = 135 ; 275 ii0 = 103 ; ii1 = 111 276 ij0 = 128 ; ij1 = 135 ; 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 … … 280 292 CALL iom_set_rstw_var_active('tilde_e3t_n') 281 293 END IF 282 ! ! -------------! 294 ! ! -------------! 283 295 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 284 296 ! ! ------------ ! … … 291 303 292 304 293 SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 305 SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 294 306 !!---------------------------------------------------------------------- 295 307 !! *** ROUTINE dom_vvl_sf_nxt *** 296 !! 308 !! 297 309 !! ** Purpose : - compute the after scale factors used in tra_zdf, dynnxt, 298 310 !! tranxt and dynspg routines 299 311 !! 300 312 !! ** Method : - z_star case: Repartition of ssh INCREMENT proportionnaly to the level thickness. 301 !! - z_tilde_case: after scale factor increment = 313 !! - z_tilde_case: after scale factor increment = 302 314 !! high frequency part of horizontal divergence 303 315 !! + retsoring towards the background grid … … 307 319 !! 308 320 !! ** Action : - hdiv_lf : restoring towards full baroclinic divergence in z_tilde case 309 !! - tilde_e3t_a: after increment of vertical scale factor 321 !! - tilde_e3t_a: after increment of vertical scale factor 310 322 !! in z_tilde case 311 323 !! - e3(t/u/v)_a … … 410 422 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 411 423 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 412 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 424 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 413 425 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 414 426 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) … … 460 472 WRITE(numout, *) 'at i, j, k=', ijk_max 461 473 WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 462 WRITE(numout, *) 'at i, j, k=', ijk_min 474 WRITE(numout, *) 'at i, j, k=', ijk_min 463 475 CALL ctl_stop( 'STOP', 'MAX( ABS( tilde_e3t_a(:,:,: ) ) / e3t_0(:,:,:) ) too high') 464 476 ENDIF … … 575 587 !!---------------------------------------------------------------------- 576 588 !! *** ROUTINE dom_vvl_sf_update *** 577 !! 578 !! ** Purpose : for z tilde case: compute time filter and swap of scale factors 589 !! 590 !! ** Purpose : for z tilde case: compute time filter and swap of scale factors 579 591 !! compute all depths and related variables for next time step 580 592 !! write outputs and restart file … … 586 598 !! ** Action : - tilde_e3t_(b/n) ready for next time step 587 599 !! - Recompute: 588 !! e3(u/v)_b 589 !! e3w(:,:,:,Kmm) 590 !! e3(u/v)w_b 591 !! e3(u/v)w_n 600 !! e3(u/v)_b 601 !! e3w(:,:,:,Kmm) 602 !! e3(u/v)w_b 603 !! e3(u/v)w_n 592 604 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 593 605 !! h(u/v) and h(u/v)r … … 620 632 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 621 633 ELSE 622 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 634 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 623 635 & + rn_atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 624 636 ENDIF … … 632 644 ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 633 645 ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 634 646 635 647 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 636 648 637 649 ! Vertical scale factor interpolations 638 650 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w(:,:,:,Kmm), 'W' ) … … 653 665 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 654 666 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 655 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 667 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 656 668 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 657 669 END_3D … … 772 784 !!--------------------------------------------------------------------- 773 785 !! *** ROUTINE dom_vvl_rst *** 774 !! 786 !! 775 787 !! ** Purpose : Read or write VVL file in restart file 776 788 !! … … 789 801 !!---------------------------------------------------------------------- 790 802 ! 791 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 803 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 792 804 ! ! =============== 793 805 IF( ln_rstart ) THEN !* Read the restart file … … 808 820 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 809 821 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 810 ! needed to restart if land processor not computed 822 ! needed to restart if land processor not computed 811 823 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 812 WHERE ( tmask(:,:,:) == 0.0_wp ) 824 WHERE ( tmask(:,:,:) == 0.0_wp ) 813 825 e3t(:,:,:,Kmm) = e3t_0(:,:,:) 814 826 e3t(:,:,:,Kbb) = e3t_0(:,:,:) … … 873 885 ! 874 886 875 IF( ll_wd ) THEN ! MJB ll_wd edits start here - these are essential 887 IF( ll_wd ) THEN ! MJB ll_wd edits start here - these are essential 876 888 ! 877 889 IF( cn_cfg == 'wad' ) THEN … … 908 920 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 909 921 ENDIF 910 END DO 911 END DO 922 END DO 923 END DO 912 924 ! 913 925 ELSE … … 950 962 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 951 963 END IF 952 ! ! -------------! 964 ! ! -------------! 953 965 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 954 966 ! ! ------------ ! … … 965 977 !!--------------------------------------------------------------------- 966 978 !! *** ROUTINE dom_vvl_ctl *** 967 !! 979 !! 968 980 !! ** Purpose : Control the consistency between namelist options 969 981 !! for vertical coordinate … … 974 986 & ln_vvl_zstar_at_eqtor , rn_ahe3 , rn_rst_e3t , & 975 987 & rn_lf_cutoff , rn_zdef_max , ln_vvl_dbg ! not yet implemented: ln_vvl_kepe 976 !!---------------------------------------------------------------------- 988 !!---------------------------------------------------------------------- 977 989 ! 978 990 READ ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901) … … 1031 1043 END SUBROUTINE dom_vvl_ctl 1032 1044 1045 #endif 1046 1033 1047 !!====================================================================== 1034 1048 END MODULE domvvl
Note: See TracChangeset
for help on using the changeset viewer.
