Changeset 7403 for branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

Timestamp:

2016-11-30T17:56:53+01:00 (8 years ago)

Author:

timgraham

Message:

Merge dev_INGV_METO_merge_2016 into branch

File:

• branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90 (modified) (2 diffs)

branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

@@ -24 +24 @@
    USE ldfslp          ! lateral diffusion: slope of iso-neutral surfaces
    USE ldfc1d_c2d      ! lateral diffusion: 1D & 2D cases 
-   USE diaar5, ONLY:   lk_diaar5
+   USE diaptr
    !
    USE trc_oce, ONLY: lk_offline ! offline flag
@@ -730 +730 @@
       CALL iom_put( "woce_eiv", zw3d )
       !
+      !      
+      !
+      CALL wrk_alloc( jpi,jpj,   zw2d )
+      !
+      zztmp = 0.5_wp * rau0 * rcp 
+      IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN
+        zw2d(:,:)   = 0._wp 
+        zw3d(:,:,:) = 0._wp 
+        DO jk = 1, jpkm1
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1   ! vector opt.
+                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   &
+                    &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) ) 
+                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+              END DO
+           END DO
+        END DO
+        CALL lbc_lnk( zw2d, 'U', -1. )
+        CALL lbc_lnk( zw3d, 'U', -1. )
+        CALL iom_put( "ueiv_heattr"  , zztmp * zw2d )                  ! heat transport in i-direction
+        CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction
+      ENDIF
+      zw2d(:,:)   = 0._wp 
+      zw3d(:,:,:) = 0._wp 
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   &
+                  &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji,jj+1,jk,jp_tem) ) 
+               zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zw2d, 'V', -1. )
+      CALL iom_put( "veiv_heattr", zztmp * zw2d )                  !  heat transport in j-direction
+      CALL iom_put( "veiv_heattr", zztmp * zw3d )                  !  heat transport in j-direction
+      !
+      IF( ln_diaptr )  CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d )
+      !
+      zztmp = 0.5_wp * 0.5
+      IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN
+        zw2d(:,:) = 0._wp 
+        zw3d(:,:,:) = 0._wp 
+        DO jk = 1, jpkm1
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1   ! vector opt.
+                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   &
+                    &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) ) 
+                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+              END DO
+           END DO
+        END DO
+        CALL lbc_lnk( zw2d, 'U', -1. )
+        CALL lbc_lnk( zw3d, 'U', -1. )
+        CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction
+        CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction
+      ENDIF
+      zw2d(:,:) = 0._wp 
+      zw3d(:,:,:) = 0._wp 
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   &
+                  &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji,jj+1,jk,jp_sal) ) 
+               zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zw2d, 'V', -1. )
+      CALL iom_put( "veiv_salttr", zztmp * zw2d )                  !  salt transport in j-direction
+      CALL iom_put( "veiv_salttr", zztmp * zw3d )                  !  salt transport in j-direction
+      !
+      IF( ln_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d )
+      !
+      CALL wrk_dealloc( jpi,jpj,   zw2d )
       CALL wrk_dealloc( jpi,jpj,jpk,   zw3d )
-      !      
-      !
-      IF( lk_diaar5 ) THEN                               !==  eiv heat transport: calculate and output  ==!
-         CALL wrk_alloc( jpi,jpj,   zw2d )
-         !
-         zztmp = 0.5_wp * rau0 * rcp 
-         zw2d(:,:) = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   &
-                     &                              * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) ) 
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( zw2d, 'U', -1. )
-         CALL iom_put( "ueiv_heattr", zw2d )                  ! heat transport in i-direction
-         zw2d(:,:) = 0._wp 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_vw(ji,jj,jk+1)      - psi_vw(ji,jj,jk)          )   &
-                     &                              * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji,jj+1,jk,jp_tem) ) 
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( zw2d, 'V', -1. )
-         CALL iom_put( "veiv_heattr", zw2d )                  !  heat transport in i-direction
-         !
-         CALL wrk_dealloc( jpi,jpj,   zw2d )
-      ENDIF
       !
       IF( nn_timing == 1 )  CALL timing_stop( 'ldf_eiv_dia')