- Timestamp:
- 2020-12-03T20:14:08+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13787_doc_latex_recovery
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DOM/domqco.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13787_doc_latex_recovery
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette @13559sette10 ^/utils/CI/sette_wave@13990 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13787_doc_latex_recovery/src/OCE/DOM/domqco.F90
r13295 r14066 8 8 !! 3.3 ! 2011-10 (M. Leclair) totally rewrote domvvl: vvl option includes z_star and z_tilde coordinates 9 9 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 10 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping11 !! 4.x ! 2020-02 (G. Madec, S. Techene) pure z* (quasi-eulerian) coordinate12 !!---------------------------------------------------------------------- 13 14 !!---------------------------------------------------------------------- 15 !! dom_q e_init: define initial vertical scale factors, depths and column thickness16 !! dom_q e_r3c : Compute ssh/h_0 ratioat t-, u-, v-, and optionally f-points17 !! qe_rst_read : read/write restart file18 !! dom_qe_ctl: Check the vvl options10 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) add time level indices for prognostic variables 11 !! - ! 2020-02 (S. Techene, G. Madec) quasi-eulerian coordinate (z* or s*) 12 !!---------------------------------------------------------------------- 13 14 !!---------------------------------------------------------------------- 15 !! dom_qco_init : define initial vertical scale factors, depths and column thickness 16 !! dom_qco_zgr : Set ssh/h_0 ratio at t 17 !! dom_qco_r3c : Compute ssh/h_0 ratio at t-, u-, v-, and optionally f-points 18 !! qco_ctl : Check the vvl options 19 19 !!---------------------------------------------------------------------- 20 20 USE oce ! ocean dynamics and tracers … … 55 55 LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE. ! debug control prints 56 56 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td ! thickness diffusion transport58 59 57 !! * Substitutions 60 58 # include "do_loop_substitute.h90" … … 79 77 !! 80 78 !!---------------------------------------------------------------------- 81 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 79 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! time level indices 80 !!---------------------------------------------------------------------- 82 81 ! 83 82 IF(lwp) WRITE(numout,*) … … 85 84 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 86 85 ! 87 CALL dom_qco_ctl! choose vertical coordinate (z_star, z_tilde or layer)88 ! 89 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf90 CALL qe_rst_read( nit000, Kbb, Kmm )91 ! 92 CALL dom_qco_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column93 ! 94 ! IF(lwxios) THEN ! define variables in restart file when writing with XIOS95 ! CALL iom_set_rstw_var_active('e3t_b')96 ! CALL iom_set_rstw_var_active('e3t_n')97 ! ENDIF 86 CALL qco_ctl ! choose vertical coordinate (z_star, z_tilde or layer) 87 ! 88 CALL dom_qco_zgr( Kbb, Kmm ) ! interpolation scale factor, depth and water column 89 ! 90 #if defined key_agrif 91 ! We need to define r3[tuv](Kaa) for AGRIF initialisation (should not be a 92 ! problem for the restartability...) 93 r3t(:,:,Kaa) = r3t(:,:,Kmm) 94 r3u(:,:,Kaa) = r3u(:,:,Kmm) 95 r3v(:,:,Kaa) = r3v(:,:,Kmm) 96 #endif 98 97 ! 99 98 END SUBROUTINE dom_qco_init 100 99 101 100 102 SUBROUTINE dom_qco_zgr( Kbb, Kmm, Kaa)101 SUBROUTINE dom_qco_zgr( Kbb, Kmm ) 103 102 !!---------------------------------------------------------------------- 104 103 !! *** ROUTINE dom_qco_init *** 105 104 !! 106 !! ** Purpose : Initialization of all ssh. to h._0 ratio 107 !! 108 !! ** Method : - interpolate scale factors 109 !! 110 !! ** Action : - r3(t/u/v)_b 111 !! - r3(t/u/v/f)_n 112 !! 113 !! Reference : Leclair, M., and G. Madec, 2011, Ocean Modelling. 114 !!---------------------------------------------------------------------- 115 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 105 !! ** Purpose : Initialization of all r3. = ssh./h._0 ratios 106 !! 107 !! ** Method : Call domqco using Kbb and Kmm 108 !! NB: dom_qco_zgr is called by dom_qco_init it uses ssh from ssh_init 109 !! 110 !! ** Action : - r3(t/u/v)(Kbb) 111 !! - r3(t/u/v/f)(Kmm) 112 !!---------------------------------------------------------------------- 113 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 116 114 !!---------------------------------------------------------------------- 117 115 ! 118 116 ! !== Set of all other vertical scale factors ==! (now and before) 119 117 ! ! Horizontal interpolation of e3t 120 CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) )118 CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 121 119 CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 122 120 ! … … 148 146 ! !== ratio at u-,v-point ==! 149 147 ! 150 IF( ln_dynadv_vec ) THEN !- Vector Form (thickness weighted averaging) 148 !!st IF( ln_dynadv_vec ) THEN !- Vector Form (thickness weighted averaging) 149 #if ! defined key_qcoTest_FluxForm 150 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 151 151 DO_2D( 0, 0, 0, 0 ) 152 152 pr3u(ji,jj) = 0.5_wp * ( e1e2t(ji ,jj) * pssh(ji ,jj) & … … 155 155 & + e1e2t(ji,jj+1) * pssh(ji,jj+1) ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) 156 156 END_2D 157 ELSE !- Flux Form (simple averaging) 157 !!st ELSE !- Flux Form (simple averaging) 158 #else 158 159 DO_2D( 0, 0, 0, 0 ) 159 pr3u(ji,jj) = 0.5_wp * ( pssh(ji ,jj) + pssh(ji+1,jj) ) * r1_hu_0(ji,jj)160 pr3v(ji,jj) = 0.5_wp * ( pssh(ji,jj ) + pssh(ji,jj+1) ) * r1_hv_0(ji,jj)160 pr3u(ji,jj) = 0.5_wp * ( pssh(ji,jj) + pssh(ji+1,jj ) ) * r1_hu_0(ji,jj) 161 pr3v(ji,jj) = 0.5_wp * ( pssh(ji,jj) + pssh(ji ,jj+1) ) * r1_hv_0(ji,jj) 161 162 END_2D 162 ENDIF 163 !!st ENDIF 164 #endif 163 165 ! 164 166 IF( .NOT.PRESENT( pr3f ) ) THEN !- lbc on ratio at u-, v-points only … … 168 170 ELSE !== ratio at f-point ==! 169 171 ! 170 IF( ln_dynadv_vec ) THEN !- Vector Form (thickness weighted averaging) 171 DO_2D( 1, 0, 1, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 172 !!st IF( ln_dynadv_vec ) THEN !- Vector Form (thickness weighted averaging) 173 #if ! defined key_qcoTest_FluxForm 174 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 175 176 DO_2D( 0, 0, 0, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 172 177 pr3f(ji,jj) = 0.25_wp * ( e1e2t(ji ,jj ) * pssh(ji ,jj ) & 173 178 & + e1e2t(ji+1,jj ) * pssh(ji+1,jj ) & … … 175 180 & + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1) ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 176 181 END_2D 177 ELSE !- Flux Form (simple averaging) 178 DO_2D( 1, 0, 1, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 179 pr3f(ji,jj) = 0.25_wp * ( pssh(ji ,jj ) + pssh(ji+1,jj ) & 180 & + pssh(ji ,jj+1) + pssh(ji+1,jj+1) ) * r1_hf_0(ji,jj) 182 !!st ELSE !- Flux Form (simple averaging) 183 #else 184 DO_2D( 0, 0, 0, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 185 pr3f(ji,jj) = 0.25_wp * ( pssh(ji,jj ) + pssh(ji+1,jj ) & 186 & + pssh(ji,jj+1) + pssh(ji+1,jj+1) ) * r1_hf_0(ji,jj) 181 187 END_2D 182 ENDIF 188 !!st ENDIF 189 #endif 183 190 ! ! lbc on ratio at u-,v-,f-points 184 191 CALL lbc_lnk_multi( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) … … 189 196 190 197 191 SUBROUTINE q e_rst_read( kt, Kbb, Kmm )198 SUBROUTINE qco_ctl 192 199 !!--------------------------------------------------------------------- 193 !! *** ROUTINE qe_rst_read *** 194 !! 195 !! ** Purpose : Read ssh in restart file 196 !! 197 !! ** Method : use of IOM library 198 !! if the restart does not contain ssh, 199 !! it is set to the _0 values. 200 !!---------------------------------------------------------------------- 201 INTEGER , INTENT(in) :: kt ! ocean time-step 202 INTEGER , INTENT(in) :: Kbb, Kmm ! ocean time level indices 203 ! 204 INTEGER :: ji, jj, jk 205 INTEGER :: id1, id2 ! local integers 206 !!---------------------------------------------------------------------- 207 ! 208 IF( ln_rstart ) THEN !* Read the restart file 209 CALL rst_read_open ! open the restart file if necessary 210 ! 211 id1 = iom_varid( numror, 'sshb', ldstop = .FALSE. ) 212 id2 = iom_varid( numror, 'sshn', ldstop = .FALSE. ) 213 ! 214 ! ! --------- ! 215 ! ! all cases ! 216 ! ! --------- ! 217 ! 218 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 219 CALL iom_get( numror, jpdom_auto, 'sshb' , ssh(:,:,Kbb), ldxios = lrxios ) 220 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 221 ! needed to restart if land processor not computed 222 IF(lwp) write(numout,*) 'qe_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files' 223 WHERE ( ssmask(:,:) == 0.0_wp ) !!gm/st ==> sm should not be necessary on ssh when it was required on e3 224 ssh(:,:,Kmm) = 0._wp 225 ssh(:,:,Kbb) = 0._wp 226 END WHERE 227 IF( l_1st_euler ) THEN 228 ssh(:,:,Kbb) = ssh(:,:,Kmm) 229 ENDIF 230 ELSE IF( id1 > 0 ) THEN 231 IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart files' 232 IF(lwp) write(numout,*) 'sshn set equal to sshb.' 233 IF(lwp) write(numout,*) 'neuler is forced to 0' 234 CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb), ldxios = lrxios ) 235 ssh(:,:,Kmm) = ssh(:,:,Kbb) 236 l_1st_euler = .TRUE. 237 ELSE IF( id2 > 0 ) THEN 238 IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kbb) not found in restart files' 239 IF(lwp) write(numout,*) 'sshb set equal to sshn.' 240 IF(lwp) write(numout,*) 'neuler is forced to 0' 241 CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm), ldxios = lrxios ) 242 ssh(:,:,Kbb) = ssh(:,:,Kmm) 243 l_1st_euler = .TRUE. 244 ELSE 245 IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart file' 246 IF(lwp) write(numout,*) 'ssh_b and ssh_n set to zero' 247 IF(lwp) write(numout,*) 'neuler is forced to 0' 248 ssh(:,:,:) = 0._wp 249 l_1st_euler = .TRUE. 250 ENDIF 251 ! 252 ELSE !* Initialize at "rest" 253 ! 254 IF( ll_wd ) THEN ! MJB ll_wd edits start here - these are essential 255 ! 256 IF( cn_cfg == 'wad' ) THEN ! Wetting and drying test case 257 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 258 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 259 ssh(:,: ,Kmm) = ssh(:,: ,Kbb) 260 uu (:,:,: ,Kmm) = uu (:,:,: ,Kbb) 261 vv (:,:,: ,Kmm) = vv (:,:,: ,Kbb) 262 ELSE ! if not test case 263 ssh(:,:,Kmm) = -ssh_ref 264 ssh(:,:,Kbb) = -ssh_ref 265 ! 266 DO_2D( 1, 1, 1, 1 ) 267 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 268 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 269 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 270 ENDIF 271 END_2D 272 ENDIF 273 274 DO ji = 1, jpi 275 DO jj = 1, jpj 276 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 277 CALL ctl_stop( 'qe_rst_read: ht_0 must be positive at potentially wet points' ) 278 ENDIF 279 END DO 280 END DO 281 ! 282 ELSE 283 ! 284 ! Just to read set ssh in fact, called latter once vertical grid 285 ! is set up: 286 ! CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 287 ! ! 288 ssh(:,:,:) = 0._wp 289 ! 290 ENDIF ! end of ll_wd edits 291 ! 292 ENDIF 293 ! 294 END SUBROUTINE qe_rst_read 295 296 297 SUBROUTINE dom_qco_ctl 298 !!--------------------------------------------------------------------- 299 !! *** ROUTINE dom_qco_ctl *** 200 !! *** ROUTINE qco_ctl *** 300 201 !! 301 202 !! ** Purpose : Control the consistency between namelist options … … 317 218 IF(lwp) THEN ! Namelist print 318 219 WRITE(numout,*) 319 WRITE(numout,*) ' dom_qco_ctl : choice/control of the variable vertical coordinate'320 WRITE(numout,*) '~~~~~~~~ ~~~'220 WRITE(numout,*) 'qco_ctl : choice/control of the variable vertical coordinate' 221 WRITE(numout,*) '~~~~~~~~' 321 222 WRITE(numout,*) ' Namelist nam_vvl : chose a vertical coordinate' 322 223 WRITE(numout,*) ' zstar ln_vvl_zstar = ', ln_vvl_zstar … … 362 263 #endif 363 264 ! 364 END SUBROUTINE dom_qco_ctl265 END SUBROUTINE qco_ctl 365 266 366 267 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
