New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5948 for branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90 – NEMO

Ignore:
Timestamp:
2015-11-30T11:47:24+01:00 (8 years ago)
Author:
timgraham
Message:

Merged in head of trunk (r5936)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r5947 r5948  
    88   !!             3.3  !  2010-10  (C. Bricaud)  Add in the reference 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_zdfgls   ||   defined key_esopa 
     10#if defined key_zdfgls 
    1111   !!---------------------------------------------------------------------- 
    1212   !!   'key_zdfgls'                 Generic Length Scale vertical physics 
     
    4242   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfgls = .TRUE.   !: TKE vertical mixing flag 
    4343   ! 
    44    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en      !: now turbulent kinetic energy 
    4544   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length 
    4645   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function 
    47    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k   ! not enhanced Kz 
    48    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avm_k   ! not enhanced Kz 
    49    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k  ! not enhanced Kz 
    50    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmv_k  ! not enhanced Kz 
    5146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points 
    5247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points 
     
    120115      !!                ***  FUNCTION zdf_gls_alloc  *** 
    121116      !!---------------------------------------------------------------------- 
    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 ) 
    126119         ! 
    127120      IF( lk_mpp             )   CALL mpp_sum ( zdf_gls_alloc ) 
     
    161154      IF( nn_timing == 1 )  CALL timing_start('zdf_gls') 
    162155      ! 
    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  ) 
    165158       
    166159      ! Preliminary computing 
     
    176169 
    177170      ! Compute surface and bottom friction at T-points 
    178 !CDIR NOVERRCHK           
    179171      DO jj = 2, jpjm1           
    180 !CDIR NOVERRCHK          
    181172         DO ji = fs_2, fs_jpim1   ! vector opt.          
    182173            ! 
     
    329320      !  
    330321      ! 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) 
    332324      en(:,:,2) = MAX(en(:,:,2), rn_emin ) 
    333325      z_elem_a(:,:,2) = 0._wp  
     
    350342      z_elem_a(:,:,2) = 0._wp 
    351343      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) 
    353346 
    354347      en(:,:,2) = en(:,:,2) + zflxs(:,:)/fse3w(:,:,2) 
     
    365358         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin 
    366359         !                      ! Balance between the production and the dissipation terms 
    367 !CDIR NOVERRCHK 
    368          DO jj = 2, jpjm1 
    369 !CDIR NOVERRCHK 
     360         DO jj = 2, jpjm1 
    370361            DO ji = fs_2, fs_jpim1   ! vector opt. 
    371362               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
     
    388379      CASE ( 1 )             ! Neumman boundary condition 
    389380         !                       
    390 !CDIR NOVERRCHK 
    391          DO jj = 2, jpjm1 
    392 !CDIR NOVERRCHK 
     381         DO jj = 2, jpjm1 
    393382            DO ji = fs_2, fs_jpim1   ! vector opt. 
    394383               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
     
    593582         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * rn_bfrz0 
    594583         !                      ! Balance between the production and the dissipation terms 
    595 !CDIR NOVERRCHK 
    596          DO jj = 2, jpjm1 
    597 !CDIR NOVERRCHK 
     584         DO jj = 2, jpjm1 
    598585            DO ji = fs_2, fs_jpim1   ! vector opt. 
    599586               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
     
    616603      CASE ( 1 )             ! Neumman boundary condition 
    617604         !                       
    618 !CDIR NOVERRCHK 
    619          DO jj = 2, jpjm1 
    620 !CDIR NOVERRCHK 
     605         DO jj = 2, jpjm1 
    621606            DO ji = fs_2, fs_jpim1   ! vector opt. 
    622607               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
     
    839824      avmv_k(:,:,:) = avmv(:,:,:) 
    840825      ! 
    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 ) 
    843828      ! 
    844829      IF( nn_timing == 1 )  CALL timing_stop('zdf_gls') 
Note: See TracChangeset for help on using the changeset viewer.