- Timestamp:
- 2018-01-04T13:30:03+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r6498 r9176 227 227 REAL(wp) :: zbbrau, zesh2 ! temporary scalars 228 228 REAL(wp) :: zfact1, zfact2, zfact3 ! - - 229 REAL(wp) :: ztx2 , zty2 , zcof 230 REAL(wp) :: ztau , zdif 229 REAL(wp) :: ztx2 , zty2 , zcof, zcofa ! - - 230 REAL(wp) :: ztau , zdif, zdifa ! - - 231 231 REAL(wp) :: zus , zwlc , zind ! - - 232 232 REAL(wp) :: zzd_up, zzd_lw ! - - … … 253 253 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 254 254 IF ( ln_isfcav ) THEN 255 !$OMP PARALLEL DO 255 256 DO jj = 2, jpjm1 ! en(mikt(ji,jj)) = rn_emin 256 257 DO ji = fs_2, fs_jpim1 ! vector opt. … … 259 260 END DO 260 261 END IF 262 !$OMP PARALLEL DO 261 263 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 262 264 DO ji = fs_2, fs_jpim1 ! vector opt. … … 296 298 ! !* total energy produce by LC : cumulative sum over jk 297 299 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * fsdepw(:,:,1) * fse3w(:,:,1) 300 !$OMP PARALLEL 298 301 DO jk = 2, jpk 299 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * fsdepw(:,:,jk) * fse3w(:,:,jk) 300 END DO 302 !$OMP DO 303 DO jj = 1, jpj 304 zpelc(:,jj,jk) = zpelc(:,jj,jk-1) + MAX( rn2b(:,jj,jk), 0._wp ) * fsdepw(:,jj,jk) * fse3w(:,jj,jk) 305 END DO 306 !$OMP END DO 307 END DO 308 !$OMP END PARALLEL 301 309 ! !* finite Langmuir Circulation depth 302 310 zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 311 zcofa = 0.016 / SQRT( zrhoa * zcdrag ) 303 312 imlc(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point (=2 over land) 313 !$OMP PARALLEL SHARED(imlc) 304 314 DO jk = jpkm1, 2, -1 315 !$OMP DO PRIVATE(zus) 305 316 DO jj = 1, jpj ! Last w-level at which zpelc>=0.5*us*us 306 317 DO ji = 1, jpi ! with us=0.016*wind(starting from jpk-1) … … 309 320 END DO 310 321 END DO 322 !$OMP END DO 311 323 END DO 312 324 ! ! finite LC depth 325 !$OMP DO 313 326 DO jj = 1, jpj 314 327 DO ji = 1, jpi … … 316 329 END DO 317 330 END DO 318 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 319 !CDIR NOVERRCHK 331 !$OMP END DO 332 ! zcof = 0.016 / SQRT( zrhoa * zcdrag ) 333 !$OMP DO PRIVATE(zus, zind, zwlc) 320 334 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 321 !CDIR NOVERRCHK 322 DO jj = 2, jpjm1 323 !CDIR NOVERRCHK 324 DO ji = fs_2, fs_jpim1 ! vector opt. 325 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 335 DO jj = 2, jpjm1 336 DO ji = fs_2, fs_jpim1 ! vector opt. 337 zus = zcofa * SQRT( taum(ji,jj) ) ! Stokes drift 326 338 ! ! vertical velocity due to LC 327 339 zind = 0.5 - SIGN( 0.5, fsdepw(ji,jj,jk) - zhlc(ji,jj) ) … … 333 345 END DO 334 346 END DO 347 !$OMP END DO 348 !$OMP END PARALLEL 335 349 ! 336 350 ENDIF … … 343 357 ! ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal 344 358 ! 359 !$OMP PARALLEL DO 345 360 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 346 361 DO jj = 1, jpj ! here avmu, avmv used as workspace … … 358 373 END DO 359 374 ! 375 !$OMP PARALLEL DO PRIVATE(zcof, zzd_up, zzd_lw, zesh2) 360 376 DO jk = 2, jpkm1 !* Matrix and right hand side in en 361 377 DO jj = 2, jpjm1 … … 390 406 END DO 391 407 ! !* Matrix inversion from level 2 (tke prescribed at level 1) 408 !$OMP PARALLEL 392 409 DO jk = 3, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 410 !$OMP DO 393 411 DO jj = 2, jpjm1 394 412 DO ji = fs_2, fs_jpim1 ! vector opt. … … 396 414 END DO 397 415 END DO 398 END DO 416 !$OMP END DO 417 END DO 418 !$OMP END PARALLEL 399 419 ! 400 420 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 421 !$OMP PARALLEL DO 401 422 DO jj = 2, jpjm1 402 423 DO ji = fs_2, fs_jpim1 ! vector opt. … … 404 425 END DO 405 426 END DO 427 !$OMP PARALLEL 406 428 DO jk = 3, jpkm1 429 !$OMP DO 407 430 DO jj = 2, jpjm1 408 431 DO ji = fs_2, fs_jpim1 ! vector opt. … … 410 433 END DO 411 434 END DO 412 END DO 435 !$OMP END DO 436 END DO 437 !$OMP END PARALLEL 413 438 ! 414 439 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 440 !$OMP PARALLEL DO 415 441 DO jj = 2, jpjm1 416 442 DO ji = fs_2, fs_jpim1 ! vector opt. … … 418 444 END DO 419 445 END DO 446 !$OMP PARALLEL 420 447 DO jk = jpk-2, 2, -1 448 !$OMP DO 421 449 DO jj = 2, jpjm1 422 450 DO ji = fs_2, fs_jpim1 ! vector opt. … … 424 452 END DO 425 453 END DO 426 END DO 454 !$OMP END DO 455 END DO 456 !$OMP END PARALLEL 457 !$OMP PARALLEL DO 427 458 DO jk = 2, jpkm1 ! set the minimum value of tke 428 459 DO jj = 2, jpjm1 … … 440 471 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 441 472 IF( nn_htau == 2 ) THEN !* mixed-layer depth dependant length scale 473 !$OMP PARALLEL DO 442 474 DO jj = 2, jpjm1 443 475 DO ji = fs_2, fs_jpim1 ! vector opt. … … 452 484 ! 453 485 IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction) 486 !$OMP PARALLEL DO 454 487 DO jk = 2, jpkm1 455 488 DO jj = 2, jpjm1 … … 461 494 END DO 462 495 ELSEIF( nn_etau == 2 ) THEN !* act only at the base of the mixed layer (jk=nmln) (rn_efr fraction) 496 !$OMP PARALLEL DO PRIVATE(jk) 463 497 DO jj = 2, jpjm1 464 498 DO ji = fs_2, fs_jpim1 ! vector opt. … … 469 503 END DO 470 504 ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) 471 ! CDIR NOVERRCHK505 !$OMP PARALLEL DO PRIVATE(ztx2, zty2, ztau, zdif, zdifa) 472 506 DO jk = 2, jpkm1 473 !CDIR NOVERRCHK 474 DO jj = 2, jpjm1 475 !CDIR NOVERRCHK 507 DO jj = 2, jpjm1 476 508 DO ji = fs_2, fs_jpim1 ! vector opt. 477 509 ztx2 = utau(ji-1,jj ) + utau(ji,jj) 478 510 zty2 = vtau(ji ,jj-1) + vtau(ji,jj) 479 511 ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1) ! module of the mean stress 480 zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean481 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications...512 zdifa = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean 513 zdif = rhftau_scl * MAX( 0._wp, zdifa + rhftau_add ) ! apply some modifications... 482 514 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) & 483 515 & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) … … 487 519 ELSEIF( nn_etau == 4 ) THEN !* column integral independant of htau (rn_efr must be scaled up) 488 520 IF( nn_htau == 2 ) THEN ! efr dependant on time-varying htau 521 !$OMP PARALLEL DO 489 522 DO jj = 2, jpjm1 490 523 DO ji = fs_2, fs_jpim1 ! vector opt. … … 493 526 END DO 494 527 ENDIF 528 !$OMP PARALLEL DO 495 529 DO jk = 2, jpkm1 496 530 DO jj = 2, jpjm1 … … 504 538 CALL lbc_lnk( en, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 505 539 ! 540 !$OMP PARALLEL DO 506 541 DO jk = 2, jpkm1 ! TKE budget: near-inertial waves term 507 542 DO jj = 2, jpjm1 … … 580 615 ! 581 616 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 617 !$OMP PARALLEL DO PRIVATE(zraug) 582 618 DO jj = 2, jpjm1 583 619 DO ji = fs_2, fs_jpim1 … … 590 626 ENDIF 591 627 ! 592 ! CDIR NOVERRCHK628 !$OMP PARALLEL DO PRIVATE(zrn2) 593 629 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 594 !CDIR NOVERRCHK595 630 DO jj = 2, jpjm1 596 !CDIR NOVERRCHK597 631 DO ji = fs_2, fs_jpim1 ! vector opt. 598 632 zrn2 = MAX( rn2(ji,jj,jk), rsmall ) … … 611 645 ! where wmask = 0 set zmxlm == fse3w 612 646 CASE ( 0 ) ! bounded by the distance to surface and bottom 647 !$OMP PARALLEL DO PRIVATE(zemxl) 613 648 DO jk = 2, jpkm1 614 649 DO jj = 2, jpjm1 … … 624 659 ! 625 660 CASE ( 1 ) ! bounded by the vertical scale factor 661 !$OMP PARALLEL DO PRIVATE(zemxl) 626 662 DO jk = 2, jpkm1 627 663 DO jj = 2, jpjm1 … … 635 671 ! 636 672 CASE ( 2 ) ! |dk[xml]| bounded by e3t : 673 !$OMP PARALLEL 637 674 DO jk = 2, jpkm1 ! from the surface to the bottom : 675 !$OMP DO 638 676 DO jj = 2, jpjm1 639 677 DO ji = fs_2, fs_jpim1 ! vector opt. … … 643 681 END DO 644 682 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : 683 !$OMP DO PRIVATE(zemxl) 645 684 DO jj = 2, jpjm1 646 685 DO ji = fs_2, fs_jpim1 ! vector opt. … … 651 690 END DO 652 691 END DO 692 !$OMP END PARALLEL 653 693 ! 654 694 CASE ( 3 ) ! lup and ldown, |dk[xml]| bounded by e3t : 695 !$OMP PARALLEL 655 696 DO jk = 2, jpkm1 ! from the surface to the bottom : lup 697 !$OMP DO 656 698 DO jj = 2, jpjm1 657 699 DO ji = fs_2, fs_jpim1 ! vector opt. … … 661 703 END DO 662 704 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : ldown 705 !$OMP DO 663 706 DO jj = 2, jpjm1 664 707 DO ji = fs_2, fs_jpim1 ! vector opt. … … 667 710 END DO 668 711 END DO 669 ! CDIR NOVERRCHK712 !$OMP DO PRIVATE(zemlm, zemlp) 670 713 DO jk = 2, jpkm1 671 !CDIR NOVERRCHK 672 DO jj = 2, jpjm1 673 !CDIR NOVERRCHK 714 DO jj = 2, jpjm1 674 715 DO ji = fs_2, fs_jpim1 ! vector opt. 675 716 zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) ) … … 680 721 END DO 681 722 END DO 723 !$OMP END PARALLEL 682 724 ! 683 725 END SELECT … … 691 733 ! ! Vertical eddy viscosity and diffusivity (avmu, avmv, avt) 692 734 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 693 !CDIR NOVERRCHK694 735 DO jk = 1, jpkm1 !* vertical eddy viscosity & diffivity at w-points 695 !CDIR NOVERRCHK696 736 DO jj = 2, jpjm1 697 !CDIR NOVERRCHK698 737 DO ji = fs_2, fs_jpim1 ! vector opt. 699 738 zsqen = SQRT( en(ji,jj,jk) ) … … 894 933 ENDIF 895 934 ! !* set vertical eddy coef. to the background value 935 !$OMP PARALLEL DO 896 936 DO jk = 1, jpk 897 937 avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) … … 959 999 ELSE !* Start from rest 960 1000 en(:,:,:) = rn_emin * tmask(:,:,:) 1001 !$OMP PARALLEL DO 961 1002 DO jk = 1, jpk ! set the Kz to the background value 962 1003 avt (:,:,jk) = avtb(jk) * wmask (:,:,jk)
Note: See TracChangeset
for help on using the changeset viewer.
