Changeset 7837 for branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

Timestamp:

2017-03-27T10:50:24+02:00 (7 years ago)

Author:

mattmartin

Message:

First version of generic obs oper which works at NEMO3.6 with other GO6 branches.

File:

• branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90 (modified) (6 diffs)

branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

@@ -174 +174 @@
       !!----------------------------------------------------------------------
       !
-#if defined key_agrif 
-      ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2)
-      IF( .NOT.Agrif_Root() )   CALL Agrif_Tke
-#endif
-      !
       IF( kt /= nit000 ) THEN   ! restore before value to compute tke
          avt (:,:,:) = avt_k (:,:,:) 
@@ -234 +229 @@
       INTEGER , POINTER, DIMENSION(:,:  ) :: imlc
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zhlc
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw, z3du, z3dv
-      REAL(wp)                            ::   zri  !   local Richardson number
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw
       !!--------------------------------------------------------------------
       !
@@ -242 +236 @@
       CALL wrk_alloc( jpi,jpj, imlc )    ! integer
       CALL wrk_alloc( jpi,jpj, zhlc ) 
-      CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 
+      CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 
       !
       zbbrau = rn_ebb / rau0       ! Local constant initialisation
@@ -367 +361 @@
                zzd_lw = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &  ! lower diagonal
                   &          / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
-               !                                   ! shear prod. at w-point weightened by mask
-               zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
-                  &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
-               !
+                  !                                                           ! shear prod. at w-point weightened by mask
+               zesh2  =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                  &    + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+                  !
                zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
                zd_lw(ji,jj,jk) = zzd_lw
@@ -468 +462 @@
       CALL wrk_dealloc( jpi,jpj, imlc )    ! integer
       CALL wrk_dealloc( jpi,jpj, zhlc ) 
-      CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 
+      CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 
       !
       IF( nn_timing == 1 )  CALL timing_stop('tke_tke')
@@ -512 +506 @@
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
       REAL(wp) ::   zrn2, zraug, zcoef, zav     ! local scalars
-      REAL(wp) ::   zdku, zri, zsqen     !   -      -
+      REAL(wp) ::   zdku, zpdlr, zri, zsqen     !   -      -
       REAL(wp) ::   zdkv, zemxl, zemlm, zemlp   !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld