- Timestamp:
- 2014-02-04T13:12:04+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r3211 r4406 285 285 DO ji = 1, jpi 286 286 zpelc(ji,jj,1) = MAX( rn2b(ji,jj,1), 0._wp ) * fsdepw(ji,jj,1) * fse3w(ji,jj,1) 287 DO jk = 2, jpk 287 DO jk = 2, jpkf 288 288 zpelc(ji,jj,jk) = zpelc(ji,jj,jk-1) + MAX( rn2b(ji,jj,jk), 0._wp ) * fsdepw(ji,jj,jk) * fse3w(ji,jj,jk) 289 289 END DO … … 292 292 #else 293 293 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * fsdepw(:,:,1) * fse3w(:,:,1) 294 DO jk = 2, jpk 294 DO jk = 2, jpkf 295 295 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * fsdepw(:,:,jk) * fse3w(:,:,jk) 296 296 END DO … … 303 303 DO ji = 1, jpi ! with us=0.016*wind(starting from jpk-1) 304 304 zus = zcof * taum(ji,jj) 305 DO jk = jpk m1, 2, -1306 #else 307 DO jk = jpk m1, 2, -1305 DO jk = jpkfm1, 2, -1 306 #else 307 DO jk = jpkfm1, 2, -1 308 308 DO jj = 1, jpj ! Last w-level at which zpelc>=0.5*us*us 309 309 DO ji = 1, jpi ! with us=0.016*wind(starting from jpk-1) … … 330 330 DO ji = 2, jpim1 331 331 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 332 DO jk = 2, jpk m1333 #else 334 !CDIR NOVERRCHK 335 DO jk = 2, jpk m1 !* TKE Langmuir circulation source term added to en332 DO jk = 2, jpkfm1 333 #else 334 !CDIR NOVERRCHK 335 DO jk = 2, jpkfm1 !* TKE Langmuir circulation source term added to en 336 336 !CDIR NOVERRCHK 337 337 DO jj = 2, jpjm1 … … 363 363 DO jj = 1, jpj 364 364 DO ji = 1, jpi 365 DO jk = 2, jpk m1366 #else 367 DO jk = 2, jpk m1 !* Shear production at uw- and vw-points (energy conserving form)365 DO jk = 2, jpkfm1 366 #else 367 DO jk = 2, jpkfm1 !* Shear production at uw- and vw-points (energy conserving form) 368 368 DO jj = 1, jpj ! here avmu, avmv used as workspace 369 369 DO ji = 1, jpi … … 385 385 DO jj = 2, jpjm1 386 386 DO ji = 2, jpim1 387 DO jk = 2, jpk m1 !* Matrix and right hand side in en388 #else 389 DO jk = 2, jpk m1 !* Matrix and right hand side in en387 DO jk = 2, jpkfm1 !* Matrix and right hand side in en 388 #else 389 DO jk = 2, jpkfm1 !* Matrix and right hand side in en 390 390 DO jj = 2, jpjm1 391 391 DO ji = fs_2, fs_jpim1 ! vector opt. … … 415 415 DO ji = 2, jpim1 416 416 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 417 DO jk = 3, jpk m1417 DO jk = 3, jpkfm1 418 418 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 419 419 END DO 420 420 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 421 421 zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 422 DO jk = 3, jpk m1422 DO jk = 3, jpkfm1 423 423 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 424 424 END DO 425 425 ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 426 en(ji,jj,jpk m1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)427 DO jk = jpk -2, 2, -1426 en(ji,jj,jpkfm1) = zd_lw(ji,jj,jpkfm1) / zdiag(ji,jj,jpkfm1) 427 DO jk = jpkf-2, 2, -1 428 428 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 429 429 END DO 430 DO jk = 2, jpk m1 ! set the minimum value of tke430 DO jk = 2, jpkfm1 ! set the minimum value of tke 431 431 en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * tmask(ji,jj,jk) 432 432 END DO … … 434 434 END DO 435 435 #else 436 DO jk = 3, jpk m1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1436 DO jk = 3, jpkfm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 437 437 DO jj = 2, jpjm1 438 438 DO ji = fs_2, fs_jpim1 ! vector opt. … … 446 446 END DO 447 447 END DO 448 DO jk = 3, jpk m1448 DO jk = 3, jpkfm1 449 449 DO jj = 2, jpjm1 450 450 DO ji = fs_2, fs_jpim1 ! vector opt. … … 455 455 DO jj = 2, jpjm1 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 456 456 DO ji = fs_2, fs_jpim1 ! vector opt. 457 en(ji,jj,jpk m1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1)458 END DO 459 END DO 460 DO jk = jpk -2, 2, -1457 en(ji,jj,jpkfm1) = zd_lw(ji,jj,jpkfm1) / zdiag(ji,jj,jpkfm1) 458 END DO 459 END DO 460 DO jk = jpkf-2, 2, -1 461 461 DO jj = 2, jpjm1 462 462 DO ji = fs_2, fs_jpim1 ! vector opt. … … 465 465 END DO 466 466 END DO 467 DO jk = 2, jpk m1 ! set the minimum value of tke467 DO jk = 2, jpkfm1 ! set the minimum value of tke 468 468 DO jj = 2, jpjm1 469 469 DO ji = fs_2, fs_jpim1 ! vector opt. … … 481 481 DO jj = 2, jpjm1 482 482 DO ji = 2, jpim1 483 DO jk = 2, jpk m1484 #else 485 DO jk = 2, jpk m1483 DO jk = 2, jpkfm1 484 #else 485 DO jk = 2, jpkfm1 486 486 DO jj = 2, jpjm1 487 487 DO ji = fs_2, fs_jpim1 ! vector opt. … … 505 505 !! unless we also make zdif a 2-d (jpi,jpj) array 506 506 !CDIR NOVERRCHK 507 DO jk = 2, jpk m1507 DO jk = 2, jpkfm1 508 508 !CDIR NOVERRCHK 509 509 DO jj = 2, jpjm1 … … 574 574 !!---------------------------------------------------------------------- 575 575 USE oce, ONLY: zmpdl => ua , zmxlm => va , zmxld => ta ! (ua,va,ta) used as workspace 576 USE arpdebugging, ONLY: dump_array 576 577 !! DCSE_NEMO: need additional directives for renamed module variables 577 578 !FTRANS zmpdl zmxlm zmxld :I :I :z … … 581 582 REAL(wp) :: zdku, zpdlr, zri, zsqen ! - - 582 583 REAL(wp) :: zdkv, zemxl, zemlm, zemlp ! - - 584 INTEGER, PARAMETER :: DUMP_LEVEL = 26 ! ARPDBG - level to dump to disk 583 585 !!-------------------------------------------------------------------- 584 586 … … 599 601 DO jj = 2, jpjm1 600 602 DO ji = 2, jpim1 601 zmxlm(ji,jj,jpk ) = rmxl_min ! last level set to the interior minium value602 DO jk = 2, jpk m1 ! interior value : l=sqrt(2*e/n^2)603 #else 604 zmxlm(:,:,jpk ) = rmxl_min ! last level set to the interior minium value605 ! 606 !CDIR NOVERRCHK 607 DO jk = 2, jpk m1 ! interior value : l=sqrt(2*e/n^2)603 zmxlm(ji,jj,jpkf) = rmxl_min ! last level set to the interior minium value 604 DO jk = 2, jpkfm1 ! interior value : l=sqrt(2*e/n^2) 605 #else 606 zmxlm(:,:,jpkf) = rmxl_min ! last level set to the interior minium value 607 ! 608 !CDIR NOVERRCHK 609 DO jk = 2, jpkfm1 ! interior value : l=sqrt(2*e/n^2) 608 610 !CDIR NOVERRCHK 609 611 DO jj = 2, jpjm1 … … 619 621 ! !* Physical limits for the mixing length 620 622 ! 621 zmxld(:,:, 1 ) = zmxlm(:,:,1) ! surface set to the zmxlm value622 zmxld(:,:,jpk ) = rmxl_min ! last level set to the minimum value623 zmxld(:,:, 1 ) = zmxlm(:,:,1) ! surface set to the zmxlm value 624 zmxld(:,:,jpkf) = rmxl_min ! last level set to the minimum value 623 625 ! 624 626 SELECT CASE ( nn_mxl ) … … 628 630 DO jj = 2, jpjm1 629 631 DO ji = 2, jpim1 630 DO jk = 2, jpk m1631 #else 632 DO jk = 2, jpk m1632 DO jk = 2, jpkfm1 633 #else 634 DO jk = 2, jpkfm1 633 635 DO jj = 2, jpjm1 634 636 DO ji = fs_2, fs_jpim1 ! vector opt. … … 646 648 DO jj = 2, jpjm1 647 649 DO ji = 2, jpim1 648 DO jk = 2, jpk m1649 #else 650 DO jk = 2, jpk m1650 DO jk = 2, jpkfm1 651 #else 652 DO jk = 2, jpkfm1 651 653 DO jj = 2, jpjm1 652 654 DO ji = fs_2, fs_jpim1 ! vector opt. … … 663 665 DO jj = 2, jpjm1 664 666 DO ji = 2, jpim1 665 DO jk = 2, jpk m1 ! from the surface to the bottom :667 DO jk = 2, jpkfm1 ! from the surface to the bottom : 666 668 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 667 669 END DO 668 DO jk = jpk m1, 2, -1 ! from the bottom to the surface :670 DO jk = jpkfm1, 2, -1 ! from the bottom to the surface : 669 671 zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 670 672 zmxlm(ji,jj,jk) = zemxl … … 674 676 END DO 675 677 #else 676 DO jk = 2, jpk m1 ! from the surface to the bottom :678 DO jk = 2, jpkfm1 ! from the surface to the bottom : 677 679 DO jj = 2, jpjm1 678 680 DO ji = fs_2, fs_jpim1 ! vector opt. … … 681 683 END DO 682 684 END DO 683 DO jk = jpk m1, 2, -1 ! from the bottom to the surface :685 DO jk = jpkfm1, 2, -1 ! from the bottom to the surface : 684 686 DO jj = 2, jpjm1 685 687 DO ji = fs_2, fs_jpim1 ! vector opt. … … 696 698 DO jj = 2, jpjm1 697 699 DO ji = 2, jpim1 698 DO jk = 2, jpk m1 ! from the surface to the bottom : lup700 DO jk = 2, jpkfm1 ! from the surface to the bottom : lup 699 701 zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 700 702 END DO 701 DO jk = jpk m1, 2, -1 ! from the bottom to the surface : ldown703 DO jk = jpkfm1, 2, -1 ! from the bottom to the surface : ldown 702 704 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 703 705 END DO 704 DO jk = 2, jpk m1706 DO jk = 2, jpkfm1 705 707 zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) ) 706 708 zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) … … 711 713 END DO 712 714 #else 713 DO jk = 2, jpk m1 ! from the surface to the bottom : lup715 DO jk = 2, jpkfm1 ! from the surface to the bottom : lup 714 716 DO jj = 2, jpjm1 715 717 DO ji = fs_2, fs_jpim1 ! vector opt. … … 718 720 END DO 719 721 END DO 720 DO jk = jpk m1, 2, -1 ! from the bottom to the surface : ldown722 DO jk = jpkfm1, 2, -1 ! from the bottom to the surface : ldown 721 723 DO jj = 2, jpjm1 722 724 DO ji = fs_2, fs_jpim1 ! vector opt. … … 726 728 END DO 727 729 !CDIR NOVERRCHK 728 DO jk = 2, jpk m1730 DO jk = 2, jpkfm1 729 731 !CDIR NOVERRCHK 730 732 DO jj = 2, jpjm1 … … 753 755 DO jj = 2, jpjm1 754 756 DO ji = 2, jpim1 755 DO jk = 1, jpk m1 !* vertical eddy viscosity & diffivity at w-points756 #else 757 !CDIR NOVERRCHK 758 DO jk = 1, jpk m1 !* vertical eddy viscosity & diffivity at w-points757 DO jk = 1, jpkfm1 !* vertical eddy viscosity & diffivity at w-points 758 #else 759 !CDIR NOVERRCHK 760 DO jk = 1, jpkfm1 !* vertical eddy viscosity & diffivity at w-points 759 761 !CDIR NOVERRCHK 760 762 DO jj = 2, jpjm1 … … 775 777 DO jj = 2, jpjm1 776 778 DO ji = 2, jpim1 777 DO jk = 2, jpk m1 !* vertical eddy viscosity at u- and v-points778 #else 779 DO jk = 2, jpk m1 !* vertical eddy viscosity at u- and v-points779 DO jk = 2, jpkfm1 !* vertical eddy viscosity at u- and v-points 780 #else 781 DO jk = 2, jpkfm1 !* vertical eddy viscosity at u- and v-points 780 782 DO jj = 2, jpjm1 781 783 DO ji = fs_2, fs_jpim1 ! vector opt. … … 786 788 END DO 787 789 END DO 790 788 791 CALL lbc_lnk( avmu, 'U', 1. ) ; CALL lbc_lnk( avmv, 'V', 1. ) ! Lateral boundary conditions 789 792 ! 793 CALL dump_array(1, 'avmu_tke',avmu(:,:,DUMP_LEVEL), & 794 withHalos=.TRUE.,atStep=1) 795 790 796 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt 791 797 #if defined key_z_first 792 798 DO jj = 2, jpjm1 793 799 DO ji = 2, jpim1 794 DO jk = 2, jpk m1795 #else 796 DO jk = 2, jpk m1800 DO jk = 2, jpkfm1 801 #else 802 DO jk = 2, jpkfm1 797 803 DO jj = 2, jpjm1 798 804 DO ji = fs_2, fs_jpim1 ! vector opt. … … 920 926 DO jj = 1, jpj 921 927 DO ji = 1, jpi 922 avt (ji,jj,: ) = avtb(:) * tmask(ji,jj,:)923 avm (ji,jj,: ) = avmb(:) * tmask(ji,jj,:)924 avmu(ji,jj,: ) = avmb(:) * umask(ji,jj,:)925 avmv(ji,jj,: ) = avmb(:) * vmask(ji,jj,:)928 avt (ji,jj,:jpk) = avtb(:jpk) * tmask(ji,jj,:jpk) 929 avm (ji,jj,:jpk) = avmb(:jpk) * tmask(ji,jj,:jpk) 930 avmu(ji,jj,:jpk) = avmb(:jpk) * umask(ji,jj,:jpk) 931 avmv(ji,jj,:jpk) = avmb(:jpk) * vmask(ji,jj,:jpk) 926 932 END DO 927 933 END DO
Note: See TracChangeset
for help on using the changeset viewer.
