Changeset 14072 for NEMO/trunk/src/OCE/DOM/domvvl.F90
- Timestamp:
- 2020-12-04T08:48:38+01:00 (4 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/DOM/domvvl.F90 (modified) (27 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DOM/domvvl.F90
r14053 r14072 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 … … 58 58 !! Default key Old management of time varying vertical coordinate 59 59 !!---------------------------------------------------------------------- 60 60 61 61 !!---------------------------------------------------------------------- 62 62 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness … … 73 73 PUBLIC dom_vvl_sf_update ! called by step.F90 74 74 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 75 75 76 76 !! * Substitutions 77 77 # include "do_loop_substitute.h90" … … 109 109 !!---------------------------------------------------------------------- 110 110 !! *** ROUTINE dom_vvl_init *** 111 !! 111 !! 112 112 !! ** Purpose : Initialization of all scale factors, depths 113 113 !! and water column heights … … 118 118 !! ** Action : - e3t_(n/b) and tilde_e3t_(n/b) 119 119 !! - Regrid: e3[u/v](:,:,:,Kmm) 120 !! e3[u/v](:,:,:,Kmm) 121 !! e3w(:,:,:,Kmm) 120 !! e3[u/v](:,:,:,Kmm) 121 !! e3w(:,:,:,Kmm) 122 122 !! e3[u/v]w_b 123 !! e3[u/v]w_n 123 !! e3[u/v]w_n 124 124 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 125 125 !! - h(t/u/v)_0 … … 151 151 !!---------------------------------------------------------------------- 152 152 !! *** ROUTINE dom_vvl_init *** 153 !! 154 !! ** Purpose : Interpolation of all scale factors, 153 !! 154 !! ** Purpose : Interpolation of all scale factors, 155 155 !! depths and water column heights 156 156 !! … … 159 159 !! ** Action : - e3t_(n/b) and tilde_e3t_(n/b) 160 160 !! - Regrid: e3(u/v)_n 161 !! e3(u/v)_b 162 !! e3w_n 163 !! e3(u/v)w_b 164 !! 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 165 165 !! gdept_n, gdepw_n and gde3w_n 166 166 !! - h(t/u/v)_0 … … 180 180 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) ! from T to U 181 181 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 182 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 183 183 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 184 184 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) ! from U to F 185 ! ! Vertical interpolation of e3t,u,v 185 ! ! Vertical interpolation of e3t,u,v 186 186 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) ! from T to W 187 187 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3w (:,:,:,Kbb), 'W' ) … … 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) 207 ! ! 0.5 where jk = mikt 207 ! ! 0.5 where jk = mikt 208 208 !!gm ??????? BUG ? gdept(:,:,:,Kmm) as well as gde3w does not include the thickness of ISF ?? 209 209 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 210 210 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 211 211 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 212 & + (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)) 213 213 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 214 214 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 215 215 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 216 & + (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)) 217 217 END_3D 218 218 ! … … 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 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1 275 ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1 276 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 … … 285 285 286 286 287 SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 287 SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 288 288 !!---------------------------------------------------------------------- 289 289 !! *** ROUTINE dom_vvl_sf_nxt *** 290 !! 290 !! 291 291 !! ** Purpose : - compute the after scale factors used in tra_zdf, dynnxt, 292 292 !! tranxt and dynspg routines 293 293 !! 294 294 !! ** Method : - z_star case: Repartition of ssh INCREMENT proportionnaly to the level thickness. 295 !! - z_tilde_case: after scale factor increment = 295 !! - z_tilde_case: after scale factor increment = 296 296 !! high frequency part of horizontal divergence 297 297 !! + retsoring towards the background grid … … 301 301 !! 302 302 !! ** Action : - hdiv_lf : restoring towards full baroclinic divergence in z_tilde case 303 !! - tilde_e3t_a: after increment of vertical scale factor 303 !! - tilde_e3t_a: after increment of vertical scale factor 304 304 !! in z_tilde case 305 305 !! - e3(t/u/v)_a … … 405 405 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 406 406 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 407 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 407 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 408 408 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 409 409 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) … … 450 450 WRITE(numout, *) 'at i, j, k=', ijk_max 451 451 WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 452 WRITE(numout, *) 'at i, j, k=', ijk_min 452 WRITE(numout, *) 'at i, j, k=', ijk_min 453 453 CALL ctl_stop( 'STOP', 'MAX( ABS( tilde_e3t_a(:,:,: ) ) / e3t_0(:,:,:) ) too high') 454 454 ENDIF … … 566 566 !!---------------------------------------------------------------------- 567 567 !! *** ROUTINE dom_vvl_sf_update *** 568 !! 569 !! ** Purpose : for z tilde case: compute time filter and swap of scale factors 568 !! 569 !! ** Purpose : for z tilde case: compute time filter and swap of scale factors 570 570 !! compute all depths and related variables for next time step 571 571 !! write outputs and restart file … … 577 577 !! ** Action : - tilde_e3t_(b/n) ready for next time step 578 578 !! - Recompute: 579 !! e3(u/v)_b 580 !! e3w(:,:,:,Kmm) 581 !! e3(u/v)w_b 582 !! e3(u/v)w_n 579 !! e3(u/v)_b 580 !! e3w(:,:,:,Kmm) 581 !! e3(u/v)w_b 582 !! e3(u/v)w_n 583 583 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 584 584 !! h(u/v) and h(u/v)r … … 611 611 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 612 612 ELSE 613 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 613 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 614 614 & + rn_atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 615 615 ENDIF … … 623 623 ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 624 624 ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 625 625 626 626 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 627 627 628 628 ! Vertical scale factor interpolations 629 629 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w(:,:,:,Kmm), 'W' ) … … 644 644 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 645 645 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 646 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 646 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 647 647 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 648 648 END_3D … … 763 763 !!--------------------------------------------------------------------- 764 764 !! *** ROUTINE dom_vvl_rst *** 765 !! 765 !! 766 766 !! ** Purpose : Read or write VVL file in restart file 767 767 !! … … 807 807 IF(lwp) WRITE(numout,*) ' Kmm scale factor read in the restart file' 808 808 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 809 WHERE ( tmask(:,:,:) == 0.0_wp ) 809 WHERE ( tmask(:,:,:) == 0.0_wp ) 810 810 e3t(:,:,:,Kmm) = e3t_0(:,:,:) 811 811 END WHERE … … 816 816 IF(lwp) WRITE(numout,*) ' Kbb scale factor read in the restart file' 817 817 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 818 WHERE ( tmask(:,:,:) == 0.0_wp ) 818 WHERE ( tmask(:,:,:) == 0.0_wp ) 819 819 e3t(:,:,:,Kbb) = e3t_0(:,:,:) 820 820 END WHERE … … 840 840 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 841 841 ENDIF 842 ELSE 842 ELSE 843 843 tilde_e3t_b(:,:,:) = 0.0_wp 844 844 tilde_e3t_n(:,:,:) = 0.0_wp … … 850 850 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 851 851 ELSE ! array is missing 852 hdiv_lf(:,:,:) = 0.0_wp 852 hdiv_lf(:,:,:) = 0.0_wp 853 853 ENDIF 854 854 ENDIF … … 884 884 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 885 885 END IF 886 ! ! -------------! 886 ! ! -------------! 887 887 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 888 888 ! ! ------------ ! … … 898 898 !!--------------------------------------------------------------------- 899 899 !! *** ROUTINE dom_vvl_ctl *** 900 !! 900 !! 901 901 !! ** Purpose : Control the consistency between namelist options 902 902 !! for vertical coordinate … … 907 907 & ln_vvl_zstar_at_eqtor , rn_ahe3 , rn_rst_e3t , & 908 908 & rn_lf_cutoff , rn_zdef_max , ln_vvl_dbg ! not yet implemented: ln_vvl_kepe 909 !!---------------------------------------------------------------------- 909 !!---------------------------------------------------------------------- 910 910 ! 911 911 READ ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901)
Note: See TracChangeset
for help on using the changeset viewer.
