Changeset 10030 for NEMO/branches/2018/dev_r9838_ENHANCE04_RK3
- Timestamp:
- 2018-08-03T10:18:16+02:00 (6 years ago)
- Location:
- NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src
- Files:
-
- 13 edited
-
ICE/iceistate.F90 (modified) (1 diff)
-
NST/agrif_oce_update.F90 (modified) (6 diffs)
-
OCE/DOM/dom_oce.F90 (modified) (2 diffs)
-
OCE/DOM/domain.F90 (modified) (1 diff)
-
OCE/DOM/domvvl.F90 (modified) (15 diffs)
-
OCE/DOM/domvvl_RK3.F90 (modified) (15 diffs)
-
OCE/DOM/iscplrst.F90 (modified) (2 diffs)
-
OCE/DYN/dynzdf.F90 (modified) (17 diffs)
-
OCE/TRA/trazdf.F90 (modified) (2 diffs)
-
OCE/ZDF/zdfosm.F90 (modified) (4 diffs)
-
OCE/ZDF/zdfphy.F90 (modified) (1 diff)
-
OCE/ZDF/zdfsh2.F90 (modified) (3 diffs)
-
OFF/dtadyn.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/iceistate.F90
r10009 r10030 421 421 ! 422 422 ! !* BEFORE fields : 423 CALL ssh2e3_before ! set: hu , hv, r1_hu, r1_hv424 ! ! e3t, e3 w, e3u, e3uw, e3v, e3vw423 CALL ssh2e3_before ! set: hu, hv, r1_hu, r1_hv 424 ! ! e3t, e3u, e3v, e3w 425 425 ! 426 426 ! !* NOW fields : 427 CALL ssh2e3_now ! set: ht , hu , hv, r1_hu, r1_hv428 ! ! e3t, e3 w, e3u, e3uw, e3v, e3vw, e3f427 CALL ssh2e3_now ! set: ht, hu, hv, r1_hu, r1_hv 428 ! ! e3t, e3u, e3v, e3w , e3f 429 429 ! ! gdept_n, gdepw_n, gde3w_n 430 430 ENDIF -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/NST/agrif_oce_update.F90
r10010 r10030 258 258 e3u_a(:,:,:) = e3u_n(:,:,:) 259 259 e3v_a(:,:,:) = e3v_n(:,:,:) 260 ! ua(:,:,:) = e3u_b(:,:,:) 261 ! va(:,:,:) = e3v_b(:,:,:) 262 hu_a(:,:) = hu_n(:,:) 263 hv_a(:,:) = hv_n(:,:) 264 260 hu_a (:,:) = hu_n (:,:) 261 hv_a (:,:) = hv_n (:,:) 262 ! 265 263 ! !* NOW fields : 266 CALL ssh2e3_now ! set: ht , hu , hv, r1_hu, r1_hv267 ! ! e3t, e3 w, e3u, e3uw, e3v, e3vw, e3f(from 1 to jpkm1)268 ! ! gdept_n, gdepw_n, gde3w_n264 CALL ssh2e3_now ! set: ht, hu, hv, r1_hu, r1_hv 265 ! ! e3t, e3u, e3v, e3f (from 1 to jpkm1) 266 ! ! e3w, gdept_n, gdepw_n, gde3w_n (from 1 to jpk ) 269 267 270 268 ! !* BEFORE fields : 271 269 IF (.NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN 272 270 ! 273 CALL ssh2e3_before ! set: hu , hv, r1_hu, r1_hv274 ! ! e3t, e3 w, e3u, e3uw, e3v, e3vw(from 1 to jpkm1)275 ! 271 CALL ssh2e3_before ! set: hu, hv, r1_hu, r1_hv 272 ! ! e3t, e3u, e3v (from 1 to jpkm1) 273 ! ! e3w (from 1 to jpk ) 276 274 ENDIF 277 275 ! … … 304 302 DO jj = j1, j2 305 303 DO ji = i1, i2 306 tabres(ji,jj,jk,jn) = (tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) )&307 * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp304 tabres(ji,jj,jk,jn) = tmask(ji,jj,jk) * (tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) & 305 + (tmask(ji,jj,jk)-1) * 999._wp 308 306 END DO 309 307 END DO … … 313 311 DO jj = j1, j2 314 312 DO ji = i1, i2 315 tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk)&316 + (tmask(ji,jj,jk)-1)*999._wp313 tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) & 314 & + (tmask(ji,jj,jk)-1) * 999._wp 317 315 END DO 318 316 END DO … … 352 350 353 351 IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN ! Add asselin part 354 355 !!gm IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN356 352 DO jn = n1, n2-1 357 353 DO jk = 1, jpk … … 416 412 END DO 417 413 !< jc tmp 418 IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN 419 !!gm IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 420 ! Add asselin part 414 IF ( .NOT.( lk_agrif_fstep .AND. l_1st_euler ) ) THEN ! Add asselin part 421 415 DO jn = 1,jpts 422 416 DO jk = k1, k2 … … 447 441 ! 448 442 IF ( l_1st_euler .AND. Agrif_Nb_Step() == 0 ) THEN 449 !!gm IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN450 443 tsb(i1:i2,j1:j2,k1:k2,1:jpts) = tsn(i1:i2,j1:j2,k1:k2,1:jpts) 451 444 ENDIF -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/dom_oce.F90
r10023 r10030 135 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 136 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_0 , e3w_b , e3w_n , e3w_a !: w- vert. scale factor [m] 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_0 , e3uw_b , e3uw_n!: uw-vert. scale factor [m]138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 , e3vw_b , e3vw_n!: vw-vert. scale factor [m]137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_0 !: uw-vert. scale factor [m] 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 !: vw-vert. scale factor [m] 139 139 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f_0 , e3f_n !: f- vert. scale factor [m] 140 140 … … 270 270 & e3t(jpi,jpj,jpk,Nt) , e3u(jpi,jpj,jpk,Nt) , e3v(jpi,jpj,jpk,Nt) , & 271 271 ! ! 272 & e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , & 273 & e3uw_b(jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) , & 274 & e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) , STAT=ierr(5) ) 272 & e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , STAT=ierr(5) ) 275 273 ! 276 274 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , hf_0(jpi,jpj) , & -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domain.F90
r10023 r10030 170 170 gde3w_n = gde3w_0 ! --- ! grid-points 171 171 ! ! ! ! 172 e3t_b= e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale173 e3u_b= e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 ! factors174 e3v_b= e3v_0 ; e3v_n = e3v_0 ; e3v_a = e3v_0 !172 e3t_b = e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale 173 e3u_b = e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 ! factors 174 e3v_b = e3v_0 ; e3v_n = e3v_0 ; e3v_a = e3v_0 ! 175 175 e3f_n = e3f_0 ! --- ! 176 e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- ! 177 e3uw_b = e3uw_0 ; e3uw_n = e3uw_0 ! --- ! 178 e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- ! 176 e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- ! 179 177 ! ! 180 178 ht_n = ht_0 ! ! water column -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domvvl.F90
r10023 r10030 144 144 CALL ssh2e3_before ! set: hu , hv , r1_hu, r1_hv 145 145 ! ! e3t, e3u , e3v (from 1 to jpkm1) 146 ! ! e3w, e3uw, e3vw (from 1 to jpk ) 147 ! ! gdept, gdepw (from 1 to jpk ) 146 ! ! e3w, gdept, gdepw (from 1 to jpk ) 148 147 ! 149 148 ! ! set jpk level one to the e3._0 values … … 153 152 CALL ssh2e3_now ! set: ht , hu , hv , r1_hu, r1_hv 154 153 ! ! e3t, e3u , e3v, e3f (from 1 to jpkm1) 155 ! ! e3w, e3uw, e3vw (from 1 to jpk ) 156 ! ! gdept, gdepw, gde3w (from 1 to jpk ) 154 ! ! e3w, gdept, gdepw, gde3w (from 1 to jpk ) 157 155 ! 158 156 ! ! set one for all last level to the e3._0 value 159 e3t_n(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_n(:,:,jpk) = e3u_0(:,:,jpk) ; e3v_n(:,:,jpk) = e3v_0(:,:,jpk)160 e3f_n(:,:,jpk) = e3f_0(:,:,jpk) 157 e3t_n(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_n(:,:,jpk) = e3u_0(:,:,jpk) 158 e3f_n(:,:,jpk) = e3f_0(:,:,jpk) ; e3v_n(:,:,jpk) = e3v_0(:,:,jpk) 161 159 ! 162 160 ! !* AFTER fields : (last level for OPA, 3D required for AGRIF initialisation) … … 215 213 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 216 214 ! 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 215 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 220 216 ! … … 332 328 ! - JC - hu_b, hv_b, hur_b, hvr_b also 333 329 ! 334 ! - GM - to be updated : e3f_n, e3w_n , e3uw_n , e3vw_n 335 ! e3w_b , e3uw_b , e3vw_b 330 ! - GM - to be updated : e3f_n , e3w_n , e3w_b 336 331 ! gdept_n , gdepw_n , gde3w_n 337 332 ! ht_n … … 356 351 ! 357 352 ! !== before ==! 358 ! !* ssh at u- and v-points) 359 DO jj = 2, jpjm1 ; DO ji = 2, jpim1 360 zsshu_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nbb) + ssh(ji+1,jj ,Nbb) ) * ssumask(ji,jj) 361 zsshv_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nbb) + ssh(ji ,jj+1,Nbb) ) * ssvmask(ji,jj) 362 END DO ; END DO 363 CALL lbc_lnk_multi( zsshu_h(:,:),'U', 1._wp , zsshv_h(:,:),'V', 1._wp ) 364 ! 365 ! !* e3w_b , e3uw_b , e3vw_b 353 ! !* e3w_b 366 354 zssht_h(:,:) = ssh (:,:,Nbb) * r1_ht_0(:,:) ! w-point 367 zsshu_h(:,:) = zsshu_h(:,:) * r1_hu_0(:,:) ! uw-point 368 zsshv_h(:,:) = zsshv_h(:,:) * r1_hv_0(:,:) ! vw-point 369 DO jk = 1, jpkm1 370 e3w_b(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) ) 371 e3uw_b(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 372 e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 355 ! 356 e3w_b(:,:,1) = e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) * tmask(:,:,1) ) 357 DO jk = 2, jpk 358 e3w_b(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) ) ) 373 359 END DO 374 360 ! … … 388 374 ! 389 375 ! !== now ==! 390 ! !* ssh at u- and v-points) 391 DO jj = 1, jpjm1 ; DO ji = 1, jpim1 ! start from 1 for f-point 392 zsshu_h(ji,jj) = 0.50_wp * ( ssh(ji ,jj,Nnn) + ssh(ji+1,jj ,Nnn) ) * ssumask(ji,jj) 393 zsshv_h(ji,jj) = 0.50_wp * ( ssh(ji ,jj,Nnn) + ssh(ji ,jj+1,Nnn) ) * ssvmask(ji,jj) 394 zsshf_h(ji,jj) = 0.25_wp * ( ssh(ji ,jj,Nnn) + ssh(ji ,jj+1,Nnn) & 395 & + ssh(ji+1,jj,Nnn) + ssh(ji+1,jj+1,Nnn) ) * ssfmask(ji,jj) 396 END DO ; END DO 397 CALL lbc_lnk_multi( zsshu_h(:,:),'U', 1._wp , zsshv_h(:,:),'V', 1._wp , zsshf_h(:,:),'F', 1._wp ) 398 ! 399 ! !* e3w_n , e3uw_n , e3vw_n, e3f_n 400 zssht_h(:,:) = ssh (:,:,Nnn) * r1_ht_0(:,:) ! t- & w-point 401 zsshu_h(:,:) = zsshu_h(:,:) * r1_hu_0(:,:) ! uw-point 402 zsshv_h(:,:) = zsshv_h(:,:) * r1_hv_0(:,:) ! vw-point 403 zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:) ! f-point 376 ! !* ssh at f-points 377 DO jj = 1, jpjm1 378 DO ji = 1, jpim1 ! start from 1 for f-point 379 zsshf_h(ji,jj) = 0.25_wp * ( ssh(ji ,jj,Nnn) + ssh(ji ,jj+1,Nnn) & 380 & + ssh(ji+1,jj,Nnn) + ssh(ji+1,jj+1,Nnn) ) * ssfmask(ji,jj) 381 END DO 382 END DO 383 CALL lbc_lnk( zsshf_h(:,:),'F', 1._wp ) 384 ! 385 ! !* e3f_n 386 zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:) ! f-point 387 ! 404 388 DO jk = 1, jpkm1 405 e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,jk) ) 406 e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,jk) ) 407 e3f_n(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 389 e3f_n(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 408 390 END DO 409 ! 410 zssht_h(:,:) = 1._wp + zssht_h(:,:) !* gdept , gdepw , gde3w 391 ! 392 ! !* gdept_n , gdepw_n , gde3w_n 393 zssht_h(:,:) = 1._wp + ssh(:,:,Nnn) * r1_ht_0(:,:) 411 394 ! 412 395 IF( ln_isfcav ) THEN ! ISF cavities : ssh scaling not applied over the iceshelf thickness … … 633 616 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 634 617 ! 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 618 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 638 619 ! … … 658 639 ! 659 640 ! !== ssh at u- and v-points ==! 660 ! 661 DO jj = 1, jpjm1 ! start from 1 due to f-point 662 DO ji = 1, jpim1 641 DO jj = 1, jpjm1 642 DO ji = 1, jpim1 ! start from 1 due to f-point 663 643 zsshu_h(ji,jj) = 0.50_wp * ( ssh(ji ,jj,Nnn) + ssh(ji+1,jj ,Nnn) ) * ssumask(ji,jj) 664 644 zsshv_h(ji,jj) = 0.50_wp * ( ssh(ji ,jj,Nnn) + ssh(ji ,jj+1,Nnn) ) * ssvmask(ji,jj) … … 670 650 ! 671 651 ! !== ht, hu and hv == ! (and their inverse) 672 !673 652 ht_n (:,:) = ht_0(:,:) + ssh (:,:,Nnn) 674 653 hu_n (:,:) = hu_0(:,:) + zsshu_h(:,:) … … 678 657 ! 679 658 ! !== ssh / h factor at t-, u- ,v- & f-points ==! 680 !681 659 zssht_h(:,:) = ssh (:,:,Nnn) * r1_ht_0(:,:) 682 660 zsshu_h(:,:) = zsshu_h(:,:) * r1_hu_0(:,:) … … 684 662 zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:) 685 663 ! 686 ! !== e3t , e3u , e3v , e3f ==! 687 ! 664 ! !== e3t , e3u , e3v , e3f , e3w ==! 688 665 DO jk = 1, jpkm1 689 666 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) … … 692 669 e3f_n(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 693 670 END DO 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) ) 671 e3w_n(:,:,1) = e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) * tmask(:,:,1) ) 700 672 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) ) ) 673 e3w_n(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) ) ) 704 674 END DO 705 675 ! … … 733 703 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 734 704 ! 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 705 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 738 706 ! … … 778 746 zsshv_h(:,:) = zsshv_h(:,:) * r1_hv_0(:,:) 779 747 ! 780 ! !== e3t , e3u , e3v ==! 781 ! 748 ! !== e3t , e3u , e3v , e3w ==! 782 749 DO jk = 1, jpkm1 783 750 e3t_b(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) … … 785 752 e3v_b(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 786 753 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) ) 754 e3w_b(:,:,1) = e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) * tmask(:,:,1) ) 793 755 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) ) ) 756 e3w_b(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) ) ) 797 757 END DO 798 758 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domvvl_RK3.F90
r10023 r10030 144 144 CALL ssh2e3_before ! set: hu , hv , r1_hu, r1_hv 145 145 ! ! e3t, e3u , e3v (from 1 to jpkm1) 146 ! ! e3w, e3uw, e3vw (from 1 to jpk ) 147 ! ! gdept, gdepw (from 1 to jpk ) 146 ! ! e3w, gdept, gdepw (from 1 to jpk ) 148 147 ! 149 148 ! ! set jpk level one to the e3._0 values … … 153 152 CALL ssh2e3_now ! set: ht , hu , hv , r1_hu, r1_hv 154 153 ! ! e3t, e3u , e3v, e3f (from 1 to jpkm1) 155 ! ! e3w, e3uw, e3vw (from 1 to jpk ) 156 ! ! gdept, gdepw, gde3w (from 1 to jpk ) 154 ! ! e3w, gdept, gdepw, gde3w (from 1 to jpk ) 157 155 ! 158 156 ! ! set one for all last level to the e3._0 value … … 215 213 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 216 214 ! 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]215 ! e3uw_0 !: uw-vert. scale factor [m] 216 ! e3vw_0 !: vw-vert. scale factor [m] 219 217 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 220 218 ! … … 332 330 ! - JC - hu_b, hv_b, hur_b, hvr_b also 333 331 ! 334 ! - GM - to be updated : e3f_n, e3w_n , e3uw_n , e3vw_n 335 ! e3w_b , e3uw_b , e3vw_b 332 ! - GM - to be updated : e3f_n , e3w_n , e3w_b 336 333 ! gdept_n , gdepw_n , gde3w_n 337 334 ! ht_n … … 356 353 ! 357 354 ! !== before ==! 358 ! !* ssh at u- and v-points) 359 DO jj = 2, jpjm1 ; DO ji = 2, jpim1 360 zsshu_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nbb) + ssh(ji+1,jj ,Nbb) ) * ssumask(ji,jj) 361 zsshv_h(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nbb) + ssh(ji ,jj+1,Nbb) ) * ssvmask(ji,jj) 362 END DO ; END DO 363 CALL lbc_lnk_multi( zsshu_h(:,:),'U', 1._wp , zsshv_h(:,:),'V', 1._wp ) 364 ! 365 ! !* e3w_b , e3uw_b , e3vw_b 355 ! !* e3w_b 366 356 zssht_h(:,:) = ssh (:,:,Nbb) * r1_ht_0(:,:) ! w-point 367 zsshu_h(:,:) = zsshu_h(:,:) * r1_hu_0(:,:) ! uw-point 368 zsshv_h(:,:) = zsshv_h(:,:) * r1_hv_0(:,:) ! vw-point 369 DO jk = 1, jpkm1 370 e3w_b(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk) , tmask(:,:,jk+1) ) ) 371 e3uw_b(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * umask(:,:,jk) ) 372 e3vw_b(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 357 ! 358 e3w_b(:,:,1) = e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) * tmask(:,:,1) ) 359 DO jk = 2, jpk 360 e3w_b(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) ) ) 373 361 END DO 374 362 ! … … 388 376 ! 389 377 ! !== now ==! 390 ! !* ssh at u- and v-points) 391 DO jj = 1, jpjm1 ; DO ji = 1, jpim1 ! start from 1 for f-point 392 zsshu_h(ji,jj) = 0.50_wp * ( ssh(ji ,jj,Nnn) + ssh(ji+1,jj ,Nnn) ) * ssumask(ji,jj) 393 zsshv_h(ji,jj) = 0.50_wp * ( ssh(ji ,jj,Nnn) + ssh(ji ,jj+1,Nnn) ) * ssvmask(ji,jj) 394 zsshf_h(ji,jj) = 0.25_wp * ( ssh(ji ,jj,Nnn) + ssh(ji ,jj+1,Nnn) & 395 & + ssh(ji+1,jj,Nnn) + ssh(ji+1,jj+1,Nnn) ) * ssfmask(ji,jj) 396 END DO ; END DO 397 CALL lbc_lnk_multi( zsshu_h(:,:),'U', 1._wp , zsshv_h(:,:),'V', 1._wp , zsshf_h(:,:),'F', 1._wp ) 398 ! 399 ! !* e3w_n , e3uw_n , e3vw_n, e3f_n 400 zssht_h(:,:) = ssh (:,:,Nnn) * r1_ht_0(:,:) ! t- & w-point 401 zsshu_h(:,:) = zsshu_h(:,:) * r1_hu_0(:,:) ! uw-point 402 zsshv_h(:,:) = zsshv_h(:,:) * r1_hv_0(:,:) ! vw-point 403 zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:) ! f-point 378 ! !* ssh at f-points 379 DO jj = 1, jpjm1 380 DO ji = 1, jpim1 ! start from 1 for f-point 381 zsshf_h(ji,jj) = 0.25_wp * ( ssh(ji ,jj,Nnn) + ssh(ji ,jj+1,Nnn) & 382 & + ssh(ji+1,jj,Nnn) + ssh(ji+1,jj+1,Nnn) ) * ssfmask(ji,jj) 383 END DO 384 END DO 385 CALL lbc_lnk( zsshf_h(:,:),'F', 1._wp ) 386 ! 387 ! !* e3f_n 388 zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:) ! f-point 389 ! 404 390 DO jk = 1, jpkm1 405 e3uw_n(:,:,jk) = e3uw_0(:,:,jk) * ( 1._wp + zsshu_h(:,:) * wumask(:,:,jk) ) 406 e3vw_n(:,:,jk) = e3vw_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * wvmask(:,:,jk) ) 407 e3f_n(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 391 e3f_n(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 408 392 END DO 409 ! 410 zssht_h(:,:) = 1._wp + zssht_h(:,:) !* gdept , gdepw , gde3w 393 ! 394 ! !* gdept_n , gdepw_n , gde3w_n 395 zssht_h(:,:) = 1._wp + ssh(:,:,Nnn) * r1_ht_0(:,:) 411 396 ! 412 397 IF( ln_isfcav ) THEN ! ISF cavities : ssh scaling not applied over the iceshelf thickness … … 633 618 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 634 619 ! 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]620 ! e3uw_0 !: uw-vert. scale factor [m] 621 ! e3vw_0 !: vw-vert. scale factor [m] 637 622 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 638 623 ! … … 658 643 ! 659 644 ! !== ssh at u- and v-points ==! 660 ! 661 DO jj = 1, jpjm1 ! start from 1 due to f-point 662 DO ji = 1, jpim1 645 DO jj = 1, jpjm1 646 DO ji = 1, jpim1 ! start from 1 due to f-point 663 647 zsshu_h(ji,jj) = 0.50_wp * ( ssh(ji ,jj,Nnn) + ssh(ji+1,jj ,Nnn) ) * ssumask(ji,jj) 664 648 zsshv_h(ji,jj) = 0.50_wp * ( ssh(ji ,jj,Nnn) + ssh(ji ,jj+1,Nnn) ) * ssvmask(ji,jj) … … 670 654 ! 671 655 ! !== ht, hu and hv == ! (and their inverse) 672 !673 656 ht_n (:,:) = ht_0(:,:) + ssh (:,:,Nnn) 674 657 hu_n (:,:) = hu_0(:,:) + zsshu_h(:,:) … … 678 661 ! 679 662 ! !== ssh / h factor at t-, u- ,v- & f-points ==! 680 !681 663 zssht_h(:,:) = ssh (:,:,Nnn) * r1_ht_0(:,:) 682 664 zsshu_h(:,:) = zsshu_h(:,:) * r1_hu_0(:,:) … … 684 666 zsshf_h(:,:) = zsshf_h(:,:) * r1_hf_0(:,:) 685 667 ! 686 ! !== e3t , e3u , e3v , e3f ==! 687 ! 668 ! !== e3t , e3u , e3v , e3f , e3w ==! 688 669 DO jk = 1, jpkm1 689 670 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) … … 692 673 e3f_n(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + zsshf_h(:,:) * fmask(:,:,jk) ) 693 674 END DO 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) ) 675 e3w_n(:,:,1) = e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) * tmask(:,:,1) ) 700 676 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) ) ) 677 e3w_n(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) ) ) 704 678 END DO 705 679 ! … … 733 707 ! e3v_0 , e3v_b , e3v_n , e3v_a !: v- vert. scale factor [m] 734 708 ! 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]709 ! e3uw_0 !: uw-vert. scale factor [m] 710 ! e3vw_0 !: vw-vert. scale factor [m] 737 711 ! e3f_0 , e3f_n !: f- vert. scale factor [m] 738 712 ! … … 778 752 zsshv_h(:,:) = zsshv_h(:,:) * r1_hv_0(:,:) 779 753 ! 780 ! !== e3t , e3u , e3v ==! 781 ! 754 ! !== e3t , e3u , e3v , e3w ==! 782 755 DO jk = 1, jpkm1 783 756 e3t_b(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * tmask(:,:,jk) ) … … 785 758 e3v_b(:,:,jk) = e3v_0(:,:,jk) * ( 1._wp + zsshv_h(:,:) * vmask(:,:,jk) ) 786 759 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) ) 760 e3w_b(:,:,1) = e3w_0(:,:,1) * ( 1._wp + zssht_h(:,:) * tmask(:,:,1) ) 793 761 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) ) ) 762 e3w_b(:,:,jk) = e3w_0(:,:,jk) * ( 1._wp + zssht_h(:,:) * MAX( tmask(:,:,jk-1) , tmask(:,:,jk) ) ) 797 763 END DO 798 764 ! -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/iscplrst.F90
r10023 r10030 102 102 e3v_b (:,:,:) = e3v_n (:,:,:) 103 103 ! 104 e3uw_b (:,:,:) = e3uw_n (:,:,:)105 e3vw_b (:,:,:) = e3vw_n (:,:,:)106 104 gdept_b(:,:,:) = gdept_n(:,:,:) 107 105 gdepw_b(:,:,:) = gdepw_n(:,:,:) … … 206 204 CALL ssh2e3_now ! set: ht , hu , hv , r1_hu, r1_hv 207 205 ! ! e3t, e3u , e3v, e3f (from 1 to jpkm1) 208 ! ! e3w, e3uw, e3vw (from 1 to jpk ) 209 ! ! gdept, gdepw, gde3w (from 1 to jpk ) 206 ! ! e3w, gdept, gdepw, gde3w (from 1 to jpk ) 210 207 ! 211 208 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynzdf.F90
r10001 r10030 36 36 37 37 PUBLIC dyn_zdf ! routine called by step.F90 38 39 REAL(wp) :: r_vvl ! non-linear free surface indicator: =0 if ln_linssh=T, =1 otherwise40 38 41 39 !! * Substitutions … … 70 68 INTEGER, INTENT(in) :: kt ! ocean time-step index 71 69 ! 72 INTEGER :: ji, jj, jk 73 INTEGER :: iku, ikv 74 REAL(wp) :: zzwi, z e3ua, z2dt_2 ! local scalars75 REAL(wp) :: zzws , ze3va! - -70 INTEGER :: ji, jj, jk ! dummy loop indices 71 INTEGER :: iku, ikv ! local integers 72 REAL(wp) :: zzwi, zDt_2 ! local scalars 73 REAL(wp) :: zzws ! - - 76 74 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwd, zws ! 3D workspace 77 75 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv ! - - 76 REAL(wp) :: ze3uw_A , ze3uw_Ap1 ! local real 77 REAL(wp) :: ze3vw_A , ze3vw_Ap1 ! local real 78 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_hA, zsshv_hA ! 2D workspace 78 79 !!--------------------------------------------------------------------- 79 80 ! … … 84 85 IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator' 85 86 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 86 ! 87 If( ln_linssh ) THEN ; r_vvl = 0._wp ! non-linear free surface indicator 88 ELSE ; r_vvl = 1._wp 89 ENDIF 90 ENDIF 91 ! 92 z2dt_2 = rDt * 0.5_wp !* =rn_Dt except in 1st Euler time step where it is equal to rn_Dt/2 87 ENDIF 88 ! 89 zDt_2 = rDt * 0.5_wp !* =rn_Dt except in 1st Euler time step where it is equal to rn_Dt/2 93 90 ! 94 91 ! … … 131 128 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 132 129 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 133 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 134 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) 135 ua(ji,jj,iku) = ua(ji,jj,iku) + z2dt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua 136 va(ji,jj,ikv) = va(ji,jj,ikv) + z2dt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va 130 ua(ji,jj,iku) = ua(ji,jj,iku) + zDt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / e3u_a(ji,jj,iku) 131 va(ji,jj,ikv) = va(ji,jj,ikv) + zDt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / e3v_a(ji,jj,ikv) 137 132 END DO 138 133 END DO … … 142 137 iku = miku(ji,jj) ! top ocean level at u- and v-points 143 138 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) 144 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 145 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) 146 ua(ji,jj,iku) = ua(ji,jj,iku) + z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua 147 va(ji,jj,ikv) = va(ji,jj,ikv) + z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va 139 ua(ji,jj,iku) = ua(ji,jj,iku) + zDt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / e3u_a(ji,jj,iku) 140 va(ji,jj,ikv) = va(ji,jj,ikv) + zDt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / e3v_a(ji,jj,ikv) 148 141 END DO 149 142 END DO … … 153 146 ! !== Vertical diffusion on u ==! 154 147 ! 148 ! !* multiplicative factors on e3uw(Naa) and e3vw(Naa) 149 ! 150 IF( ln_linssh ) THEN !-- linear ssh case 151 DO jj = 1, jpjm1 152 DO ji = 1, jpim1 153 zsshu_hA(ji,jj) = 0._wp ! no time variation in e3 154 zsshv_hA(ji,jj) = 0._wp 155 END DO 156 END DO 157 ELSE !-- Non linear ssh case 158 DO jj = 1, jpjm1 159 DO ji = 1, jpim1 160 zsshu_hA(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji+1,jj ,Naa) ) * r1_hu_0(ji,jj) * ssumask(ji,jj) 161 zsshv_hA(ji,jj) = 0.5_wp * ( ssh(ji,jj,Naa) + ssh(ji ,jj+1,Naa) ) * r1_hv_0(ji,jj) * ssvmask(ji,jj) 162 END DO 163 END DO 164 ENDIF 165 166 167 168 169 155 170 SELECT CASE( nldf_dyn ) !* Matrix construction 156 171 ! … … 159 174 DO jj = 2, jpjm1 160 175 DO ji = fs_2, fs_jpim1 ! vector opt. 161 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk) ! after scale factor at T-point 162 zzwi = - rDt * ( 0.5 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) + akzu(ji,jj,jk ) ) & 163 & / ( ze3ua * e3uw_n(ji,jj,jk ) ) * wumask(ji,jj,jk ) 164 zzws = - rDt * ( 0.5 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) + akzu(ji,jj,jk+1) ) & 165 & / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 176 !!gm Note that below, since ze3uw_A is used in a expression masked by wumask, 177 !! one can remove wumask from its expression (same for ze3uw_Ap1 178 ze3uw_A = e3uw_0(ji,jj,jk ) * ( 1._wp + zsshu_hA(ji,jj) * wumask(ji,jj,jk ) ) 179 ze3uw_Ap1 = e3uw_0(ji,jj,jk+1) * ( 1._wp + zsshu_hA(ji,jj) * wumask(ji,jj,jk+1) ) 180 ! 181 zzwi = - rDt * ( 0.5 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) + akzu(ji,jj,jk ) ) & 182 & / ( e3u_a(ji ,jj,jk ) * ze3uw_A ) * wumask(ji,jj,jk ) 183 zzws = - rDt * ( 0.5 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) + akzu(ji,jj,jk+1) ) & 184 & / ( e3u_a(ji ,jj,jk ) * ze3uw_Ap1 ) * wumask(ji,jj,jk+1) 166 185 zwi(ji,jj,jk) = zzwi 167 186 zws(ji,jj,jk) = zzws … … 174 193 DO jj = 2, jpjm1 175 194 DO ji = fs_2, fs_jpim1 ! vector opt. 176 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk) ! after scale factor at T-point 177 zzwi = - z2dt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) / ( ze3ua * e3uw_n(ji,jj,jk ) ) * wumask(ji,jj,jk ) 178 zzws = - z2dt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 195 !!gm Note that below, since ze3uw_A is used in a expression masked by wumask, 196 !! one can remove wumask from its expression (same for ze3uw_Ap1 197 ze3uw_A = e3uw_0(ji,jj,jk ) * ( 1._wp + zsshu_hA(ji,jj) * wumask(ji,jj,jk ) ) 198 ze3uw_Ap1 = e3uw_0(ji,jj,jk+1) * ( 1._wp + zsshu_hA(ji,jj) * wumask(ji,jj,jk+1) ) 199 ! 200 zzwi = - zDt_2 * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) / ( e3u_a(ji,jj,jk) * ze3uw_A ) * wumask(ji,jj,jk ) 201 zzws = - zDt_2 * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( e3u_a(ji,jj,jk) * ze3uw_Ap1 ) * wumask(ji,jj,jk+1) 179 202 zwi(ji,jj,jk) = zzwi 180 203 zws(ji,jj,jk) = zzws … … 202 225 DO ji = 2, jpim1 203 226 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 204 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) ! after scale factor at T-point 205 zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 227 zwd(ji,jj,iku) = zwd(ji,jj,iku) - zDt_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_a(ji,jj,iku) 206 228 END DO 207 229 END DO … … 211 233 !!gm top Cd is masked (=0 outside cavities) no need of test on mik>=2 ==>> it has been suppressed 212 234 iku = miku(ji,jj) ! ocean top level at u- and v-points 213 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) ! after scale factor at T-point 214 zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua 235 zwd(ji,jj,iku) = zwd(ji,jj,iku) - zDt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_a(ji,jj,iku) 215 236 END DO 216 237 END DO … … 243 264 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 244 265 DO ji = fs_2, fs_jpim1 ! vector opt. 245 ze3ua = ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 246 ua(ji,jj,1) = ua(ji,jj,1) + z2dt_2 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( ze3ua * rho0 ) * umask(ji,jj,1) 266 ua(ji,jj,1) = ua(ji,jj,1) + zDt_2 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_a(ji,jj,1) * rho0 ) * umask(ji,jj,1) 247 267 END DO 248 268 END DO … … 276 296 DO jj = 2, jpjm1 277 297 DO ji = fs_2, fs_jpim1 ! vector opt. 278 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk) ! after scale factor at T-point 279 zzwi = - rDt * ( 0.5 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) + akzv(ji,jj,jk ) ) & 280 & / ( ze3va * e3vw_n(ji,jj,jk ) ) * wvmask(ji,jj,jk ) 281 zzws = - rDt * ( 0.5 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) + akzv(ji,jj,jk+1) ) & 282 & / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 298 ze3vw_A = e3vw_0(ji,jj,jk ) * ( 1._wp + zsshv_hA(ji,jj) * wvmask(ji,jj,jk ) ) 299 ze3vw_Ap1 = e3vw_0(ji,jj,jk+1) * ( 1._wp + zsshv_hA(ji,jj) * wvmask(ji,jj,jk+1) ) 300 ! 301 zzwi = - rDt * ( 0.5 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) + akzv(ji,jj,jk ) ) & 302 & / ( e3v_a(ji,jj ,jk ) * ze3vw_A ) * wvmask(ji,jj,jk ) 303 zzws = - rDt * ( 0.5 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) + akzv(ji,jj,jk+1) ) & 304 & / ( e3v_a(ji,jj ,jk ) * ze3vw_Ap1 ) * wvmask(ji,jj,jk+1) 283 305 zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk ) 284 306 zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) … … 291 313 DO jj = 2, jpjm1 292 314 DO ji = fs_2, fs_jpim1 ! vector opt. 293 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk) ! after scale factor at T-point 294 zzwi = - z2dt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) / ( ze3va * e3vw_n(ji,jj,jk ) ) * wvmask(ji,jj,jk ) 295 zzws = - z2dt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 315 ze3vw_A = e3vw_0(ji,jj,jk ) * ( 1._wp + zsshv_hA(ji,jj) * wvmask(ji,jj,jk ) ) 316 ze3vw_Ap1 = e3vw_0(ji,jj,jk+1) * ( 1._wp + zsshv_hA(ji,jj) * wvmask(ji,jj,jk+1) ) 317 ! 318 zzwi = - zDt_2 * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) / ( e3v_a(ji,jj,jk) * ze3vw_A ) * wvmask(ji,jj,jk ) 319 zzws = - zDt_2 * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( e3v_a(ji,jj,jk) * ze3vw_Ap1 ) * wvmask(ji,jj,jk+1) 296 320 zwi(ji,jj,jk) = zzwi * wvmask(ji,jj,jk ) 297 321 zws(ji,jj,jk) = zzws * wvmask(ji,jj,jk+1) … … 318 342 DO ji = 2, jpim1 319 343 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 320 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) ! after scale factor at T-point 321 zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - z2dt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va 344 zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - zDt_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_a(ji,jj,ikv) 322 345 END DO 323 346 END DO … … 326 349 DO ji = 2, jpim1 327 350 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) 328 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) ! after scale factor at T-point 329 zwd(ji,jj,iku) = zwd(ji,jj,iku) - z2dt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va 351 zwd(ji,jj,iku) = zwd(ji,jj,iku) - zDt_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3v_a(ji,jj,ikv) 330 352 END DO 331 353 END DO … … 358 380 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 ==! 359 381 DO ji = fs_2, fs_jpim1 ! vector opt. 360 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 361 va(ji,jj,1) = va(ji,jj,1) + z2dt_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( ze3va * rho0 ) * vmask(ji,jj,1) 382 va(ji,jj,1) = va(ji,jj,1) + zDt_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_a(ji,jj,1) * rho0 ) * vmask(ji,jj,1) 362 383 END DO 363 384 END DO … … 402 423 END SUBROUTINE dyn_zdf 403 424 404 !!gm currently not used : just for memory to be able to add dissipation trend through vertical mixing405 406 SUBROUTINE zdf_trd( ptrdu, ptrdv ,kt )407 !!----------------------------------------------------------------------408 !! *** ROUTINE zdf_trd ***409 !!410 !! ** Purpose : compute the trend due to the vert. momentum diffusion411 !! together with the Leap-Frog time stepping using an412 !! implicit scheme.413 !!414 !! ** Method : - Leap-Frog time stepping on all trends but the vertical mixing415 !! ua = ub + 2*dt * ua vector form or linear free surf.416 !! ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a otherwise417 !! - update the after velocity with the implicit vertical mixing.418 !! This requires to solver the following system:419 !! ua = ua + 1/e3u_a dk+1[ mi(avm) / e3uw_a dk[ua] ]420 !! with the following surface/top/bottom boundary condition:421 !! surface: wind stress input (averaged over kt-1/2 & kt+1/2)422 !! top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfdrg.F90)423 !!424 !! ** Action : (ua,va) after velocity425 !!---------------------------------------------------------------------426 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: ptrdu, ptrdv ! 3D work arrays use for zdf trends diag427 INTEGER , INTENT(in ) :: kt ! ocean time-step index428 !429 INTEGER :: ji, jj, jk ! dummy loop indices430 REAL(wp) :: zzz ! local scalar431 REAL(wp) :: zavmu, zavmum1 ! - -432 REAL(wp) :: zavmv, zavmvm1 ! - -433 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: z2d ! - -434 !!---------------------------------------------------------------------435 !436 CALL lbc_lnk_multi( ua, 'U', -1., va, 'V', -1. ) ! apply lateral boundary condition on (ua,va)437 !438 !439 ! !== momentum trend due to vertical diffusion ==!440 !441 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! applied on velocity442 ptrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * r1_Dt - ptrdu(:,:,:)443 ptrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * r1_Dt - ptrdv(:,:,:)444 ELSE ! applied on thickness weighted velocity445 ptrdu(:,:,:) = ( e3u_a(:,:,:)*ua(:,:,:) - e3u_b(:,:,:)*ub(:,:,:) ) / e3u_n(:,:,:) * r1_Dt - ptrdu(:,:,:)446 ptrdv(:,:,:) = ( e3v_a(:,:,:)*va(:,:,:) - e3v_b(:,:,:)*vb(:,:,:) ) / e3v_n(:,:,:) * r1_Dt - ptrdv(:,:,:)447 ENDIF448 CALL trd_dyn( ptrdu, ptrdv, jpdyn_zdf, kt )449 !450 !451 ! !== KE dissipation trend due to vertical diffusion ==!452 !453 IF( iom_use( 'dispkevfo' ) ) THEN ! ocean kinetic energy dissipation per unit area454 ! ! due to v friction (v=vertical)455 ! ! see NEMO_book appendix C, §C.8 (N.B. here averaged at t-points)456 ! ! Note that formally, in a Leap-Frog environment, the shear**2 should be the product of457 ! ! now by before shears, i.e. the source term of TKE (local positivity is not ensured).458 ! ! Note also that now e3 scale factors are used as after one are not computed !459 !460 ALLOCATE( z2d(jpi,jpj) )461 z2d(:,:) = 0._wp462 DO jk = 1, jpkm1463 DO jj = 2, jpjm1464 DO ji = 2, jpim1465 zavmu = 0.5 * ( avm(ji+1,jj,jk) + avm(ji ,jj,jk) )466 zavmum1 = 0.5 * ( avm(ji ,jj,jk) + avm(ji-1,jj,jk) )467 zavmv = 0.5 * ( avm(ji,jj+1,jk) + avm(ji,jj ,jk) )468 zavmvm1 = 0.5 * ( avm(ji,jj ,jk) + avm(ji,jj-1,jk) )469 470 z2d(ji,jj) = z2d(ji,jj) + ( &471 & zavmu * ( ua(ji ,jj,jk-1) - ua(ji ,jj,jk) )**2 / e3uw_n(ji ,jj,jk) * wumask(ji ,jj,jk) &472 & + zavmum1 * ( ua(ji-1,jj,jk-1) - ua(ji-1,jj,jk) )**2 / e3uw_n(ji-1,jj,jk) * wumask(ji-1,jj,jk) &473 & + zavmv * ( va(ji,jj ,jk-1) - va(ji,jj ,jk) )**2 / e3vw_n(ji,jj ,jk) * wvmask(ji,jj ,jk) &474 & + zavmvm1 * ( va(ji,jj-1,jk-1) - va(ji,jj-1,jk) )**2 / e3vw_n(ji,jj-1,jk) * wvmask(ji,jj-1,jk) &475 & )476 !!gm --- This trends is in fact properly computed in zdf_sh2 but with a backward shift of one time-step ===>>> use it ?477 !! No since in zdfshé only kz tke (or gls) is used478 !!479 !!gm --- formally, as done below, in a Leap-Frog environment, the shear**2 should be the product of480 !!gm now by before shears, i.e. the source term of TKE (local positivity is not ensured).481 !! CAUTION: requires to compute e3uw_a and e3vw_a !!!482 ! z2d(ji,jj) = z2d(ji,jj) + ( &483 ! & avmu(ji ,jj,jk) * ( un(ji ,jj,jk-1) - un(ji ,jj,jk) ) / e3uw_n(ji ,jj,jk) &484 ! & * ( ua(ji ,jj,jk-1) - ua(ji ,jj,jk) ) / e3uw_a(ji ,jj,jk) * wumask(ji ,jj,jk) &485 ! & + avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) / e3uw_n(ji-1,jj,jk) &486 ! & ( ua(ji-1,jj,jk-1) - ua(ji-1,jj,jk) ) / e3uw_a(ji-1,jj,jk) * wumask(ji-1,jj,jk) &487 ! & + avmv(ji,jj ,jk) * ( vn(ji,jj ,jk-1) - vn(ji,jj ,jk) ) / e3vw_n(ji,jj ,jk) &488 ! & ( va(ji,jj ,jk-1) - va(ji,jj ,jk) ) / e3vw_a(ji,jj ,jk) * wvmask(ji,jj ,jk) &489 ! & + avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) / e3vw_n(ji,jj-1,jk) &490 ! & ( va(ji,jj-1,jk-1) - va(ji,jj-1,jk) ) / e3vw_a(ji,jj-1,jk) * wvmask(ji,jj-1,jk) &491 ! & )492 !!gm end493 END DO494 END DO495 END DO496 zzz= - 0.5_wp* rho0 ! caution sign minus here497 z2d(:,:) = zzz * z2d(:,:)498 CALL lbc_lnk( z2d,'T', 1. )499 CALL iom_put( 'dispkevfo', z2d )500 DEALLOCATE( z2d )501 ENDIF502 !503 END SUBROUTINE zdf_trd504 505 !!gm end not used506 507 425 !!============================================================================== 508 426 END MODULE dynzdf -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/trazdf.F90
r10001 r10030 112 112 !! 113 113 !! ** Method : The vertical diffusion of a tracer ,t , is given by: 114 !! difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3wdk(t) )114 !! difft = dz( avt dz(t) ) = 1/e3t(Naa) dk+1( avt/e3w(Naa) dk(t) ) 115 115 !! It is computed using a backward time scheme (t=after field) 116 116 !! which provide directly the after tracer field. … … 175 175 DO jj = 2, jpjm1 176 176 DO ji = fs_2, fs_jpim1 ! vector opt. 177 !!gm BUG here e3w_a should be used !!!!! but then should be added in the system 178 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w_n(ji,jj,jk ) 179 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_n(ji,jj,jk+1) 177 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w_a(ji,jj,jk ) 178 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w_a(ji,jj,jk+1) 180 179 zwd(ji,jj,jk) = e3t_a(ji,jj,jk) - zwi(ji,jj,jk) - zws(ji,jj,jk) 181 180 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfosm.F90
r9939 r10030 247 247 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zviscos ! viscosity 248 248 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdiffut ! t-diffusivity 249 250 REAL(wp) :: ze3uw_BN, ze3vw_BN ! use for e3uw, e3vw computation 251 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_hB, zsshv_hB ! at Before and Now time-step 252 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_hN, zsshv_hN 249 253 250 254 ! For debugging … … 1235 1239 1236 1240 ! KPP-style Ri# mixing 1237 IF( ln_kpprimix) THEN 1238 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 1239 DO jj = 1, jpjm1 1240 DO ji = 1, jpim1 ! vector opt. 1241 z3du(ji,jj,jk) = 0.5 * ( un(ji,jj,jk-1) - un(ji ,jj,jk) ) & 1242 & * ( ub(ji,jj,jk-1) - ub(ji ,jj,jk) ) * wumask(ji,jj,jk) & 1243 & / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 1244 z3dv(ji,jj,jk) = 0.5 * ( vn(ji,jj,jk-1) - vn(ji,jj ,jk) ) & 1245 & * ( vb(ji,jj,jk-1) - vb(ji,jj ,jk) ) * wvmask(ji,jj,jk) & 1246 & / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 1241 IF( ln_kpprimix) THEN 1242 ! 1243 IF( ln_linssh ) THEN !== linear ssh case ==! 1244 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 1245 DO jj = 1, jpjm1 1246 DO ji = 1, jpim1 ! vector opt. 1247 ze3uw_BN = e3uw_0(ji,jj,jk) * e3uw_0(ji,jj,jk) 1248 ze3vw_BN = e3vw_0(ji,jj,jk) * e3vw_0(ji,jj,jk) 1249 z3du(ji,jj,jk) = 0.5 * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) & 1250 & * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) ) / ze3uw_BN * wumask(ji,jj,jk) 1251 z3dv(ji,jj,jk) = 0.5 * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) & 1252 & * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) ) / ze3vw_BN * wvmask(ji,jj,jk) 1253 END DO 1247 1254 END DO 1248 END DO 1249 END DO 1250 ! 1255 END DO 1256 ELSE !== Non linear ssh case ==! 1257 DO jj = 1, jpjm1 1258 DO ji = 1, jpim1 1259 zsshu_hB(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nbb) + ssh(ji+1,jj ,Nbb) ) * r1_hu_0(ji,jj) * ssumask(ji,jj) 1260 zsshv_hB(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nbb) + ssh(ji ,jj+1,Nbb) ) * r1_hv_0(ji,jj) * ssvmask(ji,jj) 1261 zsshu_hN(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nnn) + ssh(ji+1,jj ,Nnn) ) * r1_hu_0(ji,jj) * ssumask(ji,jj) 1262 zsshv_hN(ji,jj) = 0.5_wp * ( ssh(ji,jj,Nnn) + ssh(ji ,jj+1,Nnn) ) * r1_hv_0(ji,jj) * ssvmask(ji,jj) 1263 END DO 1264 END DO 1265 ! 1266 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 1267 DO jj = 1, jpjm1 1268 DO ji = 1, jpim1 ! vector opt. 1269 ze3uw_BN = e3uw_0(ji,jj,jk) * e3uw_0(ji,jj,jk) * ( 1._wp + zsshu_hB(ji,jj) * wumask(ji,jj,jk) ) & 1270 & * ( 1._wp + zsshu_hN(ji,jj) * wumask(ji,jj,jk) ) 1271 ze3vw_BN = e3vw_0(ji,jj,jk) * e3vw_0(ji,jj,jk) * ( 1._wp + zsshu_hB(ji,jj) * wvmask(ji,jj,jk) ) & 1272 & * ( 1._wp + zsshu_hN(ji,jj) * wvmask(ji,jj,jk) ) 1273 z3du(ji,jj,jk) = 0.5 * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) & 1274 & * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) ) / ze3uw_BN * wumask(ji,jj,jk) 1275 z3dv(ji,jj,jk) = 0.5 * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) & 1276 & * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) ) / ze3vw_BN * wvmask(ji,jj,jk) 1277 END DO 1278 END DO 1279 END DO 1280 ENDIF 1281 ! 1251 1282 DO jk = 2, jpkm1 1252 1283 DO jj = 2, jpjm1 … … 1262 1293 END DO 1263 1294 END DO 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1295 END DO 1296 ! 1297 DO jj = 2, jpjm1 1298 DO ji = 2, jpim1 1299 DO jk = ibld(ji,jj) + 1, jpkm1 1300 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 1301 zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 1302 END DO 1303 END DO 1304 END DO 1305 ! 1275 1306 END IF ! ln_kpprimix = .true. 1276 1307 … … 1708 1739 DO jj = 2, jpjm1 1709 1740 DO ji = 2, jpim1 1710 ua(ji,jj,jk) = ua(ji,jj,jk) & 1711 & - ( ghamu(ji,jj,jk ) & 1712 & - ghamu(ji,jj,jk+1) ) / e3u_n(ji,jj,jk) 1713 va(ji,jj,jk) = va(ji,jj,jk) & 1714 & - ( ghamv(ji,jj,jk ) & 1715 & - ghamv(ji,jj,jk+1) ) / e3v_n(ji,jj,jk) 1741 ua(ji,jj,jk) = ua(ji,jj,jk) - ( ghamu(ji,jj,jk) - ghamu(ji,jj,jk+1) ) / e3u_n(ji,jj,jk) 1742 va(ji,jj,jk) = va(ji,jj,jk) - ( ghamv(ji,jj,jk) - ghamv(ji,jj,jk+1) ) / e3v_n(ji,jj,jk) 1716 1743 END DO 1717 1744 END DO -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfphy.F90
r9598 r10030 246 246 ! 247 247 IF( l_zdfsh2 ) & !* shear production at w-points (energy conserving form) 248 CALL zdf_sh2( ub, vb, un, vn, avm_k, & ! <<== in249 & zsh2 ) ! ==>> out : shear production248 CALL zdf_sh2( ssh, ub, vb, un, vn, avm_k, & ! <<== in 249 & zsh2 ) ! ==>> out : shear production 250 250 ! 251 251 SELECT CASE ( nzdf_phy ) !* Vertical eddy viscosity and diffusivity coefficients at w-points -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/ZDF/zdfsh2.F90
r9598 r10030 6 6 !! History : - ! 2014-10 (A. Barthelemy, G. Madec) original code 7 7 !! NEMO 4.0 ! 2017-04 (G. Madec) remove u-,v-pts avm 8 !! 5.0 ! 2018-08 (G. Madec) local calculation of e3uw e3vw 8 9 !!---------------------------------------------------------------------- 9 10 … … 28 29 CONTAINS 29 30 30 SUBROUTINE zdf_sh2( p ub, pvb, pun, pvn, p_avm, p_sh2 )31 SUBROUTINE zdf_sh2( pssh, pub, pvb, pun, pvn, p_avm, p_sh2 ) 31 32 !!---------------------------------------------------------------------- 32 33 !! *** ROUTINE zdf_sh2 *** … … 47 48 !! References : Bruchard, OM 2002 48 49 !! --------------------------------------------------------------------- 50 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pssh ! sea surface height 49 51 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pub, pvb, pun, pvn ! before, now horizontal velocities 50 52 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm ! vertical eddy viscosity (w-points) 51 53 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: p_sh2 ! shear production of TKE (w-points) 52 54 ! 53 INTEGER :: ji, jj, jk ! dummy loop arguments 54 REAL(wp), DIMENSION(jpi,jpj) :: zsh2u, zsh2v ! 2D workspace 55 INTEGER :: ji, jj, jk ! dummy loop arguments 56 REAL(wp):: ze3uw_BN, ze3vw_BN ! local real 57 REAL(wp), DIMENSION(jpi,jpj) :: zsh2u , zsh2v ! 2D workspace 58 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_hB, zsshv_hB ! 2D workspace 59 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_hN, zsshv_hN 55 60 !!-------------------------------------------------------------------- 56 61 ! 57 DO jk = 2, jpkm1 58 DO jj = 1, jpjm1 !* 2 x shear production at uw- and vw-points (energy conserving form) 62 IF( ln_linssh ) THEN !== linear ssh case ==! 63 DO jk = 2, jpkm1 64 DO jj = 1, jpjm1 !* 2 x shear production at uw- and vw-points (energy conserving form) 65 DO ji = 1, jpim1 66 ze3uw_BN = e3uw_0(ji,jj,jk) * e3uw_0(ji,jj,jk) 67 ze3vw_BN = e3vw_0(ji,jj,jk) * e3vw_0(ji,jj,jk) 68 ! 69 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 70 & * ( pun(ji,jj,jk-1) - pun(ji,jj,jk) ) & 71 & * ( pub(ji,jj,jk-1) - pub(ji,jj,jk) ) / ze3uw_BN * wumask(ji,jj,jk) 72 zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 73 & * ( pvn(ji,jj,jk-1) - pvn(ji,jj,jk) ) & 74 & * ( pvb(ji,jj,jk-1) - pvb(ji,jj,jk) ) / ze3vw_BN * wvmask(ji,jj,jk) 75 END DO 76 END DO 77 DO jj = 2, jpjm1 !* shear production at w-point 78 DO ji = 2, jpim1 ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 79 p_sh2(ji,jj,jk) = 0.25 * ( ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) & 80 & + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) ) ) 81 END DO 82 END DO 83 END DO 84 ! 85 ELSE !== Non linear ssh case ==! 86 DO jj = 1, jpjm1 59 87 DO ji = 1, jpim1 60 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 61 & * ( pun(ji,jj,jk-1) - pun(ji,jj,jk) ) & 62 & * ( pub(ji,jj,jk-1) - pub(ji,jj,jk) ) / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) * wumask(ji,jj,jk) 63 zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 64 & * ( pvn(ji,jj,jk-1) - pvn(ji,jj,jk) ) & 65 & * ( pvb(ji,jj,jk-1) - pvb(ji,jj,jk) ) / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) * wvmask(ji,jj,jk) 88 zsshu_hB(ji,jj) = 0.5_wp * ( pssh(ji,jj,Nbb) + pssh(ji+1,jj ,Nbb) ) * r1_hu_0(ji,jj) * ssumask(ji,jj) 89 zsshv_hB(ji,jj) = 0.5_wp * ( pssh(ji,jj,Nbb) + pssh(ji ,jj+1,Nbb) ) * r1_hv_0(ji,jj) * ssvmask(ji,jj) 90 zsshu_hN(ji,jj) = 0.5_wp * ( pssh(ji,jj,Nnn) + pssh(ji+1,jj ,Nnn) ) * r1_hu_0(ji,jj) * ssumask(ji,jj) 91 zsshv_hN(ji,jj) = 0.5_wp * ( pssh(ji,jj,Nnn) + pssh(ji ,jj+1,Nnn) ) * r1_hv_0(ji,jj) * ssvmask(ji,jj) 66 92 END DO 67 93 END DO 68 DO jj = 2, jpjm1 !* shear production at w-point 69 DO ji = 2, jpim1 ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 70 p_sh2(ji,jj,jk) = 0.25 * ( ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) & 71 & + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) ) ) 94 ! 95 DO jk = 2, jpkm1 96 DO jj = 1, jpjm1 !* 2 x shear production at uw- and vw-points (energy conserving form) 97 DO ji = 1, jpim1 98 ze3uw_BN = e3uw_0(ji,jj,jk) * e3uw_0(ji,jj,jk) * ( 1._wp + zsshu_hB(ji,jj) * wumask(ji,jj,jk) ) & 99 & * ( 1._wp + zsshu_hN(ji,jj) * wumask(ji,jj,jk) ) 100 ze3vw_BN = e3vw_0(ji,jj,jk) * e3vw_0(ji,jj,jk) * ( 1._wp + zsshu_hB(ji,jj) * wvmask(ji,jj,jk) ) & 101 & * ( 1._wp + zsshu_hN(ji,jj) * wvmask(ji,jj,jk) ) 102 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 103 & * ( pun(ji,jj,jk-1) - pun(ji,jj,jk) ) & 104 & * ( pub(ji,jj,jk-1) - pub(ji,jj,jk) ) / ze3uw_BN * wumask(ji,jj,jk) 105 zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 106 & * ( pvn(ji,jj,jk-1) - pvn(ji,jj,jk) ) & 107 & * ( pvb(ji,jj,jk-1) - pvb(ji,jj,jk) ) / ze3vw_BN * wvmask(ji,jj,jk) 108 END DO 72 109 END DO 73 END DO 74 END DO 110 DO jj = 2, jpjm1 !* shear production at w-point 111 DO ji = 2, jpim1 ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 112 p_sh2(ji,jj,jk) = 0.25 * ( ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) & 113 & + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) ) ) 114 END DO 115 END DO 116 END DO 117 ENDIF 75 118 ! 76 119 END SUBROUTINE zdf_sh2 -
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OFF/dtadyn.F90
r10009 r10030 332 332 ! 333 333 ! !* BEFORE fields : 334 CALL ssh2e3_before ! set: hu , hv , r1_hu, r1_hv 335 ! ! e3t, e3w, e3u, e3uw, e3v, e3vw (from 1 to jpkm1) 334 CALL ssh2e3_before ! set: hu, hv, r1_hu, r1_hv 335 ! ! e3t, e3u, e3v, (from 1 to jpkm1) 336 ! ! e3w, (from 1 to jpk ) 336 337 ! 337 338 ! ! set jpk level one to the e3._0 values 338 e3t_b(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_b(:,:,jpk) = e3w_0(:,:,jpk) ; e3v_b(:,:,jpk) = e3v_0(:,:,jpk)339 e3w_b(:,:,jpk) = e3w_0(:,:,jpk) ; e3uw_b(:,:,jpk) = e3uw_0(:,:,jpk) ; e3vw_b(:,:,jpk) = e3vw_0(:,:,jpk)339 e3t_b(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_b(:,:,jpk) = e3u_0(:,:,jpk) 340 e3v_b(:,:,jpk) = e3v_0(:,:,jpk) 340 341 ! 341 342 ! !* NOW fields : 342 CALL ssh2e3_now ! set: ht , hu , hv , r1_hu, r1_hv 343 ! ! e3t, e3w, e3u, e3uw, e3v, e3vw, e3f (from 1 to jpkm1) 344 ! ! gdept_n, gdepw_n, gde3w_n 345 !!gm issue? gdept_n, gdepw_n, gde3w_n never defined at jpk 343 CALL ssh2e3_now ! set: ht, hu, hv, r1_hu, r1_hv 344 ! ! e3t, e3u, e3v , e3f (from 1 to jpkm1) 345 ! ! e3w, gdept_n, gdepw_n, gde3w_n (from 1 to jpk ) 346 346 ! 347 347 ! ! set one for all last level to the e3._0 value 348 e3t_n(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_n(:,:,jpk) = e3w_0(:,:,jpk) ; e3v_n(:,:,jpk) = e3v_0(:,:,jpk) 349 e3w_n(:,:,jpk) = e3w_0(:,:,jpk) ; e3uw_n(:,:,jpk) = e3uw_0(:,:,jpk) ; e3vw_n(:,:,jpk) = e3vw_0(:,:,jpk) 350 e3f_n(:,:,jpk) = e3f_0(:,:,jpk) 348 e3t_n(:,:,jpk) = e3t_0(:,:,jpk) ; e3u_n(:,:,jpk) = e3u_0(:,:,jpk) 349 e3f_n(:,:,jpk) = e3f_0(:,:,jpk) ; e3v_n(:,:,jpk) = e3v_0(:,:,jpk) 351 350 ! 352 351 ! !* AFTER fields : (last level for OPA, 3D required for AGRIF initialisation) 353 e3t_a(:,:,:) = e3t_n(:,:,:) ; e3u_a(:,:,:) = e3u_n(:,:,:) ; e3v_a(:,:,:) = e3v_n(:,:,:) 352 e3t_a(:,:,:) = e3t_n(:,:,:) ; e3u_a(:,:,:) = e3u_n(:,:,:) 353 e3w_a(:,:,:) = e3w_n(:,:,:) ; e3v_a(:,:,:) = e3v_n(:,:,:) 354 354 ! 355 355 ENDIF … … 370 370 END DO 371 371 nk_rnf(ji,jj) = jk 372 ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1373 ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj)372 ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1 373 ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj) 374 374 ELSE 375 375 CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999' )
Note: See TracChangeset
for help on using the changeset viewer.
