Changeset 1756 for trunk/NEMO/OPA_SRC/TRA/traldf_iso.F90

Timestamp:

2009-11-25T15:15:20+01:00 (15 years ago)

Author:

smasson

Message:

implement AR5 diagnostics, see ticket:610

File:

• trunk/NEMO/OPA_SRC/TRA/traldf_iso.F90 (modified) (6 diffs)

trunk/NEMO/OPA_SRC/TRA/traldf_iso.F90

@@ -26 +26 @@
    USE zdf_oce         ! ocean vertical physics
    USE in_out_manager  ! I/O manager
+   USE iom             !
    USE ldfslp          ! iso-neutral slopes
    USE diaptr          ! poleward transport diagnostics
    USE prtctl          ! Print control
+#if defined key_diaar5
+   USE phycst          ! physical constants
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+#endif
 
    IMPLICIT NONE
@@ -98 +103 @@
       REAL(wp) ::   zmskv, zabe2, zcof2, zcoef4, zsa   !    "         "
       REAL(wp) ::   zcoef0, zbtr                       !    "         "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt , zdk1t, zftu   ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zdks , zdk1s, zfsu   !    "           "
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt , zdk1t         ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zdks , zdk1s, zfsu   !  "         "
+#if defined key_diaar5
+      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                  !  "         "
+      REAL(wp)                         ::   zztmp                !  "         "
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zftu                 ! 3D workspace
+#else
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zftu                 ! 2D workspace
+#endif
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw     ! 3D workspace
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdis, zdjs, zsfw     !  "      "
+# if defined key_diaar5
+# endif  
       !!----------------------------------------------------------------------
 
@@ -149 +163 @@
       !!----------------------------------------------------------------------
       
+#if defined key_diaar5
+!CDIR PARALLEL DO PRIVATE( zdk1t, zdk1s, zfsu ) 
+#else
 !CDIR PARALLEL DO PRIVATE( zdk1t, zdk1s, zftu, zfsu ) 
+#endif
       !                                                ! ===============
       DO jk = 1, jpkm1                                 ! Horizontal slab
@@ -186 +204 @@
                zcof2 = -fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
 
+#if defined key_diaar5
+               zftu(ji,jj,jk) = (  zabe1 * zdit(ji,jj,jk)   &
+#else
                zftu(ji,jj   ) = (  zabe1 * zdit(ji,jj,jk)   &
+#endif
                   &              + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
                   &                         + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
@@ -207 +229 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+#if defined key_diaar5
+               zta = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
+#else
                zta = zbtr * ( zftu(ji,jj   ) - zftu(ji-1,jj   ) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
+#endif
                zsa = zbtr * ( zfsu(ji,jj   ) - zfsu(ji-1,jj   ) + zfsv(ji,jj,jk) - zfsv(ji,jj-1,jk)  )
                ta (ji,jj,jk) = ta (ji,jj,jk) + zta
@@ -221 +247 @@
          pst_ldf(:) = ptr_vj( zfsv(:,:,:) )
       ENDIF
+#if defined key_diaar5
+      zztmp = 0.5 * rau0 * rcp 
+      z2d(:,:) = 0.e0 
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z2d(ji,jj) = z2d(ji,jj) + zztmp * zftu(ji,jj,jk) * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) * e1u(ji,jj) * fse3u(ji,jj,jk) 
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( z2d, 'U', -1. )
+      CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
+      z2d(:,:) = 0.e0 
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z2d(ji,jj) = z2d(ji,jj) + zztmp * zftv(ji,jj,jk) * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) ) * e2v(ji,jj) * fse3v(ji,jj,jk) 
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( z2d, 'V', -1. )
+      CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
+#endif
 
       !!----------------------------------------------------------------------