New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3211 for branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90 – NEMO

Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90

    r2715 r3211  
    3232 
    3333   PUBLIC   obc_dyn_bt  ! routine called in dynnxt (explicit free surface case) 
     34 
     35   !! * Control permutation of array indices 
     36#  include "oce_ftrans.h90" 
     37#  include "dom_oce_ftrans.h90" 
     38#  include "obc_oce_ftrans.h90" 
    3439 
    3540   !!---------------------------------------------------------------------- 
    … …  
    9297      !!---------------------------------------------------------------------- 
    9398 
     99#if defined key_z_first 
     100      DO jj = 1, jpj 
     101         DO ji = nie0, nie1 
     102            DO jk = 1, jpkm1 
     103#else 
    94104      DO ji = nie0, nie1 
    95105         DO jk = 1, jpkm1 
    96106            DO jj = 1, jpj 
     107#endif 
    97108               ua(ji,jj,jk) = ua(ji,jj,jk) + sqrt( grav*hur (ji,jj) )               & 
    98109                  &                      * ( ( sshn(ji,jj) + sshn(ji+1,jj) ) * 0.5  & 
    … …  
    123134      ! 
    124135      DO ji = niw0, niw1 
     136#if defined key_z_first 
     137         DO jj = 1, jpj 
     138            DO jk = 1, jpkm1 
     139#else 
    125140         DO jk = 1, jpkm1 
    126141            DO jj = 1, jpj 
     142#endif 
    127143               ua(ji,jj,jk) = ua(ji,jj,jk) - sqrt( grav*hur (ji,jj) )               & 
    128144                  &                      * ( ( sshn(ji,jj) + sshn(ji+1,jj) ) * 0.5  & 
    … …  
    151167      ! 
    152168      DO jj = njn0, njn1 
     169#if defined key_z_first 
     170         DO ji = 1, jpi 
     171            DO jk = 1, jpkm1 
     172#else 
    153173         DO jk = 1, jpkm1 
    154174            DO ji = 1, jpi 
     175#endif 
    155176               va(ji,jj,jk) = va(ji,jj,jk) + sqrt( grav*hvr (ji,jj) )               & 
    156177                  &                      * ( ( sshn(ji,jj) + sshn(ji,jj+1) ) * 0.5  & 
    … …  
    181202      ! 
    182203      DO jj = njs0, njs1 
     204#if defined key_z_first 
     205         DO ji = 1, jpi 
     206            DO jk = 1, jpkm1 
     207#else 
    183208         DO jk = 1, jpkm1 
    184209            DO ji = 1, jpi 
     210#endif 
    185211               va(ji,jj,jk) = va(ji,jj,jk) - sqrt( grav*hvr (ji,jj) )               & 
    186212                  &                       * ( ( sshn(ji,jj) + sshn(ji,jj+1) ) * 0.5 & 
    … …  
    209235      !!---------------------------------------------------------------------- 
    210236      ! 
     237#if defined key_z_first 
     238      DO jj = 1, jpj 
     239         DO ji = nie0, nie1 
     240             DO jk = 1, jpkm1 
     241#else 
    211242      DO ji = nie0, nie1 
    212243         DO jk = 1, jpkm1 
    213244            DO jj = 1, jpj 
     245#endif 
    214246               ua(ji,jj,jk) = ( ua(ji,jj,jk) + sshfoe_b(ji,jj) ) * uemsk(jj,jk) 
    215247            END DO 
    216248         END DO 
    217249      END DO 
     250#if defined key_z_first 
     251      DO jj = 1, jpj 
     252         DO ji = nie0p1, nie1p1 
     253#else 
    218254      DO ji = nie0p1, nie1p1 
    219255         DO jj = 1, jpj 
     256#endif 
    220257            sshn(ji,jj) = sshn(ji,jj) * (1.-temsk(jj,1)) + temsk(jj,1)*sshn_b(ji,jj) 
    221258         END DO 
    … …  
    236273      !!---------------------------------------------------------------------- 
    237274      ! 
     275#if defined key_z_first 
     276      DO jj = 1, jpj 
     277         DO ji = niw0, niw1 
     278            DO jk = 1, jpkm1 
     279               ua(ji,jj,jk) = ( ua(ji,jj,jk) + sshfow_b(ji,jj) ) * uwmsk(jj,jk) 
     280            END DO 
     281         END DO 
     282      END DO 
     283      DO jj = 1, jpj 
     284         DO ji = niw0, niw1 
     285            sshn(ji,jj) = sshn(ji,jj) * (1.-twmsk(jj,1)) + twmsk(jj,1)*sshn_b(ji,jj) 
     286         END DO 
     287      END DO 
     288#else 
    238289      DO ji = niw0, niw1 
    239290         DO jk = 1, jpkm1 
    … …  
    246297         END DO 
    247298      END DO 
     299#endif 
    248300      ! 
    249301   END SUBROUTINE obc_dyn_bt_west 
    … …  
    262314      !!---------------------------------------------------------------------- 
    263315      ! 
     316#if defined key_z_first 
    264317      DO jj = njn0, njn1 
     318         DO ji = 1, jpi 
     319            DO jk = 1, jpkm1 
     320#else 
     321      DO jj = njn0, njn1 
    265322         DO jk = 1, jpkm1 
    266323            DO ji = 1, jpi 
     324#endif 
    267325               va(ji,jj,jk) = ( va(ji,jj,jk) + sshfon_b(ji,jj) ) * vnmsk(jj,jk) 
    268326            END DO 
    … …  
    291349      ! 
    292350      DO jj = njs0, njs1 
     351#if defined key_z_first 
     352         DO ji = 1, jpi 
     353            DO jk = 1, jpkm1 
     354#else 
    293355         DO jk = 1, jpkm1 
    294356            DO ji = 1, jpi 
     357#endif 
    295358               va(ji,jj,jk) = ( va(ji,jj,jk) + sshfos_b(ji,jj) ) * vsmsk(jj,jk) 
    296359            END DO 
Note: See TracChangeset for help on using the changeset viewer.