Changeset 10023 for NEMO/branches/2018
- Timestamp:
- 2018-08-02T08:19:03+02:00 (6 years ago)
- Location:
- NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE
- Files:
-
- 17 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/dom_oce.F90
r10001 r10023 127 127 LOGICAL, PUBLIC :: ln_sco !: s-coordinate or hybrid z-s coordinate 128 128 LOGICAL, PUBLIC :: ln_isfcav !: presence of ISF 129 130 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e3t, e3u, e3v, e3w !: t-, u-, v-, w-points vertical scale factors [m] 131 129 132 ! ! ref. ! before ! now ! after ! 130 133 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_0 , e3t_b , e3t_n , e3t_a !: t- vert. scale factor [m] 131 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_0 , e3u_b , e3u_n , e3u_a !: u- vert. scale factor [m] 132 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 133 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f_0 , e3f_n !: f- vert. scale factor [m] 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_0 , e3w_b , e3w_n !: w- vert. scale factor [m] 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_0 , e3w_b , e3w_n , e3w_a !: w- vert. scale factor [m] 135 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_0 , e3uw_b , e3uw_n !: uw-vert. scale factor [m] 136 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 , e3vw_b , e3vw_n !: vw-vert. scale factor [m] 139 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f_0 , e3f_n !: f- vert. scale factor [m] 137 140 138 141 ! ! ref. ! before ! now ! … … 171 174 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_h !: internal domain T-point mask (Figure 8.5 NEMO book) 172 175 173 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: misfdep !: top first ocean level (ISF)174 176 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF) 175 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfdep!: Iceshelf draft (ISF)177 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_isf !: Iceshelf draft (ISF) 176 178 177 179 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask !: surface mask at T-,U-, V- and F-pts … … 264 266 & e3t_b(jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk) , e3w_b(jpi,jpj,jpk) , & 265 267 & e3t_n(jpi,jpj,jpk) , e3u_n(jpi,jpj,jpk) , e3v_n(jpi,jpj,jpk) , e3f_n(jpi,jpj,jpk) , e3w_n(jpi,jpj,jpk) , & 266 & e3t_a(jpi,jpj,jpk) , e3u_a(jpi,jpj,jpk) , e3v_a(jpi,jpj,jpk) , & 268 & e3t_a(jpi,jpj,jpk) , e3u_a(jpi,jpj,jpk) , e3v_a(jpi,jpj,jpk) , e3w_a(jpi,jpj,jpk) , & 269 ! 270 & e3t(jpi,jpj,jpk,Nt) , e3u(jpi,jpj,jpk,Nt) , e3v(jpi,jpj,jpk,Nt) , & 267 271 ! ! 268 272 & e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , & … … 282 286 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , STAT=ierr(9) ) 283 287 ! 284 ALLOCATE( misfdep(jpi,jpj) , mikt(jpi,jpj) , miku(jpi,jpj) , &285 & risfdep(jpi,jpj) ,mikv(jpi,jpj) , mikf(jpi,jpj) , STAT=ierr(10) )288 ALLOCATE( ht_isf(jpi,jpj) , mikt(jpi,jpj) , miku(jpi,jpj) , & 289 & mikv(jpi,jpj) , mikf(jpi,jpj) , STAT=ierr(10) ) 286 290 ! 287 291 ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) , & -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domain.F90
r10009 r10023 141 141 DO ji = 1, jpi 142 142 ik = mikt(ji,jj) 143 risfdep(ji,jj) = gdepw_0(ji,jj,ik) !!gm RENAME it as h_isf(:,:) better no?143 ht_isf(ji,jj) = gdepw_0(ji,jj,ik) 144 144 END DO 145 145 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domvvl.F90
r10009 r10023 9 9 ! 1- remove z-tilde ==>>> pure z-star (or s-star) 10 10 ! 2- remove dom_vvl_interpol 11 ! 3- 11 12 12 13 !!---------------------------------------------------------------------- … … 142 143 ! !* BEFORE fields : 143 144 CALL ssh2e3_before ! set: hu , hv , r1_hu, r1_hv 144 ! ! e3t, e3w, e3u, e3uw, e3v, e3vw (from 1 to jpkm1) 145 ! ! e3t, e3u , e3v (from 1 to jpkm1) 146 ! ! e3w, e3uw, e3vw (from 1 to jpk ) 147 ! ! gdept, gdepw (from 1 to jpk ) 145 148 ! 146 149 ! ! set jpk level one to the e3._0 values 147 e3t_b(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_b(:,:,jpk) = e3w_0(:,:,jpk) ; e3v_b(:,:,jpk) = e3v_0(:,:,jpk) 148 e3w_b(:,:,jpk) = e3w_0(:,:,jpk) ; e3uw_b(:,:,jpk) = e3uw_0(:,:,jpk) ; e3vw_b(:,:,jpk) = e3vw_0(:,:,jpk) 150 e3t_b(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_b(:,:,jpk) = e3u_0(:,:,jpk) ; e3v_b(:,:,jpk) = e3v_0(:,:,jpk) 149 151 ! 150 152 ! !* NOW fields : 151 153 CALL ssh2e3_now ! set: ht , hu , hv , r1_hu, r1_hv 152 ! ! e3t, e3 w, e3u, e3uw, e3v, e3vw, e3f(from 1 to jpkm1)153 ! ! gdept_n, gdepw_n, gde3w_n154 !!gm issue? gdept_n, gdepw_n, gde3w_n never defined at jpk 154 ! ! e3t, e3u , e3v, e3f (from 1 to jpkm1) 155 ! ! e3w, e3uw, e3vw (from 1 to jpk ) 156 ! ! gdept, gdepw, gde3w (from 1 to jpk ) 155 157 ! 156 158 ! ! set one for all last level to the e3._0 value 157 e3t_n(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_n(:,:,jpk) = e3w_0(:,:,jpk) ; e3v_n(:,:,jpk) = e3v_0(:,:,jpk) 158 e3w_n(:,:,jpk) = e3w_0(:,:,jpk) ; e3uw_n(:,:,jpk) = e3uw_0(:,:,jpk) ; e3vw_n(:,:,jpk) = e3vw_0(:,:,jpk) 159 e3t_n(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_n(:,:,jpk) = e3u_0(:,:,jpk) ; e3v_n(:,:,jpk) = e3v_0(:,:,jpk) 159 160 e3f_n(:,:,jpk) = e3f_0(:,:,jpk) 160 161 ! 161 162 ! !* AFTER fields : (last level for OPA, 3D required for AGRIF initialisation) 162 e3t_a(:,:,:) = e3t_n(:,:,:) ; e3u_a(:,:,:) = e3u_n(:,:,:) ; e3v_a(:,:,:) = e3v_n(:,:,:) 163 e3t_a(:,:,:) = e3t_n(:,:,:) ; e3u_a(:,:,:) = e3u_n(:,:,:) 164 e3w_a(:,:,:) = e3w_n(:,:,:) ; e3v_a(:,:,:) = e3v_n(:,:,:) 163 165 164 166 !!gm … … 207 209 !! 208 210 !! Reference : Leclair, M., and Madec, G. 2011, Ocean Modelling. 211 !! 212 ! ! ref. ! before ! now ! after ! 213 ! e3t_0 , e3t_b , e3t_n , e3t_a !: t- vert. scale factor [m] 214 ! e3u_0 , e3u_b , e3u_n , e3u_a !: u- vert. scale factor [m] 215 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 216 ! e3w_0 , e3w_b , e3w_n , e3w_a !: w- vert. scale factor [m] 217 ! e3uw_0 , e3uw_b , e3uw_n !: uw-vert. scale factor [m] 218 ! e3vw_0 , e3vw_b , e3vw_n !: vw-vert. scale factor [m] 219 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 220 ! 221 ! ! ref. ! before ! now ! 222 ! gdept_0 , gdept_b , gdept_n !: t- depth [m] 223 ! gdepw_0 , gdepw_b , gdepw_n !: w- depth [m] 224 ! gde3w_0 , gde3w_n !: w- depth (sum of e3w) [m] 225 ! 226 ! ! ref. ! before ! now ! after ! 227 ! ht_0 , ht_n !: t-depth [m] 228 ! hu_0 , hu_b , hu_n , hu_a !: u-depth [m] 229 ! hv_0 , hv_b , hv_n , hv_a !: v-depth [m] 230 ! hf_0 !: v-depth [m] 231 ! r1_ht_0 !: inverse of u-depth [1/m] 232 ! r1_hu_0 , r1_hu_b , r1_hu_n , r1_hu_a !: inverse of u-depth [1/m] 233 ! r1_hv_0 , r1_hv_b , r1_hv_n , r1_hv_a !: inverse of v-depth [1/m] 234 ! r1_hf_0 !: inverse of v-depth [1/m] 235 ! 209 236 !!---------------------------------------------------------------------- 210 237 INTEGER, INTENT( in ) :: kt ! time step … … 230 257 ! 231 258 ! !== after ssh ==! (u- and v-points) 232 DO jj = 2, jpjm1 ; DO ji = 2, jpim1 233 zsshu_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji+1,jj,Naa) ) * ssumask(ji,jj) 234 zsshv_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji,jj+1,Naa) ) * ssvmask(ji,jj) 235 END DO ; END DO 259 DO jj = 2, jpjm1 260 DO ji = 2, jpim1 261 zsshu_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji+1,jj,Naa) ) * ssumask(ji,jj) 262 zsshv_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji,jj+1,Naa) ) * ssvmask(ji,jj) 263 END DO 264 END DO 236 265 CALL lbc_lnk_multi( zsshu_h(:,:), 'U', 1._wp , zsshv_h(:,:), 'V', 1._wp ) 237 266 ! … … 247 276 zsshv_h(:,:) = zsshv_h(:,:) * r1_hv_0(:,:) ! v-point 248 277 DO jk = 1, jpkm1 249 e3t_a(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 250 e3u_a(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 251 e3v_a(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 278 e3t_a(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 279 e3u_a(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 280 e3v_a(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 281 e3w_a(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) ) 252 282 END DO 253 283 ! … … 315 345 gdept_b(:,:,jk) = gdept_n(:,:,jk) ! depth at t and w 316 346 gdepw_b(:,:,jk) = gdepw_n(:,:,jk) 317 e3t_n (:,:,jk) = e3t_a (:,:,jk) ! e3t, e3u, e3v 347 e3t_n (:,:,jk) = e3t_a (:,:,jk) ! e3t, e3u, e3v, e3w 318 348 e3u_n (:,:,jk) = e3u_a (:,:,jk) 319 349 e3v_n (:,:,jk) = e3v_a (:,:,jk) 350 e3w_n (:,:,jk) = e3w_a (:,:,jk) 320 351 END DO 321 352 ht_n(:,:) = ht_0(:,:) + ssh(:,:,Nnn) ! ocean thickness … … 324 355 hv_n(:,:) = hv_a(:,:) ; r1_hv_n(:,:) = r1_hv_a(:,:) 325 356 ! 326 ! !== before :357 ! !== before ==! 327 358 ! !* ssh at u- and v-points) 328 359 DO jj = 2, jpjm1 ; DO ji = 2, jpim1 … … 341 372 e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 342 373 END DO 374 ! 375 zssht_h(:,:) = 1._wp + zssht_h(:,:) !* gdept , gdepw 376 ! 377 IF( ln_isfcav ) THEN ! ISF cavities : ssh scaling not applied over the iceshelf thickness 378 DO jk = 1, jpkm1 379 gdept_b(:,:,jk) = ( gdept_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 380 gdepw_b(:,:,jk) = ( gdepw_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 381 END DO 382 ELSE ! no ISF cavities 383 DO jk = 1, jpkm1 384 gdept_b(:,:,jk) = gdept_0(:,:,jk) * zssht_h(:,:) 385 gdepw_b(:,:,jk) = gdepw_0(:,:,jk) * zssht_h(:,:) 386 END DO 387 ENDIF 343 388 ! 344 ! !== now :389 ! !== now ==! 345 390 ! !* ssh at u- and v-points) 346 391 DO jj = 1, jpjm1 ; DO ji = 1, jpim1 ! start from 1 for f-point … … 358 403 zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:) ! f-point 359 404 DO jk = 1, jpkm1 360 e3w_n(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) )361 405 e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,jk) ) 362 406 e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,jk) ) … … 364 408 END DO 365 409 ! 366 zssht_h(:,:) = 1._wp + zssht_h(:,:) ! t-point410 zssht_h(:,:) = 1._wp + zssht_h(:,:) !* gdept , gdepw , gde3w 367 411 ! 368 412 IF( ln_isfcav ) THEN ! ISF cavities : ssh scaling not applied over the iceshelf thickness 369 413 DO jk = 1, jpkm1 370 gdept_n(:,:,jk) = ( gdept_0(:,:,jk) - risfdep(:,:) ) * zssht_h(:,:) + risfdep(:,:)371 gdepw_n(:,:,jk) = ( gdepw_0(:,:,jk) - risfdep(:,:) ) * zssht_h(:,:) + risfdep(:,:)414 gdept_n(:,:,jk) = ( gdept_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 415 gdepw_n(:,:,jk) = ( gdepw_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 372 416 gde3w_n(:,:,jk) = gdept_n(:,:,jk) - ssh (:,:,Nnn) 373 417 END DO … … 584 628 !!---------------------------------------------------------------------- 585 629 !! *** ROUTINE ssh2e3_now *** 630 ! ! ref. ! before ! now ! after ! 631 ! e3t_0 , e3t_b , e3t_n , e3t_a !: t- vert. scale factor [m] 632 ! e3u_0 , e3u_b , e3u_n , e3u_a !: u- vert. scale factor [m] 633 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 634 ! e3w_0 , e3w_b , e3w_n , e3w_a !: w- vert. scale factor [m] 635 ! e3uw_0 , e3uw_b , e3uw_n !: uw-vert. scale factor [m] 636 ! e3vw_0 , e3vw_b , e3vw_n !: vw-vert. scale factor [m] 637 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 638 ! 639 ! ! ref. ! before ! now ! 640 ! gdept_0 , gdept_b , gdept_n !: t- depth [m] 641 ! gdepw_0 , gdepw_b , gdepw_n !: w- depth [m] 642 ! gde3w_0 , gde3w_n !: w- depth (sum of e3w) [m] 643 ! 644 ! ! ref. ! before ! now ! after ! 645 ! ht_0 , ht_n !: t-depth [m] 646 ! hu_0 , hu_b , hu_n , hu_a !: u-depth [m] 647 ! hv_0 , hv_b , hv_n , hv_a !: v-depth [m] 648 ! hf_0 !: v-depth [m] 649 ! r1_ht_0 !: inverse of u-depth [1/m] 650 ! r1_hu_0 , r1_hu_b , r1_hu_n , r1_hu_a !: inverse of u-depth [1/m] 651 ! r1_hv_0 , r1_hv_b , r1_hv_n , r1_hv_a !: inverse of v-depth [1/m] 652 ! r1_hf_0 !: inverse of v-depth [1/m] 653 ! 586 654 !!---------------------------------------------------------------------- 587 655 INTEGER :: ji, jj, jk … … 616 684 zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:) 617 685 ! 618 ! !== e3t , e3w , e3u, e3uw , e3v, e3vw , ande3f ==!686 ! !== e3t , e3u , e3v , e3f ==! 619 687 ! 620 688 DO jk = 1, jpkm1 621 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 622 e3w_n(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) ) 623 ! 624 e3u_n(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 625 e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,jk) ) 626 ! 627 e3v_n(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 628 e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,jk) ) 629 ! 689 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 690 e3u_n(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 691 e3v_n(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 630 692 e3f_n(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 631 693 END DO 632 694 ! 695 ! !== e3w , e3uw , e3vw ==! 696 ! 697 e3w_n(:,:,1) = e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) * tmask(:,:,1) ) 698 e3uw_n(:,:,1) = e3uw_0(:,:,1) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,1) ) 699 e3vw_n(:,:,1) = e3vw_0(:,:,1) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,1) ) 700 DO jk = 2, jpk 701 e3w_n(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) ) ) 702 e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * MAX( wumask(:,:,jk-1) , wumask(:,:,jk) ) ) 703 e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * MAX( wvmask(:,:,jk-1) , wvmask(:,:,jk) ) ) 704 END DO 705 ! 633 706 ! !== depth of t- and w-points ==! 634 707 ! … … 636 709 ! 637 710 IF( ln_isfcav ) THEN ! ISF cavities : ssh scaling not applied over the iceshelf thickness 638 DO jk = 1, jpk m1639 gdept_n(:,:,jk) = ( gdept_0(:,:,jk) - risfdep(:,:) ) * zssht_h(:,:) + risfdep(:,:)640 gdepw_n(:,:,jk) = ( gdepw_0(:,:,jk) - risfdep(:,:) ) * zssht_h(:,:) + risfdep(:,:)711 DO jk = 1, jpk 712 gdept_n(:,:,jk) = ( gdept_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 713 gdepw_n(:,:,jk) = ( gdepw_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 641 714 gde3w_n(:,:,jk) = gdept_n(:,:,jk) - ssh(:,:,Nnn) 642 715 END DO 643 716 ELSE ! no ISF cavities 644 !!gm BUG ??? gdept should be updated down to the ocean floor ! ===>> jpk NOT jpkm1 !!! 645 DO jk = 1, jpkm1 717 DO jk = 1, jpk 646 718 gdept_n(:,:,jk) = gdept_0(:,:,jk) * zssht_h(:,:) 647 719 gdepw_n(:,:,jk) = gdepw_0(:,:,jk) * zssht_h(:,:) … … 656 728 !!---------------------------------------------------------------------- 657 729 !! *** ROUTINE ssh2e3_before *** 730 ! ! ref. ! before ! now ! after ! 731 ! e3t_0 , e3t_b , e3t_n , e3t_a !: t- vert. scale factor [m] 732 ! e3u_0 , e3u_b , e3u_n , e3u_a !: u- vert. scale factor [m] 733 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 734 ! e3w_0 , e3w_b , e3w_n , e3w_a !: w- vert. scale factor [m] 735 ! e3uw_0 , e3uw_b , e3uw_n !: uw-vert. scale factor [m] 736 ! e3vw_0 , e3vw_b , e3vw_n !: vw-vert. scale factor [m] 737 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 738 ! 739 ! ! ref. ! before ! now ! 740 ! gdept_0 , gdept_b , gdept_n !: t- depth [m] 741 ! gdepw_0 , gdepw_b , gdepw_n !: w- depth [m] 742 ! gde3w_0 , gde3w_n !: w- depth (sum of e3w) [m] 743 ! 744 ! ! ref. ! before ! now ! after ! 745 ! ht_0 , ht_n !: t-depth [m] 746 ! hu_0 , hu_b , hu_n , hu_a !: u-depth [m] 747 ! hv_0 , hv_b , hv_n , hv_a !: v-depth [m] 748 ! hf_0 !: v-depth [m] 749 ! r1_ht_0 !: inverse of u-depth [1/m] 750 ! r1_hu_0 , r1_hu_b , r1_hu_n , r1_hu_a !: inverse of u-depth [1/m] 751 ! r1_hv_0 , r1_hv_b , r1_hv_n , r1_hv_a !: inverse of v-depth [1/m] 752 ! r1_hf_0 !: inverse of v-depth [1/m] 753 ! 658 754 !!---------------------------------------------------------------------- 659 755 INTEGER :: ji, jj, jk … … 677 773 ! 678 774 ! 679 ! !== ssh / h factor at t-, u- ,v- & f-points ==!775 ! !== ssh / h factor at t-, u- ,v-points ==! 680 776 zssht_h(:,:) = ssh (:,:,Nbb) * r1_ht_0(:,:) 681 777 zsshu_h(:,:) = zsshu_h(:,:) * r1_hu_0(:,:) 682 778 zsshv_h(:,:) = zsshv_h(:,:) * r1_hv_0(:,:) 683 779 ! 684 ! !== e3t, e3w , e3u, e3uw , and e3v, e3vw ==! 780 ! !== e3t , e3u , e3v ==! 781 ! 685 782 DO jk = 1, jpkm1 686 e3t_b(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 687 e3w_b(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) ) 688 ! 689 e3u_b(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h (:,:) * umask(:,:,jk) ) 690 e3uw_b(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h (:,:) * wumask(:,:,jk) ) 691 ! 692 e3v_b(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h (:,:) * vmask(:,:,jk) ) 693 e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h (:,:) * wvmask(:,:,jk) ) 783 e3t_b(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 784 e3u_b(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 785 e3v_b(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 786 END DO 787 ! 788 ! !== e3w , e3uw , e3vw ==! 789 ! 790 e3w_b(:,:,1) = e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) * tmask(:,:,1) ) 791 e3uw_b(:,:,1) = e3uw_0(:,:,1) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,1) ) 792 e3vw_b(:,:,1) = e3vw_0(:,:,1) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,1) ) 793 DO jk = 2, jpk 794 e3w_b(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) ) ) 795 e3uw_b(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * MAX( wumask(:,:,jk-1) , wumask(:,:,jk) ) ) 796 e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * MAX( wvmask(:,:,jk-1) , wvmask(:,:,jk) ) ) 694 797 END DO 695 798 ! 799 ! !== depth of t- and w-points ==! 800 ! 801 zssht_h(:,:) = 1._wp + zssht_h(:,:) ! = 1 + ssh(Nnn) / ht_0 802 ! 803 IF( ln_isfcav ) THEN ! ISF cavities : ssh scaling not applied over the iceshelf thickness 804 DO jk = 1, jpk 805 gdept_b(:,:,jk) = ( gdept_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 806 gdepw_b(:,:,jk) = ( gdepw_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 807 END DO 808 ELSE ! no ISF cavities 809 DO jk = 1, jpk 810 gdept_b(:,:,jk) = gdept_0(:,:,jk) * zssht_h(:,:) 811 gdepw_b(:,:,jk) = gdepw_0(:,:,jk) * zssht_h(:,:) 812 END DO 813 ENDIF 814 ! 696 815 END SUBROUTINE ssh2e3_before 697 816 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domvvl_RK3.F90
r10009 r10023 1 MODULE domvvl 1 MODULE domvvl_RK3 2 2 !!====================================================================== 3 !! *** MODULE domvvl ***3 !! *** MODULE domvvl_RK3 *** 4 4 !! Ocean : 5 5 !!====================================================================== … … 9 9 ! 1- remove z-tilde ==>>> pure z-star (or s-star) 10 10 ! 2- remove dom_vvl_interpol 11 ! 3- 11 12 12 13 !!---------------------------------------------------------------------- … … 142 143 ! !* BEFORE fields : 143 144 CALL ssh2e3_before ! set: hu , hv , r1_hu, r1_hv 144 ! ! e3t, e3w, e3u, e3uw, e3v, e3vw (from 1 to jpkm1) 145 ! ! e3t, e3u , e3v (from 1 to jpkm1) 146 ! ! e3w, e3uw, e3vw (from 1 to jpk ) 147 ! ! gdept, gdepw (from 1 to jpk ) 145 148 ! 146 149 ! ! set jpk level one to the e3._0 values 147 e3t_b(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_b(:,:,jpk) = e3w_0(:,:,jpk) ; e3v_b(:,:,jpk) = e3v_0(:,:,jpk) 148 e3w_b(:,:,jpk) = e3w_0(:,:,jpk) ; e3uw_b(:,:,jpk) = e3uw_0(:,:,jpk) ; e3vw_b(:,:,jpk) = e3vw_0(:,:,jpk) 150 e3t_b(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_b(:,:,jpk) = e3u_0(:,:,jpk) ; e3v_b(:,:,jpk) = e3v_0(:,:,jpk) 149 151 ! 150 152 ! !* NOW fields : 151 153 CALL ssh2e3_now ! set: ht , hu , hv , r1_hu, r1_hv 152 ! ! e3t, e3 w, e3u, e3uw, e3v, e3vw, e3f(from 1 to jpkm1)153 ! ! gdept_n, gdepw_n, gde3w_n154 !!gm issue? gdept_n, gdepw_n, gde3w_n never defined at jpk 154 ! ! e3t, e3u , e3v, e3f (from 1 to jpkm1) 155 ! ! e3w, e3uw, e3vw (from 1 to jpk ) 156 ! ! gdept, gdepw, gde3w (from 1 to jpk ) 155 157 ! 156 158 ! ! set one for all last level to the e3._0 value 157 e3t_n(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_n(:,:,jpk) = e3w_0(:,:,jpk) ; e3v_n(:,:,jpk) = e3v_0(:,:,jpk) 158 e3w_n(:,:,jpk) = e3w_0(:,:,jpk) ; e3uw_n(:,:,jpk) = e3uw_0(:,:,jpk) ; e3vw_n(:,:,jpk) = e3vw_0(:,:,jpk) 159 e3t_n(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_n(:,:,jpk) = e3u_0(:,:,jpk) ; e3v_n(:,:,jpk) = e3v_0(:,:,jpk) 159 160 e3f_n(:,:,jpk) = e3f_0(:,:,jpk) 160 161 ! 161 162 ! !* AFTER fields : (last level for OPA, 3D required for AGRIF initialisation) 162 e3t_a(:,:,:) = e3t_n(:,:,:) ; e3u_a(:,:,:) = e3u_n(:,:,:) ; e3v_a(:,:,:) = e3v_n(:,:,:) 163 e3t_a(:,:,:) = e3t_n(:,:,:) ; e3u_a(:,:,:) = e3u_n(:,:,:) 164 e3w_a(:,:,:) = e3w_n(:,:,:) ; e3v_a(:,:,:) = e3v_n(:,:,:) 163 165 164 166 !!gm … … 207 209 !! 208 210 !! Reference : Leclair, M., and Madec, G. 2011, Ocean Modelling. 211 !! 212 ! ! ref. ! before ! now ! after ! 213 ! e3t_0 , e3t_b , e3t_n , e3t_a !: t- vert. scale factor [m] 214 ! e3u_0 , e3u_b , e3u_n , e3u_a !: u- vert. scale factor [m] 215 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 216 ! e3w_0 , e3w_b , e3w_n , e3w_a !: w- vert. scale factor [m] 217 ! e3uw_0 , e3uw_b , e3uw_n !: uw-vert. scale factor [m] 218 ! e3vw_0 , e3vw_b , e3vw_n !: vw-vert. scale factor [m] 219 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 220 ! 221 ! ! ref. ! before ! now ! 222 ! gdept_0 , gdept_b , gdept_n !: t- depth [m] 223 ! gdepw_0 , gdepw_b , gdepw_n !: w- depth [m] 224 ! gde3w_0 , gde3w_n !: w- depth (sum of e3w) [m] 225 ! 226 ! ! ref. ! before ! now ! after ! 227 ! ht_0 , ht_n !: t-depth [m] 228 ! hu_0 , hu_b , hu_n , hu_a !: u-depth [m] 229 ! hv_0 , hv_b , hv_n , hv_a !: v-depth [m] 230 ! hf_0 !: v-depth [m] 231 ! r1_ht_0 !: inverse of u-depth [1/m] 232 ! r1_hu_0 , r1_hu_b , r1_hu_n , r1_hu_a !: inverse of u-depth [1/m] 233 ! r1_hv_0 , r1_hv_b , r1_hv_n , r1_hv_a !: inverse of v-depth [1/m] 234 ! r1_hf_0 !: inverse of v-depth [1/m] 235 ! 209 236 !!---------------------------------------------------------------------- 210 237 INTEGER, INTENT( in ) :: kt ! time step … … 230 257 ! 231 258 ! !== after ssh ==! (u- and v-points) 232 DO jj = 2, jpjm1 ; DO ji = 2, jpim1 233 zsshu_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji+1,jj,Naa) ) * ssumask(ji,jj) 234 zsshv_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji,jj+1,Naa) ) * ssvmask(ji,jj) 235 END DO ; END DO 259 DO jj = 2, jpjm1 260 DO ji = 2, jpim1 261 zsshu_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji+1,jj,Naa) ) * ssumask(ji,jj) 262 zsshv_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji,jj+1,Naa) ) * ssvmask(ji,jj) 263 END DO 264 END DO 236 265 CALL lbc_lnk_multi( zsshu_h(:,:), 'U', 1._wp , zsshv_h(:,:), 'V', 1._wp ) 237 266 ! … … 247 276 zsshv_h(:,:) = zsshv_h(:,:) * r1_hv_0(:,:) ! v-point 248 277 DO jk = 1, jpkm1 249 e3t_a(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 250 e3u_a(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 251 e3v_a(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 278 e3t_a(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 279 e3u_a(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 280 e3v_a(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 281 e3w_a(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) ) 252 282 END DO 253 283 ! … … 315 345 gdept_b(:,:,jk) = gdept_n(:,:,jk) ! depth at t and w 316 346 gdepw_b(:,:,jk) = gdepw_n(:,:,jk) 317 e3t_n (:,:,jk) = e3t_a (:,:,jk) ! e3t, e3u, e3v 347 e3t_n (:,:,jk) = e3t_a (:,:,jk) ! e3t, e3u, e3v, e3w 318 348 e3u_n (:,:,jk) = e3u_a (:,:,jk) 319 349 e3v_n (:,:,jk) = e3v_a (:,:,jk) 350 e3w_n (:,:,jk) = e3w_a (:,:,jk) 320 351 END DO 321 352 ht_n(:,:) = ht_0(:,:) + ssh(:,:,Nnn) ! ocean thickness … … 324 355 hv_n(:,:) = hv_a(:,:) ; r1_hv_n(:,:) = r1_hv_a(:,:) 325 356 ! 326 ! !== before :357 ! !== before ==! 327 358 ! !* ssh at u- and v-points) 328 359 DO jj = 2, jpjm1 ; DO ji = 2, jpim1 … … 341 372 e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 342 373 END DO 374 ! 375 zssht_h(:,:) = 1._wp + zssht_h(:,:) !* gdept , gdepw 376 ! 377 IF( ln_isfcav ) THEN ! ISF cavities : ssh scaling not applied over the iceshelf thickness 378 DO jk = 1, jpkm1 379 gdept_b(:,:,jk) = ( gdept_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 380 gdepw_b(:,:,jk) = ( gdepw_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 381 END DO 382 ELSE ! no ISF cavities 383 DO jk = 1, jpkm1 384 gdept_b(:,:,jk) = gdept_0(:,:,jk) * zssht_h(:,:) 385 gdepw_b(:,:,jk) = gdepw_0(:,:,jk) * zssht_h(:,:) 386 END DO 387 ENDIF 343 388 ! 344 ! !== now :389 ! !== now ==! 345 390 ! !* ssh at u- and v-points) 346 391 DO jj = 1, jpjm1 ; DO ji = 1, jpim1 ! start from 1 for f-point … … 358 403 zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:) ! f-point 359 404 DO jk = 1, jpkm1 360 e3w_n(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) )361 405 e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,jk) ) 362 406 e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,jk) ) … … 364 408 END DO 365 409 ! 366 zssht_h(:,:) = 1._wp + zssht_h(:,:) ! t-point410 zssht_h(:,:) = 1._wp + zssht_h(:,:) !* gdept , gdepw , gde3w 367 411 ! 368 412 IF( ln_isfcav ) THEN ! ISF cavities : ssh scaling not applied over the iceshelf thickness 369 413 DO jk = 1, jpkm1 370 gdept_n(:,:,jk) = ( gdept_0(:,:,jk) - risfdep(:,:) ) * zssht_h(:,:) + risfdep(:,:)371 gdepw_n(:,:,jk) = ( gdepw_0(:,:,jk) - risfdep(:,:) ) * zssht_h(:,:) + risfdep(:,:)414 gdept_n(:,:,jk) = ( gdept_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 415 gdepw_n(:,:,jk) = ( gdepw_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 372 416 gde3w_n(:,:,jk) = gdept_n(:,:,jk) - ssh (:,:,Nnn) 373 417 END DO … … 584 628 !!---------------------------------------------------------------------- 585 629 !! *** ROUTINE ssh2e3_now *** 630 ! ! ref. ! before ! now ! after ! 631 ! e3t_0 , e3t_b , e3t_n , e3t_a !: t- vert. scale factor [m] 632 ! e3u_0 , e3u_b , e3u_n , e3u_a !: u- vert. scale factor [m] 633 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 634 ! e3w_0 , e3w_b , e3w_n , e3w_a !: w- vert. scale factor [m] 635 ! e3uw_0 , e3uw_b , e3uw_n !: uw-vert. scale factor [m] 636 ! e3vw_0 , e3vw_b , e3vw_n !: vw-vert. scale factor [m] 637 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 638 ! 639 ! ! ref. ! before ! now ! 640 ! gdept_0 , gdept_b , gdept_n !: t- depth [m] 641 ! gdepw_0 , gdepw_b , gdepw_n !: w- depth [m] 642 ! gde3w_0 , gde3w_n !: w- depth (sum of e3w) [m] 643 ! 644 ! ! ref. ! before ! now ! after ! 645 ! ht_0 , ht_n !: t-depth [m] 646 ! hu_0 , hu_b , hu_n , hu_a !: u-depth [m] 647 ! hv_0 , hv_b , hv_n , hv_a !: v-depth [m] 648 ! hf_0 !: v-depth [m] 649 ! r1_ht_0 !: inverse of u-depth [1/m] 650 ! r1_hu_0 , r1_hu_b , r1_hu_n , r1_hu_a !: inverse of u-depth [1/m] 651 ! r1_hv_0 , r1_hv_b , r1_hv_n , r1_hv_a !: inverse of v-depth [1/m] 652 ! r1_hf_0 !: inverse of v-depth [1/m] 653 ! 586 654 !!---------------------------------------------------------------------- 587 655 INTEGER :: ji, jj, jk … … 616 684 zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:) 617 685 ! 618 ! !== e3t , e3w , e3u, e3uw , e3v, e3vw , ande3f ==!686 ! !== e3t , e3u , e3v , e3f ==! 619 687 ! 620 688 DO jk = 1, jpkm1 621 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 622 e3w_n(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) ) 623 ! 624 e3u_n(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 625 e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,jk) ) 626 ! 627 e3v_n(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 628 e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,jk) ) 629 ! 689 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 690 e3u_n(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 691 e3v_n(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 630 692 e3f_n(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 631 693 END DO 632 694 ! 695 ! !== e3w , e3uw , e3vw ==! 696 ! 697 e3w_n(:,:,1) = e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) * tmask(:,:,1) ) 698 e3uw_n(:,:,1) = e3uw_0(:,:,1) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,1) ) 699 e3vw_n(:,:,1) = e3vw_0(:,:,1) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,1) ) 700 DO jk = 2, jpk 701 e3w_n(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) ) ) 702 e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * MAX( wumask(:,:,jk-1) , wumask(:,:,jk) ) ) 703 e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * MAX( wvmask(:,:,jk-1) , wvmask(:,:,jk) ) ) 704 END DO 705 ! 633 706 ! !== depth of t- and w-points ==! 634 707 ! … … 636 709 ! 637 710 IF( ln_isfcav ) THEN ! ISF cavities : ssh scaling not applied over the iceshelf thickness 638 DO jk = 1, jpk m1639 gdept_n(:,:,jk) = ( gdept_0(:,:,jk) - risfdep(:,:) ) * zssht_h(:,:) + risfdep(:,:)640 gdepw_n(:,:,jk) = ( gdepw_0(:,:,jk) - risfdep(:,:) ) * zssht_h(:,:) + risfdep(:,:)711 DO jk = 1, jpk 712 gdept_n(:,:,jk) = ( gdept_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 713 gdepw_n(:,:,jk) = ( gdepw_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 641 714 gde3w_n(:,:,jk) = gdept_n(:,:,jk) - ssh(:,:,Nnn) 642 715 END DO 643 716 ELSE ! no ISF cavities 644 !!gm BUG ??? gdept should be updated down to the ocean floor ! ===>> jpk NOT jpkm1 !!! 645 DO jk = 1, jpkm1 717 DO jk = 1, jpk 646 718 gdept_n(:,:,jk) = gdept_0(:,:,jk) * zssht_h(:,:) 647 719 gdepw_n(:,:,jk) = gdepw_0(:,:,jk) * zssht_h(:,:) … … 656 728 !!---------------------------------------------------------------------- 657 729 !! *** ROUTINE ssh2e3_before *** 730 ! ! ref. ! before ! now ! after ! 731 ! e3t_0 , e3t_b , e3t_n , e3t_a !: t- vert. scale factor [m] 732 ! e3u_0 , e3u_b , e3u_n , e3u_a !: u- vert. scale factor [m] 733 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 734 ! e3w_0 , e3w_b , e3w_n , e3w_a !: w- vert. scale factor [m] 735 ! e3uw_0 , e3uw_b , e3uw_n !: uw-vert. scale factor [m] 736 ! e3vw_0 , e3vw_b , e3vw_n !: vw-vert. scale factor [m] 737 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 738 ! 739 ! ! ref. ! before ! now ! 740 ! gdept_0 , gdept_b , gdept_n !: t- depth [m] 741 ! gdepw_0 , gdepw_b , gdepw_n !: w- depth [m] 742 ! gde3w_0 , gde3w_n !: w- depth (sum of e3w) [m] 743 ! 744 ! ! ref. ! before ! now ! after ! 745 ! ht_0 , ht_n !: t-depth [m] 746 ! hu_0 , hu_b , hu_n , hu_a !: u-depth [m] 747 ! hv_0 , hv_b , hv_n , hv_a !: v-depth [m] 748 ! hf_0 !: v-depth [m] 749 ! r1_ht_0 !: inverse of u-depth [1/m] 750 ! r1_hu_0 , r1_hu_b , r1_hu_n , r1_hu_a !: inverse of u-depth [1/m] 751 ! r1_hv_0 , r1_hv_b , r1_hv_n , r1_hv_a !: inverse of v-depth [1/m] 752 ! r1_hf_0 !: inverse of v-depth [1/m] 753 ! 658 754 !!---------------------------------------------------------------------- 659 755 INTEGER :: ji, jj, jk … … 677 773 ! 678 774 ! 679 ! !== ssh / h factor at t-, u- ,v- & f-points ==!775 ! !== ssh / h factor at t-, u- ,v-points ==! 680 776 zssht_h(:,:) = ssh (:,:,Nbb) * r1_ht_0(:,:) 681 777 zsshu_h(:,:) = zsshu_h(:,:) * r1_hu_0(:,:) 682 778 zsshv_h(:,:) = zsshv_h(:,:) * r1_hv_0(:,:) 683 779 ! 684 ! !== e3t, e3w , e3u, e3uw , and e3v, e3vw ==! 780 ! !== e3t , e3u , e3v ==! 781 ! 685 782 DO jk = 1, jpkm1 686 e3t_b(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 687 e3w_b(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) ) 688 ! 689 e3u_b(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h (:,:) * umask(:,:,jk) ) 690 e3uw_b(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h (:,:) * wumask(:,:,jk) ) 691 ! 692 e3v_b(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h (:,:) * vmask(:,:,jk) ) 693 e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h (:,:) * wvmask(:,:,jk) ) 783 e3t_b(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) 784 e3u_b(:,:,jk) = e3u_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 785 e3v_b(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 786 END DO 787 ! 788 ! !== e3w , e3uw , e3vw ==! 789 ! 790 e3w_b(:,:,1) = e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) * tmask(:,:,1) ) 791 e3uw_b(:,:,1) = e3uw_0(:,:,1) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,1) ) 792 e3vw_b(:,:,1) = e3vw_0(:,:,1) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,1) ) 793 DO jk = 2, jpk 794 e3w_b(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) ) ) 795 e3uw_b(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * MAX( wumask(:,:,jk-1) , wumask(:,:,jk) ) ) 796 e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * MAX( wvmask(:,:,jk-1) , wvmask(:,:,jk) ) ) 694 797 END DO 695 798 ! 799 ! !== depth of t- and w-points ==! 800 ! 801 zssht_h(:,:) = 1._wp + zssht_h(:,:) ! = 1 + ssh(Nnn) / ht_0 802 ! 803 IF( ln_isfcav ) THEN ! ISF cavities : ssh scaling not applied over the iceshelf thickness 804 DO jk = 1, jpk 805 gdept_b(:,:,jk) = ( gdept_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 806 gdepw_b(:,:,jk) = ( gdepw_0(:,:,jk) - ht_isf(:,:) ) * zssht_h(:,:) + ht_isf(:,:) 807 END DO 808 ELSE ! no ISF cavities 809 DO jk = 1, jpk 810 gdept_b(:,:,jk) = gdept_0(:,:,jk) * zssht_h(:,:) 811 gdepw_b(:,:,jk) = gdepw_0(:,:,jk) * zssht_h(:,:) 812 END DO 813 ENDIF 814 ! 696 815 END SUBROUTINE ssh2e3_before 697 816 698 817 !!====================================================================== 699 END MODULE domvvl 818 END MODULE domvvl_RK3 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domwri.F90
r9598 r10023 159 159 zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp ) 160 160 CALL iom_rstput( 0, 0, inum, 'misf', zprt, ktype = jp_i4 ) ! ! nb of ocean T-points 161 zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp )161 zprt(:,:) = ssmask(:,:) * REAL( ht_isf(:,:) , wp ) 162 162 CALL iom_rstput( 0, 0, inum, 'isfdraft', zprt, ktype = jp_r8 ) ! ! nb of ocean T-points 163 163 ! ! vertical mesh -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/iscplrst.F90
r10009 r10023 13 13 USE oce ! global tra/dyn variable 14 14 USE dom_oce ! ocean space and time domain 15 USE domvvl ! 15 16 USE domwri ! ocean space and time domain 16 17 USE phycst ! physical constants … … 149 150 zwmaskn(:,:,1) = tmask (:,:,1) 150 151 zwmaskb(:,:,1) = ptmask_b(:,:,1) 151 DO jk = 2, jpk152 DO jk = 2, jpk 152 153 zwmaskn(:,:,jk) = tmask (:,:,jk) * tmask (:,:,jk-1) 153 154 zwmaskb(:,:,jk) = ptmask_b(:,:,jk) * ptmask_b(:,:,jk-1) … … 179 180 ssh(:,:,Nnn) = ssh(:,:,Nnn) * ssmask(:,:) 180 181 182 !!gm BUGs.... 183 ! 184 ! for me ht_0, hu_0, hv_0 and hf_0 should be recomputed whatever the value of ln_linssh 185 ! further more mask at all grid-point should be recomputed 186 ! and mikt, u, v, f also... 187 ! 188 ! perhaps, not, if dom_cfg.nc file has been modified.... 189 ! 190 ! Pierre we should discuss of that ! 191 192 193 194 181 195 !============================================================================= 182 196 !PM: Is this needed since introduction of VVL by default? 183 197 IF ( .NOT.ln_linssh ) THEN 184 ! Reconstruction of all vertical scale factors at now time steps 185 ! ====================================================================== 198 ! Reconstruction of all vertical scale factors at now time steps 199 ! ====================================================================== 200 201 202 CALL ctl_stop( 'iscplrst : gm: here there is a BUG: not all required fields are defined') 203 204 ! 205 ! !* NOW fields : 206 CALL ssh2e3_now ! set: ht , hu , hv , r1_hu, r1_hv 207 ! ! e3t, e3u , e3v, e3f (from 1 to jpkm1) 208 ! ! e3w, e3uw, e3vw (from 1 to jpk ) 209 ! ! gdept, gdepw, gde3w (from 1 to jpk ) 210 ! 211 212 186 213 187 214 !!gm Question : bug ???? … … 193 220 ! Note that the former calculation were using ht_0 so if it as not been updated ===>>> BUG 194 221 !!gm 195 196 197 ! Horizontal scale factor interpolations198 ! --------------------------------------199 DO jj = 1, jpj200 DO ji = 1, jpi201 IF ( tmask(ji,jj,1) == 0._wp .OR. ptmask_b(ji,jj,1) == 0._wp ) THEN202 DO jk = 1, jpk203 e3t_n(ji,jj,jk) = e3t_0(ji,jj,jk) * ( 1._wp + ssh(ji,jj,Nnn) * r1_ht_0(ji,jj) * tmask(ji,jj,jk) )204 END DO205 ENDIF206 END DO207 END DO208 !209 !!gm Note that if this routine is called in dom_vvl_init then all the lines below are uselss !!!210 !! they are a duplication of dom_vvl_init lines211 212 ! !== now fields ==!213 !214 ! !* ssh at u- and v-points)215 DO jj = 1, jpjm1 ; DO ji = 1, jpim1 ! start from 1 due to f-point216 zsshu(ji,jj) = 0.5_wp * ( ssh(ji ,jj,Nnn) + ssh(ji+1,jj ,Nnn) ) * ssumask(ji,jj)217 zsshv(ji,jj) = 0.5_wp * ( ssh(ji ,jj,Nnn) + ssh(ji ,jj+1,Nnn) ) * ssvmask(ji,jj)218 zsshf(ji,jj) = 0.25_wp * ( ssh(ji ,jj,Nnn) + ssh(ji ,jj+1,Nnn) &219 & + ssh(ji+1,jj,Nnn) + ssh(ji+1,jj+1,Nnn) ) * ssfmask(ji,jj)220 END DO ; END DO221 CALL lbc_lnk_multi( zsshu(:,:),'U', 1._wp , zsshu(:,:),'V', 1._wp , zsshf(:,:),'F', 1._wp )222 !223 ! !* hu and hv (and their inverse)224 ht_n (:,:) = ht_0(:,:) + ssh (:,:,Nnn)225 hu_n (:,:) = hu_0(:,:) + zsshu(:,:)226 hv_n (:,:) = hv_0(:,:) + zsshv(:,:)227 r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) ! ss mask mask due to ISF228 r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) )229 !230 ! !* e3u, e3uw and e3v, e3vw231 z_ssh_h0(:,:) = ssh(:,:,Nnn) * r1_ht_0(:,:) ! t-point232 DO jk = 1, jpkm1233 e3w_n(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + z_ssh_h0(:,:) * tmask(:,:,jk) )234 END DO235 z_ssh_h0(:,:) = zsshu(:,:) * r1_hu_0(:,:) ! u-point236 DO jk = 1, jpkm1237 e3u_n (:,:,jk) = e3u_0 (:,:,jk) * ( 1._wp + z_ssh_h0(:,:) * umask(:,:,jk) )238 e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + z_ssh_h0(:,:) * wumask(:,:,jk) )239 END DO240 z_ssh_h0(:,:) = zsshv(:,:) * r1_hv_0(:,:) ! v-point241 DO jk = 1, jpkm1242 e3v_n (:,:,jk) = e3v_0 (:,:,jk) * ( 1._wp + z_ssh_h0(:,:) * vmask(:,:,jk) )243 e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + z_ssh_h0(:,:) * wvmask(:,:,jk) )244 END DO245 z_ssh_h0(:,:) = zsshf(:,:) * r1_hf_0(:,:) ! f-point246 DO jk = 1, jpkm1247 e3f_n(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + z_ssh_h0(:,:) * fmask(:,:,jk) )248 END DO249 250 z_ssh_h0(:,:) = 1._wp + ssh(:,:,Nnn) * r1_ht_0(:,:) ! t-point251 !252 IF( ln_isfcav ) THEN ! iceshelf cavities : ssh scaling not applied over the iceshelf thickness253 DO jk = 1, jpkm1254 gdept_n(:,:,jk) = ( gdept_0(:,:,jk) - risfdep(:,:) ) * z_ssh_h0(:,:) + risfdep(:,:)255 gdepw_n(:,:,jk) = ( gdepw_0(:,:,jk) - risfdep(:,:) ) * z_ssh_h0(:,:) + risfdep(:,:)256 gde3w_n(:,:,jk) = gdept_n(:,:,jk) - ssh(:,:,Nnn)257 END DO258 ELSE259 DO jk = 1, jpkm1260 gdept_n(:,:,jk) = gdept_0(:,:,jk) * z_ssh_h0(:,:)261 gdepw_n(:,:,jk) = gdepw_0(:,:,jk) * z_ssh_h0(:,:)262 gde3w_n(:,:,jk) = gdept_n(:,:,jk) - ssh(:,:,Nnn)263 END DO264 ENDIF265 266 222 ENDIF 267 223 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/istate.F90
r10009 r10023 104 104 ! 105 105 ELSE ! user defined initial T and S 106 CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, ssh(:,:,Nbb) ) 106 !!gm CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, ssh(:,:,Nbb) ) 107 !!gm when ln_linssh=.FALSE. (non linear free surface, gdept_b is NOT initialized ! 108 !!gm 109 CALL usr_def_istate( gdept_0, tmask, tsb, ub, vb, ssh(:,:,Nbb) ) 110 !!gm 107 111 ENDIF 108 112 tsn (:,:,:,:) = tsb(:,:,:,:) ! set now values from to before ones -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynhpg.F90
r10009 r10023 232 232 ! 233 233 ! !- compute rhd at the ice/oce interface (ice shelf side) 234 CALL eos( zts_top , risfdep, zrhdtop_isf )234 CALL eos( zts_top , ht_isf, zrhdtop_isf ) 235 235 ! 236 236 ! !- Surface value + ice shelf gradient … … 245 245 END DO 246 246 IF (ikt >= 2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) & 247 & * ( risfdep(ji,jj) - gdept_1d(ikt-1) )247 & * ( ht_isf(ji,jj) - gdept_1d(ikt-1) ) 248 248 END DO 249 249 END DO … … 599 599 END DO 600 600 END DO 601 CALL eos( zts_top, risfdep, zrhdtop_oce )601 CALL eos( zts_top, ht_isf, zrhdtop_oce ) 602 602 603 603 !================================================================================== -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynnxt.F90
r10009 r10023 255 255 zsshv(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nbb) + ssh(ji ,jj+1,Nbb) ) * ssvmask(ji,jj) 256 256 END DO ; END DO 257 CALL lbc_lnk_multi( zsshu(:,:),'U', 1._wp , zssh u(:,:),'V', 1._wp )257 CALL lbc_lnk_multi( zsshu(:,:),'U', 1._wp , zsshv(:,:),'V', 1._wp ) 258 258 ! 259 259 ! … … 291 291 zsshv(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nbb) + ssh(ji ,jj+1,Nbb) ) * ssvmask(ji,jj) 292 292 END DO ; END DO 293 CALL lbc_lnk_multi( zsshu(:,:),'U', 1._wp , zssh u(:,:),'V', 1._wp )293 CALL lbc_lnk_multi( zsshu(:,:),'U', 1._wp , zsshv(:,:),'V', 1._wp ) 294 294 ! 295 295 ! … … 301 301 z_ssh_h0(:,:) = zsshv(:,:) * r1_hv_0(:,:) ! v-point 302 302 DO jk = 1, jpkm1 303 ze3 u_f(:,:,jk) = e3v_0 (:,:,jk) * ( 1._wp + z_ssh_h0(:,:) * vmask(:,:,jk) )303 ze3v_f(:,:,jk) = e3v_0 (:,:,jk) * ( 1._wp + z_ssh_h0(:,:) * vmask(:,:,jk) ) 304 304 END DO 305 305 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/sshwzv.F90
r10009 r10023 245 245 Naa = isave ! after <-- previously now index 246 246 ! 247 ELSE 247 ELSEIF ( ln_MLF ) THEN !== Leap-Frog time-stepping ==! Asselin filter + swap 248 248 ! 249 249 ! ! before <-- now filtered … … 258 258 Nnn = Naa ! now <-- after 259 259 Naa = isave ! after <-- previously now index 260 ! 261 ELSEIF ( ln_MLF ) THEN !== RK3 time-stepping ==! swap 262 isave = Nnn 263 Nnn = Naa ! now <-- after 264 Naa = isave ! after <-- previously now index 265 260 266 ENDIF 261 267 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/LDF/ldfslp.F90
r9736 r10023 180 180 DO jj = 2, jpjm1 181 181 DO ji = fs_2, fs_jpim1 ! vector opt. 182 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX( hmlpt (ji,jj), hmlpt (ji+1,jj ), 5._wp)&183 & - MAX( risfdep(ji,jj), risfdep(ji+1,jj ) ))184 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / ( MAX( hmlpt (ji,jj), hmlpt (ji ,jj+1), 5._wp)&185 & - MAX( risfdep(ji,jj), risfdep(ji ,jj+1) ))182 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / ( MAX( hmlpt (ji,jj) , hmlpt (ji+1,jj ) , 5._wp ) & 183 & - MAX( ht_isf(ji,jj) , ht_isf(ji+1,jj ) ) ) 184 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / ( MAX( hmlpt (ji,jj) , hmlpt (ji ,jj+1) , 5._wp ) & 185 & - MAX( ht_isf(ji,jj) , ht_isf(ji ,jj+1) ) ) 186 186 END DO 187 187 END DO … … 189 189 DO jj = 2, jpjm1 190 190 DO ji = fs_2, fs_jpim1 ! vector opt. 191 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj ), 5._wp)192 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX( hmlpt(ji,jj), hmlpt(ji ,jj+1), 5._wp)191 zslpml_hmlpu(ji,jj) = uslpml(ji,jj) / MAX( hmlpt(ji,jj) , hmlpt(ji+1,jj ) , 5._wp ) 192 zslpml_hmlpv(ji,jj) = vslpml(ji,jj) / MAX( hmlpt(ji,jj) , hmlpt(ji ,jj+1) , 5._wp ) 193 193 END DO 194 194 END DO … … 211 211 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 212 212 ! thickness of water column between surface and level k at u/v point 213 zdepu = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n(ji+1,jj,jk) ) &214 - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj) ) - e3u_n(ji,jj,miku(ji,jj)) )215 zdepv = 0.5_wp * ( ( gdept_n (ji,jj,jk) + gdept_n(ji,jj+1,jk) ) &216 - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) - e3v_n(ji,jj,mikv(ji,jj)) )213 zdepu = 0.5_wp * ( ( gdept_n(ji,jj,jk) + gdept_n(ji+1,jj,jk) ) & 214 - 2 * MAX( ht_isf(ji,jj), ht_isf(ji+1,jj) ) - e3u_n(ji,jj,miku(ji,jj)) ) 215 zdepv = 0.5_wp * ( ( gdept_n(ji,jj,jk) + gdept_n(ji,jj+1,jk) ) & 216 - 2 * MAX( ht_isf(ji,jj), ht_isf(ji,jj+1) ) - e3v_n(ji,jj,mikv(ji,jj)) ) 217 217 ! 218 218 zwz(ji,jj,jk) = ( ( 1._wp - zfi) * zau / ( zbu - zeps ) & -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/SBC/sbcisf.F90
r9939 r10023 517 517 CASE ( 1 ) ! ISOMIP formulation (2 equations) for volume flux (Hunter et al., 2006) 518 518 ! Calculate freezing temperature 519 CALL eos_fzp( stbl(:,:), zfrz(:,:), risfdep(:,:) )519 CALL eos_fzp( stbl(:,:), zfrz(:,:), ht_isf(:,:) ) 520 520 521 521 ! compute gammat every where (2d) … … 543 543 DO ji = 1, jpi 544 544 ! compute coeficient to solve the 2nd order equation 545 zeps1 = r cp*rho0*zgammat(ji,jj)546 zeps2 = r Lfus*rho0*zgammas(ji,jj)547 zeps3 = rho_isf*rcp_isf*rkappa /MAX(risfdep(ji,jj),zeps)548 zeps4 = zlamb2 +zlamb3*risfdep(ji,jj)549 zeps6 = zeps4 -ttbl(ji,jj)550 zeps7 = zeps4 -tsurf551 zaqe = zlamb1 * ( zeps1 + zeps3)552 zaqer = 0.5_wp /MIN(zaqe,-zeps)553 zbqe = zeps1 *zeps6+zeps3*zeps7-zeps2554 zcqe = zeps2 *stbl(ji,jj)555 zdis = zbqe *zbqe-4.0_wp*zaqe*zcqe545 zeps1 = rho0_rcp * zgammat(ji,jj) 546 zeps2 = rho0*rLfus * zgammas(ji,jj) 547 zeps3 = rho_isf*rcp_isf*rkappa / MAX( ht_isf(ji,jj) , zeps ) 548 zeps4 = zlamb2 + zlamb3 * ht_isf(ji,jj) 549 zeps6 = zeps4 - ttbl(ji,jj) 550 zeps7 = zeps4 - tsurf 551 zaqe = zlamb1 * ( zeps1 + zeps3 ) 552 zaqer = 0.5_wp / MIN( zaqe , -zeps ) 553 zbqe = zeps1 * zeps6 + zeps3 * zeps7 - zeps2 554 zcqe = zeps2 * stbl(ji,jj) 555 zdis = zbqe * zbqe - 4.0_wp * zaqe * zcqe 556 556 557 557 ! Presumably zdis can never be negative because gammas is very small compared to gammat -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trasbc.F90
r10009 r10023 122 122 ENDIF 123 123 ! !== Now sbc tracer content fields ==! 124 DO jj = 2, jpj 125 DO ji = fs_2, fs_jpim1 ! vector opt. 126 IF ( ll_wd ) THEN ! If near WAD point limit the flux for now 127 IF ( ssh(ji,jj,Nnn) + ht_0(ji,jj) > 2._wp * rn_wdmin1 ) THEN 124 ! 125 IF ( ll_wd ) THEN !* WAD case: If near WAD point limit the flux for now 126 DO jj = 2, jpj 127 DO ji = fs_2, fs_jpim1 ! vector opt. 128 IF ( ssh(ji,jj,Nnn) + ht_0(ji,jj) > 2._wp * rn_wdmin1 ) THEN 128 129 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 129 ELSE 130 ELSEIF ( ssh(ji,jj,Nnn) + ht_0(ji,jj) > rn_wdmin1 ) THEN 130 131 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) & 131 132 & * tanh ( 5._wp * ( ( ssh(ji,jj,Nnn) + ht_0(ji,jj) - rn_wdmin1 ) * r_rn_wdmin1 ) ) … … 133 134 sbc_tsc(ji,jj,jp_tem) = 0._wp 134 135 ENDIF 135 ELSE 136 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 137 END DO 138 END DO 139 ELSE !* standard case 140 DO jj = 2, jpj 141 DO ji = fs_2, fs_jpim1 ! vector opt. 136 142 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 137 ENDIF138 139 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting140 END DO141 END DO143 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 144 END DO 145 END DO 146 ENDIF 147 ! 142 148 IF( ln_linssh ) THEN !* linear free surface 143 149 DO jj = 2, jpj !==>> add concentration/dilution effect due to constant volume cell -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfmxl.F90
r9939 r10023 126 126 IF( .NOT.l_offline ) THEN 127 127 IF( iom_use("mldr10_1") ) THEN 128 IF( ln_isfcav ) THEN ; CALL iom_put( "mldr10_1", hmlp - risfdep) ! mixed layer thickness129 ELSE ; CALL iom_put( "mldr10_1", hmlp ) 128 IF( ln_isfcav ) THEN ; CALL iom_put( "mldr10_1", hmlp - ht_isf) ! mixed layer thickness 129 ELSE ; CALL iom_put( "mldr10_1", hmlp ) ! mixed layer depth 130 130 END IF 131 131 END IF 132 132 IF( iom_use("mldkz5") ) THEN 133 IF( ln_isfcav ) THEN ; CALL iom_put( "mldkz5" , hmld - risfdep) ! turbocline thickness134 ELSE ; CALL iom_put( "mldkz5" , hmld ) 133 IF( ln_isfcav ) THEN ; CALL iom_put( "mldkz5" , hmld - ht_isf ) ! turbocline thickness 134 ELSE ; CALL iom_put( "mldkz5" , hmld ) ! turbocline depth 135 135 END IF 136 136 ENDIF -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdftke.F90
r9939 r10023 392 392 ! ! TKE due to surface and internal wave breaking 393 393 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 394 !!gm BUG : in the exp remove the depth of ssh !!! 394 !!gm BUG : in the exp remove the depth of ssh !!! ===>>> not sure of that 395 395 !!gm i.e. use gde3w in argument (pdepw) 396 396 … … 518 518 !!gm Not sure of that coding for ISF.... 519 519 ! where wmask = 0 set zmxlm == p_e3w 520 521 !!gm pdepw(ji,jj,mikt(ji,jj)+1) = ht_n .... 522 !!gm pdepw(ji,jj,mikt(ji,jj)) = ht_isf(:,:) + ssh(:,:,Nnn) 523 520 524 CASE ( 0 ) ! bounded by the distance to surface and bottom 521 525 DO jk = 2, jpkm1 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/oce.F90
r10009 r10023 81 81 !! *** FUNCTION oce_alloc *** 82 82 !!---------------------------------------------------------------------- 83 INTEGER :: ierr( 6)83 INTEGER :: ierr(7) 84 84 !!---------------------------------------------------------------------- 85 85 ! … … 102 102 & riceload(jpi,jpj) , STAT=ierr(2) ) 103 103 ! 104 105 106 ALLOCATE( ssh(jpi,jpj,Nt) , STAT=ierr(5) ) 107 108 104 ALLOCATE( ssh(jpi,jpj,Nt) , STAT=ierr(3) ) 109 105 ! 110 ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr( 3) )106 ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) ) 111 107 ! 112 108 ALLOCATE( ssha_e(jpi,jpj), sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 113 109 & ua_e(jpi,jpj), un_e(jpi,jpj), ub_e(jpi,jpj), ubb_e(jpi,jpj), & 114 110 & va_e(jpi,jpj), vn_e(jpi,jpj), vb_e(jpi,jpj), vbb_e(jpi,jpj), & 115 & hu_e(jpi,jpj), hur_e(jpi,jpj), hv_e(jpi,jpj), hvr_e(jpi,jpj), STAT=ierr( 4) )111 & hu_e(jpi,jpj), hur_e(jpi,jpj), hv_e(jpi,jpj), hvr_e(jpi,jpj), STAT=ierr(5) ) 116 112 ! 117 113 ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_bf(jpi,jpj), vn_bf(jpi,jpj) , STAT=ierr(6) ) 118 114 #if defined key_agrif 119 ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj) , STAT=ierr( 6) )115 ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj) , STAT=ierr(7) ) 120 116 #endif 121 117 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/par_oce.F90
r10009 r10023 64 64 INTEGER, PUBLIC, PARAMETER :: nn_hls = 1 !: halo width (applies to both rows and columns) 65 65 66 !!gm thsi should be move in dom_oce 67 66 68 !!---------------------------------------------------------------------- 67 69 !! namcfg namelist parameters … … 82 84 INTEGER :: nn_cfg !: resolution of the configuration 83 85 86 !!gm end 87 84 88 !!---------------------------------------------------------------------- 85 89 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/step.F90
r10001 r10023 94 94 IF( ln_timing ) CALL timing_start('stp') 95 95 ! 96 96 97 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 97 98 ! update I/O and calendar … … 273 274 CALL tra_nxt ( kstp ) ! finalize (bcs) tracer fields at next time step and swap 274 275 CALL dyn_nxt ( kstp ) ! finalize (bcs) velocities at next time step and swap (always called after tra_nxt) 276 ! 275 277 CALL ssh_swp ( kstp ) ! swap of sea surface height 276 278 IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors
Note: See TracChangeset
for help on using the changeset viewer.