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 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90 – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90

    r2528 r2715  
    4545   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4646   !! $Id$ 
    47    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    48    !!---------------------------------------------------------------------- 
    49  
     47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     48   !!---------------------------------------------------------------------- 
    5049CONTAINS 
    5150 
     
    5756      !!              momentum equations at every time step frequency nn_trd. 
    5857      !!---------------------------------------------------------------------- 
    59       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dx             ! Temperature or U trend  
    60       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dy             ! Salinity    or V trend 
    61       INTEGER                     , INTENT(in   ) ::   ktrd                ! tracer trend index 
    62       CHARACTER(len=3)            , INTENT(in   ) ::   ctype               ! momentum ('DYN') or tracers ('TRA') trends 
     58      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dx   ! Temperature or U trend  
     59      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dy   ! Salinity    or V trend 
     60      INTEGER                     , INTENT(in   ) ::   ktrd      ! tracer trend index 
     61      CHARACTER(len=3)            , INTENT(in   ) ::   ctype     ! momentum ('DYN') or tracers ('TRA') trends 
    6362      !! 
    64       INTEGER  ::   ji, jj                                                 ! loop indices 
    65       REAL(wp) ::   zmsku, zbtu, zbt                                       ! temporary scalars 
    66       REAL(wp) ::   zmskv, zbtv                                            !    "         " 
    67       !!---------------------------------------------------------------------- 
    68  
    69  
    70       ! 1. Mask trends 
    71       ! -------------- 
    72  
    73       SELECT CASE( ctype ) 
    74       ! 
    75       CASE( 'DYN' )              ! Momentum 
     63      INTEGER ::   ji, jj   ! loop indices 
     64      !!---------------------------------------------------------------------- 
     65 
     66      SELECT CASE( ctype )    !==  Mask trends  ==! 
     67      ! 
     68      CASE( 'DYN' )                    ! Momentum 
    7669         DO jj = 1, jpjm1 
    7770            DO ji = 1, jpim1 
    78                zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,1) 
    79                zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1) 
    80                ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * zmsku 
    81                ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * zmskv 
     71               ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,1) 
     72               ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1) 
    8273            END DO 
    8374         END DO 
    84          ptrd2dx(jpi, : ) = 0.e0      ;      ptrd2dy(jpi, : ) = 0.e0 
    85          ptrd2dx( : ,jpj) = 0.e0      ;      ptrd2dy( : ,jpj) = 0.e0 
    86          ! 
    87       CASE( 'TRA' )              ! Tracers 
     75         ptrd2dx(jpi, : ) = 0._wp      ;      ptrd2dy(jpi, : ) = 0._wp 
     76         ptrd2dx( : ,jpj) = 0._wp      ;      ptrd2dy( : ,jpj) = 0._wp 
     77         ! 
     78      CASE( 'TRA' )                    ! Tracers 
    8879         ptrd2dx(:,:) = ptrd2dx(:,:) * tmask_i(:,:) 
    8980         ptrd2dy(:,:) = ptrd2dy(:,:) * tmask_i(:,:) 
     
    9182      END SELECT 
    9283       
    93       ! 2. Basin averaged tracer/momentum trends 
    94       ! ---------------------------------------- 
    95  
    96       SELECT CASE( ctype ) 
    97       ! 
    98       CASE( 'DYN' )              ! Momentum 
    99          umo(ktrd) = 0.e0 
    100          vmo(ktrd) = 0.e0 
     84      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum trends  ==! 
     85      ! 
     86      CASE( 'DYN' )                    ! Momentum 
     87         umo(ktrd) = 0._wp 
     88         vmo(ktrd) = 0._wp 
    10189         ! 
    10290         SELECT CASE( ktrd ) 
    103          ! 
    10491         CASE( jpdyn_trd_swf )         ! surface forcing 
    105             DO jj = 1, jpj 
    106                DO ji = 1, jpi 
    107                   umo(ktrd) = umo(ktrd) + ptrd2dx(ji,jj) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 
    108                   vmo(ktrd) = vmo(ktrd) + ptrd2dy(ji,jj) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 
    109                END DO 
    110             END DO 
    111             ! 
     92            umo(ktrd) = SUM( ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1) ) 
     93            vmo(ktrd) = SUM( ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1) ) 
    11294         END SELECT 
    11395         ! 
    11496      CASE( 'TRA' )              ! Tracers 
    115          tmo(ktrd) = 0.e0 
    116          smo(ktrd) = 0.e0 
    117          DO jj = 1, jpj 
    118             DO ji = 1, jpi 
    119                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) 
    120                tmo(ktrd) =  tmo(ktrd) + ptrd2dx(ji,jj) * zbt 
    121                smo(ktrd) =  smo(ktrd) + ptrd2dy(ji,jj) * zbt 
    122             END DO 
    123          END DO 
    124          ! 
     97         tmo(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) ) 
     98         smo(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) ) 
    12599      END SELECT 
    126100       
    127       ! 3. Basin averaged tracer/momentum square trends 
    128       ! ---------------------------------------------- 
    129       ! c a u t i o n: field now 
    130        
    131       SELECT CASE( ctype ) 
     101      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum square trends  ==!   (now field) 
    132102      ! 
    133103      CASE( 'DYN' )              ! Momentum 
    134          hke(ktrd) = 0.e0 
    135          DO jj = 1, jpj 
    136             DO ji = 1, jpi 
    137                zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 
    138                zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 
    139                hke(ktrd) = hke(ktrd)   & 
    140                &   + un(ji,jj,1) * ptrd2dx(ji,jj) * zbtu & 
    141                &   + vn(ji,jj,1) * ptrd2dy(ji,jj) * zbtv 
    142             END DO 
    143          END DO 
     104         hke(ktrd) = SUM(   un(:,:,1) * ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1)   & 
     105            &             + vn(:,:,1) * ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1)   ) 
    144106         ! 
    145107      CASE( 'TRA' )              ! Tracers 
    146          t2(ktrd) = 0.e0 
    147          s2(ktrd) = 0.e0 
    148          DO jj = 1, jpj 
    149             DO ji = 1, jpi 
    150                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) 
    151                t2(ktrd) = t2(ktrd) + ptrd2dx(ji,jj) * zbt * tn(ji,jj,1) 
    152                s2(ktrd) = s2(ktrd) + ptrd2dy(ji,jj) * zbt * sn(ji,jj,1) 
    153             END DO 
    154          END DO 
     108         t2(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tn(:,:,1) ) 
     109         s2(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) * sn(:,:,1) ) 
    155110         !       
    156111      END SELECT 
     
    166121      !!              momentum equations at every time step frequency nn_trd. 
    167122      !!---------------------------------------------------------------------- 
    168       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dx            ! Temperature or U trend  
    169       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dy            ! Salinity    or V trend 
    170       INTEGER,                          INTENT(in   ) ::   ktrd               ! momentum or tracer trend index 
    171       CHARACTER(len=3),                 INTENT(in   ) ::   ctype              ! momentum ('DYN') or tracers ('TRA') trends 
     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 
     125      INTEGER,                          INTENT(in   ) ::   ktrd      ! momentum or tracer trend index 
     126      CHARACTER(len=3),                 INTENT(in   ) ::   ctype     ! momentum ('DYN') or tracers ('TRA') trends 
    172127      !! 
    173       INTEGER ::   ji, jj, jk 
    174       REAL(wp) ::   zbt, zbtu, zbtv, zmsku, zmskv                             ! temporary scalars 
    175       !!---------------------------------------------------------------------- 
    176  
    177       ! 1. Mask the trends 
    178       ! ------------------ 
    179  
    180       SELECT CASE( ctype ) 
     128      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     129      !!---------------------------------------------------------------------- 
     130 
     131      SELECT CASE( ctype )    !==  Mask the trends  ==! 
    181132      ! 
    182133      CASE( 'DYN' )              ! Momentum         
    183          DO jk = 1, jpk 
     134         DO jk = 1, jpkm1 
    184135            DO jj = 1, jpjm1 
    185136               DO ji = 1, jpim1 
    186                   zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    187                   zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    188                   ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * zmsku 
    189                   ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * zmskv 
     137                  ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
     138                  ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    190139               END DO 
    191140            END DO 
    192141         END DO 
    193          ptrd3dx(jpi, : ,:) = 0.e0      ;      ptrd3dy(jpi, : ,:) = 0.e0 
    194          ptrd3dx( : ,jpj,:) = 0.e0      ;      ptrd3dy( : ,jpj,:) = 0.e0 
     142         ptrd3dx(jpi, : ,:) = 0._wp      ;      ptrd3dy(jpi, : ,:) = 0._wp 
     143         ptrd3dx( : ,jpj,:) = 0._wp      ;      ptrd3dy( : ,jpj,:) = 0._wp 
    195144         ! 
    196145      CASE( 'TRA' )              ! Tracers 
    197          DO jk = 1, jpk 
     146         DO jk = 1, jpkm1 
    198147            ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    199148            ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
     
    202151      END SELECT    
    203152 
    204       ! 2. Basin averaged tracer/momentum trends 
    205       ! ---------------------------------------- 
    206        
    207       SELECT CASE( ctype ) 
     153      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum trends  ==! 
    208154      ! 
    209155      CASE( 'DYN' )              ! Momentum 
    210          umo(ktrd) = 0.e0 
    211          vmo(ktrd) = 0.e0 
    212          DO jk = 1, jpk 
    213             DO jj = 1, jpj 
    214                DO ji = 1, jpi 
    215                   zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    216                   zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    217                   umo(ktrd) = umo(ktrd) + ptrd3dx(ji,jj,jk) * zbtu 
    218                   vmo(ktrd) = vmo(ktrd) + ptrd3dy(ji,jj,jk) * zbtv 
    219                END DO 
    220             END DO 
     156         umo(ktrd) = 0._wp 
     157         vmo(ktrd) = 0._wp 
     158         DO jk = 1, jpkm1 
     159            umo(ktrd) = umo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk) ) 
     160            vmo(ktrd) = vmo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk) ) 
    221161         END DO 
    222162         ! 
    223163      CASE( 'TRA' )              ! Tracers 
    224          tmo(ktrd) = 0.e0 
    225          smo(ktrd) = 0.e0 
    226          DO jk = 1, jpkm1 
    227             DO jj = 1, jpj 
    228                DO ji = 1, jpi 
    229                   zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)  
    230                   tmo(ktrd) =  tmo(ktrd) + ptrd3dx(ji,jj,jk) * zbt 
    231                   smo(ktrd) =  smo(ktrd) + ptrd3dy(ji,jj,jk) * zbt 
    232                END DO 
    233             END DO 
     164         tmo(ktrd) = 0._wp 
     165         smo(ktrd) = 0._wp 
     166         DO jk = 1, jpkm1 
     167            tmo(ktrd) = tmo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     168            smo(ktrd) = smo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    234169         END DO 
    235170         ! 
    236171      END SELECT 
    237172 
    238       ! 3. Basin averaged tracer/momentum square trends 
    239       ! ----------------------------------------------- 
    240       ! c a u t i o n: field now 
    241        
    242       SELECT CASE( ctype ) 
     173      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum square trends  ==!   (now field) 
    243174      ! 
    244175      CASE( 'DYN' )              ! Momentum 
    245          hke(ktrd) = 0.e0 
    246          DO jk = 1, jpk 
    247             DO jj = 1, jpj 
    248                DO ji = 1, jpi 
    249                   zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    250                   zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    251                   hke(ktrd) = hke(ktrd)   & 
    252                   &   + un(ji,jj,jk) * ptrd3dx(ji,jj,jk) * zbtu & 
    253                   &   + vn(ji,jj,jk) * ptrd3dy(ji,jj,jk) * zbtv 
    254                END DO 
    255             END DO 
     176         hke(ktrd) = 0._wp 
     177         DO jk = 1, jpkm1 
     178            hke(ktrd) = hke(ktrd) + SUM(   un(:,:,jk) * ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk)   & 
     179               &                         + vn(:,:,jk) * ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk)   ) 
    256180         END DO 
    257181         ! 
    258182      CASE( 'TRA' )              ! Tracers 
    259          t2(ktrd) = 0.e0 
    260          s2(ktrd) = 0.e0 
    261          DO jk = 1, jpk 
    262             DO jj = 1, jpj 
    263                DO ji = 1, jpi 
    264                   zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    265                   t2(ktrd) = t2(ktrd) + ptrd3dx(ji,jj,jk) * zbt * tn(ji,jj,jk) 
    266                   s2(ktrd) = s2(ktrd) + ptrd3dy(ji,jj,jk) * zbt * sn(ji,jj,jk) 
    267                END DO 
    268             END DO 
     183         t2(ktrd) = 0._wp 
     184         s2(ktrd) = 0._wp 
     185         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) ) 
    269188         END DO 
    270189         ! 
     
    272191      ! 
    273192   END SUBROUTINE trd_3d 
    274  
    275193 
    276194 
     
    281199      !! ** Purpose :   Read the namtrd namelist 
    282200      !!---------------------------------------------------------------------- 
    283       INTEGER  ::   ji, jj, jk 
    284       REAL(wp) ::   zmskt 
    285 #if  defined key_trddyn 
    286       REAL(wp) ::   zmsku, zmskv 
    287 #endif 
     201      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    288202      !!---------------------------------------------------------------------- 
    289203 
     
    295209 
    296210      ! Total volume at t-points: 
    297       tvolt = 0.e0 
     211      tvolt = 0._wp 
    298212      DO jk = 1, jpkm1 
    299          DO jj = 2, jpjm1 
    300             DO ji = fs_2, fs_jpim1   ! vector opt. 
    301                zmskt = tmask(ji,jj,jk) * tmask_i(ji,jj) 
    302                tvolt = tvolt + zmskt * e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) 
    303             END DO 
    304          END DO 
     213         tvolt = SUM( e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) ) 
    305214      END DO 
    306215      IF( lk_mpp )   CALL mpp_sum( tvolt )   ! sum over the global domain 
     
    310219#if  defined key_trddyn 
    311220      ! Initialization of potential to kinetic energy conversion 
    312       rpktrd = 0.e0 
     221      rpktrd = 0._wp 
    313222 
    314223      ! Total volume at u-, v- points: 
    315       tvolu = 0.e0 
    316       tvolv = 0.e0 
     224      tvolu = 0._wp 
     225      tvolv = 0._wp 
    317226 
    318227      DO jk = 1, jpk 
    319228         DO jj = 2, jpjm1 
    320229            DO ji = fs_2, fs_jpim1   ! vector opt. 
    321                zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    322                zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    323                tvolu = tvolu + zmsku * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    324                tvolv = tvolv + zmskv * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
     230               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) 
     231               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) 
    325232            END DO 
    326233         END DO 
     
    344251      !! ** Purpose :  write dynamic trends in ocean.output  
    345252      !!---------------------------------------------------------------------- 
    346       INTEGER, INTENT(in) ::   kt                                  ! ocean time-step index 
    347       !! 
    348       INTEGER  ::   ji, jj, jk 
    349       REAL(wp) ::   ze1e2w, zcof, zbe1ru, zbe2rv, zbtr, ztz, zth   !    "      scalars 
    350       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zkepe, zkx, zky, zkz   ! temporary arrays 
    351       !!---------------------------------------------------------------------- 
     253      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     254      USE wrk_nemo, ONLY:   zkepe => wrk_3d_1 , zkx => wrk_3d_2   ! 3D workspace 
     255      USE wrk_nemo, ONLY:   zky   => wrk_3d_3 , zkz => wrk_3d_4   !  -      - 
     256      ! 
     257      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     258      ! 
     259      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     260      REAL(wp) ::   zcof         ! local scalar 
     261      !!---------------------------------------------------------------------- 
     262 
     263      IF( wrk_in_use(3, 1,2,3,4) ) THEN 
     264         CALL ctl_stop('trd_dwr: requested workspace arrays unavailable')   ;   RETURN 
     265      ENDIF 
    352266 
    353267      ! I. Momentum trends 
     
    359273         ! -------------------------------------------------- 
    360274         ! c a u t i o n here, trends are computed at kt+1 (now , but after the swap) 
    361  
    362          zkx(:,:,:)   = 0.e0 
    363          zky(:,:,:)   = 0.e0 
    364          zkz(:,:,:)   = 0.e0 
    365          zkepe(:,:,:) = 0.e0 
     275         zkx  (:,:,:) = 0._wp 
     276         zky  (:,:,:) = 0._wp 
     277         zkz  (:,:,:) = 0._wp 
     278         zkepe(:,:,:) = 0._wp 
    366279    
    367280         CALL eos( tsn, rhd, rhop )       ! now potential and in situ densities 
    368281 
    369          ! Density flux at w-point 
     282         zcof = 0.5_wp / rau0             ! Density flux at w-point 
     283         zkz(:,:,1) = 0._wp 
    370284         DO jk = 2, jpk 
    371             DO jj = 1, jpj 
    372                DO ji = 1, jpi 
    373                   ze1e2w = 0.5 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) * tmask_i(ji,jj) 
    374                   zkz(ji,jj,jk) = ze1e2w / rau0 * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) ) 
     285            zkz(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 
     286         END DO 
     287          
     288         zcof   = 0.5_wp / rau0           ! Density flux at u and v-points 
     289         DO jk = 1, jpkm1 
     290            DO jj = 1, jpjm1 
     291               DO ji = 1, jpim1 
     292                  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) ) 
     293                  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) ) 
    375294               END DO 
    376295            END DO 
    377296         END DO 
    378          zkz(:,:,1) = 0.e0 
    379297          
    380          ! Density flux at u and v-points 
    381          DO jk = 1, jpk 
    382             DO jj = 1, jpjm1 
    383                DO ji = 1, jpim1 
    384                   zcof   = 0.5 / rau0 
    385                   zbe1ru = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) 
    386                   zbe2rv = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) 
    387                   zkx(ji,jj,jk) = zbe1ru * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
    388                   zky(ji,jj,jk) = zbe2rv * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
     298         DO jk = 1, jpkm1                 ! Density flux divergence at t-point 
     299            DO jj = 2, jpjm1 
     300               DO ji = 2, jpim1 
     301                  zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               & 
     302                     &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
     303                     &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           & 
     304                     &              / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    389305               END DO 
    390306            END DO 
    391307         END DO 
    392           
    393          ! Density flux divergence at t-point 
    394          DO jk = 1, jpkm1 
    395             DO jj = 2, jpjm1 
    396                DO ji = 2, jpim1 
    397                   zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 
    398                   ztz = - zbtr * (    zkz(ji,jj,jk) - zkz(ji,jj,jk+1) ) 
    399                   zth = - zbtr * (  ( zkx(ji,jj,jk) - zkx(ji-1,jj,jk) )   & 
    400                     &             + ( zky(ji,jj,jk) - zky(ji,jj-1,jk) )  ) 
    401                   zkepe(ji,jj,jk) = (zth + ztz) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    402                END DO 
    403             END DO 
    404          END DO 
    405          zkepe( : , : ,jpk) = 0.e0 
    406          zkepe( : ,jpj, : ) = 0.e0 
    407          zkepe(jpi, : , : ) = 0.e0 
    408308 
    409309         ! I.2 Basin averaged kinetic energy trend 
    410310         ! ---------------------------------------- 
    411          peke = 0.e0 
    412          DO jk = 1,jpk 
    413             DO jj = 1, jpj 
    414                DO ji = 1, jpi 
    415                   peke = peke + zkepe(ji,jj,jk) * grav * fsdept(ji,jj,jk)   & 
    416                      &                     * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    417                END DO 
    418             END DO 
    419          END DO 
     311         peke = 0._wp 
     312         DO jk = 1, jpkm1 
     313            peke = peke + SUM( zkepe(:,:,jk) * fsdept(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     314         END DO 
     315         peke = grav * peke 
    420316 
    421317         ! I.3 Sums over the global domain 
     
    542438         ! 
    543439      ENDIF 
     440      ! 
     441      IF( wrk_not_released(3, 1,2,3,4) )   CALL ctl_stop('trd_dwr: failed to release workspace arrays') 
    544442      ! 
    545443   END SUBROUTINE trd_dwr 
Note: See TracChangeset for help on using the changeset viewer.