Changeset 15603 for branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

Timestamp:

2021-12-16T10:39:55+01:00 (3 years ago)

Author:

mattmartin

Message:

Updated NEMO branch for coupled NWP at GO6 to include stochastic model perturbations.
For more info see ticket: ​https://code.metoffice.gov.uk/trac/nwpscience/ticket/1125.

File:

• branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90 (modified) (7 diffs)

branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

@@ -20 +20 @@
    USE zdfkpp          ! KPP vertical mixing
    USE trd_oce         ! trends: ocean variables
-   USE trdtra          ! trends manager: tracers 
+   USE trdtra          ! trends manager: tracers
    USE in_out_manager  ! I/O manager
    USE iom             ! for iom_put
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE timing          ! Timing
+   USE stopack
 
    IMPLICIT NONE
@@ -30 +31 @@
 
    PUBLIC   zdf_evd    ! called by step.F90
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rn_avevd0
 
    !! * Substitutions
@@ -43 +45 @@
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE zdf_evd  ***
-      !!                   
+      !!
       !! ** Purpose :   Local increased the vertical eddy viscosity and diffu-
       !!      sivity coefficients when a static instability is encountered.
       !!
       !! ** Method  :   avt, avm, and the 4 neighbouring avmu, avmv coefficients
-      !!      are set to avevd (namelist parameter) if the water column is 
+      !!      are set to avevd (namelist parameter) if the water column is
       !!      statically unstable (i.e. if rn2 < -1.e-12 )
       !!
@@ -70 +72 @@
          IF(lwp) WRITE(numout,*)
          IF(lwp .AND. lflush) CALL flush(numout)
+         ALLOCATE ( rn_avevd0(jpi,jpj) )
+         rn_avevd0(:,:) = rn_avevd
       ENDIF
 
       zavt_evd(:,:,:) = avt(:,:,:)           ! set avt prior to evd application
+
+#if defined key_traldf_c2d || key_traldf_c3d
+      IF( ln_stopack .AND. ( nn_spp_aevd > 0 ) ) THEN
+         rn_avevd0(:,:) = rn_avevd
+         CALL spp_gen(kt, rn_avevd0, nn_spp_aevd, rn_aevd_sd, jk_spp_aevd)
+      ENDIF
+#else
+      IF ( ln_stopack .AND. ( nn_spp_aevd > 0 ) ) &
+         & CALL ctl_stop( 'zdf_evd: parameter perturbation will only work with '// &
+                          'key_traldf_c2d or key_traldf_c3d')
+#endif
 
       SELECT CASE ( nn_evdm )
@@ -80 +95 @@
          zavm_evd(:,:,:) = avm(:,:,:)           ! set avm prior to evd application
          !
-         DO jk = 1, jpkm1 
+         DO jk = 1, jpkm1
             DO jj = 2, jpj             ! no vector opt.
                DO ji = 2, jpi
@@ -89 +104 @@
                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN
 #endif
-                     avt (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
-                     avm (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk)
-                     avmu(ji  ,jj  ,jk) = rn_avevd * umask(ji  ,jj  ,jk)
-                     avmu(ji-1,jj  ,jk) = rn_avevd * umask(ji-1,jj  ,jk)
-                     avmv(ji  ,jj  ,jk) = rn_avevd * vmask(ji  ,jj  ,jk)
-                     avmv(ji  ,jj-1,jk) = rn_avevd * vmask(ji  ,jj-1,jk)
+                     avt (ji  ,jj  ,jk) = rn_avevd0(ji,jj) * tmask(ji  ,jj  ,jk)
+                     avm (ji  ,jj  ,jk) = rn_avevd0(ji,jj) * tmask(ji  ,jj  ,jk)
+                     avmu(ji  ,jj  ,jk) = rn_avevd0(ji,jj) * umask(ji  ,jj  ,jk)
+                     avmu(ji-1,jj  ,jk) = rn_avevd0(ji,jj) * umask(ji-1,jj  ,jk)
+                     avmv(ji  ,jj  ,jk) = rn_avevd0(ji,jj) * vmask(ji  ,jj  ,jk)
+                     avmv(ji  ,jj-1,jk) = rn_avevd0(ji,jj) * vmask(ji  ,jj-1,jk)
                   ENDIF
                END DO
             END DO
-         END DO 
+         END DO
          CALL lbc_lnk( avt , 'W', 1. )   ;   CALL lbc_lnk( avm , 'W', 1. )   ! Lateral boundary conditions
          CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )
@@ -105 +120 @@
          CALL iom_put( "avm_evd", zavm_evd )              ! output this change
          !
-      CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12) 
+      CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12)
          DO jk = 1, jpkm1
-!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL! 
+!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL!
             DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call)
                DO ji = 1, jpi
 #if defined key_zdfkpp
                   ! no evd mixing in the boundary layer with KPP
-                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  )   &          
+                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  )   &
 #else
                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   &
 #endif
-                     avt(ji,jj,jk) = rn_avevd * tmask(ji,jj,jk)
+                     avt(ji,jj,jk) = rn_avevd0(ji,jj) * tmask(ji,jj,jk)
                END DO
             END DO
          END DO
          !
-      END SELECT 
+      END SELECT
 
       zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd