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 5901 for branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90 – NEMO

Ignore:
Timestamp:
2015-11-20T09:39:06+01:00 (8 years ago)
Author:
jamesharle
Message:

merging branch with head of the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r5620 r5901  
    102102         IF(lwp) WRITE(numout,*) 
    103103      ENDIF 
     104      ! 
    104105      l_trd = .FALSE. 
    105106      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
     
    130131      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    131132      !! 
    132       INTEGER  :: ji, jj, jk, jn   ! dummy loop indices 
    133       REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars 
    134       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zfu, zfc, zfd 
     133      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     134      REAL(wp) ::   ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars 
     135      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zfu, zfc, zfd 
    135136      !---------------------------------------------------------------------- 
    136137      ! 
     
    139140      DO jn = 1, kjpt                                            ! tracer loop 
    140141         !                                                       ! =========== 
    141          zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0   
    142          zfd(:,:,:) = 0.0     ;   zwx(:,:,:) = 0.0      
    143          !                                                   
    144          DO jk = 1, jpkm1                                 
    145             !                                              
    146             !--- Computation of the ustream and downstream value of the tracer and the mask 
     142         zfu(:,:,:) = 0._wp     ;   zfc(:,:,:) = 0._wp  
     143         zfd(:,:,:) = 0._wp     ;   zwx(:,:,:) = 0._wp    
     144         ! 
     145!!gm why not using a SHIFT instruction... 
     146         DO jk = 1, jpkm1     !--- Computation of the ustream and downstream value of the tracer and the mask 
    147147            DO jj = 2, jpjm1 
    148148               DO ji = fs_2, fs_jpim1   ! vector opt. 
    149                   ! Upstream in the x-direction for the tracer 
    150                   zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn) 
    151                   ! Downstream in the x-direction for the tracer 
    152                   zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn) 
     149                  zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)        ! Upstream   in the x-direction for the tracer 
     150                  zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)        ! Downstream in the x-direction for the tracer 
    153151               END DO 
    154152            END DO 
     
    159157         ! Horizontal advective fluxes 
    160158         ! --------------------------- 
    161          ! 
    162159         DO jk = 1, jpkm1                              
    163160            DO jj = 2, jpjm1 
     
    220217            DO jj = 2, jpjm1 
    221218               DO ji = fs_2, fs_jpim1   ! vector opt.   
    222                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     219                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    223220                  ! horizontal advective trends 
    224221                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) 
     
    344341            DO jj = 2, jpjm1 
    345342               DO ji = fs_2, fs_jpim1   ! vector opt.   
    346                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     343                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    347344                  ! horizontal advective trends 
    348345                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) 
     
    380377      ! 
    381378      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    382       REAL(wp) ::   zbtr , ztra      ! local scalars 
    383379      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz 
    384380      !!---------------------------------------------------------------------- 
    385381      ! 
    386       CALL wrk_alloc( jpi, jpj, jpk, zwz ) 
     382      CALL wrk_alloc( jpi,jpj,jpk,   zwz ) 
     383      ! 
     384      !                          ! surface & bottom values  
     385      IF( lk_vvl )   zwz(:,:, 1 ) = 0._wp             ! set to zero one for all 
     386                     zwz(:,:,jpk) = 0._wp             ! except at the surface in linear free surface 
     387      ! 
    387388      !                                                          ! =========== 
    388389      DO jn = 1, kjpt                                            ! tracer loop 
    389390         !                                                       ! =========== 
    390          ! 1. Bottom value : flux set to zero 
    391          zwz(:,:,jpk) = 0.e0             ! Bottom value : flux set to zero 
    392          ! 
    393          !                                 ! Surface value 
    394          IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                      ! Variable volume : flux set to zero 
    395          ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)   ! Constant volume : advective flux through the surface 
     391         ! 
     392         DO jk = 2, jpkm1                    !* Interior point   (w-masked 2nd order centered flux) 
     393            DO jj = 2, jpjm1 
     394               DO ji = fs_2, fs_jpim1   ! vector opt. 
     395                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 
     396               END DO 
     397            END DO 
     398         END DO 
     399         IF(.NOT.lk_vvl ) THEN               !* top value   (only in linear free surf. as zwz is multiplied by wmask) 
     400            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean) 
     401               DO jj = 1, jpj 
     402                  DO ji = 1, jpi 
     403                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
     404                  END DO 
     405               END DO    
     406            ELSE                                   ! no ice-shelf cavities (only ocean surface) 
     407               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn) 
     408            ENDIF 
    396409         ENDIF 
    397410         ! 
    398          DO jk = 2, jpkm1                  ! Interior point: second order centered tracer flux at w-point 
     411         DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==! 
    399412            DO jj = 2, jpjm1 
    400413               DO ji = fs_2, fs_jpim1   ! vector opt. 
    401                   zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) 
    402                END DO 
    403             END DO 
    404          END DO 
    405          ! 
    406          DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==! 
    407             DO jj = 2, jpjm1 
    408                DO ji = fs_2, fs_jpim1   ! vector opt. 
    409                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    410                   ! k- vertical advective trends  
    411                   ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )  
    412                   ! added to the general tracer trends 
    413                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
     414                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
     415                     &                                / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    414416               END DO 
    415417            END DO 
Note: See TracChangeset for help on using the changeset viewer.