Changeset 7241

Timestamp:

2016-11-16T16:29:54+01:00 (7 years ago)

Author:

timgraham

Message:

Added advective 2D (i/j) heat transport fields in FCT advection scheme

File:

• branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90 (modified) (6 diffs)

branches/2016/dev_r7233_CMIP6_diags_trunk_version/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

@@ -36 +36 @@
 
    LOGICAL  ::   l_trd   ! flag to compute trends
+   LOGICAL  ::   l_trans   ! flag to output vertically integrated transports
    REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
 
@@ -81 +82 @@
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrd, zptry
+      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d
       !!----------------------------------------------------------------------
       !
@@ -94 +96 @@
       !
       l_trd = .FALSE.
+      l_trans = .FALSE.
       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
-      !
-      IF( l_trd )  THEN
+      IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE.
+      !
+      IF( l_trd .OR. l_trans )  THEN
          CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
          ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp
@@ -165 +169 @@
          CALL lbc_lnk( zwi, 'T', 1. )  ! Lateral boundary conditions on zwi  (unchanged sign)
          !                
-         IF( l_trd )  THEN             ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd .OR. l_trans )  THEN             ! trend diagnostics (contribution of upstream fluxes)
             ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:)
          END IF
@@ -293 +297 @@
          END DO
          !
-         IF( l_trd ) THEN     ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd .OR. l_trans ) THEN     ! trend diagnostics (contribution of upstream fluxes)
             ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
             ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
-            !
+         ENDIF
+            !
+         IF( l_trd ) THEN 
             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )
             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )
             CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )
             !
-            CALL wrk_dealloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz )
          END IF
-         !                    ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+
+         IF( l_trans .AND. jn==jp_tem ) THEN
+            CALL wrk_alloc( jpi, jpj, z2d )
+            z2d(:,:) = 0._wp 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( z2d, 'U', -1. )
+            CALL iom_put( "uadv_heattr", rau0_rcp * z2d )       ! heat transport in i-direction
+              !
+            z2d(:,:) = 0._wp 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( z2d, 'V', -1. )
+            CALL iom_put( "vadv_heattr", rau0_rcp * z2d )       ! heat transport in j-direction
+            CALL wrk_dealloc( jpi, jpj, z2d )
+         ENDIF
+         ! "Poleward" heat and salt transports (contribution of upstream fluxes)
          IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
             zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
@@ -313 +344 @@
       !
       CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw )
+      IF( l_trd .OR. l_trans )  THEN 
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+      ENDIF
       IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry )
       !