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 791 for branches/dev_001_GM/NEMO/OPA_SRC/TRA/traadv.F90 – NEMO

Ignore:
Timestamp:
2008-01-12T21:33:34+01:00 (16 years ago)
Author:
gm
Message:

dev_001_GM - TRA/traadv : switch from velocity to transport + optimised traadv_eiv2 introduced - compilation OK

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_001_GM/NEMO/OPA_SRC/TRA/traadv.F90

    r786 r791  
    44   !! Ocean active tracers:  advection trend  
    55   !!============================================================================== 
    6    !! History :  9.0  !  05-11  (G. Madec)  Original code 
     6   !! History :  1.0  !  2005-11  (G. Madec)  Original code 
     7   !!            2.4  !  2008-01  (G. Madec)  merge TRC-TRA + switch from velocity to transport 
    78   !!---------------------------------------------------------------------- 
    89 
    … …  
    2324   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    2425   USE in_out_manager  ! I/O manager 
    25 !  USE prtctl          ! Print control 
    2626 
    2727   IMPLICIT NONE 
    … …  
    5959      !! ** Method  : - Update (ua,va) with the advection term following nadv 
    6060      !!---------------------------------------------------------------------- 
    61 #if ( defined key_trabbl_adv || defined key_traldf_eiv ) 
    62       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn   ! effective velocity 
    63 #else 
    64       USE oce, ONLY :                       zun => un       ! the effective velocity is the 
    65       USE oce, ONLY :                       zvn => vn       ! Eulerian velocity 
    66       USE oce, ONLY :                       zwn => wn       !  
    67 #endif 
     61      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    6862      !! 
    69       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     63      INTEGER ::   jk   ! dummy loop index 
     64      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn   ! effective transports 
    7065      !!---------------------------------------------------------------------- 
    7166 
    7267      IF( kt == nit000 )   CALL tra_adv_ctl          ! initialisation & control of options 
    7368 
     69 
     70      !                                              ! effective transport 
     71      DO jk = 1, jpkm1  
    7472#if defined key_trabbl_adv 
    75       zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:)          ! add the bbl velocity 
    76       zvn(:,:,:) = vn(:,:,:) - v_bbl(:,:,:) 
    77       zwn(:,:,:) = wn(:,:,:) + w_bbl(:,:,:) 
     73         !                                                ! eulerian + bbl transport 
     74         zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * ( un(:,:,jk) - u_bbl(:,:,jk) ) 
     75         zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * ( vn(:,:,jk) - v_bbl(:,:,jk) ) 
     76         zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * ( wn(:,:,jk) + w_bbl(:,:,jk) ) 
     77#else 
     78         !                                                ! eulerian transport only 
     79         zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) *   un(:,:,jk)  
     80         zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) *   vn(:,:,jk) 
     81         zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      *   wn(:,:,jk) 
    7882#endif 
    79       IF( lk_traldf_eiv ) THEN                       ! commpute and add the eiv velocity 
    80          IF( .NOT. lk_trabbl_adv ) THEN  
    81             zun(:,:,:) = un(:,:,:) 
    82             zvn(:,:,:) = vn(:,:,:) 
    83             zwn(:,:,:) = wn(:,:,:) 
    84          ENDIF 
    85          CALL tra_adv_eiv( kt, zun, zvn, zwn )  
    86       ENDIF 
     83      END DO 
     84      zwn(:,:,jpk) = 0.e0                                 ! no transport trough the bottom 
     85 
     86      !                                                   ! add the eiv transport (if necessary) 
     87      IF( lk_traldf_eiv )   CALL tra_adv_eiv( kt, zun, zvn, zwn )  
     88 
    8789 
    8890      SELECT CASE ( nadv )                           ! compute advection trend and add it to general trend 
    89       CASE ( 0 )   ;   CALL tra_adv_cen2    ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! 2nd order centered 
    90                        CALL tra_adv_cen2    ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! 2nd order centered 
    91 !     CASE ( 1 )   ;   CALL tra_adv_cen2_jki( kt, zun, zvn, zwn )    ! 2nd order centered scheme 
     91      ! 
     92      CASE ( 1 )   ;   CALL tra_adv_cen2    ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! 2nd order centered 
     93                       CALL tra_adv_cen2    ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! on T & S 
     94      ! 
    9295      CASE ( 2 )   ;   CALL tra_adv_tvd     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! TVD      scheme 
    93                        CALL tra_adv_tvd     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! TVD      scheme 
     96                       CALL tra_adv_tvd     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! on T & S 
     97      ! 
    9498      CASE ( 3 )   ;   CALL tra_adv_muscl   ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb    , ta )    ! MUSCL    scheme 
    95                        CALL tra_adv_muscl   ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb    , sa )    ! MUSCL    scheme 
     99                       CALL tra_adv_muscl   ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb    , sa )    ! on T & S 
     100      ! 
    96101      CASE ( 4 )   ;   CALL tra_adv_muscl2  ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! MUSCL2   scheme 
    97                        CALL tra_adv_muscl2  ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! MUSCL2   scheme 
     102                       CALL tra_adv_muscl2  ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! on T & S 
     103      ! 
    98104      CASE ( 5 )   ;   CALL tra_adv_ubs     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! UBS      scheme 
    99                        CALL tra_adv_ubs     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! UBS      scheme 
     105                       CALL tra_adv_ubs     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! on T & S 
     106      ! 
    100107      CASE ( 6 )   ;   CALL tra_adv_qck     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! QUICKEST scheme 
    101                        CALL tra_adv_qck     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! QUICKEST scheme 
     108                       CALL tra_adv_qck     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! on T & S 
    102109      ! 
    103       CASE (-1 )                                                     ! esopa: test all possibility with control print 
     110      CASE (-1 )                                     ! NEMO debug : test all the schemes at once 
    104111                       CALL tra_adv_cen2    ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! 2nd order centered 
    105                        CALL tra_adv_cen2    ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! 2nd order centered 
     112                       CALL tra_adv_cen2    ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )  
    106113                       CALL tra_adv_tvd     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! TVD      scheme 
    107                        CALL tra_adv_tvd     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! TVD      scheme 
     114                       CALL tra_adv_tvd     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )   
    108115                       CALL tra_adv_muscl   ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb    , ta )    ! MUSCL    scheme 
    109                        CALL tra_adv_muscl   ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb    , sa )    ! MUSCL    scheme 
     116                       CALL tra_adv_muscl   ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb    , sa )  
    110117                       CALL tra_adv_muscl2  ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! MUSCL2   scheme 
    111                        CALL tra_adv_muscl2  ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! MUSCL2   scheme 
     118                       CALL tra_adv_muscl2  ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa ) 
    112119                       CALL tra_adv_ubs     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! UBS      scheme 
    113                        CALL tra_adv_ubs     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! UBS      scheme 
     120                       CALL tra_adv_ubs     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa ) 
    114121                       CALL tra_adv_qck     ( kt, 'TRA', jp_tem, zun, zvn, zwn, tb, tn, ta )    ! QUICKEST scheme 
    115                        CALL tra_adv_qck     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa )    ! QUICKEST scheme 
     122                       CALL tra_adv_qck     ( kt, 'TRA', jp_sal, zun, zvn, zwn, sb, sn, sa ) 
    116123      END SELECT 
    117124      ! 
    … …  
    127134      !!---------------------------------------------------------------------- 
    128135      INTEGER ::   ioptio 
    129  
     136      !! 
    130137      NAMELIST/nam_traadv/ ln_traadv_cen2 , ln_traadv_tvd,    & 
    131138         &                 ln_traadv_muscl, ln_traadv_muscl2, & 
    … …  
    163170         &                CALL ctl_stop( 'cross-land advection only with 2nd order advection scheme' ) 
    164171 
    165       !                              ! Set nadv 
    166       IF( ln_traadv_cen2   )   nadv =  0 
    167 #if defined key_mpp_omp 
     172      !                               ! Set nadv 
    168173      IF( ln_traadv_cen2   )   nadv =  1 
    169 #endif 
    170174      IF( ln_traadv_tvd    )   nadv =  2 
    171175      IF( ln_traadv_muscl  )   nadv =  3 
    … …  
    175179      IF( lk_esopa         )   nadv = -1 
    176180 
    177       IF(lwp) THEN                   ! Print the choice 
     181      IF(lwp) THEN                    ! Print the choice 
    178182         WRITE(numout,*) 
    179          IF( nadv ==  0 )   WRITE(numout,*) '         2nd order scheme is used' 
    180          IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is usedi, k-j-i case' 
     183         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used' 
    181184         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used' 
    182185         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used' 
    … …  
    185188         IF( nadv ==  6 )   WRITE(numout,*) '         PPM       scheme is used' 
    186189         IF( nadv ==  7 )   WRITE(numout,*) '         QUICKEST  scheme is used' 
    187          IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme' 
     190         IF( nadv == -1 )   WRITE(numout,*) '         NEMO debug: test all advection scheme at once' 
    188191      ENDIF 
    189192      ! 
Note: See TracChangeset for help on using the changeset viewer.