Changeset 9286


Ignore:
Timestamp:
2018-01-29T10:40:42+01:00 (3 weeks ago)
Author:
Christian Ethe
Message:

bugfix on ocean kinetic energy dissipation due to vertical friction diag., see ticket #2005

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r8627 r9286  
    7474      REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d 
    7575      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwd, zws 
     76      REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d 
    7677      !!---------------------------------------------------------------------- 
    7778      ! 
     
    354355         !                                ! Note that formally, in a Leap-Frog environment, the shear**2 should be the product of  
    355356         !                                ! now by before shears, i.e. the source term of TKE (local positivity is not ensured). 
    356          CALL wrk_alloc(jpi,jpj,   z2d ) 
     357         CALL wrk_alloc(jpi, jpj,      z2d ) 
     358         CALL wrk_alloc(jpi, jpj, jpk, z3d ) 
    357359         z2d(:,:) = 0._wp 
    358          DO jk = 1, jpkm1 
     360         z3d(:,:,:) = ua(:,:,:)     ;      CALL lbc_lnk( z3d,'U', -1. ) 
     361         DO jk = 2, jpkm1 
    359362            DO jj = 2, jpjm1 
    360                DO ji = 2, jpim1 
     363               DO ji = fs_2, fs_jpim1   ! vector opt. 
    361364                  z2d(ji,jj) = z2d(ji,jj)  +  (                                                                                  & 
    362                      &   avmu(ji  ,jj,jk) * ( ua(ji  ,jj,jk-1) - ua(ji  ,jj,jk) )**2 / fse3uw(ji  ,jj,jk) * wumask(ji  ,jj,jk)   & 
    363                      & + avmu(ji-1,jj,jk) * ( ua(ji-1,jj,jk-1) - ua(ji-1,jj,jk) )**2 / fse3uw(ji-1,jj,jk) * wumask(ji-1,jj,jk)   & 
    364                      & + avmv(ji,jj  ,jk) * ( va(ji,jj  ,jk-1) - va(ji,jj  ,jk) )**2 / fse3vw(ji,jj  ,jk) * wvmask(ji,jj  ,jk)   & 
    365                      & + avmv(ji,jj-1,jk) * ( va(ji,jj-1,jk-1) - va(ji,jj-1,jk) )**2 / fse3vw(ji,jj-1,jk) * wvmask(ji,jj-1,jk)   & 
     365                     &   avmu(ji  ,jj,jk) * ( z3d(ji  ,jj,jk-1) - z3d(ji  ,jj,jk) )**2 / fse3uw(ji  ,jj,jk) * wumask(ji  ,jj,jk)   & 
     366                     & + avmu(ji-1,jj,jk) * ( z3d(ji-1,jj,jk-1) - z3d(ji-1,jj,jk) )**2 / fse3uw(ji-1,jj,jk) * wumask(ji-1,jj,jk)   & 
     367                     &                        ) 
     368               END DO 
     369            END DO 
     370         END DO 
     371         z3d(:,:,:) = va(:,:,:)     ;      CALL lbc_lnk( z3d,'V', -1. ) 
     372         DO jk = 2, jpkm1 
     373            DO jj = 2, jpjm1 
     374               DO ji = fs_2, fs_jpim1   ! vector opt. 
     375                  z2d(ji,jj) = z2d(ji,jj)  +  (                                                                                  & 
     376                     &   avmv(ji,jj  ,jk) * ( z3d(ji,jj  ,jk-1) - z3d(ji,jj  ,jk) )**2 / fse3vw(ji,jj  ,jk) * wvmask(ji,jj  ,jk)   & 
     377                     & + avmv(ji,jj-1,jk) * ( z3d(ji,jj-1,jk-1) - z3d(ji,jj-1,jk) )**2 / fse3vw(ji,jj-1,jk) * wvmask(ji,jj-1,jk)   & 
    366378                     &                        ) 
    367379               END DO 
     
    372384         CALL lbc_lnk( z2d,'T', 1. ) 
    373385         CALL iom_put( 'dispkevfo', z2d ) 
    374          CALL wrk_dealloc(jpi,jpj,   z2d ) 
     386         ! 
     387         CALL wrk_dealloc(jpi, jpj,     z2d  ) 
     388         CALL wrk_dealloc(jpi, jpj, jpk, z3d ) 
    375389      ENDIF 
    376390 
Note: See TracChangeset for help on using the changeset viewer.