Changeset 15603 for branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.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/TRA/trabbl.F90 (modified) (10 diffs)

branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

@@ -32 +32 @@
    USE trdtra         ! trends: active tracers
    !
-   USE iom            ! IOM library               
+   USE iom            ! IOM library
    USE in_out_manager ! I/O manager
    USE lbclnk         ! ocean lateral boundary conditions
@@ -38 +38 @@
    USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE stopack
 
    IMPLICIT NONE
@@ -67 +68 @@
    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction (PUBLIC for TAM)
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   ahu_bbl_1, ahv_bbl_1   ! diffusive bbl flux coefficients at u and v-points
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points (PUBLIC for TAM)
 
@@ -86 +88 @@
          &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d  (jpi,jpj) , mgrhv(jpi,jpj) ,     &
          &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                          &
+         &      ahu_bbl_1(jpi,jpj) , ahv_bbl_1(jpi,jpj) ,                                          &
          &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) ,                                      STAT=tra_bbl_alloc )
          !
@@ -195 +198 @@
       ALLOCATE(zptb(1:jpi, 1:jpj))
       !
+      ahu_bbl_1(:,:) = ahu_bbl(:,:)
+#if defined key_traldf_c2d || key_traldf_c3d
+      IF( ln_stopack .AND. nn_spp_ahubbl > 0 ) THEN
+          CALL spp_gen(1, ahu_bbl_1, nn_spp_ahubbl, rn_ahubbl_sd, jk_spp_ahubbl )
+      ENDIF
+#else
+      IF ( ln_stopack .AND. nn_spp_ahubbl > 0 ) &
+         & CALL ctl_stop( 'tra_bbl_dif: parameter perturbation will only work with '// &
+                          'key_traldf_c2d or key_traldf_c3d')
+#endif
+
+
+      ahv_bbl_1(:,:) = ahv_bbl(:,:)
+#if defined key_traldf_c2d || key_traldf_c3d
+      IF( ln_stopack .AND. nn_spp_ahvbbl > 0 ) THEN
+          CALL spp_gen(1, ahv_bbl_1, nn_spp_ahvbbl, rn_ahvbbl_sd, jk_spp_ahvbbl )
+      ENDIF
+#else
+      IF ( ln_stopack .AND. nn_spp_ahvbbl > 0 ) &
+         & CALL ctl_stop( 'tra_bbl_dif: parameter perturbation will only work with '// &
+                          'key_traldf_c2d or key_traldf_c3d')
+#endif
+
+      !
       DO jn = 1, kjpt                                     ! tracer loop
          !                                                ! ===========
@@ -203 +230 @@
             END DO
          END DO
-         !               
+         !
          DO jj = 2, jpjm1                                    ! Compute the trend
             DO ji = 2, jpim1
@@ -209 +236 @@
                zbtr = r1_e12t(ji,jj)  / fse3t(ji,jj,ik)
                pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         &
-                  &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   &
-                  &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   &
-                  &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   &
-                  &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr
+                  &               + (   ahu_bbl_1(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   &
+                  &                   - ahu_bbl_1(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   &
+                  &                   + ahv_bbl_1(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   &
+                  &                   - ahv_bbl_1(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr
             END DO
          END DO
@@ -415 +442 @@
                   za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
                   zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal)
-                  !                                                          ! 2*masked bottom density gradient 
+                  !                                                          ! 2*masked bottom density gradient
                   zgdrho = (  za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) )    &
                             - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) )  ) * umask(ji,jj,1)
@@ -578 +605 @@
                gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) )  )
             ENDIF
-            !     
+            !
             IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN
                mgrhv(ji,jj) = INT(  SIGN( 1.e0, &
@@ -598 +625 @@
       ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)  * umask(:,:,1)
       ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask(:,:,1)
-
 
       IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : regional enhancement of ah_bbl