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

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

Merge of active and passive tracer advection/diffusion modules, see ticket:693

File:
1 edited

Legend:

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

    r1601 r2024  
    44   !! Ocean active tracers:  advection trend  
    55   !!============================================================================== 
    6    !! History :  2.0  !  05-11  (G. Madec)  Original code 
     6   !! History :  2.0  !  2005-11  (G. Madec)  Original code 
     7   !!            3.0  !  2008-01  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
    78   !!---------------------------------------------------------------------- 
    89 
     
    1819   USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine) 
    1920   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine) 
    20    USE traadv_qck     !! QUICKEST scheme           (tra_adv_qck    routine) 
     21   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine) 
    2122   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine) 
    22    USE trabbl          ! tracers: bottom boundary layer 
    2323   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    2424   USE in_out_manager  ! I/O manager 
     
    2929   PRIVATE 
    3030 
    31    PUBLIC   tra_adv    ! routine called by step module 
     31   PUBLIC   tra_adv         ! routine called by step module 
     32   PUBLIC   tra_adv_init    ! routine called by opa module 
    3233  
    3334   !                                                   !!* Namelist namtra_adv * 
    34    LOGICAL, PUBLIC ::   ln_traadv_cen2   = .TRUE.       ! 2nd order centered scheme flag 
    35    LOGICAL, PUBLIC ::   ln_traadv_tvd    = .FALSE.      ! TVD scheme flag 
    36    LOGICAL, PUBLIC ::   ln_traadv_muscl  = .FALSE.      ! MUSCL scheme flag 
    37    LOGICAL, PUBLIC ::   ln_traadv_muscl2 = .FALSE.      ! MUSCL2 scheme flag 
    38    LOGICAL, PUBLIC ::   ln_traadv_ubs    = .FALSE.      ! UBS scheme flag 
    39    LOGICAL, PUBLIC ::   ln_traadv_qck    = .FALSE.      ! QUICKEST scheme flag 
     35   LOGICAL ::   ln_traadv_cen2   = .TRUE.       ! 2nd order centered scheme flag 
     36   LOGICAL ::   ln_traadv_tvd    = .FALSE.      ! TVD scheme flag 
     37   LOGICAL ::   ln_traadv_muscl  = .FALSE.      ! MUSCL scheme flag 
     38   LOGICAL ::   ln_traadv_muscl2 = .FALSE.      ! MUSCL2 scheme flag 
     39   LOGICAL ::   ln_traadv_ubs    = .FALSE.      ! UBS scheme flag 
     40   LOGICAL ::   ln_traadv_qck    = .FALSE.      ! QUICKEST scheme flag 
    4041 
    4142   INTEGER ::   nadv   ! choice of the type of advection scheme 
     
    6061      !! ** Method  : - Update (ua,va) with the advection term following nadv 
    6162      !!---------------------------------------------------------------------- 
    62 #if ( defined key_trabbl_adv || defined key_traldf_eiv ) 
    63       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn   ! effective velocity 
    64 #else 
    65       USE oce, ONLY :                       zun => un       ! the effective velocity is the 
    66       USE oce, ONLY :                       zvn => vn       ! Eulerian velocity 
    67       USE oce, ONLY :                       zwn => wn       !  
    68 #endif 
     63      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    6964      !! 
    70       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    71       !!---------------------------------------------------------------------- 
    72  
    73       IF( kt == nit000 )   CALL tra_adv_ctl          ! initialisation & control of options 
    74  
    75 #if defined key_trabbl_adv 
    76       zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:)          ! add the bbl velocity 
    77       zvn(:,:,:) = vn(:,:,:) - v_bbl(:,:,:) 
    78       zwn(:,:,:) = wn(:,:,:) + w_bbl(:,:,:) 
    79 #endif 
    80       IF( lk_traldf_eiv ) THEN                       ! commpute and add the eiv velocity 
    81          IF( .NOT. lk_trabbl_adv ) THEN  
    82             zun(:,:,:) = un(:,:,:) 
    83             zvn(:,:,:) = vn(:,:,:) 
    84             zwn(:,:,:) = wn(:,:,:) 
    85          ENDIF 
    86          CALL tra_adv_eiv( kt, zun, zvn, zwn )  
    87       ENDIF 
     65      INTEGER ::   jk   ! dummy loop index 
     66      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::  zun, zvn, zwn   ! effective transport 
     67      !!---------------------------------------------------------------------- 
     68 
     69      !                                                   ! effective transport 
     70      DO jk = 1, jpkm1 
     71         !                                                ! eulerian transport only 
     72         zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     73         zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     74         zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk) 
     75         ! 
     76      END DO 
     77      zwn(:,:,jpk) = 0.e0                                 ! no transport trough the bottom 
     78 
     79      !                                                   ! add the eiv transport (if necessary) 
     80      IF( lk_traldf_eiv )   CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' ) 
     81 
    8882 
    8983      SELECT CASE ( nadv )                           ! compute advection trend and add it to general trend 
    90       CASE ( 1 )   ;   CALL tra_adv_cen2    ( kt, zun, zvn, zwn )    ! 2nd order centered scheme 
    91       CASE ( 2 )   ;   CALL tra_adv_tvd     ( kt, zun, zvn, zwn )    ! TVD      scheme 
    92       CASE ( 3 )   ;   CALL tra_adv_muscl   ( kt, zun, zvn, zwn )    ! MUSCL    scheme 
    93       CASE ( 4 )   ;   CALL tra_adv_muscl2  ( kt, zun, zvn, zwn )    ! MUSCL2   scheme 
    94       CASE ( 5 )   ;   CALL tra_adv_ubs     ( kt, zun, zvn, zwn )    ! UBS      scheme 
    95       CASE ( 6 )   ;   CALL tra_adv_qck     ( kt, zun, zvn, zwn )    ! QUICKEST scheme 
     84      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt , 'TRA', zun, zvn, zwn, & 
     85                        &                    tsb, tsn  , tsa, jpts      )    !  2nd order centered scheme 
     86      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt , 'TRA', zun, zvn, zwn, & 
     87                        &                    tsb, tsn  , tsa, jpts      )    !  TVD scheme 
     88      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt , 'TRA', zun, zvn, zwn, & 
     89                        &                    tsb, tsa  , jpts           )    !  MUSCL scheme 
     90      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt , 'TRA', zun, zvn, zwn, & 
     91                        &                    tsb, tsn  , tsa, jpts      )    !  MUSCL2 scheme 
     92      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt , 'TRA', zun, zvn, zwn, & 
     93                        &                    tsb, tsn  , tsa, jpts      )    !  UBS scheme 
     94      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt , 'TRA', zun, zvn, zwn, & 
     95                        &                    tsb, tsn  , tsa, jpts      )    !  QUICKEST scheme 
    9696      ! 
    97       CASE (-1 )                                                     ! esopa: test all possibility with control print 
    98                        CALL tra_adv_cen2    ( kt, zun, zvn, zwn ) 
    99                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv0 - Ta: ', mask1=tmask,               & 
    100             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    101                        CALL tra_adv_tvd     ( kt, zun, zvn, zwn ) 
    102                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv2 - Ta: ', mask1=tmask,               & 
    103             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    104                        CALL tra_adv_muscl   ( kt, zun, zvn, zwn ) 
    105                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv3 - Ta: ', mask1=tmask,               & 
    106             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    107                        CALL tra_adv_muscl2  ( kt, zun, zvn, zwn ) 
    108                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv4 - Ta: ', mask1=tmask,               & 
    109             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    110                        CALL tra_adv_ubs     ( kt, zun, zvn, zwn ) 
    111                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv5 - Ta: ', mask1=tmask,               & 
    112             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    113                        CALL tra_adv_qck     ( kt, zun, zvn, zwn ) 
    114                        CALL prt_ctl( tab3d_1=ta, clinfo1=' adv6 - Ta: ', mask1=tmask,               & 
    115             &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     97      CASE (-1 )                                   ! esopa: test all possibility with control pr 
     98                        CALL tra_adv_cen2  ( kt , 'TRA', zun, zvn, zwn, & 
     99                        &                    tsb, tsn  , tsa, jpts      )           
     100                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask,               & 
     101         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     102                        CALL tra_adv_tvd   ( kt , 'TRA', zun, zvn, zwn, & 
     103                        &                    tsb, tsn  , tsa, jpts      )           
     104                        CALL tra_adv_tvd   ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     105                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask,               & 
     106         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     107                        CALL tra_adv_muscl ( kt , 'TRA', zun, zvn, zwn, & 
     108                        &                    tsb, tsa  , jpts           )           
     109                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask,               & 
     110         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     111                        CALL tra_adv_muscl2( kt , 'TRA', zun, zvn, zwn, & 
     112                        &                    tsb, tsn  , tsa, jpts      )           
     113                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask,               & 
     114         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     115                        CALL tra_adv_ubs   ( kt , 'TRA', zun, zvn, zwn, & 
     116                        &                    tsb, tsn  , tsa, jpts      )           
     117                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask,               & 
     118         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     119                        CALL tra_adv_qck   ( kt , 'TRA', zun, zvn, zwn, & 
     120                        &                    tsb, tsn  , tsa, jpts      )           
     121                        CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask,               & 
     122         &                            tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     123         ! 
    116124      END SELECT 
    117125        
     
    121129 
    122130      !                                              ! print mean trends (used for debugging) 
    123       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' adv  - Ta: ', mask1=tmask,               & 
    124          &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     131      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               & 
     132         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    125133      ! 
    126134   END SUBROUTINE tra_adv 
    127135 
    128136 
    129    SUBROUTINE tra_adv_ctl 
     137   SUBROUTINE tra_adv_init 
    130138      !!--------------------------------------------------------------------- 
    131       !!                  ***  ROUTINE tra_adv_ctl  *** 
     139      !!                  ***  ROUTINE tra_adv_init  *** 
    132140      !!                 
    133141      !! ** Purpose :   Control the consistency between namelist options for  
     
    146154      IF(lwp) THEN                    ! Namelist print 
    147155         WRITE(numout,*) 
    148          WRITE(numout,*) 'tra_adv_ctl : choice/control of the tracer advection scheme' 
     156         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme' 
    149157         WRITE(numout,*) '~~~~~~~~~~~' 
    150158         WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers' 
     
    188196         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used' 
    189197         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used' 
     198         IF( nadv ==  7 )   WRITE(numout,*) '         SMOLAR    scheme is used' 
    190199         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme' 
    191200      ENDIF 
    192201      ! 
    193    END SUBROUTINE tra_adv_ctl 
     202   END SUBROUTINE tra_adv_init 
    194203 
    195204  !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.