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 5974 for branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90 – NEMO

Ignore:
Timestamp:
2015-12-02T11:52:05+01:00 (8 years ago)
Author:
timgraham
Message:

Upgrade to head of trunk (r5936)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r5682 r5974  
    2020   USE trd_oce         ! trends: ocean variables 
    2121   USE trdtra          ! trends manager: tracers  
    22    USE dynspg_oce      ! surface pressure gradient variables 
    2322   USE diaptr          ! poleward transport diagnostics 
    2423   ! 
     
    102101         IF(lwp) WRITE(numout,*) 
    103102      ENDIF 
     103      ! 
    104104      l_trd = .FALSE. 
    105105      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
     
    130130      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    131131      !! 
    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 
     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 
    135135      !---------------------------------------------------------------------- 
    136136      ! 
     
    139139      DO jn = 1, kjpt                                            ! tracer loop 
    140140         !                                                       ! =========== 
    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 
     141         zfu(:,:,:) = 0._wp     ;   zfc(:,:,:) = 0._wp  
     142         zfd(:,:,:) = 0._wp     ;   zwx(:,:,:) = 0._wp    
     143         ! 
     144!!gm why not using a SHIFT instruction... 
     145         DO jk = 1, jpkm1     !--- Computation of the ustream and downstream value of the tracer and the mask 
    147146            DO jj = 2, jpjm1 
    148147               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) 
     148                  zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)        ! Upstream   in the x-direction for the tracer 
     149                  zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)        ! Downstream in the x-direction for the tracer 
    153150               END DO 
    154151            END DO 
     
    159156         ! Horizontal advective fluxes 
    160157         ! --------------------------- 
    161          ! 
    162158         DO jk = 1, jpkm1                              
    163159            DO jj = 2, jpjm1 
     
    220216            DO jj = 2, jpjm1 
    221217               DO ji = fs_2, fs_jpim1   ! vector opt.   
    222                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     218                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    223219                  ! horizontal advective trends 
    224220                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) 
     
    344340            DO jj = 2, jpjm1 
    345341               DO ji = fs_2, fs_jpim1   ! vector opt.   
    346                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     342                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    347343                  ! horizontal advective trends 
    348344                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) 
     
    380376      ! 
    381377      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    382       REAL(wp) ::   zbtr , ztra      ! local scalars 
    383378      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz 
    384379      !!---------------------------------------------------------------------- 
    385380      ! 
    386       CALL wrk_alloc( jpi, jpj, jpk, zwz ) 
     381      CALL wrk_alloc( jpi,jpj,jpk,   zwz ) 
     382      ! 
     383      !                          ! surface & bottom values  
     384      IF( lk_vvl )   zwz(:,:, 1 ) = 0._wp             ! set to zero one for all 
     385                     zwz(:,:,jpk) = 0._wp             ! except at the surface in linear free surface 
     386      ! 
    387387      !                                                          ! =========== 
    388388      DO jn = 1, kjpt                                            ! tracer loop 
    389389         !                                                       ! =========== 
    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 
     390         ! 
     391         DO jk = 2, jpkm1                    !* Interior point   (w-masked 2nd order centered flux) 
     392            DO jj = 2, jpjm1 
     393               DO ji = fs_2, fs_jpim1   ! vector opt. 
     394                  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) 
     395               END DO 
     396            END DO 
     397         END DO 
     398         IF(.NOT.lk_vvl ) THEN               !* top value   (only in linear free surf. as zwz is multiplied by wmask) 
     399            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean) 
     400               DO jj = 1, jpj 
     401                  DO ji = 1, jpi 
     402                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
     403                  END DO 
     404               END DO    
     405            ELSE                                   ! no ice-shelf cavities (only ocean surface) 
     406               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn) 
     407            ENDIF 
    396408         ENDIF 
    397409         ! 
    398          DO jk = 2, jpkm1                  ! Interior point: second order centered tracer flux at w-point 
     410         DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==! 
    399411            DO jj = 2, jpjm1 
    400412               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 
     413                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
     414                     &                                / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    414415               END DO 
    415416            END DO 
Note: See TracChangeset for help on using the changeset viewer.