Changeset 5948 for branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
- Timestamp:
- 2015-11-30T11:47:24+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r5947 r5948 8 8 !! 3.3 ! 2010-10 (C. Bricaud) Add in the reference 9 9 !!---------------------------------------------------------------------- 10 #if defined key_zdfgls || defined key_esopa10 #if defined key_zdfgls 11 11 !!---------------------------------------------------------------------- 12 12 !! 'key_zdfgls' Generic Length Scale vertical physics … … 42 42 LOGICAL , PUBLIC, PARAMETER :: lk_zdfgls = .TRUE. !: TKE vertical mixing flag 43 43 ! 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy45 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length 46 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zwall !: wall function 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k ! not enhanced Kz48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avm_k ! not enhanced Kz49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k ! not enhanced Kz50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmv_k ! not enhanced Kz51 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustars2 !: Squared surface velocity scale at T-points 52 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustarb2 !: Squared bottom velocity scale at T-points … … 120 115 !! *** FUNCTION zdf_gls_alloc *** 121 116 !!---------------------------------------------------------------------- 122 ALLOCATE( en(jpi,jpj,jpk), mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 123 & avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk), & 124 & avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), & 125 & ustars2(jpi,jpj), ustarb2(jpi,jpj) , STAT= zdf_gls_alloc ) 117 ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 118 & ustars2(jpi,jpj) , ustarb2(jpi,jpj) , STAT= zdf_gls_alloc ) 126 119 ! 127 120 IF( lk_mpp ) CALL mpp_sum ( zdf_gls_alloc ) … … 161 154 IF( nn_timing == 1 ) CALL timing_start('zdf_gls') 162 155 ! 163 CALL wrk_alloc( jpi,jpj, zdep, zkar, zflxs, zhsro )164 CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )156 CALL wrk_alloc( jpi,jpj, zdep, zkar, zflxs, zhsro ) 157 CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi ) 165 158 166 159 ! Preliminary computing … … 176 169 177 170 ! Compute surface and bottom friction at T-points 178 !CDIR NOVERRCHK179 171 DO jj = 2, jpjm1 180 !CDIR NOVERRCHK181 172 DO ji = fs_2, fs_jpim1 ! vector opt. 182 173 ! … … 329 320 ! 330 321 ! One level below 331 en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+fsdepw(:,:,2))/zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp) 322 en(:,:,2) = rc02r * ustars2(:,:) * (1._wp + rsbc_tke1 * ((zhsro(:,:)+fsdepw(:,:,2)) & 323 & / zhsro(:,:) )**(1.5_wp*ra_sf))**(2._wp/3._wp) 332 324 en(:,:,2) = MAX(en(:,:,2), rn_emin ) 333 325 z_elem_a(:,:,2) = 0._wp … … 350 342 z_elem_a(:,:,2) = 0._wp 351 343 zkar(:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-exp(-rtrans*fsdept(:,:,1)/zhsro(:,:)) )) 352 zflxs(:,:) = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) * ((zhsro(:,:)+fsdept(:,:,1))/zhsro(:,:) )**(1.5_wp*ra_sf) 344 zflxs(:,:) = rsbc_tke2 * ustars2(:,:)**1.5_wp * zkar(:,:) & 345 & * ((zhsro(:,:)+fsdept(:,:,1)) / zhsro(:,:) )**(1.5_wp*ra_sf) 353 346 354 347 en(:,:,2) = en(:,:,2) + zflxs(:,:)/fse3w(:,:,2) … … 365 358 ! ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin 366 359 ! ! Balance between the production and the dissipation terms 367 !CDIR NOVERRCHK 368 DO jj = 2, jpjm1 369 !CDIR NOVERRCHK 360 DO jj = 2, jpjm1 370 361 DO ji = fs_2, fs_jpim1 ! vector opt. 371 362 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 388 379 CASE ( 1 ) ! Neumman boundary condition 389 380 ! 390 !CDIR NOVERRCHK 391 DO jj = 2, jpjm1 392 !CDIR NOVERRCHK 381 DO jj = 2, jpjm1 393 382 DO ji = fs_2, fs_jpim1 ! vector opt. 394 383 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 593 582 ! ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * rn_bfrz0 594 583 ! ! Balance between the production and the dissipation terms 595 !CDIR NOVERRCHK 596 DO jj = 2, jpjm1 597 !CDIR NOVERRCHK 584 DO jj = 2, jpjm1 598 585 DO ji = fs_2, fs_jpim1 ! vector opt. 599 586 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 616 603 CASE ( 1 ) ! Neumman boundary condition 617 604 ! 618 !CDIR NOVERRCHK 619 DO jj = 2, jpjm1 620 !CDIR NOVERRCHK 605 DO jj = 2, jpjm1 621 606 DO ji = fs_2, fs_jpim1 ! vector opt. 622 607 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 839 824 avmv_k(:,:,:) = avmv(:,:,:) 840 825 ! 841 CALL wrk_dealloc( jpi,jpj, zdep, zkar, zflxs, zhsro )842 CALL wrk_dealloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )826 CALL wrk_dealloc( jpi,jpj, zdep, zkar, zflxs, zhsro ) 827 CALL wrk_dealloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi ) 843 828 ! 844 829 IF( nn_timing == 1 ) CALL timing_stop('zdf_gls')
Note: See TracChangeset
for help on using the changeset viewer.