Changeset 1175 for trunk/NEMO/TOP_SRC/TRP/trcadv_muscl.F90

Timestamp:

2008-09-11T18:26:34+02:00 (16 years ago)

Author:

cetlod

Message:

update transport modules to take into account new trends organization, see ticket:248

File:

• trunk/NEMO/TOP_SRC/TRP/trcadv_muscl.F90 (modified) (9 diffs)

trunk/NEMO/TOP_SRC/TRP/trcadv_muscl.F90

@@ -18 +18 @@
    USE lib_mpp
    USE prtctl_trc      ! Print control for debbuging
+   USE trdmld_trc
+   USE trdmld_trc_oce          ! ocean variables trends
 
    IMPLICIT NONE
@@ -29 +31 @@
    !!----------------------------------------------------------------------
    !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcadv_muscl.F90,v 1.13 2007/10/12 09:26:30 opalod Exp $ 
    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    !!----------------------------------------------------------------------
@@ -46 +48 @@
       !!
       !! ** Action  : - update tra with the now advective tracer trends
-      !!              - save trends in trtrd ('key_trc_diatrd')
+      !!              - save trends ('key_trdmld_trc')
       !!
       !! References :                
@@ -78 +80 @@
       REAL(wp) ::   z0u, z0v, z0w
       REAL(wp) ::   zzt1, zzt2, zalpha, z2dtt
-#if defined key_trc_diatrd
-      REAL(wp) ::   ztai, ztaj
-      REAL(wp) ::   zfui, zfvj
-#endif
+      REAL(wp) ::   ztai, ztaj, zfui, zfvj
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
       CHARACTER (len=22) :: charout
       !!----------------------------------------------------------------------
@@ -92 +92 @@
       ENDIF
 
- 
+       IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
 
 #if defined key_trcbbl_adv
@@ -105 +105 @@
 
       DO jn = 1, jptra
-#if defined key_trc_diatrd
-        DO jk = 1,jpk
-           DO jj = 1,jpj
-              DO ji = 1,jpi
-                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = 0.
-                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = 0.
-                 IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = 0.
-              END DO
-            END DO
-          END DO
-#endif
+
          ! I. Horizontal advective fluxes
          ! ------------------------------
@@ -224 +214 @@
 #if defined key_trc_diatrd
                   ! recompute the trends in i- and j-direction as Uh gradh(T)
-#if ! defined key_zco
+#   if defined key_s_coord || defined key_partial_steps
                   zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   &
                      & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)
@@ -241 +231 @@
                   IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj
 #endif
-               END DO
-            END DO
-         END DO
+
+               END DO
+            END DO
+         END DO
+
+         ! 3. Save the horizontal advective trends for diagnostics
+         ! -------------------------------------------------------
+!CDIR BEGIN COLLAPSE
+         TRDTRC_XY : IF( l_trdtrc ) THEN
+
+            ! 3.1) Passive tracer ZONAL advection trends
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+#if ! defined key_zco
+                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     zfui = e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk)   &
+                        & - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk)
+#else
+                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
+                     zfui = e2u(ji  ,jj) * zun(ji,  jj,jk)  - e2u(ji-1,jj) * zun(ji-1,jj,jk)
+#endif
+                     ! recompute the trends in i- direction as Uh gradh(T)
+                     ztrtrd(ji,jj,jk) = - zbtr*( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) - trn(ji,jj,jk,jn)*zfui )
+                  END DO
+               END DO
+            END DO
+
+            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_xad, kt )
+
+            ! 3.2)  Passive tracer MERIDIONAL advection trends
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ! recompute the trends in i- and j-direction as Uh gradh(T)
+#if ! defined key_zco
+                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     zfvj = e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk)   &
+                        & - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk)
+#else
+                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
+                     zfvj = e1v(ji,jj  ) * zvn(ji,jj  ,jk) - e1v(ji,jj-1) * zvn(ji,jj-1,jk)
+#endif
+                     ztrtrd(ji,jj,jk) = - zbtr*( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) - trn(ji,jj,jk,jn)*zfvj )
+                  END DO
+               END DO
+            END DO
+
+            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_yad, kt )
+
+         ENDIF TRDTRC_XY
+!CDIR END
+
       ENDDO
 
@@ -328 +368 @@
                   IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
 #endif
-               END DO
-            END DO
-         END DO
-
+
+               END DO
+            END DO
+         END DO
+
+         ! 3. Save the vertical advective trends for diagnostic
+         ! ----------------------------------------------------
+!CDIR BEGIN COLLAPSE
+         TRDTRC_Z : IF( l_trdtrc )THEN
+
+            ! Compute T/S vertical advection trends
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zbtr = 1. / fse3t(ji,jj,jk)
+                     ! horizontal advective trends
+                     ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
+                     ! save the vertical advective trends computed as w gradz(T)
+                     ztrtrd(ji,jj,jk) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+
+            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zad, kt)
+
+         END IF TRDTRC_Z
+!CDIR END
       END DO