Changeset 3211 for branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.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/DIA/diaptr.F90 (modified) (14 diffs)

branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

@@ -80 +80 @@
    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30
 
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
@@ -138 +143 @@
       !! ** Action  : - p_fval: i-k-mean poleward flux of pva
       !!----------------------------------------------------------------------
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point
+!FTRANS pva :I :I :z
+!! DCSE_NEMO: work around deficiency in ftrans
+!     REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point
+      REAL(wp) , INTENT(in)    ::   pva(jpi,jpj,jpk)           ! mask flux array at V-point
       !!
       INTEGER                  ::   ji, jj, jk   ! dummy loop arguments
@@ -149 +157 @@
       ijpj = jpj
       p_fval(:) = 0._wp
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! Vector opt.
+#endif
                p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 
             END DO
@@ -162 +176 @@
    END FUNCTION ptr_vj_3d
 
+!FTRANS CLEAR
+   !! * Re-instate directives to control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
 
    FUNCTION ptr_vj_2d( pva )   RESULT ( p_fval )
@@ -215 +234 @@
       !!
       IMPLICIT none
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva    ! mask flux array at V-point
+!FTRANS pva :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva    ! mask flux array at V-point
+      REAL(wp) , INTENT(in)             ::   pva(jpi,jpj,jpk)             ! mask flux array at V-point
       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask
       !!
@@ -236 +258 @@
 
       p_fval(:,:) = 0._wp
+
       !
       IF( PRESENT( pmsk ) ) THEN 
@@ -270 +293 @@
    END FUNCTION ptr_vjk
 
+!FTRANS CLEAR
+   !! * Re-instate directives to control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
 
    FUNCTION ptr_tjk( pta, pmsk )   RESULT ( p_fval )
@@ -286 +314 @@
 #endif
       !!
-      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point
+!FTRANS pta :I :I :z
+!! DCSE_NEMO: work around a deficiency in ftrans
+!     REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point
+      REAL(wp) , INTENT(in)             :: pta(jpi,jpj,jpk)     ! tracer flux array at T-point
       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk   ! Optional 2D basin mask
       !!
@@ -307 +338 @@
 
       p_fval(:,:) = 0._wp
+#if defined key_z_first
+      DO jj = 2, jpjm1
+         DO ji =  nldi, nlei
+            DO jk = 1, jpkm1
+#else
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1
             DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
+#endif
                p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj)
             END DO
@@ -328 +365 @@
    END FUNCTION ptr_tjk
 
+!FTRANS CLEAR
+   !! * Re-instate directives to control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
 
    SUBROUTINE dia_ptr( kt )
@@ -334 +376 @@
       !!----------------------------------------------------------------------
       USE oce,     vt  =>   ua   ! use ua as workspace
-      USE oce,     vs  =>   ua   ! use ua as workspace
+!! DCSE_NEMO: see ticket 873
+      USE oce,     vs  =>   va   ! use va as workspace
+!! DCSE_NEMO: ua, va are re-named, so need additional directives
+!FTRANS vt vs :I :I :z
       IMPLICIT none
       !!
@@ -370 +415 @@
             !                                ! local heat & salt transports at T-points  ( tn*mj[vn+v_eiv] )
             vt(:,:,jpk) = 0._wp   ;   vs(:,:,jpk) = 0._wp
+
             DO jk= 1, jpkm1
                DO jj = 2, jpj
@@ -434 +480 @@
    END SUBROUTINE dia_ptr
 
+!FTRANS CLEAR
+   !! * Re-instate directives to control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "ldftra_oce_ftrans.h90"
 
    SUBROUTINE dia_ptr_init
@@ -489 +540 @@
          btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin
          WHERE( gphit(:,:) < -30._wp)   ;   btm30(:,:) = 0._wp      ! mask out Southern Ocean
+#if defined key_z_first
+         ELSE WHERE                     ;   btm30(:,:) = tmask_1(:,:)
+#else
          ELSE WHERE                     ;   btm30(:,:) = tmask(:,:,1)
+#endif
          END WHERE
       ENDIF