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

branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

@@ -79 +79 @@
    REAL(wp) ::   eps20  = 1.e-20   ! constant values
    
+   !! * Control permutation of array indices
+#  include "oce_ftrans.h90"
+#  include "dom_oce_ftrans.h90"
+#  include "sbc_oce_ftrans.h90"
+
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
@@ -308 +313 @@
             !--------------------------------------------------
             !                                                          ! vapour pressure at saturation of ocean
+#if defined key_z_first
+            zeso =  611.0 * EXP ( 17.2693884 * ( zsst - rtt ) * tmask_1(ji,jj) / ( zsst - 35.86 ) )
+#else
             zeso =  611.0 * EXP ( 17.2693884 * ( zsst - rtt ) * tmask(ji,jj,1) / ( zsst - 35.86 ) )
+#endif
 
             zqsato = ( 0.622 * zeso ) / ( zpatm - 0.378 * zeso )       ! humidity close to the ocean surface (at saturation)
@@ -369 +378 @@
 
 !CDIR COLLAPSE
+#if defined key_z_first
+      emp (:,:) = zqla(:,:) / cevap - sf(jp_prec)%fnow(:,:,1) / rday * tmask_1(:,:)
+#else
       emp (:,:) = zqla(:,:) / cevap - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1)
+#endif
       qns (:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)         ! Downward Non Solar flux
       emps(:,:) = emp(:,:)
@@ -560 +573 @@
 
                ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential)
+#if defined key_z_first
+               zesi =  611.0 * EXP( 21.8745587 * tmask_1(ji,jj) * ( pst(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )
+#else
                zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( pst(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )
+#endif
                ! humidity close to the ice surface (at saturation)
                zqsati   = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi )
@@ -619 +636 @@
 !!gm : mask is not required on forcing
       DO jl = 1, ijpl
+#if defined key_z_first
+         p_qns (:,:,jl) = p_qns (:,:,jl) * tmask_1(:,:)
+         p_qla (:,:,jl) = p_qla (:,:,jl) * tmask_1(:,:)
+         p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask_1(:,:)
+         p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask_1(:,:)
+#else
          p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1)
          p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1)
          p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1)
          p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1)
+#endif
       END DO
 
@@ -787 +811 @@
             zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj,1)   &     ! cloud correction (Reed 1977)
                &                          + 0.0019 * zlmunoon )                 )
+#if defined key_z_first
+            pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask_1(ji,jj)    ! and zcoef1: ellipsity
+#else
             pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1)    ! and zcoef1: ellipsity
+#endif
          END DO
       END DO
@@ -925 +953 @@
          !
          ! Correction : Taking into account the ellipsity of the earth orbit
+#if defined key_z_first
+         pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * zcoef1 * tmask_1(:,:)
+#else
          pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * zcoef1 * tmask(:,:,1)
+#endif
          !
          !                 !--------------------------------!