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 2034 for branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_tvd.F90 – NEMO

Ignore:
Timestamp:
2010-07-29T17:05:35+02:00 (14 years ago)
Author:
cetlod
Message:

cosmetic changes

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r2024 r2034  
    88   !!                 !  00-10  (MA Foujols E.Kestenare)  include file not routine 
    99   !!                 !  00-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes 
    10    !!                 !  01-07  (E. Durand G. Madec)  adaptraation to ORCA config 
     10   !!                 !  01-07  (E. Durand G. Madec)  adaptation to ORCA config 
    1111   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    1212   !!            9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl 
    1313   !!            9.0  !  08-04  (S. Cravatte) add the i-, j- & k- trends computation 
    1414   !!            " "  !  09-11  (V. Garnier) Surface pressure gradient organization 
    15    !!            3.3  !  10-05 (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
     15   !!            3.3  !  10-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
    1616   !!---------------------------------------------------------------------- 
    1717 
     
    4545#  include "vectopt_loop_substitute.h90" 
    4646   !!---------------------------------------------------------------------- 
    47    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     47   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    4848   !! $Id$ 
    4949   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     
    5252CONTAINS 
    5353 
    54    SUBROUTINE tra_adv_tvd ( kt   , cdtype, pun  , pvn, pwn, & 
    55       &                     ptrab, ptran , ptraa, kjpt   ) 
     54   SUBROUTINE tra_adv_tvd ( kt, cdtype, pun, pvn, pwn, & 
     55      &                                 ptb, ptn, pta, kjpt   ) 
    5656      !!---------------------------------------------------------------------- 
    5757      !!                  ***  ROUTINE tra_adv_tvd  *** 
     
    6464      !!       note: - this advection scheme needs a leap-frog time scheme 
    6565      !! 
    66       !! ** Action : - update (ptraa) with the now advective tracer trends 
     66      !! ** Action : - update (pta) with the now advective tracer trends 
    6767      !!             - save the trends  
    6868      !!---------------------------------------------------------------------- 
    69       !!* Module used 
    7069      USE oce         , zwx => ua   ! use ua as workspace 
    7170      USE oce         , zwy => va   ! use va as workspace 
    72       !!* Arguments 
     71      !! 
    7372      INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index 
    7473      CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator) 
    7574      INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers 
    7675      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun, pvn, pwn   ! 3 ocean velocity components 
    77       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptrab, ptran        ! before and now tracer fields 
    78       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptraa           ! tracer trend  
    79       !!* Local declarations 
     76      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb, ptn        ! before and now tracer fields 
     77      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta           ! tracer trend  
     78      !! 
    8079      INTEGER  ::   ji, jj, jk, jn          ! dummy loop indices   
    8180      REAL(wp) ::   & 
     
    127126                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) ) 
    128127                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 
    129                   zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptrab(ji,jj,jk,jn) + zfm_ui * ptrab(ji+1,jj  ,jk,jn) ) 
    130                   zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptrab(ji,jj,jk,jn) + zfm_vj * ptrab(ji  ,jj+1,jk,jn) ) 
     128                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) ) 
     129                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) ) 
    131130               END DO 
    132131            END DO 
     
    136135         ! Surface value 
    137136         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable 
    138          ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptrab(:,:,1,jn)   ! linear free surface  
     137         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface  
    139138         ENDIF 
    140139         ! Interior value 
     
    144143                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
    145144                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
    146                   zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptrab(ji,jj,jk,jn) + zfm_wk * ptrab(ji,jj,jk-1,jn) ) 
     145                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) 
    147146               END DO 
    148147            END DO 
     
    160159                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) 
    161160                  ! update and guess with monotonic sheme 
    162                   ptraa(ji,jj,jk,jn) =   ptraa(ji,jj,jk,jn)         + ztra 
    163                   zwi(ji,jj,jk)    = ( ptrab(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk) 
     161                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra 
     162                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk) 
    164163               END DO 
    165164            END DO 
     
    185184            DO jj = 1, jpjm1 
    186185               DO ji = 1, fs_jpim1   ! vector opt. 
    187                   zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk) 
    188                   zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk) 
     186                  zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk) 
     187                  zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk) 
    189188               END DO 
    190189            END DO 
     
    198197            DO jj = 1, jpj 
    199198               DO ji = 1, jpi 
    200                   zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptran(ji,jj,jk,jn) + ptran(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk) 
     199                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk) 
    201200               END DO 
    202201            END DO 
     
    210209         ! 4. monotonicity algorithm 
    211210         ! ------------------------- 
    212          CALL nonosc( ptrab(:,:,:,jn), zwx, zwy, zwz, zwi, z2 ) 
     211         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, z2 ) 
    213212 
    214213 
     
    224223                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) 
    225224                  ! add them to the general tracer trends 
    226                   ptraa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra 
     225                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
    227226               END DO 
    228227            END DO 
     
    235234            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    236235             
    237             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptran(:,:,:,jn) )    
    238             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptran(:,:,:,jn) )   
    239             CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptran(:,:,:,jn) )  
     236            CALL trd_tra( kt, cdtype, jn, jpt_trd_xad, ztrdx, pun, ptn(:,:,:,jn) )    
     237            CALL trd_tra( kt, cdtype, jn, jpt_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
     238            CALL trd_tra( kt, cdtype, jn, jpt_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
    240239         END IF 
    241240         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
Note: See TracChangeset for help on using the changeset viewer.