- Timestamp:
- 2011-12-11T16:00:26+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r2715 r3211 39 39 LOGICAL , PUBLIC, PARAMETER :: lk_zdfgls = .TRUE. !: TKE vertical mixing flag 40 40 ! 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zwall !: wall function 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustars2 !: Squared surface velocity scale at T-points 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustarb2 !: Squared bottom velocity scale at T-points 41 !! DCSE_NEMO: does not need to be public 42 ! REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy 43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy 44 45 !! DCSE_NEMO: does not need to be public 46 ! REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length 47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length 48 49 !! DCSE_NEMO: does not need to be public 50 ! REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zwall !: wall function 51 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zwall !: wall function 52 53 !! DCSE_NEMO: does not need to be public 54 ! REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustars2 !: Squared surface velocity scale at T-points 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustars2 !: Squared surface velocity scale at T-points 56 57 !! DCSE_NEMO: does not need to be public 58 ! REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustarb2 !: Squared bottom velocity scale at T-points 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustarb2 !: Squared bottom velocity scale at T-points 46 60 47 61 ! !!! ** Namelist namzdf_gls ** … … 102 116 REAL(wp) :: rpsi3m, rpsi3p, rpp, rmm, rnn ! - - - - 103 117 118 !! * Control permutation of array indices 119 # include "oce_ftrans.h90" 120 # include "dom_oce_ftrans.h90" 121 # include "domvvl_ftrans.h90" 122 # include "zdf_oce_ftrans.h90" 123 # include "sbc_oce_ftrans.h90" 124 !! DCSE_NEMO: private module variables do not need their own directives file 125 !FTRANS en mxln zwall :I :I :z 126 104 127 !! * Substitutions 105 128 # include "domzgr_substitute.h90" … … 144 167 USE wrk_nemo, ONLY: eps => wrk_3d_4 ! dissipation rate 145 168 USE wrk_nemo, ONLY: zwall_psi => wrk_3d_5 ! Wall function use in the wb case (ln_sigpsi.AND.ln_crban=T) 169 170 !! DCSE_NEMO: need additional directives for renamed module variables 171 !FTRANS z_elem_a z_elem_b z_elem_c psi :I :I :z 172 !FTRANS eb mxlb shear eps zwall_psi :I :I :z 146 173 ! 147 174 INTEGER, INTENT(in) :: kt ! ocean time step … … 169 196 ! 170 197 ! surface friction 198 #if defined key_z_first 199 ustars2(ji,jj) = rau0r * taum(ji,jj) * tmask_1(ji,jj) 200 #else 171 201 ustars2(ji,jj) = rau0r * taum(ji,jj) * tmask(ji,jj,1) 202 #endif 172 203 ! 173 204 ! bottom friction (explicit before friction) 174 205 ! Note that we chose here not to bound the friction as in dynbfr) 206 #if defined key_z_first 207 ztx2 = ( bfrua(ji,jj) * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) ) & 208 & * ( 1._wp - 0.5_wp * umask_1(ji,jj) * umask_1(ji-1,jj) ) 209 zty2 = ( bfrva(ji,jj) * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1)) ) & 210 & * ( 1._wp - 0.5_wp * vmask_1(ji,jj) * vmask_1(ji,jj-1) ) 211 ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask_1(ji,jj) 212 #else 175 213 ztx2 = ( bfrua(ji,jj) * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) ) & 176 214 & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1) ) … … 178 216 & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1) ) 179 217 ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1) 218 #endif 180 219 END DO 181 220 END DO … … 188 227 189 228 ! Compute shear and dissipation rate 229 #if defined key_z_first 230 DO jj = 2, jpjm1 231 DO ji = 2, jpim1 232 DO jk = 2, jpkm1 233 #else 190 234 DO jk = 2, jpkm1 191 235 DO jj = 2, jpjm1 192 236 DO ji = fs_2, fs_jpim1 ! vector opt. 237 #endif 193 238 avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) & 194 239 & * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) ) & … … 212 257 213 258 IF( nn_clos == 0 ) THEN ! Mellor-Yamada 259 #if defined key_z_first 260 DO jj = 2, jpjm1 261 DO ji = 2, jpim1 262 DO jk = 2, jpkm1 263 #else 214 264 DO jk = 2, jpkm1 215 265 DO jj = 2, jpjm1 216 266 DO ji = fs_2, fs_jpim1 ! vector opt. 267 #endif 217 268 zup = mxln(ji,jj,jk) * fsdepw(ji,jj,mbkt(ji,jj)+1) 218 269 zdown = vkarmn * fsdepw(ji,jj,jk) * ( -fsdepw(ji,jj,jk) + fsdepw(ji,jj,mbkt(ji,jj)+1) ) … … 237 288 ! Warning : after this step, en : right hand side of the matrix 238 289 290 #if defined key_z_first 291 DO jj = 2, jpjm1 292 DO ji = 2, jpim1 293 DO jk = 2, jpkm1 294 #else 239 295 DO jk = 2, jpkm1 240 296 DO jj = 2, jpjm1 241 297 DO ji = fs_2, fs_jpim1 ! vector opt. 298 #endif 242 299 ! 243 300 ! shear prod. at w-point weightened by mask … … 422 479 ! ---------------------------------------------------------- 423 480 ! 481 #if defined key_z_first 482 DO jj = 2, jpjm1 483 DO ji = 2, jpim1 484 DO jk = 2, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 485 #else 424 486 DO jk = 2, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 425 487 DO jj = 2, jpjm1 426 488 DO ji = fs_2, fs_jpim1 ! vector opt. 489 #endif 427 490 z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1) 428 491 END DO 429 492 END DO 430 493 END DO 494 #if defined key_z_first 495 DO jj = 2, jpjm1 496 DO ji = 2, jpim1 497 DO jk = 2, jpk ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 498 #else 431 499 DO jk = 2, jpk ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 432 500 DO jj = 2, jpjm1 433 501 DO ji = fs_2, fs_jpim1 ! vector opt. 502 #endif 434 503 z_elem_a(ji,jj,jk) = en(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1) 435 504 END DO 436 505 END DO 437 506 END DO 438 DO jk = jpk-1, 2, -1 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 507 #if defined key_z_first 508 DO jj = 2, jpjm1 509 DO ji = 2, jpim1 510 DO jk = jpk-1, 2, -1 ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 511 #else 512 DO jk = jpk-1, 2, -1 ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 439 513 DO jj = 2, jpjm1 440 514 DO ji = fs_2, fs_jpim1 ! vector opt. 515 #endif 441 516 en(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * en(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk) 442 517 END DO … … 455 530 ! 456 531 CASE( 0 ) ! k-kl (Mellor-Yamada) 532 #if defined key_z_first 533 DO jj = 2, jpjm1 534 DO ji = 2, jpim1 535 DO jk = 2, jpkm1 536 #else 457 537 DO jk = 2, jpkm1 458 538 DO jj = 2, jpjm1 459 539 DO ji = fs_2, fs_jpim1 ! vector opt. 540 #endif 460 541 psi(ji,jj,jk) = en(ji,jj,jk) * mxln(ji,jj,jk) 461 542 END DO … … 464 545 ! 465 546 CASE( 1 ) ! k-eps 547 #if defined key_z_first 548 DO jj = 2, jpjm1 549 DO ji = 2, jpim1 550 DO jk = 2, jpkm1 551 #else 466 552 DO jk = 2, jpkm1 467 553 DO jj = 2, jpjm1 468 554 DO ji = fs_2, fs_jpim1 ! vector opt. 555 #endif 469 556 psi(ji,jj,jk) = eps(ji,jj,jk) 470 557 END DO … … 473 560 ! 474 561 CASE( 2 ) ! k-w 562 #if defined key_z_first 563 DO jj = 2, jpjm1 564 DO ji = 2, jpim1 565 DO jk = 2, jpkm1 566 #else 475 567 DO jk = 2, jpkm1 476 568 DO jj = 2, jpjm1 477 569 DO ji = fs_2, fs_jpim1 ! vector opt. 570 #endif 478 571 psi(ji,jj,jk) = SQRT( en(ji,jj,jk) ) / ( rc0 * mxln(ji,jj,jk) ) 479 572 END DO … … 482 575 ! 483 576 CASE( 3 ) ! generic 577 #if defined key_z_first 578 DO jj = 2, jpjm1 579 DO ji = 2, jpim1 580 DO jk = 2, jpkm1 581 #else 484 582 DO jk = 2, jpkm1 485 583 DO jj = 2, jpjm1 486 584 DO ji = fs_2, fs_jpim1 ! vector opt. 585 #endif 487 586 psi(ji,jj,jk) = rc02 * en(ji,jj,jk) * mxln(ji,jj,jk)**rnn 488 587 END DO … … 499 598 ! Warning : after this step, en : right hand side of the matrix 500 599 600 #if defined key_z_first 601 DO jj = 2, jpjm1 602 DO ji = 2, jpim1 603 DO jk = 2, jpkm1 604 #else 501 605 DO jk = 2, jpkm1 502 606 DO jj = 2, jpjm1 503 607 DO ji = fs_2, fs_jpim1 ! vector opt. 608 #endif 504 609 ! 505 610 ! psi / k … … 556 661 ! ! balance between the production and the dissipation terms including the wave effect 557 662 zdep(:,:) = rl_sf * zhsro(:,:) 663 #if defined key_z_first 664 psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask_1(:,:) 665 #else 558 666 psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 667 #endif 559 668 z_elem_a(:,:,1) = psi(:,:,1) 560 669 z_elem_c(:,:,1) = 0._wp … … 565 674 zex2 = (rmm*ra_sf) 566 675 zdep(:,:) = ( (zhsro(:,:) + fsdepw(:,:,2))**zex1 ) / zhsro(:,:)**zex2 676 #if defined key_z_first 677 psi (:,:,2) = rsbc_psi1 * ustars2(:,:)**rmm * zdep(:,:) * tmask_1(:,:) 678 #else 567 679 psi (:,:,2) = rsbc_psi1 * ustars2(:,:)**rmm * zdep(:,:) * tmask(:,:,1) 680 #endif 568 681 z_elem_a(:,:,2) = 0._wp 569 682 z_elem_c(:,:,2) = 0._wp … … 575 688 ! 576 689 zdep(:,:) = vkarmn * zhsro(:,:) 690 #if defined key_z_first 691 psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask_1(:,:) 692 #else 577 693 psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 694 #endif 578 695 z_elem_a(:,:,1) = psi(:,:,1) 579 696 z_elem_c(:,:,1) = 0._wp … … 582 699 ! one level below 583 700 zdep(:,:) = vkarmn * ( zhsro(:,:) + fsdepw(:,:,2) ) 701 #if defined key_z_first 702 psi (:,:,2) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask_1(:,:) 703 #else 584 704 psi (:,:,2) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 705 #endif 585 706 z_elem_a(:,:,2) = 0._wp 586 707 z_elem_c(:,:,2) = 0._wp … … 594 715 ! 595 716 zdep(:,:) = rl_sf * zhsro(:,:) 717 #if defined key_z_first 718 psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask_1(:,:) 719 #else 596 720 psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 721 #endif 597 722 z_elem_a(:,:,1) = psi(:,:,1) 598 723 z_elem_c(:,:,1) = 0._wp … … 612 737 ! 613 738 zdep(:,:) = vkarmn * zhsro(:,:) 739 #if defined key_z_first 740 psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask_1(:,:) 741 #else 614 742 psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 743 #endif 615 744 z_elem_a(:,:,1) = psi(:,:,1) 616 745 z_elem_c(:,:,1) = 0._wp … … 693 822 ! ---------------- 694 823 ! 824 #if defined key_z_first 825 DO jj = 2, jpjm1 826 DO ji = 2, jpim1 827 DO jk = 2, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 828 #else 695 829 DO jk = 2, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 696 830 DO jj = 2, jpjm1 697 831 DO ji = fs_2, fs_jpim1 ! vector opt. 832 #endif 698 833 z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1) 699 834 END DO 700 835 END DO 701 836 END DO 837 #if defined key_z_first 838 DO jj = 2, jpjm1 839 DO ji = 2, jpim1 840 DO jk = 2, jpk ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 841 #else 702 842 DO jk = 2, jpk ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 703 843 DO jj = 2, jpjm1 704 844 DO ji = fs_2, fs_jpim1 ! vector opt. 845 #endif 705 846 z_elem_a(ji,jj,jk) = psi(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1) 706 847 END DO 707 848 END DO 708 849 END DO 850 #if defined key_z_first 851 DO jj = 2, jpjm1 852 DO ji = 2, jpim1 853 DO jk = jpk-1, 2, -1 ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 854 #else 709 855 DO jk = jpk-1, 2, -1 ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 710 856 DO jj = 2, jpjm1 711 857 DO ji = fs_2, fs_jpim1 ! vector opt. 858 #endif 712 859 psi(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * psi(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk) 713 860 END DO … … 721 868 ! 722 869 CASE( 0 ) ! k-kl (Mellor-Yamada) 870 #if defined key_z_first 871 DO jj = 2, jpjm1 872 DO ji = 2, jpim1 873 DO jk = 1, jpkm1 874 #else 723 875 DO jk = 1, jpkm1 724 876 DO jj = 2, jpjm1 725 877 DO ji = fs_2, fs_jpim1 ! vector opt. 878 #endif 726 879 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / psi(ji,jj,jk) 727 880 END DO … … 730 883 ! 731 884 CASE( 1 ) ! k-eps 885 #if defined key_z_first 886 DO jj = 2, jpjm1 887 DO ji = 2, jpim1 888 DO jk = 1, jpkm1 889 #else 732 890 DO jk = 1, jpkm1 733 891 DO jj = 2, jpjm1 734 892 DO ji = fs_2, fs_jpim1 ! vector opt. 893 #endif 735 894 eps(ji,jj,jk) = psi(ji,jj,jk) 736 895 END DO … … 739 898 ! 740 899 CASE( 2 ) ! k-w 900 #if defined key_z_first 901 DO jj = 2, jpjm1 902 DO ji = 2, jpim1 903 DO jk = 1, jpkm1 904 #else 741 905 DO jk = 1, jpkm1 742 906 DO jj = 2, jpjm1 743 907 DO ji = fs_2, fs_jpim1 ! vector opt. 908 #endif 744 909 eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 745 910 END DO … … 751 916 zex1 = ( 1.5_wp + rmm/rnn ) 752 917 zex2 = -1._wp / rnn 918 #if defined key_z_first 919 DO jj = 2, jpjm1 920 DO ji = 2, jpim1 921 DO jk = 1, jpkm1 922 #else 753 923 DO jk = 1, jpkm1 754 924 DO jj = 2, jpjm1 755 925 DO ji = fs_2, fs_jpim1 ! vector opt. 926 #endif 756 927 eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 757 928 END DO … … 763 934 ! Limit dissipation rate under stable stratification 764 935 ! -------------------------------------------------- 936 #if defined key_z_first 937 DO jj = 2, jpjm1 938 DO ji = 2, jpim1 939 DO jk = 1, jpkm1 ! Note that this set boundary conditions on mxln at the same time 940 #else 765 941 DO jk = 1, jpkm1 ! Note that this set boundary conditions on mxln at the same time 766 942 DO jj = 2, jpjm1 767 943 DO ji = fs_2, fs_jpim1 ! vector opt. 944 #endif 768 945 ! limitation 769 946 eps(ji,jj,jk) = MAX( eps(ji,jj,jk), rn_epsmin ) … … 783 960 ! 784 961 CASE ( 0 , 1 ) ! Galperin or Kantha-Clayson stability functions 962 #if defined key_z_first 963 DO jj = 2, jpjm1 964 DO ji = 2, jpim1 965 DO jk = 2, jpkm1 966 #else 785 967 DO jk = 2, jpkm1 786 968 DO jj = 2, jpjm1 787 969 DO ji = fs_2, fs_jpim1 ! vector opt. 970 #endif 788 971 ! zcof = l²/q² 789 972 zcof = mxlb(ji,jj,jk) * mxlb(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) ) … … 804 987 ! 805 988 CASE ( 2, 3 ) ! Canuto stability functions 989 #if defined key_z_first 990 DO jj = 2, jpjm1 991 DO ji = 2, jpim1 992 DO jk = 2, jpkm1 993 #else 806 994 DO jk = 2, jpkm1 807 995 DO jj = 2, jpjm1 808 996 DO ji = fs_2, fs_jpim1 ! vector opt. 997 #endif 809 998 ! zcof = l²/q² 810 999 zcof = mxlb(ji,jj,jk)*mxlb(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) ) … … 850 1039 ! Compute diffusivities/viscosities 851 1040 ! The computation below could be restrained to jk=2 to jpkm1 if GOTM style Dirichlet conditions are used 1041 #if defined key_z_first 1042 DO jj = 2, jpjm1 1043 DO ji = 2, jpim1 1044 DO jk = 1, jpk 1045 #else 1046 DO jk = 1, jpk 1047 DO jj = 2, jpjm1 1048 DO ji = fs_2, fs_jpim1 ! vector opt. 1049 #endif 852 1050 DO jk = 1, jpk 853 1051 DO jj = 2, jpjm1 … … 866 1064 CALL lbc_lnk( avm, 'W', 1. ) ; CALL lbc_lnk( avt, 'W', 1. ) 867 1065 1066 #if defined key_z_first 1067 DO jj = 2, jpjm1 1068 DO ji = 2, jpim1 1069 DO jk = 2, jpkm1 !* vertical eddy viscosity at u- and v-points 1070 #else 868 1071 DO jk = 2, jpkm1 !* vertical eddy viscosity at u- and v-points 869 1072 DO jj = 2, jpjm1 870 1073 DO ji = fs_2, fs_jpim1 ! vector opt. 1074 #endif 871 1075 avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj ,jk) ) * umask(ji,jj,jk) 872 1076 avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji ,jj+1,jk) ) * vmask(ji,jj,jk) … … 887 1091 ! 888 1092 END SUBROUTINE zdf_gls 889 1093 1094 !! * Reset control of array index permutation 1095 !FTRANS CLEAR 1096 # include "oce_ftrans.h90" 1097 # include "dom_oce_ftrans.h90" 1098 # include "domvvl_ftrans.h90" 1099 # include "zdf_oce_ftrans.h90" 1100 # include "sbc_oce_ftrans.h90" 1101 !! DCSE_NEMO: private module variables do not need their own directives file 1102 !FTRANS en mxln zwall :I :I :z 890 1103 891 1104 SUBROUTINE zdf_gls_init … … 907 1120 USE trazdf_exp 908 1121 ! 909 INTEGER :: j k ! dummy loop indices910 REAL(wp):: zcr ! local scalar1122 INTEGER :: ji, jj, jk ! dummy loop indices 1123 REAL(wp):: zcr ! local scalar 911 1124 !! 912 1125 NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, & … … 1175 1388 1176 1389 ! !* set vertical eddy coef. to the background value 1390 #if defined key_z_first 1391 DO jj = 1, jpj 1392 DO ji = 1, jpi 1393 DO jk = 1, jpk 1394 avt (ji,jj,jk) = avtb(jk) * tmask(ji,jj,jk) 1395 avm (ji,jj,jk) = avmb(jk) * tmask(ji,jj,jk) 1396 avmu(ji,jj,jk) = avmb(jk) * umask(ji,jj,jk) 1397 avmv(ji,jj,jk) = avmb(jk) * vmask(ji,jj,jk) 1398 END DO 1399 END DO 1400 END DO 1401 #else 1177 1402 DO jk = 1, jpk 1178 1403 avt (:,:,jk) = avtb(jk) * tmask(:,:,jk) … … 1181 1406 avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk) 1182 1407 END DO 1408 #endif 1183 1409 ! 1184 1410 CALL gls_rst( nit000, 'READ' ) !* read or initialize all required files
Note: See TracChangeset
for help on using the changeset viewer.
