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.
trcnxt.F90 in trunk/NEMO/TOP_SRC/TRP – NEMO

source: trunk/NEMO/TOP_SRC/TRP/trcnxt.F90 @ 941

Last change on this file since 941 was 941, checked in by cetlod, 16 years ago

phasing the passive tracer transport module to the new version of NEMO, see ticket 143

  • Property svn:executable set to *
File size: 7.4 KB
Line 
1MODULE trcnxt
2   !!======================================================================
3   !!                       ***  MODULE  trcnxt  ***
4   !! Ocean passive tracers:  time stepping on passives tracers
5   !!======================================================================
6#if defined key_top
7   !!----------------------------------------------------------------------
8   !!   'key_top'                                                TOP models
9   !!----------------------------------------------------------------------
10   !!   trc_nxt     : time stepping on passive tracers
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE oce_trc         ! ocean dynamics and tracers variables
14   USE trc             ! ocean passive tracers variables
15   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
16   USE trctrp_lec      ! pasive tracers transport
17   USE prtctl_trc      ! Print control for debbuging
18   USE agrif_top_update
19   USE agrif_top_interp
20
21   IMPLICIT NONE
22   PRIVATE
23
24   !! * Routine accessibility
25   PUBLIC trc_nxt          ! routine called by step.F90
26   !!----------------------------------------------------------------------
27   !!   TOP 1.0 , LOCEAN-IPSL (2005)
28   !! $Header$
29   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
30   !!----------------------------------------------------------------------
31
32CONTAINS
33
34   SUBROUTINE trc_nxt( kt )
35      !!----------------------------------------------------------------------
36      !!                   ***  ROUTINE trcnxt  ***
37      !!
38      !! ** Purpose :   Compute the passive tracers fields at the
39      !!      next time-step from their temporal trends and swap the fields.
40      !!
41      !! ** Method  :   Apply lateral boundary conditions on (ua,va) through
42      !!      call to lbc_lnk routine
43      !!   default:
44      !!      arrays swap
45      !!         (trn) = (tra) ; (tra) = (0,0)
46      !!         (trb) = (trn)
47      !!
48      !!   For Arakawa or TVD Scheme :
49      !!      A Asselin time filter applied on now tracers (trn) to avoid
50      !!      the divergence of two consecutive time-steps and tr arrays
51      !!      to prepare the next time_step:
52      !!         (trb) = (trn) + atfp [ (trb) + (tra) - 2 (trn) ]
53      !!         (trn) = (tra) ; (tra) = (0,0)
54      !!
55      !!
56      !! ** Action  : - update trb, trn
57      !!
58      !! History :
59      !!   7.0  !  91-11  (G. Madec)  Original code
60      !!        !  93-03  (M. Guyon)  symetrical conditions
61      !!        !  95-02  (M. Levy)   passive tracers
62      !!        !  96-02  (G. Madec & M. Imbard)  opa release 8.0
63      !!   8.0  !  96-04  (A. Weaver)  Euler forward step
64      !!   8.2  !  99-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
65      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
66      !!        !  02-11  (C. Talandier, A-M Treguier) Open boundaries
67      !!   9.0  !  04-03  (C. Ethe) passive tracers
68      !!----------------------------------------------------------------------
69      !! * Arguments
70      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
71      !! * Local declarations
72      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
73      REAL(wp) ::   zfact            ! temporary scalar
74      CHARACTER (len=22) :: charout
75      !!----------------------------------------------------------------------
76
77      IF( kt == nittrc000 .AND. lwp ) THEN
78         WRITE(numout,*)
79         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers'
80      ENDIF
81
82
83      DO jn = 1, jptra
84
85         ! 0. Lateral boundary conditions on tra (T-point, unchanged sign)
86         ! ---------------------------------============
87         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )   
88         
89         !                                                ! ===============
90         DO jk = 1, jpk                                   ! Horizontal slab
91            !                                             ! ===============
92            ! 1. Leap-frog scheme (only in explicit case, otherwise the
93            ! -------------------  time stepping is already done in trczdf)
94            IF( l_trczdf_exp .AND. ( ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN
95               zfact = 2. * rdttra(jk) * FLOAT(ndttrc) 
96               IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * FLOAT(ndttrc) 
97               tra(:,:,jk,jn) = ( trb(:,:,jk,jn) + zfact * tra(:,:,jk,jn) ) * tmask(:,:,jk)
98            ENDIF
99
100         END DO
101
102#if defined key_obc
103        CALL ctl_stop( '          Passive tracers and Open Boundary condition can not be used together ' &
104           &           '          Check in trc_nxt routine' )
105#endif
106
107#if defined key_agrif
108         !                                             ! ===============
109      END DO                                           !   End of slab
110      !                                                ! ===============
111      ! Update tracers
112      CALL Agrif_trc( kt )
113      !                                                ! ===============
114      DO jn = 1, jptra                                 ! Horizontal slab
115         !                                             ! ===============
116#endif
117
118         DO jk = 1, jpk 
119
120            ! 2. Time filter and swap of arrays
121            ! ---------------------------------
122            IF ( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN
123
124               IF( neuler == 0 .AND. kt == nittrc000 ) THEN
125                  DO jj = 1, jpj
126                     DO ji = 1, jpi
127                        trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
128                        trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
129                        tra(ji,jj,jk,jn) = 0.
130                     END DO
131                  END DO
132               ELSE
133                  DO jj = 1, jpj
134                     DO ji = 1, jpi
135                        trb(ji,jj,jk,jn) = atfp  * ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) + atfp1 * trn(ji,jj,jk,jn)
136                        trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
137                        tra(ji,jj,jk,jn) = 0.
138                     END DO
139                  END DO
140               ENDIF
141
142            ELSE
143!  case of smolar scheme or muscl
144               DO jj = 1, jpj
145                  DO ji = 1, jpi
146                     trb(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
147                     trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
148                     tra(ji,jj,jk,jn) = 0.
149                  END DO
150               END DO
151
152            ENDIF
153            !                                             ! ===============
154         END DO                                           !   End of slab
155         !                                                ! ===============
156      END DO
157
158      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
159         WRITE(charout, FMT="('nxt')")
160         CALL prt_ctl_trc_info(charout)
161         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
162      ENDIF
163
164#if defined key_agrif
165      IF (.NOT.Agrif_Root())    CALL Agrif_Update_Trc( kt )
166#endif     
167
168
169   END SUBROUTINE trc_nxt
170
171#else
172   !!----------------------------------------------------------------------
173   !!   Default option                                         Empty module
174   !!----------------------------------------------------------------------
175CONTAINS
176   SUBROUTINE trc_nxt( kt ) 
177      INTEGER, INTENT(in) :: kt
178      WRITE(*,*) 'trc_nxt: You should not have seen this print! error?', kt
179   END SUBROUTINE trc_nxt
180#endif
181   !!======================================================================
182END MODULE trcnxt
Note: See TracBrowser for help on using the repository browser.