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 – 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

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/TRD
Files:
9 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 
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90

    r2528 r2715  
    1515   !!   'key_trdmld'                          mixed layer trend diagnostics 
    1616   !!---------------------------------------------------------------------- 
    17    !!---------------------------------------------------------------------- 
    1817   !!   trd_mld          : T and S cumulated trends averaged over the mixed layer 
    1918   !!   trd_mld_zint     : T and S trends vertical integration 
     
    2322   USE dom_oce         ! ocean space and time domain variables 
    2423   USE trdmod_oce      ! ocean variables trends 
     24   USE trdmld_oce      ! ocean variables trends 
    2525   USE ldftra_oce      ! ocean active tracers lateral physics 
    2626   USE zdf_oce         ! ocean vertical physics 
     
    3737   USE prtctl          ! Print control 
    3838   USE restart         ! for lrst_oce 
     39   USE lib_mpp         ! MPP library 
    3940 
    4041   IMPLICIT NONE 
     
    4748   CHARACTER (LEN=40) ::  clhstnam         ! name of the trends NetCDF file 
    4849   INTEGER ::   nh_t, nmoymltrd 
    49    INTEGER ::   nidtrd, ndextrd1(jpi*jpj) 
     50   INTEGER ::   nidtrd 
     51   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::   ndextrd1 
    5052   INTEGER ::   ndimtrd1                         
    5153   INTEGER ::   ionce, icount                    
     
    5860   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5961   !! $Id$  
    60    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     62   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6163   !!---------------------------------------------------------------------- 
    62  
    6364CONTAINS 
     65 
     66   INTEGER FUNCTION trd_mld_alloc() 
     67      !!---------------------------------------------------------------------- 
     68      !!                  ***  ROUTINE trd_mld_alloc  *** 
     69      !!---------------------------------------------------------------------- 
     70      ALLOCATE( ndextrd1(jpi*jpj) , STAT=trd_mld_alloc ) 
     71      ! 
     72      IF( lk_mpp             )   CALL mpp_sum ( trd_mld_alloc ) 
     73      IF( trd_mld_alloc /= 0 )   CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1') 
     74   END FUNCTION trd_mld_alloc 
     75 
    6476 
    6577   SUBROUTINE trd_mld_zint( pttrdmld, pstrdmld, ktrd, ctype ) 
     
    8193      !!            surface and the control surface is called "mixed-layer" 
    8294      !!---------------------------------------------------------------------- 
    83       INTEGER, INTENT( in ) ::   ktrd                             ! ocean trend index 
    84       CHARACTER(len=2), INTENT( in ) :: ctype                     ! surface/bottom (2D arrays) or 
    85       !                                                           ! interior (3D arrays) physics 
    86       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  pttrdmld ! temperature trend  
    87       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  pstrdmld ! salinity trend  
     95      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     96      USE wrk_nemo, ONLY:   zvlmsk => wrk_2d_10     ! 2D workspace 
     97      ! 
     98      INTEGER                         , INTENT( in ) ::   ktrd       ! ocean trend index 
     99      CHARACTER(len=2)                , INTENT( in ) ::   ctype      ! 2D surface/bottom or 3D interior physics 
     100      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   pttrdmld   ! temperature trend  
     101      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   pstrdmld   ! salinity trend  
     102      ! 
    88103      INTEGER ::   ji, jj, jk, isum 
    89       REAL(wp), DIMENSION(jpi,jpj) ::  zvlmsk 
    90       !!---------------------------------------------------------------------- 
     104      !!---------------------------------------------------------------------- 
     105 
     106      IF( wrk_in_use(2, 10) ) THEN 
     107         CALL ctl_stop('trd_mld_zint : requested workspace arrays unavailable')   ;   RETURN 
     108      ENDIF 
    91109 
    92110      ! I. Definition of control surface and associated fields 
     
    176194         smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,1) * wkx(:,:,1)             
    177195      END SELECT 
     196      ! 
     197      IF( wrk_not_released(2, 10) )   CALL ctl_stop('trd_mld_zint: failed to release workspace arrays') 
    178198      ! 
    179199   END SUBROUTINE trd_mld_zint 
     
    227247      !!       - See NEMO documentation (in preparation) 
    228248      !!---------------------------------------------------------------------- 
     249      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     250      USE wrk_nemo, ONLY: ztmltot => wrk_2d_1,  zsmltot => wrk_2d_2 ! dT/dt over the anlysis window (including Asselin) 
     251      USE wrk_nemo, ONLY: ztmlres => wrk_2d_3,  zsmlres => wrk_2d_4 ! residual = dh/dt entrainment term 
     252      USE wrk_nemo, ONLY: ztmlatf => wrk_2d_5,  zsmlatf => wrk_2d_6 ! needed for storage only 
     253      USE wrk_nemo, ONLY: ztmltot2 => wrk_2d_7, ztmlres2 => wrk_2d_8, ztmltrdm2 => wrk_2d_9    ! \  working arrays to diagnose the trends 
     254      USE wrk_nemo, ONLY: zsmltot2 => wrk_2d_10, zsmlres2 => wrk_2d_11, zsmltrdm2 => wrk_2d_12 !  > associated with the time meaned ML T & S 
     255      USE wrk_nemo, ONLY: ztmlatf2 => wrk_2d_13, zsmlatf2 => wrk_2d_14     
     256      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2                     ! / 
     257      ! 
    229258      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    230       !! 
     259      ! 
    231260      INTEGER :: ji, jj, jk, jl, ik, it, itmod 
    232261      LOGICAL :: lldebug = .TRUE. 
    233262      REAL(wp) :: zavt, zfn, zfn2 
    234       REAL(wp) ,DIMENSION(jpi,jpj) ::     & 
    235            ztmltot,  zsmltot,             & ! dT/dt over the anlysis window (including Asselin) 
    236            ztmlres,  zsmlres,             & ! residual = dh/dt entrainment term 
    237            ztmlatf,  zsmlatf,             & ! needed for storage only 
    238            ztmltot2, ztmlres2, ztmltrdm2, & ! \  working arrays to diagnose the trends 
    239            zsmltot2, zsmlres2, zsmltrdm2, & !  > associated with the time meaned ML T & S 
    240            ztmlatf2, zsmlatf2               ! / 
    241       REAL(wp), DIMENSION(jpi,jpj,jpltrd) ::  & 
    242            ztmltrd2, zsmltrd2               ! only needed for mean diagnostics 
     263      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztmltrd2, zsmltrd2   ! only needed for mean diagnostics 
    243264#if defined key_dimgout 
    244265      INTEGER ::  iyear,imon,iday 
     
    247268      !!---------------------------------------------------------------------- 
    248269       
     270      ! Check that the workspace arrays are all OK to be used 
     271      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)  .OR. & 
     272          wrk_in_use(3, 1,2)                                 ) THEN 
     273         CALL ctl_stop('trd_mld : requested workspace arrays unavailable')   ;   RETURN 
     274      ELSE IF(jpltrd > jpk) THEN 
     275         ! ARPDBG, is this reasonable or will this cause trouble in the future? 
     276         CALL ctl_stop('trd_mld : no. of mixed-layer trends (jpltrd) exceeds no. of model levels so cannot use 3D workspaces.') 
     277         RETURN          
     278      END IF 
     279      ! Set-up pointers into sub-arrays of 3d-workspaces 
     280      ztmltrd2 => wrk_3d_1(1:,:,1:jpltrd) 
     281      zsmltrd2 => wrk_3d_2(1:,:,1:jpltrd) 
    249282 
    250283      ! ====================================================================== 
     
    707740      IF( lrst_oce )   CALL trd_mld_rst_write( kt )  
    708741 
     742      IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)  .OR. & 
     743          wrk_not_released(3, 1,2)                                )   & 
     744          CALL ctl_stop('trd_mld : failed to release workspace arrays.') 
     745      ! 
    709746   END SUBROUTINE trd_mld 
    710747 
     
    716753      !! ** Purpose :   computation of vertically integrated T and S budgets 
    717754      !!      from ocean surface down to control surface (NetCDF output) 
    718       !! 
    719       !!---------------------------------------------------------------------- 
    720       !! * Local declarations 
     755      !!---------------------------------------------------------------------- 
    721756      INTEGER :: jl 
    722757      INTEGER :: inum   ! logical unit 
    723  
    724758      REAL(wp) ::   zjulian, zsto, zout 
    725  
    726759      CHARACTER (LEN=40) ::   clop 
    727760      CHARACTER (LEN=12) ::   clmxl, cltu, clsu 
    728  
    729761      !!---------------------------------------------------------------------- 
    730762 
     
    763795         nwarn = nwarn + 1 
    764796      END IF 
     797 
     798      !                                   ! allocate trdmld arrays 
     799      IF( trd_mld_alloc()    /= 0 )   CALL ctl_stop( 'STOP', 'trd_mld_init : unable to allocate trdmld     arrays' ) 
     800      IF( trdmld_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_mld_init : unable to allocate trdmld_oce arrays' ) 
    765801 
    766802      ! I.2 Initialize arrays to zero or read a restart file 
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90

    r2528 r2715  
    44   !! Ocean trends :   set tracer and momentum trend variables 
    55   !!====================================================================== 
    6    !! History :  9.0  !  04-08  (C. Talandier)  New trends organization 
     6   !! History :  1.0  ! 2004-08  (C. Talandier)  New trends organization 
    77   !!---------------------------------------------------------------------- 
    8    USE par_oce         ! ocean parameters 
     8   USE par_oce        ! ocean parameters 
    99 
    1010   IMPLICIT NONE 
    1111   PRIVATE 
     12 
     13   PUBLIC   trdmld_oce_alloc    ! Called in trdmld.F90 
    1214 
    1315#if defined key_trdmld 
     
    1719#endif 
    1820   !!* mixed layer trends indices 
    19    INTEGER, PARAMETER, PUBLIC ::   jpltrd = 11    !: number of mixed-layer trends arrays 
    20    INTEGER, PUBLIC   &  
    21 #if !defined key_agrif 
    22       , PARAMETER  & 
    23 #endif 
    24 ::   jpktrd = jpk   !: max level for mixed-layer trends diag. 
     21   INTEGER, PARAMETER, PUBLIC ::   jpltrd = 11      !: number of mixed-layer trends arrays 
     22   INTEGER, PUBLIC            ::   jpktrd           !: max level for mixed-layer trends diag. 
    2523   ! 
    2624   INTEGER, PUBLIC, PARAMETER ::   jpmld_xad =  1   !:  zonal       
     
    4644   CHARACTER(LEN=80) , PUBLIC :: clname, ctrd(jpltrd+1,2) 
    4745 
    48    INTEGER , PUBLIC, DIMENSION(jpi,jpj)     ::   nmld   !: mixed layer depth indexes  
    49    INTEGER , PUBLIC, DIMENSION(jpi,jpj)     ::   nbol   !: mixed-layer depth indexes when read from file 
     46   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nmld   !: mixed layer depth indexes  
     47   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nbol   !: mixed-layer depth indexes when read from file 
    5048 
    51    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   wkx    !: 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wkx    !: 
    5250 
    53    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  & 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  ::  & 
    5452      rmld   ,                      & !: mld depth (m) corresponding to nmld 
    5553      tml    , sml  ,               & !: \ "now" mixed layer temperature/salinity 
     
    6664      rmld_sum, rmldbn                !: needed to compute the leap-frog time mean of the ML depth 
    6765 
    68    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  & 
     66   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  & 
    6967      tmlatfb, tmlatfn ,            & !: "before" Asselin contribution at begining of the averaging 
    7068      smlatfb, smlatfn,             & !: period (i.e. last contrib. from previous such period) and  
     
    7270      tmlatfm, smlatfm                !: accumulator for Asselin trends (needed for storage only) 
    7371 
    74    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpltrd) ::  & 
     72   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::  & 
    7573      tmltrd,                       & !: \ physical contributions to the total trend (for T/S), 
    7674      smltrd,                       & !: / cumulated over the current analysis window 
     
    8381#endif 
    8482   !!---------------------------------------------------------------------- 
    85    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     83   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    8684   !! $Id$  
    87    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     85   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     86   !!---------------------------------------------------------------------- 
     87CONTAINS 
     88 
     89  INTEGER FUNCTION trdmld_oce_alloc() 
     90     !!---------------------------------------------------------------------- 
     91     !!                 ***  FUNCTION trdmld_oce_alloc   *** 
     92     !!---------------------------------------------------------------------- 
     93     USE lib_mpp 
     94     INTEGER :: ierr(5) 
     95     !!---------------------------------------------------------------------- 
     96 
     97     ! Initialise jpktrd here as can no longer do it in MODULE body since 
     98     ! jpk is now a variable. 
     99     jpktrd = jpk   !: max level for mixed-layer trends diag. 
     100 
     101     ierr(:) = 0 
     102 
     103#if   defined  key_trdmld   ||   defined key_esopa 
     104     ALLOCATE( nmld(jpi,jpj), nbol(jpi,jpj),       & 
     105        &      wkx(jpi,jpj,jpk), rmld(jpi,jpj),    &  
     106        &      tml(jpi,jpj)    , sml(jpi,jpj),     &  
     107        &      tmlb(jpi,jpj)   , smlb(jpi,jpj) ,   & 
     108        &      tmlbb(jpi,jpj)  , smlbb(jpi,jpj), STAT = ierr(1) ) 
     109 
     110     ALLOCATE( tmlbn(jpi,jpj)  , smlbn(jpi,jpj),   & 
     111        &      tmltrdm(jpi,jpj), smltrdm(jpi,jpj), & 
     112        &      tml_sum(jpi,jpj), tml_sumb(jpi,jpj),& 
     113        &      tmltrd_atf_sumb(jpi,jpj)           , STAT=ierr(2) ) 
     114 
     115     ALLOCATE( sml_sum(jpi,jpj), sml_sumb(jpi,jpj), & 
     116        &      smltrd_atf_sumb(jpi,jpj),            & 
     117        &      rmld_sum(jpi,jpj), rmldbn(jpi,jpj),  & 
     118        &      tmlatfb(jpi,jpj), tmlatfn(jpi,jpj), STAT = ierr(3) ) 
     119 
     120     ALLOCATE( smlatfb(jpi,jpj), smlatfn(jpi,jpj), &  
     121        &      tmlatfm(jpi,jpj), smlatfm(jpi,jpj), & 
     122        &      tmltrd(jpi,jpj,jpltrd),   smltrd(jpi,jpj,jpltrd), STAT=ierr(4)) 
     123 
     124     ALLOCATE( tmltrd_sum(jpi,jpj,jpltrd),tmltrd_csum_ln(jpi,jpj,jpltrd),      & 
     125        &      tmltrd_csum_ub(jpi,jpj,jpltrd), smltrd_sum(jpi,jpj,jpltrd),     & 
     126        &      smltrd_csum_ln(jpi,jpj,jpltrd), smltrd_csum_ub(jpi,jpj,jpltrd), STAT=ierr(5) ) 
     127#endif 
     128      ! 
     129      trdmld_oce_alloc = MAXVAL( ierr ) 
     130      IF( lk_mpp                )   CALL mpp_sum ( trdmld_oce_alloc ) 
     131      IF( trdmld_oce_alloc /= 0 )   CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays') 
     132      ! 
     133   END FUNCTION trdmld_oce_alloc 
     134 
    88135   !!====================================================================== 
    89136END MODULE trdmld_oce 
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90

    r2528 r2715  
    2424   USE trdmld                  ! ocean active mixed layer tracers trends  
    2525   USE in_out_manager          ! I/O manager 
     26   USE lib_mpp         ! MPP library 
    2627 
    2728   IMPLICIT NONE 
     
    3940   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4041   !! $Id$ 
    41    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4243   !!---------------------------------------------------------------------- 
    4344 
     
    5152      !!              integral constraints 
    5253      !!---------------------------------------------------------------------- 
    53       INTEGER, INTENT( in ) ::   kt                                ! time step 
    54       INTEGER, INTENT( in ) ::   ktrd                              ! tracer trend index 
    55       CHARACTER(len=3), INTENT( in ) ::   ctype                    ! momentum or tracers trends type 'DYN'/'TRA' 
    56       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   ptrdx ! Temperature or U trend  
    57       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   ptrdy ! Salinity    or V trend 
     54      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     55      USE wrk_nemo, ONLY: ztswu => wrk_2d_1,  & 
     56                          ztswv => wrk_2d_2,  & 
     57                          ztbfu => wrk_2d_3,  & 
     58                          ztbfv => wrk_2d_4,  & 
     59                          z2dx  => wrk_2d_5,  & 
     60                          z2dy  => wrk_2d_6 
     61      ! 
     62      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
     63      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
     64      CHARACTER(len=3)          , INTENT(in   ) ::   ctype   ! momentum or tracers trends type 'DYN'/'TRA' 
     65      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     66      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    5867      !! 
    59       INTEGER ::   ji, jj 
    60       REAL(wp), DIMENSION(jpi,jpj) ::   ztswu, ztswv               ! 2D workspace 
    61       REAL(wp), DIMENSION(jpi,jpj) ::   ztbfu, ztbfv               ! 2D workspace 
    62       REAL(wp), DIMENSION(jpi,jpj) ::   z2dx, z2dy                 ! workspace arrays 
    63       !!---------------------------------------------------------------------- 
    64  
    65       z2dx(:,:)   = 0.e0   ;   z2dy(:,:)   = 0.e0                  ! initialization of workspace arrays 
    66  
    67       IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restarting with Euler time stepping) 
    68       ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdttra (leapfrog) 
     68      INTEGER ::   ji, jj   ! dummy loop indices 
     69      !!---------------------------------------------------------------------- 
     70 
     71      IF(wrk_in_use(2, 1,2,3,4,5,6))THEN 
     72         CALL ctl_warn('trd_mod: Requested workspace arrays already in use.')   ;   RETURN 
     73      END IF 
     74 
     75      z2dx(:,:) = 0._wp   ;   z2dy(:,:) = 0._wp                            ! initialization of workspace arrays 
     76 
     77      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt   ! = rdtra (restart with Euler time stepping) 
     78      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt   ! = 2 rdttra (leapfrog) 
    6979      ENDIF 
    7080 
     
    8494            CASE ( jptra_trd_dmp )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype )   ! damping 
    8595            CASE ( jptra_trd_qsr )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype )   ! penetrative solar radiat. 
    86             CASE ( jptra_trd_nsr )    
    87                z2dx(:,:) = ptrdx(:,:,1)   ;   z2dy(:,:) = ptrdy(:,:,1) 
    88                CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype )                               ! non solar radiation 
     96            CASE ( jptra_trd_nsr )   ;   z2dx(:,:) = ptrdx(:,:,1)    
     97                                         z2dy(:,:) = ptrdy(:,:,1) 
     98                                         CALL trd_icp( z2dx , z2dy , jpicpt_nsr, ctype )   ! non solar radiation 
    8999            CASE ( jptra_trd_xad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype )   ! x- horiz adv 
    90100            CASE ( jptra_trd_yad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype )   ! y- horiz adv 
    91             CASE ( jptra_trd_zad )                                                         ! z- vertical adv  
    92                CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )    
    93                ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 
    94                z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 
    95                z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 
    96                CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )                             ! 1st z- vertical adv  
     101            CASE ( jptra_trd_zad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )   ! z- vertical adv  
     102                                         CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )    
     103                                         ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 
     104                                         z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 
     105                                         z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 
     106                                         CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )   ! 1st z- vertical adv  
    97107            END SELECT 
    98108         END IF 
     
    113123               ! subtract surface forcing/bottom friction trends  
    114124               ! from vertical diffusive momentum trends 
    115                ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0 
    116                ztbfu(:,:) = 0.e0   ;   ztbfv(:,:) = 0.e0  
     125               ztswu(:,:) = 0._wp   ;   ztswv(:,:) = 0._wp 
     126               ztbfu(:,:) = 0._wp   ;   ztbfv(:,:) = 0._wp  
    117127               DO jj = 2, jpjm1    
    118128                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    121131                     ztswv(ji,jj) = vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 
    122132                     ! bottom friction contribution now handled explicitly 
    123                      ! 
    124                      ptrdx(ji,jj,1     ) = ptrdx(ji,jj,1     ) - ztswu(ji,jj) 
    125                      ptrdy(ji,jj,1     ) = ptrdy(ji,jj,1     ) - ztswv(ji,jj) 
     133                     ptrdx(ji,jj,1) = ptrdx(ji,jj,1) - ztswu(ji,jj) 
     134                     ptrdy(ji,jj,1) = ptrdy(ji,jj,1) - ztswv(ji,jj) 
    126135                  END DO 
    127136               END DO 
     
    218227      ENDIF 
    219228      ! 
     229      IF( wrk_not_released(2, 1,2,3,4,5,6) )   CALL ctl_warn('trd_mod: Failed to release workspace arrays.') 
     230      ! 
    220231   END SUBROUTINE trd_mod 
    221232 
     
    228239   USE trdicp          ! ocean bassin integral constraints properties 
    229240   USE trdmld          ! ocean active mixed layer tracers trends  
    230  
     241   !!---------------------------------------------------------------------- 
    231242CONTAINS 
    232243   SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt )   ! Empty routine 
    233       REAL    ::   ptrd3dx(:,:,:), ptrd3dy(:,:,:) 
    234       INTEGER ::   ktrd, kt                             
     244      REAL(wp) ::   ptrd3dx(:,:,:), ptrd3dy(:,:,:) 
     245      INTEGER  ::   ktrd, kt                             
    235246      CHARACTER(len=3) ::  ctype                   
    236247      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1), ptrd3dy(1,1,1) 
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90

    r2528 r2715  
    7575   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    7676   !! $Id$ 
    77    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     77   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7878   !!====================================================================== 
    7979END MODULE trdmod_oce 
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_trc.F90

    r2528 r2715  
    44   !!  Dummy module 
    55   !!====================================================================== 
    6    !!---------------------------------------------------------------------- 
    7    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    8    !! $Id$ 
    9    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    10    !!---------------------------------------------------------------------- 
    116   !!---------------------------------------------------------------------- 
    127   !!   Dummy module                                             NO TOP use 
     
    2116   END SUBROUTINE trd_mod_trc 
    2217 
     18   !!---------------------------------------------------------------------- 
     19   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     20   !! $Id$ 
     21   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2322   !!====================================================================== 
    2423END MODULE trdmod_trc 
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r2528 r2715  
    44   !! Ocean diagnostics:  ocean tracers trends 
    55   !!===================================================================== 
    6    !! History :  9.0  !  2004-08  (C. Talandier) Original code 
    7    !!                 !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget 
    8    !!      NEMO  3.3  !  2010-06  (C. Ethe) merge TRA-TRC  
     6   !! History :  1.0  !  2004-08  (C. Talandier) Original code 
     7   !!            2.0  !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget 
     8   !!            3.3  !  2010-06  (C. Ethe) merge TRA-TRC  
    99   !!---------------------------------------------------------------------- 
    1010#if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc  
     
    1212   !!   trd_tra      : Call the trend to be computed 
    1313   !!---------------------------------------------------------------------- 
    14    USE dom_oce            ! ocean domain  
    15    USE trdmod_oce         ! ocean active mixed layer tracers trends  
    16    USE trdmod             ! ocean active mixed layer tracers trends  
    17    USE trdmod_trc         ! ocean passive mixed layer tracers trends  
     14   USE dom_oce          ! ocean domain  
     15   USE trdmod_oce       ! ocean active mixed layer tracers trends  
     16   USE trdmod           ! ocean active mixed layer tracers trends  
     17   USE trdmod_trc       ! ocean passive mixed layer tracers trends  
     18   USE in_out_manager   ! I/O manager 
     19   USE lib_mpp          ! MPP library 
    1820 
    1921   IMPLICIT NONE 
    2022   PRIVATE 
    2123 
    22    PUBLIC trd_tra          ! called by all  traXX modules 
     24   PUBLIC   trd_tra          ! called by all  traXX modules 
    2325  
    24    !! * Module declaration 
    25    REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE :: trdtx, trdty, trdt  !: 
     26   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt  !: 
    2627 
    2728   !! * Substitutions 
     
    2930#  include "vectopt_loop_substitute.h90" 
    3031   !!---------------------------------------------------------------------- 
    31    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     32   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    3233   !! $Id$ 
    33    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    34    !!---------------------------------------------------------------------- 
    35  
     34   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     35   !!---------------------------------------------------------------------- 
    3636CONTAINS 
     37 
     38   INTEGER FUNCTION trd_tra_alloc() 
     39      !!---------------------------------------------------------------------------- 
     40      !!                  ***  FUNCTION trd_tra_alloc  *** 
     41      !!---------------------------------------------------------------------------- 
     42      ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc ) 
     43      ! 
     44      IF( lk_mpp             )   CALL mpp_sum ( trd_tra_alloc ) 
     45      IF( trd_tra_alloc /= 0 )   CALL ctl_warn('trd_tra_alloc: failed to allocate arrays') 
     46   END FUNCTION trd_tra_alloc 
     47 
    3748 
    3849   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra ) 
     
    5061      !!        nn_ctls > 1  : use fixed level surface jk = nn_ctls 
    5162      !!---------------------------------------------------------------------- 
     63      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     64      USE wrk_nemo, ONLY:   ztrds => wrk_3d_10   ! 3D workspace 
     65      ! 
    5266      INTEGER                         , INTENT(in)           ::  kt      ! time step 
    5367      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC' 
     
    5771      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity  
    5872      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable  
    59       !! 
    60       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztrds    !   
    61       !!---------------------------------------------------------------------- 
    62  
     73      !!---------------------------------------------------------------------- 
     74 
     75      IF( wrk_in_use(3, 10) ) THEN 
     76         CALL ctl_stop('trd_tra: requested workspace array unavailable')   ;   RETURN 
     77      ENDIF 
     78 
     79      IF( .NOT. ALLOCATED( trdtx ) ) THEN       ! allocate trdtra arrays 
     80         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 
     81      ENDIF 
     82       
    6383      ! Control of optional arguments 
    6484      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN  
     
    118138      ENDIF 
    119139      ! 
     140      IF( wrk_not_released(3, 10) )   CALL ctl_stop('trd_tra: failed to release workspace array') 
     141      ! 
    120142   END SUBROUTINE trd_tra 
     143 
    121144 
    122145   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd ) 
     
    130153      !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] ) 
    131154      !!---------------------------------------------------------------------- 
    132       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pf      ! advective flux in one direction 
    133       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pun     ! now velocity  in one direction 
    134       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   ptn     ! now or before tracer  
    135       CHARACTER(len=1), INTENT(in )                                   ::   cdir    ! X/Y/Z direction 
    136       REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk)           ::   ptrd    ! advective trend in one direction 
    137       !! 
    138       INTEGER                          ::   ji, jj, jk   ! dummy loop indices 
    139       INTEGER                          ::   ii, ij, ik   ! index shift function of the direction 
    140       REAL(wp)                         ::   zbtr         ! temporary scalar 
     155      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pf      ! advective flux in one direction 
     156      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pun     ! now velocity  in one direction 
     157      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   ptn     ! now or before tracer  
     158      CHARACTER(len=1), INTENT(in )                         ::   cdir    ! X/Y/Z direction 
     159      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk) ::   ptrd    ! advective trend in one direction 
     160      ! 
     161      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     162      INTEGER  ::   ii, ij, ik   ! index shift function of the direction 
     163      REAL(wp) ::   zbtr         ! local scalar 
    141164      !!---------------------------------------------------------------------- 
    142165 
     
    167190#   else 
    168191   !!---------------------------------------------------------------------- 
    169    !!   Default case :                                         Empty module 
     192   !!   Default case :          Dummy module           No trend diagnostics 
    170193   !!---------------------------------------------------------------------- 
    171194   USE par_oce      ! ocean variables trends 
    172  
    173195CONTAINS 
    174  
    175196   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra ) 
    176197      !!---------------------------------------------------------------------- 
     
    182203      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity  
    183204      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable  
    184       WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1) 
    185       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptra(1,1,1) 
    186       WRITE(*,*) ' "   ": You should not have seen this print! error ?', pu(1,1,1) 
    187       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd 
    188       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktra 
    189       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype 
    190       WRITE(*,*) ' "   ": You should not have seen this print! error ?', kt 
     205      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1),   & 
     206         &                                                               ktrd, ktra, ctype, kt 
    191207   END SUBROUTINE trd_tra 
    192208#   endif 
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90

    r2528 r2715  
    44   !! Ocean diagnostics:  momentum trends 
    55   !!===================================================================== 
    6    !! History :  9.0  !  04-06  (L. Brunier, A-M. Treguier) Original code  
    7    !!                 !  04-08  (C. Talandier) New trends organization 
     6   !! History :  1.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code  
     7   !!            2.0  !  04-2008  (C. Talandier) New trends organization 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_trdvor   ||   defined key_esopa 
     
    2626   USE ioipsl          ! NetCDF library 
    2727   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     28   USE lib_mpp         ! MPP library 
    2829 
    2930   IMPLICIT NONE 
     
    3738   PUBLIC   trd_vor_zint   ! routine called by dynamics routines 
    3839   PUBLIC   trd_vor_init   ! routine called by opa.F90 
    39  
    40    INTEGER ::   nh_t, nmoydpvor, nidvor, nhoridvor, ndexvor1(jpi*jpj), ndimvor1, icount   ! needs for IOIPSL output 
     40   PUBLIC   trd_vor_alloc  ! routine called by nemogcm.F90 
     41 
     42   INTEGER ::   nh_t, nmoydpvor, nidvor, nhoridvor, ndimvor1, icount   ! needs for IOIPSL output 
     43   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) ::   ndexvor1   ! needed for IOIPSL output 
    4144   INTEGER ::   ndebug     ! (0/1) set it to 1 in case of problem to have more print 
    4245 
    43    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avr      ! average 
    44    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrb     ! before vorticity (kt-1) 
    45    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrbb    ! vorticity at begining of the nwrite-1 timestep averaging period 
    46    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrbn    ! after vorticity at time step after the 
    47    REAL(wp), DIMENSION(jpi,jpj) ::   rotot        ! begining of the NWRITE-1 timesteps 
    48    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrtot   ! 
    49    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrres   ! 
    50  
    51    REAL(wp), DIMENSION(jpi,jpj,jpltot_vor) ::   vortrd  ! curl of trends 
     46   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avr      ! average 
     47   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrb     ! before vorticity (kt-1) 
     48   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrbb    ! vorticity at begining of the nwrite-1 timestep averaging period 
     49   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrbn    ! after vorticity at time step after the 
     50   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   rotot        ! begining of the NWRITE-1 timesteps 
     51   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrtot   ! 
     52   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::   vor_avrres   ! 
     53   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   vortrd       ! curl of trends 
    5254          
    5355   CHARACTER(len=12) ::   cvort 
     
    6365   !!---------------------------------------------------------------------- 
    6466CONTAINS 
     67 
     68   INTEGER FUNCTION trd_vor_alloc() 
     69      !!---------------------------------------------------------------------------- 
     70      !!                  ***  ROUTINE trd_vor_alloc  *** 
     71      !!---------------------------------------------------------------------------- 
     72      ALLOCATE( vor_avr   (jpi,jpj) , vor_avrb(jpi,jpj) , vor_avrbb (jpi,jpj) ,   & 
     73         &      vor_avrbn (jpi,jpj) , rotot   (jpi,jpj) , vor_avrtot(jpi,jpj) ,   & 
     74         &      vor_avrres(jpi,jpj) , vortrd  (jpi,jpj,jpltot_vor) ,              & 
     75         &      ndexvor1  (jpi*jpj)                                ,   STAT= trd_vor_alloc ) 
     76         ! 
     77      IF( lk_mpp             )   CALL mpp_sum ( trd_vor_alloc ) 
     78      IF( trd_vor_alloc /= 0 )   CALL ctl_warn('trd_vor_alloc: failed to allocate arrays') 
     79   END FUNCTION trd_vor_alloc 
     80 
    6581 
    6682   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd ) 
     
    91107      !!      trends output in netCDF format using ioipsl 
    92108      !!---------------------------------------------------------------------- 
     109      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     110      USE wrk_nemo, ONLY:   zudpvor => wrk_2d_1 , zvdpvor => wrk_2d_2   ! total cmulative trends 
     111      ! 
    93112      INTEGER                     , INTENT(in   ) ::   ktrd       ! ocean trend index 
    94113      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    95114      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pvtrdvor   ! v vorticity trend 
    96       !! 
     115      ! 
    97116      INTEGER ::   ji, jj       ! dummy loop indices 
    98117      INTEGER ::   ikbu, ikbv   ! local integers 
    99       REAL(wp), DIMENSION(jpi,jpj) ::   zudpvor, zvdpvor   ! total cmulative trends 
    100       !!---------------------------------------------------------------------- 
     118      !!---------------------------------------------------------------------- 
     119 
     120      IF( wrk_in_use(2, 1,2) ) THEN 
     121         CALL ctl_stop('trd_vor_zint_2d: requested workspace arrays unavailable')   ;   RETURN 
     122      ENDIF 
    101123 
    102124      ! Initialization 
    103       zudpvor(:,:) = 0._wp 
    104       zvdpvor(:,:) = 0._wp 
    105       ! 
    106       CALL lbc_lnk( putrdvor,  'U' , -1. )         ! lateral boundary condition on input momentum trends 
    107       CALL lbc_lnk( pvtrdvor,  'V' , -1. ) 
     125      zudpvor(:,:) = 0._wp                 ;   zvdpvor(:,:) = 0._wp 
     126      CALL lbc_lnk( putrdvor, 'U', -1. )   ;   CALL lbc_lnk( pvtrdvor, 'V', -1. )      ! lateral boundary condition 
     127       
    108128 
    109129      !  ===================================== 
     
    147167      ENDIF 
    148168      ! 
     169      IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('trd_vor_zint_2d : failed to release workspace arrays.') 
     170      ! 
    149171   END SUBROUTINE trd_vor_zint_2d 
    150172 
     
    177199      !!      trends output in netCDF format using ioipsl 
    178200      !!---------------------------------------------------------------------- 
     201      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     202      USE wrk_nemo, ONLY:   zubet   => wrk_2d_1,   zvbet => wrk_2d_2   ! Beta.V  
     203      USE wrk_nemo, ONLY:   zudpvor => wrk_2d_3, zvdpvor => wrk_2d_4   ! total cmulative trends 
     204      ! 
    179205      INTEGER                         , INTENT(in   ) ::   ktrd       ! ocean trend index 
    180206      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    181207      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend 
    182       !! 
    183       INTEGER ::   ji, jj, jk 
    184       REAL(wp), DIMENSION(jpi,jpj) ::   zubet  , zvbet     ! Beta.V  
    185       REAL(wp), DIMENSION(jpi,jpj) ::   zudpvor, zvdpvor   ! total cmulative trends 
     208      ! 
     209      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    186210      !!---------------------------------------------------------------------- 
    187211      
     212      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
     213         CALL ctl_stop('trd_vor_zint_3d: requested workspace arrays unavailable.')   ;   RETURN 
     214      ENDIF 
     215 
    188216      ! Initialization 
    189217      zubet  (:,:) = 0._wp 
     
    192220      zvdpvor(:,:) = 0._wp 
    193221      ! 
    194       CALL lbc_lnk( putrdvor, 'U' , -1. )         ! lateral boundary condition on input momentum trends 
    195       CALL lbc_lnk( pvtrdvor, 'V' , -1. ) 
     222      CALL lbc_lnk( putrdvor, 'U', -1. )         ! lateral boundary condition on input momentum trends 
     223      CALL lbc_lnk( pvtrdvor, 'V', -1. ) 
    196224 
    197225      !  ===================================== 
     
    248276      ENDIF 
    249277      ! 
     278      IF( wrk_not_released(2, 1,2,3,4) )   CALL ctl_stop('trd_vor_zint_3d: failed to release workspace arrays') 
     279      ! 
    250280   END SUBROUTINE trd_vor_zint_3d 
    251281 
     
    258288      !!               and make outputs (NetCDF or DIMG format) 
    259289      !!---------------------------------------------------------------------- 
     290      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     291      USE wrk_nemo, ONLY:   zun => wrk_2d_1 , zvn => wrk_2d_2 ! 2D workspace 
     292      ! 
    260293      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    261       !! 
     294      ! 
    262295      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    263296      INTEGER  ::   it, itmod        ! local integers 
    264297      REAL(wp) ::   zmean            ! local scalars 
    265       REAL(wp), DIMENSION(jpi,jpj) ::   zun, zvn   ! 2D workspace 
    266       !!---------------------------------------------------------------------- 
     298      !!---------------------------------------------------------------------- 
     299 
     300      IF( wrk_in_use(2, 1,2) ) THEN 
     301         CALL ctl_stop('trd_vor: requested workspace arrays unavailable.')   ;   RETURN 
     302      ENDIF 
    267303 
    268304      !  ================= 
     
    431467      IF( kt == nitend )   CALL histclo( nidvor ) 
    432468      ! 
     469      IF( wrk_not_released(2, 1,2) )   CALL ctl_stop('trd_vor: failed to release workspace arrays') 
     470      ! 
    433471   END SUBROUTINE trd_vor 
    434472 
     
    466504         WRITE(numout,*) ' ' 
    467505      ENDIF 
     506 
     507      IF( trd_vor_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_vor_init : unable to allocate trdvor arrays' ) 
     508 
    468509 
    469510      ! cumulated trends array init 
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90

    r2528 r2715  
    44   !! Ocean trends :   set vorticity trend variables 
    55   !!====================================================================== 
    6    !! History :  9.0  ! ??? 
     6   !! History :  9.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code  
    77   !!---------------------------------------------------------------------- 
    88 
     
    1414 
    1515#if defined key_trdvor 
    16    LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .TRUE.     !: momentum trend flag 
     16   LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .TRUE.    !: momentum trend flag 
    1717#else 
    18    LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .FALSE.    !: momentum trend flag 
     18   LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .FALSE.   !: momentum trend flag 
    1919#endif 
    20    !!* vorticity trends index 
     20   !                                               !!* vorticity trends index 
    2121   INTEGER, PUBLIC, PARAMETER ::   jpltot_vor = 11  !: Number of vorticity trend terms 
    2222   ! 
     
    3636   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3737   !! $Id$  
    38    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3939   !!====================================================================== 
    4040END MODULE trdvor_oce 
Note: See TracChangeset for help on using the changeset viewer.