Changeset 14994 for NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/TRA

Timestamp:

2021-06-15T16:39:31+02:00 (3 years ago)

Author:

mathiot

Message:

ticket #2669: update to the head of trunk

Location:

NEMO/branches/2021/ticket2669_isf_fluxes/src

Files:

• . (modified) (1 prop)
• OCE/TRA/traadv_qck.F90 (modified) (1 diff)
• OCE/TRA/traadv_qck_lf.F90 (modified) (4 diffs)
• OCE/TRA/traadv_ubs.F90 (modified) (6 diffs)
• OCE/TRA/tradmp.F90 (modified) (4 diffs)
• OCE/TRA/tramle.F90 (modified) (1 diff)

NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/TRA/traadv_qck.F90

@@ -246 +246 @@
          IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions
 
+         ! Correct zfd on northfold after lbc_lnk; see #2640
+         IF( nn_hls == 1 .AND. l_IdoNFold .AND. ntej == Nje0 ) THEN
+            DO jk = 1, jpkm1
+               WHERE( tmask_i(ntsi:ntei,ntej:jpj) == 0._wp ) zfd(ntsi:ntei,ntej:jpj,jk) = zfc(ntsi:ntei,ntej:jpj,jk)
+            END DO
+         ENDIF
          !
          ! Horizontal advective fluxes

NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/TRA/traadv_qck_lf.F90

@@ -111 +111 @@
       !
       !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme
-      CALL tra_adv_qck_i( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs )
-      CALL tra_adv_qck_j( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs )
+      CALL tra_adv_qck_i_lf( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs )
+      CALL tra_adv_qck_j_lf( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs )
 
       !        ! vertical fluxes are computed with the 2nd order centered scheme
-      CALL tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs )
+      CALL tra_adv_cen2_k_lf( kt, cdtype, pW, Kmm, pt, kjpt, Krhs )
       !
    END SUBROUTINE tra_adv_qck_lf
 
 
-   SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs )
+   SUBROUTINE tra_adv_qck_i_lf( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs )
       !!----------------------------------------------------------------------
       !!
@@ -193 +193 @@
       END DO
       !
-   END SUBROUTINE tra_adv_qck_i
-
-
-   SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs )
+   END SUBROUTINE tra_adv_qck_i_lf
+
+
+   SUBROUTINE tra_adv_qck_j_lf( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs )
       !!----------------------------------------------------------------------
       !!
@@ -273 +273 @@
       END DO
       !
-   END SUBROUTINE tra_adv_qck_j
-
-
-   SUBROUTINE tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs )
+   END SUBROUTINE tra_adv_qck_j_lf
+
+
+   SUBROUTINE tra_adv_cen2_k_lf( kt, cdtype, pW, Kmm, pt, kjpt, Krhs )
       !!----------------------------------------------------------------------
       !!
@@ -323 +323 @@
       END DO
       !
-   END SUBROUTINE tra_adv_cen2_k
+   END SUBROUTINE tra_adv_cen2_k_lf
 
 

NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/TRA/traadv_ubs.F90

@@ -161 +161 @@
          END_3D
          !
-         DO_3D( 1, 1, 1, 1, 1, jpk )
+         DO_3D( 0, 0, 0, 0, 1, jpk )
             zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs)      ! store the initial trends before its update
          END_3D
@@ -175 +175 @@
          END DO
          !
-         DO_3D( 1, 1, 1, 1, 1, jpk )
+         DO_3D( 0, 0, 0, 0, 1, jpk )
             zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltu(ji,jj,jk)  ! Horizontal advective trend used in vertical 2nd order FCT case
          END_3D                                                     ! and/or in trend diagnostic (l_trd=T)
@@ -203 +203 @@
             !
             !                               !*  upstream advection with initial mass fluxes & intermediate update  ==!
-            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
+            DO_3D( 0, 0, 0, 0, 2, jpkm1 )
                zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) )
                zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) )
@@ -210 +210 @@
             IF( ln_linssh ) THEN                ! top ocean value (only in linear free surface as ztw has been w-masked)
                IF( ln_isfcav ) THEN                   ! top of the ice-shelf cavities and at the ocean surface
-                  DO_2D( 1, 1, 1, 1 )
+                  DO_2D( 0, 0, 0, 0 )
                      ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface
                   END_2D
                ELSE                                   ! no cavities: only at the ocean surface
