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 7158 for branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90 – NEMO

Ignore:
Timestamp:
2016-10-29T01:21:05+02:00 (8 years ago)
Author:
clem
Message:

debug branch

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r5385 r7158  
    3232 
    3333   PUBLIC   trc_adv          ! routine called by step module 
    34    PUBLIC   trc_adv_alloc    ! routine called by nemogcm module 
    3534 
    3635   INTEGER ::   nadv   ! choice of the type of advection scheme 
    37    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    38    !                                                    ! except at nitrrc000 (=rdttra) if neuler=0 
     36 
     37   REAL(wp) ::   r2dttrc  ! vertical profile time-step, = 2 rdt 
     38   !                                                    ! except at nitrrc000 (=rdt) if neuler=0 
    3939 
    4040   !! * Substitutions 
    … …  
    4747   !!---------------------------------------------------------------------- 
    4848CONTAINS 
    49  
    50    INTEGER FUNCTION trc_adv_alloc() 
    51       !!---------------------------------------------------------------------- 
    52       !!                  ***  ROUTINE trc_adv_alloc  *** 
    53       !!---------------------------------------------------------------------- 
    54  
    55       ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc ) 
    56  
    57       IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 
    58  
    59    END FUNCTION trc_adv_alloc 
    6049 
    6150 
    … …  
    8473 
    8574      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    86          r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping) 
     75         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping) 
    8776      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    88          r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
     77         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
    8978      ENDIF 
    9079      !                                                   ! effective transport 
    … …  
    112101      ! 
    113102      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  
     103      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',          zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
     104      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD  
     105      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups )   !  MUSCL  
     106      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2  
     107      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS  
     108      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST  
    120109      ! 
    121110      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    … …  
    123112         WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout) 
    124113                                           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 )           
     114         CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )           
    126115         WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout) 
    127116                                           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  )           
     117         CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups  )           
    129118         WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout) 
    130119                                           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 )           
     120         CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )           
    132121         WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout) 
    133122                                           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 )           
     123         CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )           
    135124         WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout) 
    136125                                           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 )           
     126         CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra )           
    138127         WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout) 
    139128                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
Note: See TracChangeset for help on using the changeset viewer.