Changeset 85 for trunk/NEMOGCM/NEMO/OPA_SRC/ZDF
- Timestamp:
- 12/17/13 23:25:54 (10 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
r1 r85 42 42 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avmu , avmv !: vertical viscosity coef at uw- & vw-pts [m2/s] 43 43 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avm , avt !: vertical viscosity & diffusivity coef at w-pt [m2/s] 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz 44 46 45 47 !!---------------------------------------------------------------------- … … 58 60 & avtb(jpk) , bfrva(jpi,jpj) , avtb_2d(jpi,jpj) , & 59 61 & avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk) , & 60 & avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk) , STAT = zdf_oce_alloc ) 62 & avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk) , & 63 & avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk) , & 64 & avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk) , & 65 & STAT = zdf_oce_alloc ) 61 66 ! 62 67 IF( zdf_oce_alloc /= 0 ) CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r46 r85 51 51 USE wrk_nemo ! work arrays 52 52 USE timing ! Timing 53 #if defined key_agrif 54 USE agrif_opa_interp 55 USE agrif_opa_update 56 #endif 53 57 54 58 IMPLICIT NONE … … 86 90 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 87 91 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz90 92 #if defined key_c1d 91 93 ! !!** 1D cfg only ** ('key_c1d') … … 93 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_pdl, e_ric !: prandl and local Richardson numbers 94 96 #endif 97 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wei3d ! 98 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,: ) :: wmix ! 95 99 96 100 !! * Substitutions … … 113 117 & e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) , & 114 118 #endif 115 & en (jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , & 116 & avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk), & 117 & avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc ) 119 & en (jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , & 120 & STAT= zdf_tke_alloc ) 118 121 ! 119 122 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) 120 123 IF( zdf_tke_alloc /= 0 ) CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays') 124 ! 125 IF(.NOT. Agrif_Root()) THEN 126 ALLOCATE( wei3d(jpi,jpj,jpk), wmix(jpi,jpj), STAT= zdf_tke_alloc ) 127 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) 128 IF( zdf_tke_alloc /= 0 ) CALL ctl_warn('zdf_tke_alloc2: failed to allocate arrays') 129 ENDIF 121 130 ! 122 131 END FUNCTION zdf_tke_alloc … … 172 181 ! 173 182 IF( kt /= nit000 ) THEN ! restore before value to compute tke 183 #if defined key_agrif 184 ! interpolation parent grid => child grid for avt_k, avm_k, avmu_k, avmv_k (at west border: update column 1 and 2) 185 CALL Agrif_Tke 186 #endif 174 187 avt (:,:,:) = avt_k (:,:,:) 175 188 avm (:,:,:) = avm_k (:,:,:) … … 187 200 avmv_k(:,:,:) = avmv(:,:,:) 188 201 ! 202 #if defined key_agrif 203 ! Update child grid f => parent grid 204 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tke( kt ) ! children only 205 #endif 206 207 189 208 END SUBROUTINE zdf_tke 190 209 … … 491 510 REAL(wp) :: zdku, zpdlr, zri, zsqen ! - - 492 511 REAL(wp) :: zdkv, zemxl, zemlm, zemlp ! - - 512 REAL(wp), POINTER, DIMENSION(:,: ) :: ztmp2d 493 513 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld 494 514 !!-------------------------------------------------------------------- … … 496 516 IF( nn_timing == 1 ) CALL timing_start('tke_avn') 497 517 518 CALL wrk_alloc( jpi,jpj, ztmp2d ) 498 519 CALL wrk_alloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld ) 499 520 … … 626 647 END DO 627 648 CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 649 ! 650 IF(.NOT. Agrif_Root()) THEN 651 652 DO jk = 1, jpkm1 653 DO jj = 2, jpjm1 654 DO ji = 2, jpim1 655 ztmp2d(ji,jj) = 1. * avm(ji-1,jj-1,jk) * tmask(ji-1,jj-1,jk) & 656 & + 2. * avm(ji ,jj-1,jk) * tmask(ji ,jj-1,jk) & 657 & + 1. * avm(ji+1,jj-1,jk) * tmask(ji+1,jj-1,jk) & 658 & + 2. * avm(ji-1,jj ,jk) * tmask(ji-1,jj ,jk) & 659 & + 4. * avm(ji ,jj ,jk) * tmask(ji ,jj ,jk) & 660 & + 2. * avm(ji+1,jj ,jk) * tmask(ji+1,jj ,jk) & 661 & + 1. * avm(ji-1,jj+1,jk) * tmask(ji-1,jj+1,jk) & 662 & + 2. * avm(ji ,jj+1,jk) * tmask(ji ,jj+1,jk) & 663 & + 1. * avm(ji+1,jj+1,jk) * tmask(ji+1,jj+1,jk) 664 END DO 665 END DO 666 DO jj = 2, jpjm1 667 DO ji = 2, jpim1 668 avm(ji,jj,jk) = ztmp2d(ji,jj) * wei3d(ji,jj,jk) * wmix(ji,jj) + avm(ji,jj,jk) * ( 1. - wmix(ji,jj) ) 669 END DO 670 END DO 671 END DO 672 CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 673 DO jk = 1, jpkm1 674 DO jj = 2, jpjm1 675 DO ji = 2, jpim1 676 ztmp2d(ji,jj) = 1. * avt(ji-1,jj-1,jk) * tmask(ji-1,jj-1,jk) & 677 & + 2. * avt(ji ,jj-1,jk) * tmask(ji ,jj-1,jk) & 678 & + 1. * avt(ji+1,jj-1,jk) * tmask(ji+1,jj-1,jk) & 679 & + 2. * avt(ji-1,jj ,jk) * tmask(ji-1,jj ,jk) & 680 & + 4. * avt(ji ,jj ,jk) * tmask(ji ,jj ,jk) & 681 & + 2. * avt(ji+1,jj ,jk) * tmask(ji+1,jj ,jk) & 682 & + 1. * avt(ji-1,jj+1,jk) * tmask(ji-1,jj+1,jk) & 683 & + 2. * avt(ji ,jj+1,jk) * tmask(ji ,jj+1,jk) & 684 & + 1. * avt(ji+1,jj+1,jk) * tmask(ji+1,jj+1,jk) 685 END DO 686 END DO 687 DO jj = 2, jpjm1 688 DO ji = 2, jpim1 689 avt(ji,jj,jk) = ztmp2d(ji,jj) * wei3d(ji,jj,jk) * wmix(ji,jj) + avt(ji,jj,jk) * ( 1. - wmix(ji,jj) ) 690 END DO 691 END DO 692 END DO 693 CALL lbc_lnk( avt, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 694 695 END IF 628 696 ! 629 697 DO jk = 2, jpkm1 !* vertical eddy viscosity at u- and v-points … … 662 730 ENDIF 663 731 CALL lbc_lnk( avt, 'W', 1. ) ! Lateral boundary conditions on avt (sign unchanged) 664 732 ! 665 733 IF(ln_ctl) THEN 666 734 CALL prt_ctl( tab3d_1=en , clinfo1=' tke - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk) … … 669 737 ENDIF 670 738 ! 739 CALL wrk_dealloc( jpi,jpj, ztmp2d ) 671 740 CALL wrk_dealloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld ) 672 741 ! … … 766 835 CALL tke_rst( nit000, 'READ' ) !* read or initialize all required files 767 836 ! 837 IF(.NOT. Agrif_Root()) THEN 838 839 wei3d(:,:,:) = 1. 840 DO jk = 1, jpkm1 841 DO jj = 2, jpjm1 842 DO ji = 2, jpim1 843 wei3d(ji,jj,jk) = & 844 & 1.*tmask(ji-1,jj-1,jk) + 2.*tmask(ji,jj-1,jk) + 1.*tmask(ji+1,jj-1,jk)& 845 & + 2.*tmask(ji-1,jj ,jk) + 4.*tmask(ji,jj ,jk) + 2.*tmask(ji+1,jj ,jk)& 846 & + 1.*tmask(ji-1,jj+1,jk) + 2.*tmask(ji,jj+1,jk) + 1.*tmask(ji+1,jj+1,jk) 847 wei3d(ji,jj,jk) = tmask(ji,jj,jk) / MAX( 1., wei3d(ji,jj,jk) ) 848 END DO 849 END DO 850 END DO 851 CALL lbc_lnk( wei3d, 'T', 1. ) 852 853 wmix(:,:) = 0. 854 wmix(mi0(2):mi1(jpiglo-1),mj0(2):mj1(jpjglo-1)) = 1. 855 wmix(mi0(6):mi1(jpiglo-5),mj0(6):mj1(jpjglo-5)) = 0.75 856 wmix(mi0(7):mi1(jpiglo-6),mj0(7):mj1(jpjglo-6)) = 0.5 857 wmix(mi0(8):mi1(jpiglo-7),mj0(8):mj1(jpjglo-7)) = 0.25 858 wmix(mi0(9):mi1(jpiglo-8),mj0(9):mj1(jpjglo-8)) = 0. 859 860 END IF 861 768 862 END SUBROUTINE zdf_tke_init 769 863
Note: See TracChangeset
for help on using the changeset viewer.