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/TRD/trdicp.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/TRD/trdicp.F90

    r2715 r3211  
    3939   PUBLIC   trd_icp_init  ! called by opa.F90 
    4040 
     41   !! * Control permutation of array indices 
     42#  include "oce_ftrans.h90" 
     43#  include "dom_oce_ftrans.h90" 
     44#  include "trdmld_oce_ftrans.h90" 
     45#  include "ldftra_oce_ftrans.h90" 
     46#  include "ldfdyn_oce_ftrans.h90" 
     47#  include "zdf_oce_ftrans.h90" 
     48 
    4149   !! * Substitutions 
    4250#  include "domzgr_substitute.h90" 
    … …  
    121129      !!              momentum equations at every time step frequency nn_trd. 
    122130      !!---------------------------------------------------------------------- 
    123       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dx   ! Temperature or U trend  
    124       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dy   ! Salinity    or V trend 
     131 
     132      !! DCSE_NEMO: This style defeats ftrans 
     133!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dx   ! Temperature or U trend  
     134!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dy   ! Salinity    or V trend 
     135 
     136!FTRANS ptrd3dx ptrd3dy :I :I :z 
     137      REAL(wp), INTENT(inout) ::   ptrd3dx(jpi,jpj,jpk)   ! Temperature or U trend  
     138      REAL(wp), INTENT(inout) ::   ptrd3dy(jpi,jpj,jpk)   ! Salinity    or V trend 
     139 
    125140      INTEGER,                          INTENT(in   ) ::   ktrd      ! momentum or tracer trend index 
    126141      CHARACTER(len=3),                 INTENT(in   ) ::   ctype     ! momentum ('DYN') or tracers ('TRA') trends 
    … …  
    132147      ! 
    133148      CASE( 'DYN' )              ! Momentum         
     149#if defined key_z_first 
     150         DO jj = 1, jpjm1 
     151            DO ji = 1, jpim1 
     152               DO jk = 1, jpkm1 
     153#else 
    134154         DO jk = 1, jpkm1 
    135155            DO jj = 1, jpjm1 
    136156               DO ji = 1, jpim1 
     157#endif 
    137158                  ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    138159                  ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    … …  
    144165         ! 
    145166      CASE( 'TRA' )              ! Tracers 
     167#if defined key_z_first 
     168         DO jj = 1, jpj 
     169            DO ji = 1, jpi 
     170               DO jk = 1, jpkm1 
     171                  ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     172                  ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     173               END DO 
     174            END DO 
     175         END DO 
     176#else 
    146177         DO jk = 1, jpkm1 
    147178            ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    148179            ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    149180         END DO 
     181#endif 
    150182         ! 
    151183      END SELECT    
    … …  
    156188         umo(ktrd) = 0._wp 
    157189         vmo(ktrd) = 0._wp 
     190#if defined key_z_first 
     191         !! DCSE_NEMO: this changes the order of summation 
     192         DO jj = 1, jpj 
     193            DO ji = 1, jpi 
     194               DO jk = 1, jpkm1 
     195                  umo(ktrd) = umo(ktrd) + ptrd3dx(ji,jj,jk) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
     196                  vmo(ktrd) = vmo(ktrd) + ptrd3dy(ji,jj,jk) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
     197               END DO 
     198            END DO 
     199         END DO 
     200#else 
    158201         DO jk = 1, jpkm1 
    159202            umo(ktrd) = umo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk) ) 
    160203            vmo(ktrd) = vmo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk) ) 
    161204         END DO 
     205#endif 
    162206         ! 
    163207      CASE( 'TRA' )              ! Tracers 
    164208         tmo(ktrd) = 0._wp 
    165209         smo(ktrd) = 0._wp 
     210#if defined key_z_first 
     211         !! DCSE_NEMO: this changes the order of summation 
     212         DO jj = 1, jpj 
     213            DO ji = 1, jpi 
     214               DO jk = 1, jpkm1 
     215                  tmo(ktrd) = tmo(ktrd) + ptrd3dx(ji,jj,jk) * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     216                  smo(ktrd) = smo(ktrd) + ptrd3dy(ji,jj,jk) * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     217               END DO 
     218            END DO 
     219         END DO 
     220#else 
    166221         DO jk = 1, jpkm1 
    167222            tmo(ktrd) = tmo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    168223            smo(ktrd) = smo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    169224         END DO 
     225#endif 
    170226         ! 
    171227      END SELECT 
    … …  
    175231      CASE( 'DYN' )              ! Momentum 
    176232         hke(ktrd) = 0._wp 
     233#if defined key_z_first 
     234         !! DCSE_NEMO: this changes the order of summation 
     235         DO jj = 1, jpj 
     236            DO ji = 1, jpi 
     237               DO jk = 1, jpkm1 
     238                  hke(ktrd) = hke(ktrd) + un(ji,jj,jk) * ptrd3dx(ji,jj,jk) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)   & 
     239                     &                  + vn(ji,jj,jk) * ptrd3dy(ji,jj,jk) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)   
     240               END DO 
     241            END DO 
     242         END DO 
     243#else 
    177244         DO jk = 1, jpkm1 
    178245            hke(ktrd) = hke(ktrd) + SUM(   un(:,:,jk) * ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk)   & 
    179246               &                         + vn(:,:,jk) * ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk)   ) 
    180247         END DO 
     248#endif 
    181249         ! 
    182250      CASE( 'TRA' )              ! Tracers 
    183251         t2(ktrd) = 0._wp 
    184252         s2(ktrd) = 0._wp 
     253#if defined key_z_first 
     254         !! DCSE_NEMO: this changes the order of summation 
     255         DO jj = 1, jpj 
     256            DO ji = 1, jpi 
     257               DO jk = 1, jpkm1 
     258                  t2(ktrd) = t2(ktrd) + ptrd3dx(ji,jj,jk) * tn(ji,jj,jk) * e1e2t(ji,jj) * fse3t(ji,jj,jk) 
     259                  s2(ktrd) = s2(ktrd) + ptrd3dy(ji,jj,jk) * sn(ji,jj,jk) * e1e2t(ji,jj) * fse3t(ji,jj,jk) 
     260               END DO 
     261            END DO 
     262         END DO 
     263#else 
    185264         DO jk = 1, jpkm1 
    186             t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(ji,jj,jk) * tn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    187             s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(ji,jj,jk) * sn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    188          END DO 
     265         !! DCSE_NEMO: This looks plain wrong! 
     266!           t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(ji,jj,jk) * tn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     267!           s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(ji,jj,jk) * sn(ji,jj,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     268            t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(:,:,jk) * tn(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     269            s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(:,:,jk) * sn(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     270         END DO 
     271#endif 
    189272         ! 
    190273      END SELECT 
    … …  
    210293      ! Total volume at t-points: 
    211294      tvolt = 0._wp 
     295#if defined key_z_first 
     296      DO jj = 1, jpj 
     297         DO ji = 1, jpi 
     298            DO jk = 1, jpkm1 
     299               tvolt = tvolt + e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     300            END DO 
     301         END DO 
     302      END DO 
     303#else 
    212304      DO jk = 1, jpkm1 
    213          tvolt = SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 
     305      !! DCSE_NEMO: This looks plain wrong 
     306!        tvolt = SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 
     307         tvolt = tvolt + SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 
    214308      END DO 
     309#endif 
    215310      IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain 
    216311 
    … …  
    225320      tvolv = 0._wp 
    226321 
     322#if defined key_z_first 
     323      DO jj = 2, jpjm1 
     324         DO ji = 2, jpim1 
     325            DO jk = 1, jpk 
     326#else 
    227327      DO jk = 1, jpk 
    228328         DO jj = 2, jpjm1 
    229329            DO ji = fs_2, fs_jpim1   ! vector opt. 
     330#endif 
    230331               tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    231332               tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    … …  
    254355      USE wrk_nemo, ONLY:   zkepe => wrk_3d_1 , zkx => wrk_3d_2   ! 3D workspace 
    255356      USE wrk_nemo, ONLY:   zky   => wrk_3d_3 , zkz => wrk_3d_4   !  -      - 
     357 
     358      !! DCSE_NEMO: need additional directives for renamed module variables 
     359!FTRANS zkepe zkx zky zkz :I :I :z 
     360 
    256361      ! 
    257362      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    281386 
    282387         zcof = 0.5_wp / rau0             ! Density flux at w-point 
     388#if defined key_z_first 
     389         DO jj = 1, jpj 
     390            DO ji = 1, jpi 
     391               zkz(ji,jj,1) = 0._wp 
     392               DO jk = 2, jpk 
     393                  zkz(ji,jj,jk) = e1e2t(ji,jj) * wn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) ) * tmask_i(ji,jj) 
     394               END DO 
     395            END DO 
     396         END DO 
     397#else 
    283398         zkz(:,:,1) = 0._wp 
    284399         DO jk = 2, jpk 
    285400            zkz(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 
    286401         END DO 
     402#endif 
    287403          
    288404         zcof   = 0.5_wp / rau0           ! Density flux at u and v-points 
     405#if defined key_z_first 
     406         DO jj = 1, jpjm1 
     407            DO ji = 1, jpim1 
     408               DO jk = 1, jpkm1 
     409#else 
    289410         DO jk = 1, jpkm1 
    290411            DO jj = 1, jpjm1 
    291412               DO ji = 1, jpim1 
     413#endif 
    292414                  zkx(ji,jj,jk) = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
    293415                  zky(ji,jj,jk) = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
    … …  
    296418         END DO 
    297419          
     420#if defined key_z_first 
     421         DO jj = 2, jpjm1                 ! Density flux divergence at t-point 
     422            DO ji = 2, jpim1 
     423               DO jk = 1, jpkm1 
     424#else 
    298425         DO jk = 1, jpkm1                 ! Density flux divergence at t-point 
    299426            DO jj = 2, jpjm1 
    300427               DO ji = 2, jpim1 
     428#endif 
    301429                  zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               & 
    302430                     &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
    … …  
    310438         ! ---------------------------------------- 
    311439         peke = 0._wp 
     440#if defined key_z_first 
     441         DO jj = 1, jpj 
     442            DO ji = 1, jpi 
     443               DO jk = 1, jpkm1 
     444                  peke = peke + zkepe(ji,jj,jk) * fsdept(ji,jj,jk) * e1e2t(ji,jj) * fse3t(ji,jj,jk) 
     445               END DO 
     446            END DO 
     447         END DO 
     448#else 
    312449         DO jk = 1, jpkm1 
    313450            peke = peke + SUM( zkepe(:,:,jk) * fsdept(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    314451         END DO 
     452#endif 
    315453         peke = grav * peke 
    316454 
Note: See TracChangeset for help on using the changeset viewer.