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 6772 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90 – NEMO

Ignore:
Timestamp:
2016-07-01T18:02:45+02:00 (8 years ago)
Author:
cbricaud
Message:

clean in coarsening branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_crs.F90

    r6101 r6772  
    9191      !!---------------------------------------------------------------------- 
    9292      ! 
     93 
    9394      IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd') 
    9495      ! 
     
    126127         ! upstream tracer flux in the i and j direction 
    127128         DO jk = 1, jpkm1 
    128             DO jj = 1, jpjm1 
    129                DO ji = 1, fs_jpim1   ! vector opt. 
     129            DO jj = 2, jpj_crs-1 
     130               DO ji = 2, jpi_crs-1 
    130131                  ! upstream scheme 
    131132                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) ) 
     
    138139            END DO 
    139140         END DO 
     141         CALL crs_lbc_lnk( zwx, 'U', -1._wp )   
     142         CALL crs_lbc_lnk( zwy, 'V', -1._wp )   
    140143         ! upstream tracer flux in the k direction 
    141144         ! Surface value 
    142145         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable 
    143          ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface  
     146         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) !cbr * ptb(:,:,1,jn)   ! linear free surface  
    144147         ENDIF 
    145148         ! Interior value 
    146149         DO jk = 2, jpkm1 
    147             DO jj = 1, jpj 
    148                DO ji = 1, jpi 
     150            DO jj = 2,  jpj_crs-1 
     151               DO ji = nldi_crs, nlei_crs 
    149152                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
    150153                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
     
    153156            END DO 
    154157         END DO 
     158         CALL crs_lbc_lnk( zwz, 'T', 1. )   
     159 
    155160         ! total advective trend 
    156161         DO jk = 1, jpkm1 
    157162            z2dtt = p2dt(jk) 
    158             DO jj = 2, jpjm1 
    159                DO ji = fs_2, fs_jpim1   ! vector opt. 
     163            DO jj = 2, jpj_crs-1 
     164               DO ji = 2, jpi_crs-1 
    160165                  zbtr = r1_bt_crs(ji,jj,jk)  
    161166                  ! total intermediate advective trends 
     
    163168                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    164169                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) 
    165                   ! update and guess with monotonic sheme 
     170 
    166171                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra 
    167172                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask_crs(ji,jj,jk) 
     
    169174            END DO 
    170175         END DO 
     176  
    171177         !                             ! Lateral boundary conditions on zwi  (unchanged sign) 
    172178         CALL crs_lbc_lnk( zwi, 'T', 1. )   
     
    187193         ! antidiffusive flux on i and j 
    188194         DO jk = 1, jpkm1 
    189             DO jj = 1, jpjm1 
    190                DO ji = 1, fs_jpim1   ! vector opt. 
     195            DO jj = 2, jpj_crs-1 
     196               DO ji = 2, jpi_crs-1 
    191197                  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) 
    192198                  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) 
     
    198204         ! 
    199205         DO jk = 2, jpkm1          ! Interior value 
    200             DO jj = 1, jpj 
    201                DO ji = 1, jpi 
     206            DO jj = 2, jpj_crs-1 
     207               DO ji = 2, jpi_crs-1 
    202208                  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) 
    203209               END DO 
    204210            END DO 
    205          END DO 
     211        END DO 
    206212         CALL crs_lbc_lnk( zwx, 'U', -1. )   ;   CALL crs_lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions 
    207213         CALL crs_lbc_lnk( zwz, 'W',  1. ) 
     
    214220         ! ------------------------------------ 
    215221         DO jk = 1, jpkm1 
    216             DO jj = 2, jpjm1 
    217                DO ji = fs_2, fs_jpim1   ! vector opt.   
     222            DO jj = 2, jpj_crs-1 
     223               DO ji = 2, jpi_crs-1 
    218224                  zbtr = r1_bt_crs(ji,jj,jk) 
    219225                  ! total advective trends 
     
    247253      END DO 
    248254      ! 
     255 
    249256                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz , zwx, zwy ) 
    250257      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     
    302309         ikm1 = MAX(jk-1,1) 
    303310         z2dtt = p2dt(jk) 
    304          DO jj = 2, jpjm1 
    305             DO ji = fs_2, fs_jpim1   ! vector opt. 
     311         DO jj = 2, jpj_crs-1 
     312            DO ji = 2, jpi_crs-1 
    306313 
    307314               ! search maximum in neighbourhood 
     
    339346      ! ---------------------------------------- 
    340347      DO jk = 1, jpkm1 
    341          DO jj = 2, jpjm1 
    342             DO ji = fs_2, fs_jpim1   ! vector opt. 
     348         DO jj = 2, jpj_crs-1 
     349            DO ji = 2, jpi_crs-1 
    343350               zau = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 
    344351               zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 
Note: See TracChangeset for help on using the changeset viewer.