Changeset 3211 for branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90

Timestamp:

2011-12-11T16:00:26+01:00 (13 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/C1D/dynnxt_c1d.F90 (modified) (4 diffs)

branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90

@@ -23 +23 @@
 
    PUBLIC dyn_nxt_c1d                ! routine called by step.F90
+   !! * Array index permutations
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
    !!----------------------------------------------------------------------
    !! NEMO/C1D 3.3 , NEMO Consortium (2010)
@@ -51 +54 @@
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
       !!
+#if defined key_z_first
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+#else
       INTEGER  ::   jk           ! dummy loop indices
+#endif
       REAL(wp) ::   z2dt         ! temporary scalar
       !!----------------------------------------------------------------------
@@ -66 +73 @@
       CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )      ! Lateral boundary conditions
 
+#if defined key_z_first
+      DO jj = 1, jpj                                                       ! Next Velocity
+         DO ji = 1, jpi 
+            DO jk = 1, jpkm1
+               ua(ji,jj,jk) = ( ub(ji,jj,jk) + z2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk)
+               va(ji,jj,jk) = ( vb(ji,jj,jk) + z2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO 
+#else
       DO jk = 1, jpkm1                                                     ! Next Velocity
          ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk)
          va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk)
       END DO 
+#endif
  
+#if defined key_z_first
+      IF( neuler == 0 .AND. kt == nit000 ) THEN                            ! Euler (forward) time stepping
+         DO jj = 1, jpj                                                    ! Time filter and swap of dynamics arrays
+            DO ji = 1, jpi
+               ub(ji,jj,1:jpkm1) = un(ji,jj,1:jpkm1)
+               vb(ji,jj,1:jpkm1) = vn(ji,jj,1:jpkm1)
+               un(ji,jj,1:jpkm1) = ua(ji,jj,1:jpkm1)
+               vn(ji,jj,1:jpkm1) = va(ji,jj,1:jpkm1)
+            END DO
+         END DO
+      ELSE                                                                ! Leap-frog time stepping
+         DO jj =1 , jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  ub(ji,jj,jk) = atfp * ( ub(ji,jj,jk) + ua(ji,jj,jk) ) + atfp1 * un(ji,jj,jk)
+                  vb(ji,jj,jk) = atfp * ( vb(ji,jj,jk) + va(ji,jj,jk) ) + atfp1 * vn(ji,jj,jk)
+                  un(ji,jj,jk) = ua(ji,jj,jk)
+                  vn(ji,jj,jk) = va(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+#else
       DO jk = 1, jpkm1                                                     ! Time filter and swap of dynamics arrays
          IF( neuler == 0 .AND. kt == nit000 ) THEN                               ! Euler (forward) time stepping
@@ -84 +125 @@
          ENDIF
       END DO
+#endif
 
       IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt_c1d  - Un: ', mask1=umask,   &