-                  DO_2D( 1, 1, 1, 1 )
+                  DO_2D( 0, 0, 0, 0 )
                      ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb)
                   END_2D
@@ -228 +228 @@
             !
             !                          !*  anti-diffusive flux : high order minus low order
-            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
+            DO_3D( 0, 0, 0, 0, 2, jpkm1 )
                ztw(ji,jj,jk) = (   0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   &
                   &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk)
@@ -243 +243 @@
             END_3D
             IF( ln_linssh ) THEN
-               DO_2D( 1, 1, 1, 1 )
+               DO_2D( 0, 0, 0, 0 )
                   ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm)     !!gm ISF & 4th COMPACT doesn't work
                END_2D

NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/TRA/tradmp.F90

@@ -53 +53 @@
    !! * Substitutions
 #  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -96 +97 @@
       INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
       REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts)     ::  zts_dta
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE ::  zwrk
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts
       !!----------------------------------------------------------------------
@@ -102 +104 @@
       !
       IF( l_trdtra .OR. iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN   !* Save ta and sa trends
-         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) )
-         ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs)
+         ALLOCATE( ztrdts(A2D(nn_hls),jpk,jpts) )
+         DO jn = 1, jpts
+            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+               ztrdts(ji,jj,jk,jn) = pts(ji,jj,jk,jn,Krhs)
+            END_3D
+         END DO
       ENDIF
       !                           !==  input T-S data at kt  ==!
@@ -141 +147 @@
       !
       ! outputs (clem trunk)
-      IF( iom_use('hflx_dmp_cea') )       &
-         &   CALL iom_put('hflx_dmp_cea', &
-         &   SUM( ( pts(:,:,:,jp_tem,Krhs) - ztrdts(:,:,:,jp_tem) ) * e3t(:,:,:,Kmm), dim=3 ) * rcp * rho0 ) ! W/m2
-      IF( iom_use('sflx_dmp_cea') )       &
-         &   CALL iom_put('sflx_dmp_cea', &
-         &   SUM( ( pts(:,:,:,jp_sal,Krhs) - ztrdts(:,:,:,jp_sal) ) * e3t(:,:,:,Kmm), dim=3 ) * rho0 )       ! g/m2/s
+      IF( iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN
+         ALLOCATE( zwrk(A2D(nn_hls),jpk) )          ! Needed to handle expressions containing e3t when using key_qco or key_linssh
+         zwrk(:,:,:) = 0._wp
+
+         IF( iom_use('hflx_dmp_cea') ) THEN
+            DO_3D( 0, 0, 0, 0, 1, jpk )
+               zwrk(ji,jj,jk) = ( pts(ji,jj,jk,jp_tem,Krhs) - ztrdts(ji,jj,jk,jp_tem) ) * e3t(ji,jj,jk,Kmm)
+            END_3D
+            CALL iom_put('hflx_dmp_cea', SUM( zwrk(:,:,:), dim=3 ) * rcp * rho0 ) ! W/m2
+         ENDIF
+         IF( iom_use('sflx_dmp_cea') ) THEN
+            DO_3D( 0, 0, 0, 0, 1, jpk )
+               zwrk(ji,jj,jk) = ( pts(ji,jj,jk,jp_sal,Krhs) - ztrdts(ji,jj,jk,jp_sal) ) * e3t(ji,jj,jk,Kmm)
+            END_3D
+            CALL iom_put('sflx_dmp_cea', SUM( zwrk(:,:,:), dim=3 ) * rho0 )       ! g/m2/s
+         ENDIF
+
+         DEALLOCATE( zwrk )
+      ENDIF
       !
       IF( l_trdtra )   THEN       ! trend diagnostic

NEMO/branches/2021/ticket2669_isf_fluxes/src/OCE/TRA/tramle.F90

@@ -366 +366 @@
          r1_ft(:,:) = 1._wp / SQRT(  ff_t(:,:) * ff_t(:,:) + z1_t2  )
          !
-         ! Specifically, dbdx_mle, dbdy_mle and mld_prof need to be defined for nn_hls = 2
-         IF( nn_hls == 2 .AND. ln_osm_mle .AND. ln_zdfosm ) THEN
-            CALL ctl_stop('nn_hls = 2 cannot be used with ln_mle = ln_osm_mle = ln_zdfosm = T (zdfosm not updated for nn_hls = 2)')
-         ENDIF
       ENDIF
       !