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 5972 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90 – NEMO

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

Upgraded to head of trunk (r5936)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r5967 r5972  
    44   !! Ocean passive tracers:  advection trend  
    55   !!============================================================================== 
    6    !! History :  2.0  !  05-11  (G. Madec)  Original code 
    7    !!            3.0  !  10-06  (C. Ethe)   Adapted to passive tracers 
     6   !! History :  2.0  !  2005-11  (G. Madec)  Original code 
     7   !!            3.0  !  2010-06  (C. Ethe)   Adapted to passive tracers 
     8   !!            3.7  !  2014-05  (G. Madec, C. Ethe)  Add 2nd/4th order cases for CEN and FCT schemes  
    89   !!---------------------------------------------------------------------- 
    910#if defined key_top 
     
    1112   !!   'key_top'                                                TOP models 
    1213   !!---------------------------------------------------------------------- 
    13    !!   trc_adv      : compute ocean tracer advection trend 
    14    !!   trc_adv_ctl  : control the different options of advection scheme 
    15    !!---------------------------------------------------------------------- 
    16    USE oce_trc         ! ocean dynamics and active tracers 
    17    USE trc             ! ocean passive tracers variables 
    18    USE trcnam_trp      ! passive tracers transport namelist variables 
    19    USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine) 
    20    USE traadv_tvd      ! TVD      scheme           (tra_adv_tvd    routine) 
    21    USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine) 
    22    USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine) 
    23    USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine) 
    24    USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine) 
    25    USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine) 
    26    USE traadv_mle      ! ML eddy induced velocity  (tra_adv_mle    routine) 
    27    USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    28    USE prtctl_trc      ! Print control 
     14   !!   trc_adv       : compute ocean tracer advection trend 
     15   !!   trc_adv_ini   : control the different options of advection scheme 
     16   !!---------------------------------------------------------------------- 
     17   USE oce_trc        ! ocean dynamics and active tracers 
     18   USE trc            ! ocean passive tracers variables 
     19   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine) 
     20   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine) 
     21   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine) 
     22   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine) 
     23   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine) 
     24   USE traadv_mle     ! ML eddy induced velocity  (tra_adv_mle  routine) 
     25   USE ldftra         ! lateral diffusion coefficient on tracers 
     26   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
     27   ! 
     28   USE prtctl_trc     ! Print control 
    2929 
    3030   IMPLICIT NONE 
    3131   PRIVATE 
    3232 
    33    PUBLIC   trc_adv          ! routine called by step module 
    34    PUBLIC   trc_adv_alloc    ! routine called by nemogcm module 
    35  
    36    INTEGER ::   nadv   ! choice of the type of advection scheme 
     33   PUBLIC   trc_adv        
     34   PUBLIC   trc_adv_alloc  
     35   PUBLIC   trc_adv_ini   
     36 
     37   !                            !!* Namelist namtrc_adv * 
     38   LOGICAL ::   ln_trcadv_cen    ! centered scheme flag 
     39   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme 
     40   LOGICAL ::   ln_trcadv_fct    ! FCT scheme flag 
     41   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme 
     42   INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping 
     43   LOGICAL ::   ln_trcadv_mus    ! MUSCL scheme flag 
     44   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths 
     45   LOGICAL ::   ln_trcadv_ubs    ! UBS scheme flag 
     46   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme 
     47   LOGICAL ::   ln_trcadv_qck    ! QUICKEST scheme flag 
     48 
     49   !                                        ! choices of advection scheme: 
     50   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection 
     51   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme 
     52   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme 
     53   INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping 
     54   INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme 
     55   INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme 
     56   INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme 
     57 
     58   INTEGER ::              nadv             ! chosen advection scheme 
     59   ! 
    3760   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    3861   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0 
     
    4265#  include "vectopt_loop_substitute.h90" 
    4366   !!---------------------------------------------------------------------- 
    44    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     67   !! NEMO/TOP 3.7 , NEMO Consortium (2015) 
    4568   !! $Id$ 
    4669   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    5275      !!                  ***  ROUTINE trc_adv_alloc  *** 
    5376      !!---------------------------------------------------------------------- 
    54  
     77      ! 
    5578      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc ) 
    56  
     79      ! 
    5780      IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 
    58  
     81      ! 
    5982   END FUNCTION trc_adv_alloc 
    6083 
     
    6891      !! ** Method  : - Update the tracer with the advection term following nadv 
    6992      !!---------------------------------------------------------------------- 
    70       !! 
    7193      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7294      ! 
    73       INTEGER ::   jk  
     95      INTEGER ::   jk   ! dummy loop index 
    7496      CHARACTER (len=22) ::   charout 
    7597      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity 
    7698      !!---------------------------------------------------------------------- 
    7799      ! 
    78       IF( nn_timing == 1 )  CALL timing_start('trc_adv') 
    79       ! 
    80       CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 
    81       ! 
    82  
    83       IF( kt == nittrc000 )   CALL trc_adv_ctl          ! initialisation & control of options 
    84  
     100      IF( nn_timing == 1 )   CALL timing_start('trc_adv') 
     101      ! 
     102      CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
     103      ! 
    85104      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    86105         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping) 
     
    88107         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    89108      ENDIF 
    90       !                                                   ! effective transport 
     109      !                                               !==  effective transport  ==! 
    91110      DO jk = 1, jpkm1 
    92          !                                                ! eulerian transport only 
    93          zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     111         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    94112         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    95113         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    96          ! 
    97114      END DO 
    98115      ! 
    99       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
     116      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
    100117         zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
    101118         zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
    102119      ENDIF 
    103120      ! 
    104       zun(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    105       zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    106       zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    107  
    108       IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary) 
    109          &              CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 
    110       ! 
    111       IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )    ! add the mle transport (if necessary) 
    112       ! 
    113       SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    114       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
    115       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD  
    116       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups )   !  MUSCL  
    117       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2  
    118       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS  
    119       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST  
    120       ! 
    121       CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    122          CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )           
    123          WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout) 
    124                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    125          CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    126          WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout) 
    127                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    128          CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups  )           
    129          WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout) 
    130                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    131          CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    132          WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout) 
    133                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    134          CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    135          WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout) 
    136                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    137          CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    138          WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout) 
    139                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    140          ! 
     121      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &  
     122         &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport 
     123      ! 
     124      IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
     125      ! 
     126      zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom 
     127      zvn(:,:,jpk) = 0._wp 
     128      zwn(:,:,jpk) = 0._wp 
     129      ! 
     130      ! 
     131      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 
     132      ! 
     133      CASE ( np_CEN )                                    ! Centered : 2nd / 4th order 
     134         CALL tra_adv_cen    ( kt, nittrc000,'TRC',       zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v ) 
     135      CASE ( np_FCT )                                    ! FCT      : 2nd / 4th order 
     136         CALL tra_adv_fct    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
     137      CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting 
     138         CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra        , nn_fct_zts ) 
     139      CASE ( np_MUS )                                    ! MUSCL 
     140         CALL tra_adv_mus    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
     141      CASE ( np_UBS )                                    ! UBS 
     142         CALL tra_adv_ubs    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra        , nn_ubs_v   ) 
     143      CASE ( np_QCK )                                    ! QUICKEST 
     144         CALL tra_adv_qck    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
     145      ! 
    141146      END SELECT 
    142  
    143       !                                              ! print mean trends (used for debugging) 
    144       IF( ln_ctl )   THEN 
     147      !                   
     148      IF( ln_ctl )   THEN                             !== print mean trends (used for debugging) 
    145149         WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout) 
    146150                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    147151      END IF 
    148152      ! 
    149       CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn ) 
     153      CALL wrk_dealloc( jpi,jpj,jpk,  zun, zvn, zwn ) 
    150154      ! 
    151155      IF( nn_timing == 1 )  CALL timing_stop('trc_adv') 
     
    154158 
    155159 
    156    SUBROUTINE trc_adv_ctl 
     160   SUBROUTINE trc_adv_ini 
    157161      !!--------------------------------------------------------------------- 
    158       !!                  ***  ROUTINE trc_adv_ctl  *** 
     162      !!                  ***  ROUTINE trc_adv_ini  *** 
    159163      !!                 
    160164      !! ** Purpose : Control the consistency between namelist options for  
     
    162166      !!---------------------------------------------------------------------- 
    163167      INTEGER ::   ioptio 
    164       !!---------------------------------------------------------------------- 
    165  
    166       ioptio = 0                      ! Parameter control 
    167       IF( ln_trcadv_cen2   )   ioptio = ioptio + 1 
    168       IF( ln_trcadv_tvd    )   ioptio = ioptio + 1 
    169       IF( ln_trcadv_muscl  )   ioptio = ioptio + 1 
    170       IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1 
    171       IF( ln_trcadv_ubs    )   ioptio = ioptio + 1 
    172       IF( ln_trcadv_qck    )   ioptio = ioptio + 1 
    173       IF( lk_esopa         )   ioptio =          1 
    174  
     168      INTEGER ::  ios                 ! Local integer output status for namelist read 
     169      !! 
     170      NAMELIST/namtrc_adv/ ln_trcadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN 
     171         &                 ln_trcadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT 
     172         &                 ln_trcadv_mus,                     ln_mus_ups,   &   ! MUSCL 
     173         &                 ln_trcadv_ubs,           nn_ubs_v,               &   ! UBS 
     174         &                 ln_trcadv_qck                                        ! QCK 
     175      !!---------------------------------------------------------------------- 
     176      ! 
     177      REWIND( numnat_ref )              !  namtrc_adv in reference namelist  
     178      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 
     179901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 
     180 
     181      REWIND( numnat_cfg )              ! namtrc_adv in configuration namelist 
     182      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 
     183902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 
     184      IF(lwm) WRITE ( numont, namtrc_adv ) 
     185 
     186      IF(lwp) THEN                    ! Namelist print 
     187         WRITE(numout,*) 
     188         WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme' 
     189         WRITE(numout,*) '~~~~~~~~~~~' 
     190         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers' 
     191         WRITE(numout,*) '      centered scheme                           ln_trcadv_cen = ', ln_trcadv_cen 
     192         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h 
     193         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v 
     194         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_trcadv_fct = ', ln_trcadv_fct 
     195         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h 
     196         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v 
     197         WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts 
     198         WRITE(numout,*) '      MUSCL scheme                              ln_trcadv_mus = ', ln_trcadv_mus 
     199         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups 
     200         WRITE(numout,*) '      UBS scheme                                ln_trcadv_ubs = ', ln_trcadv_ubs 
     201         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v 
     202         WRITE(numout,*) '      QUICKEST scheme                           ln_trcadv_qck = ', ln_trcadv_qck 
     203      ENDIF 
     204      ! 
     205 
     206      ioptio = 0                       !==  Parameter control  ==! 
     207      IF( ln_trcadv_cen )   ioptio = ioptio + 1 
     208      IF( ln_trcadv_fct )   ioptio = ioptio + 1 
     209      IF( ln_trcadv_mus )   ioptio = ioptio + 1 
     210      IF( ln_trcadv_ubs )   ioptio = ioptio + 1 
     211      IF( ln_trcadv_qck )   ioptio = ioptio + 1 
     212 
     213      ! 
     214      IF( ioptio == 0 ) THEN 
     215         nadv = np_NO_adv 
     216         CALL ctl_warn( 'trc_adv_init: You are running without tracer advection.' ) 
     217      ENDIF 
    175218      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' ) 
    176  
    177       !                              ! Set nadv 
    178       IF( ln_trcadv_cen2   )   nadv =  1 
    179       IF( ln_trcadv_tvd    )   nadv =  2 
    180       IF( ln_trcadv_muscl  )   nadv =  3 
    181       IF( ln_trcadv_muscl2 )   nadv =  4 
    182       IF( ln_trcadv_ubs    )   nadv =  5 
    183       IF( ln_trcadv_qck    )   nadv =  6 
    184       IF( lk_esopa         )   nadv = -1 
    185  
     219      ! 
     220      IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   & 
     221                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN 
     222        CALL ctl_stop( 'trc_adv_init: CEN scheme, choose 2nd or 4th order' ) 
     223      ENDIF 
     224      IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   & 
     225                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN 
     226        CALL ctl_stop( 'trc_adv_init: FCT scheme, choose 2nd or 4th order' ) 
     227      ENDIF 
     228      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) THEN 
     229         IF( nn_fct_h == 4 ) THEN 
     230            nn_fct_h = 2 
     231            CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 
     232         ENDIF 
     233         IF( lk_vvl ) THEN 
     234            CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 
     235         ENDIF 
     236         IF( nn_fct_zts == 1 )   CALL ctl_warn( 'trc_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' ) 
     237      ENDIF 
     238      IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN 
     239        CALL ctl_stop( 'trc_adv_init: UBS scheme, choose 2nd or 4th order' ) 
     240      ENDIF 
     241      IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN 
     242         CALL ctl_warn( 'trc_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' ) 
     243      ENDIF 
     244      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities 
     245         IF(  ln_trcadv_cen .AND. nn_cen_v /= 4    .OR.   &                            ! NO 4th order with ISF 
     246            & ln_trcadv_fct .AND. nn_fct_v /= 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' ) 
     247      ENDIF 
     248      ! 
     249      !                                !==  used advection scheme  ==! 
     250      !                                      ! set nadv 
     251      IF( ln_trcadv_cen                      )   nadv = np_CEN 
     252      IF( ln_trcadv_fct                      )   nadv = np_FCT 
     253      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts 
     254      IF( ln_trcadv_mus                      )   nadv = np_MUS 
     255      IF( ln_trcadv_ubs                      )   nadv = np_UBS 
     256      IF( ln_trcadv_qck                      )   nadv = np_QCK 
     257      ! 
    186258      IF(lwp) THEN                   ! Print the choice 
    187259         WRITE(numout,*) 
    188          IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used' 
    189          IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used' 
    190          IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used' 
    191          IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used' 
    192          IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used' 
    193          IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used' 
    194          IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme' 
    195       ENDIF 
    196       ! 
    197    END SUBROUTINE trc_adv_ctl 
     260         IF( nadv == np_NO_adv  )   WRITE(numout,*) '         NO passive tracer advection' 
     261         IF( nadv == np_CEN     )   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
     262            &                                                                        ' Vertical   order: ', nn_cen_v 
     263         IF( nadv == np_FCT     )   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
     264            &                                                                       ' Vertical   order: ', nn_fct_v 
     265         IF( nadv == np_FCT_zts )   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
     266         IF( nadv == np_MUS     )   WRITE(numout,*) '         MUSCL    scheme is used' 
     267         IF( nadv == np_UBS     )   WRITE(numout,*) '         UBS      scheme is used' 
     268         IF( nadv == np_QCK     )   WRITE(numout,*) '         QUICKEST scheme is used' 
     269      ENDIF 
     270      ! 
     271   END SUBROUTINE trc_adv_ini 
    198272    
    199273#else 
Note: See TracChangeset for help on using the changeset viewer.