source: NEMO/branches/2018/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_crs.F90 @ 10104

Last change on this file since 10104 was 10104, checked in by cbricaud, 3 years ago

clean trcadv_crs.F90 and add ubs scheme for coarsenig

  • Property svn:executable set to *
File size: 8.3 KB
Line 
1MODULE trcadv_crs
2   !!==============================================================================
3   !!                       ***  MODULE  trcadv  ***
4   !! Ocean passive tracers:  advection trend
5   !!==============================================================================
6   !! History :  2.0  !  05-11  (G. Madec)  Original code
7   !!            3.0  !  10-06  (C. Ethe)   Adapted to passive tracers
8   !!----------------------------------------------------------------------
9#if defined key_top
10   !!----------------------------------------------------------------------
11   !!   'key_top'                                                TOP models
12   !!----------------------------------------------------------------------
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 oce_trc, ONLY: un,vn,wn
18   USE trc             ! ocean passive tracers variables
19   USE trcnam_trp      ! passive tracers transport namelist variables
20   USE traadv_tvd_crs  ! TVD      scheme           (tra_adv_tvd    routine)
21   USE traadv_ubs_crs  ! TVD      scheme           (tra_adv_tvd    routine)
22   USE ldftra_oce      ! lateral diffusion coefficient on tracers
23   USE prtctl_trc      ! Print control
24   USE crs , ONLY : e2e3u_msk , e1e3v_msk , e1e2w_msk,jpi_crs,jpj_crs
25   USE timing
26   USE iom, ONLY: iom_put,iom_swap
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   trc_adv_crs          ! routine called by step module
32   PUBLIC   trc_adv_alloc_crs   ! routine called by nemogcm module
33
34   INTEGER ::   nadv   ! choice of the type of advection scheme
35   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra
36   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0
37
38   !! * Substitutions
39#  include "domzgr_substitute.h90"
40#  include "vectopt_loop_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
43   !! $Id: trcadv.F90 3294 2012-01-28 16:44:18Z rblod $
44   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   INTEGER FUNCTION trc_adv_alloc_crs()
49      !!----------------------------------------------------------------------
50      !!                  ***  ROUTINE trc_adv_alloc  ***
51      !!----------------------------------------------------------------------
52
53      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc_crs )
54
55      IF( trc_adv_alloc_crs /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')
56
57   END FUNCTION trc_adv_alloc_crs
58
59
60   SUBROUTINE trc_adv_crs( kt )
61      !!----------------------------------------------------------------------
62      !!                  ***  ROUTINE trc_adv  ***
63      !!
64      !! ** Purpose :   compute the ocean tracer advection trend.
65      !!
66      !! ** Method  : - Update the tracer with the advection term following nadv
67      !!----------------------------------------------------------------------
68      !!
69      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
70      !
71      INTEGER ::   jk 
72      INTEGER ::   ji,jj
73      CHARACTER (len=22) ::   charout
74      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity
75      !!----------------------------------------------------------------------
76      !
77     
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_crs          ! initialisation & control of options
84
85#if ! defined key_pisces
86      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
87         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
88      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1
89         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
90      ENDIF
91#else
92      r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping)
93#endif
94
95      DO jk = 1, jpkm1
96         !                                                ! eulerian transport only
97         zun(:,:,jk) = e2e3u_msk(:,:,jk) * un(:,:,jk)
98         zvn(:,:,jk) = e1e3v_msk(:,:,jk) * vn(:,:,jk)
99         zwn(:,:,jk) = e1e2w_msk(:,:,jk) * wn(:,:,jk)
100         !
101      END DO
102
103      zwn(:,:,jpk) = 0.e0                                 ! no transport trough the bottom
104
105      !
106      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
107      CASE ( 2 )   ;    CALL tra_adv_tvd_crs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD
108      CASE ( 5 )   ;    CALL tra_adv_ubs_crs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS
109      !
110      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
111         CALL tra_adv_tvd_crs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )         
112         WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout)
113                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
114         !
115      END SELECT
116
117      !                                              ! print mean trends (used for debugging)
118      IF( ln_ctl )   THEN
119         WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout)
120                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
121      END IF
122      !
123      CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn )
124      !
125      IF( nn_timing == 1 )  CALL timing_stop('trc_adv')
126      !
127   END SUBROUTINE trc_adv_crs
128
129
130   SUBROUTINE trc_adv_ctl_crs
131      !!---------------------------------------------------------------------
132      !!                  ***  ROUTINE trc_adv_ctl  ***
133      !!               
134      !! ** Purpose : Control the consistency between namelist options for
135      !!              passive tracer advection schemes and set nadv
136      !!----------------------------------------------------------------------
137      INTEGER ::   ioptio
138      !!----------------------------------------------------------------------
139
140      ioptio = 0                      ! Parameter control
141      IF( ln_trcadv_cen2   )   ioptio = ioptio + 1
142      IF( ln_trcadv_tvd    )   ioptio = ioptio + 1
143      IF( ln_trcadv_muscl  )   ioptio = ioptio + 1
144      IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1
145      IF( ln_trcadv_ubs    )   ioptio = ioptio + 1
146      IF( ln_trcadv_qck    )   ioptio = ioptio + 1
147      IF( lk_esopa         )   ioptio =          1
148
149      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' )
150
151      !                              ! Set nadv
152      IF( ln_trcadv_cen2   )   nadv =  1
153      IF( ln_trcadv_tvd    )   nadv =  2
154      IF( ln_trcadv_muscl  )   nadv =  3
155      IF( ln_trcadv_muscl2 )   nadv =  4
156      IF( ln_trcadv_ubs    )   nadv =  5
157      IF( ln_trcadv_qck    )   nadv =  6
158      IF( lk_esopa         )   nadv = -1
159
160      IF(lwp) THEN                   ! Print the choice
161         WRITE(numout,*)
162         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used'
163         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used'
164         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used'
165         IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used'
166         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used'
167         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used'
168         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
169      ENDIF
170      !
171   END SUBROUTINE trc_adv_ctl_crs
172   
173#else
174   !!----------------------------------------------------------------------
175   !!   Default option                                         Empty module
176   !!----------------------------------------------------------------------
177CONTAINS
178   SUBROUTINE trc_adv_crs( kt )
179      INTEGER, INTENT(in) :: kt
180      WRITE(*,*) 'trc_adv: You should not have seen this print! error?', kt
181   END SUBROUTINE trc_adv_crs
182#endif
183
184  !!======================================================================
185END MODULE trcadv_crs
Note: See TracBrowser for help on using the repository browser.