Changeset 3211 for branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

Timestamp:

2011-12-11T16:00:26+01:00 (12 years ago)

Author:

spickles2

Message:

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.

File:

• branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90 (modified) (8 diffs)

branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

@@ -49 +49 @@
    PUBLIC    dyn_nxt   ! routine called by step.F90
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+#  include "domvvl_ftrans.h90"
+#  include "obc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -95 +102 @@
       USE oce     , ONLY:   ze3u_f => ta       , ze3v_f => sa       ! (ta,sa) used as 3D workspace
       USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3
+      !! DCSE_NEMO: need additional directives for renamed module variables
+!FTRANS ze3u_f :I :I :z
+!FTRANS ze3v_f :I :I :z
       !
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
@@ -214 +224 @@
       ! ------------------------------------------
       IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap
+#if defined key_z_first
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  un(ji,jj,jk) = ua(ji,jj,jk)                ! un <-- ua
+                  vn(ji,jj,jk) = va(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+#else
          DO jk = 1, jpkm1
             un(:,:,jk) = ua(:,:,jk)                          ! un <-- ua
             vn(:,:,jk) = va(:,:,jk)
          END DO
+#endif
       ELSE                                             !* Leap-Frog : Asselin filter and swap
          !                                ! =============!
          IF( .NOT. lk_vvl ) THEN          ! Fixed volume !
             !                             ! =============!
+#if defined key_z_first
+            DO jj = 1, jpj
+               DO ji = 1, jpi    
+                  DO jk = 1, jpkm1                              
+#else
             DO jk = 1, jpkm1                              
                DO jj = 1, jpj
                   DO ji = 1, jpi    
+#endif
                      zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) )
                      zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) )
@@ -247 +274 @@
             ! Add volume filter correction only at the first level of t-point scale factors
             zec = atfp * rdt / rau0
+#if defined key_z_first
+            fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask_1(:,:)
+#else
             fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1)
+#endif
             ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations
             zs_t  (:,:) =       e1t(:,:) * e2t(:,:)
@@ -257 +288 @@
                ! -----------------------------------
                ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points
+#if defined key_z_first
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     DO jk = 1, jpkm1
+#else
                DO jk = 1, jpkm1
                   DO jj = 1, jpjm1
                      DO ji = 1, jpim1
+#endif
                         zv_t_ij           = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk)
                         zv_t_ip1j         = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk)
@@ -276 +313 @@
                ! Leap-Frog - Asselin filter and swap: applied on velocity
                ! -----------------------------------
+#if defined key_z_first
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     DO jk = 1, jpkm1
+#else
                DO jk = 1, jpkm1
                   DO jj = 1, jpj
                      DO ji = 1, jpi
+#endif
                         zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) )
                         zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) )
@@ -294 +337 @@
                !-----------------------------------------------
                ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points
+#if defined key_z_first
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     DO jk = 1, jpkm1
+#else
                DO jk = 1, jpkm1
                   DO jj = 1, jpjm1
                      DO ji = 1, jpim1
+#endif
                         zv_t_ij          = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk)
                         zv_t_ip1j        = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk)
@@ -313 +362 @@
                ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity
                ! -----------------------------------             ===========================
+#if defined key_z_first
+               DO jj = 1, jpj
+                  DO ji = 1, jpim1
+                     DO jk = 1, jpkm1
+#else
                DO jk = 1, jpkm1
                   DO jj = 1, jpj
                      DO ji = 1, jpim1
+#endif
                         zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk)
                         zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk)