Changeset 1756 for trunk/NEMO/OPA_SRC/DIA/diawri.F90

Timestamp:

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

Author:

smasson

Message:

implement AR5 diagnostics, see ticket:610

File:

• trunk/NEMO/OPA_SRC/DIA/diawri.F90 (modified) (4 diffs)

trunk/NEMO/OPA_SRC/DIA/diawri.F90

@@ -24 +24 @@
    USE in_out_manager  ! I/O manager
    USE diadimg         ! dimg direct access file format output
+   USE diaar5, ONLY :   lk_diaar5
    USE iom
    USE ioipsl
@@ -50 +51 @@
    !! * Substitutions
 #  include "zdfddm_substitute.h90"
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !!   OPA 9.0 , LOCEAN-IPSL (2005) 
@@ -85 +88 @@
       !!   3.2  !  05-11  (B. Lemaire) creation from old diawri
       !!----------------------------------------------------------------------
+      USE oce, ONLY :   z3d => ta   ! use ta as 3D workspace
+      !!
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
+      INTEGER                      ::   ji, jj, jk              ! dummy loop indices
+      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   ! 
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d                     ! 
       !!----------------------------------------------------------------------
       ! 
@@ -94 +103 @@
       ENDIF
 
-      CALL iom_put( "toce"   , tn        )    ! temperature
-      CALL iom_put( "soce"   , sn        )    ! salinity
-      CALL iom_put( "sst"    , tn(:,:,1) )    ! sea surface temperature
-      CALL iom_put( "sss"    , sn(:,:,1) )    ! sea surface salinity
-      CALL iom_put( "uoce"   , un        )    ! i-current      
-      CALL iom_put( "voce"   , vn        )    ! j-current
+      CALL iom_put( "toce"   , tn                    )    ! temperature
+      CALL iom_put( "soce"   , sn                    )    ! salinity
+      CALL iom_put( "sst"    , tn(:,:,1)             )    ! sea surface temperature
+      CALL iom_put( "sst2"   , tn(:,:,1) * tn(:,:,1) )    ! square of sea surface temperature
+      CALL iom_put( "sss"    , sn(:,:,1)             )    ! sea surface salinity
+      CALL iom_put( "sss2"   , sn(:,:,1) * sn(:,:,1) )    ! square of sea surface salinity
+      CALL iom_put( "uoce"   , un                    )    ! i-current      
+      CALL iom_put( "voce"   , vn                    )    ! j-current
       
-      CALL iom_put( "avt"    , avt       )    ! T vert. eddy diff. coef.
-      CALL iom_put( "avm"    , avmu      )    ! T vert. eddy visc. coef.
+      CALL iom_put( "avt"    , avt                   )    ! T vert. eddy diff. coef.
+      CALL iom_put( "avm"    , avmu                  )    ! T vert. eddy visc. coef.
       IF( lk_zdfddm ) THEN
-         CALL iom_put( "avs", fsavs(:,:,:) )    ! S vert. eddy diff. coef.
+         CALL iom_put( "avs" , fsavs(:,:,:)          )    ! S vert. eddy diff. coef.
+      ENDIF
+
+      DO jj = 2, jpjm1                                    ! sst gradient
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zztmp      = tn(ji,jj,1)
+            zztmpx     = ( tn(ji+1,jj  ,1) - zztmp ) / e1u(ji,jj) + ( zztmp - tn(ji-1,jj  ,1) ) / e1u(ji-1,jj  )
+            zztmpy     = ( tn(ji  ,jj+1,1) - zztmp ) / e2v(ji,jj) + ( zztmp - tn(ji  ,jj-1,1) ) / e2v(ji  ,jj-1)
+            z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   &
+               &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1)
+         END DO
+      END DO
+      CALL lbc_lnk( z2d, 'T', 1. )
+      CALL iom_put( "|sstgrad|2",  z2d               )    ! square of module of sst gradient
+!CDIR NOVERRCHK
+      z2d(:,:) = SQRT( z2d(:,:) )
+      CALL iom_put( "|sstgrad|" ,  z2d               )    ! module of sst gradient
+
+      IF( lk_diaar5 ) THEN
+         z3d(:,:,jpk) = 0.e0
+         DO jk = 1, jpkm1
+            z3d(:,:,jk) = rau0 * un(:,:,jk) * e1u(:,:) * fse3u(:,:,jk)
+         END DO
+         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction
+         zztmp = 0.5 * 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) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( z2d, 'U', -1. )
+         CALL iom_put( "u_heattr", z2d )                  ! heat transport in i-direction
+         DO jk = 1, jpkm1
+            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e2v(:,:) * fse3v(:,:,jk)
+         END DO
+         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-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) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) )
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( z2d, 'V', -1. )
+         CALL iom_put( "v_heattr", z2d )                  !  heat transport in i-direction
       ENDIF