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.
tranxt.F90 in trunk/NEMO/OPA_SRC/TRA – NEMO

source: trunk/NEMO/OPA_SRC/TRA/tranxt.F90 @ 247

Last change on this file since 247 was 247, checked in by opalod, 19 years ago

CL : Add CVS Header and CeCILL licence information
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.0 KB
Line 
1MODULE tranxt
2   !!======================================================================
3   !!                       ***  MODULE  tranxt  ***
4   !! Ocean active tracers:  time stepping on temperature and salinity
5   !!======================================================================
6   
7   !!----------------------------------------------------------------------
8   !!   tra_nxt     : time stepping on temperature and salinity
9   !!----------------------------------------------------------------------
10   !! * Modules used
11   USE oce             ! ocean dynamics and tracers variables
12   USE dom_oce         ! ocean space and time domain variables
13   USE zdf_oce         ! ???
14   USE in_out_manager  ! I/O manager
15   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
16   USE obctra          ! open boundary condition (obc_tra routine)
17
18   IMPLICIT NONE
19   PRIVATE
20
21   !! * Routine accessibility
22   PUBLIC tra_nxt          ! routine called by step.F90
23   !!----------------------------------------------------------------------
24   !!   OPA 9.0 , LOCEAN-IPSL (2005)
25   !! $Header$
26   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
27   !!----------------------------------------------------------------------
28
29CONTAINS
30
31   SUBROUTINE tra_nxt( kt )
32      !!----------------------------------------------------------------------
33      !!                   ***  ROUTINE tranxt  ***
34      !!
35      !! ** Purpose :   Compute the temperature and salinity fields at the
36      !!      next time-step from their temporal trends and swap the fields.
37      !!
38      !! ** Method  :   Apply lateral boundary conditions on (ua,va) through
39      !!      call to lbc_lnk routine
40      !!      After t and s are compute using a leap-frog scheme environment:
41      !!         ta = tb + 2 rdttra(k) * ta
42      !!         sa = sb + 2 rdttra(k) * sa
43      !!      Compute and save in (ta,sa) an average over three time levels
44      !!      (before,now and after) of temperature and salinity which is
45      !!      used to compute rhd in eos routine and thus the hydrostatic
46      !!      pressure gradient (ln_dynhpg_imp = T)
47      !!      Apply an Asselin time filter on now tracers (tn,sn) to avoid
48      !!      the divergence of two consecutive time-steps and swap tracer
49      !!      arrays to prepare the next time_step:
50      !!         (zt,zs) = (ta+2tn+tb,sa+2sn+sb)/4       (ln_dynhpg_imp = T)
51      !!         (zt,zs) = (0,0)                            (default option)
52      !!         (tb,sb) = (tn,vn) + atfp [ (tb,sb) + (ta,sa) - 2 (tn,sn) ]
53      !!         (tn,sn) = (ta,sa)
54      !!         (ta,sa) = (zt,zs)  (NB: reset to 0 after use in eos.F)
55      !!
56      !! ** Action  : - update (tb,sb) and (tn,sn)
57      !!              - (ta,sa) time averaged (t,s)      (ln_dynhpg_imp = T)
58      !!
59      !! History :
60      !!   7.0  !  91-11  (G. Madec)  Original code
61      !!        !  93-03  (M. Guyon)  symetrical conditions
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      !!----------------------------------------------------------------------
68      !! * Arguments
69      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
70
71      !! * Local declarations
72      INTEGER ::   ji, jj, jk   ! dummy loop indices
73      REAL(wp) ::   zt, zs      ! temporary scalars
74      REAL(wp) ::   zfact       ! temporary scalar
75      !!----------------------------------------------------------------------
76
77
78      ! 0. Lateral boundary conditions on ( ta, sa )   (T-point, unchanged sign)
79      ! ---------------------------------============
80      CALL lbc_lnk( ta, 'T', 1. )   
81      CALL lbc_lnk( sa, 'T', 1. )
82
83
84      !                                                ! ===============
85      DO jk = 1, jpkm1                                 ! Horizontal slab
86         !                                             ! ===============
87
88         ! 1. Leap-frog scheme (only in explicit case, otherwise the
89         ! -------------------  time stepping is already done in trazdf)
90         IF( l_trazdf_exp ) THEN
91            zfact = 2. * rdttra(jk)
92            IF( neuler == 0 .AND. kt == nit000 ) zfact = rdttra(jk)
93            ta(:,:,jk) = ( tb(:,:,jk) + zfact * ta(:,:,jk) ) * tmask(:,:,jk)
94            sa(:,:,jk) = ( sb(:,:,jk) + zfact * sa(:,:,jk) ) * tmask(:,:,jk)
95         ENDIF
96
97#if defined key_obc
98         !                                             ! ===============
99      END DO                                           !   End of slab
100      !                                                ! ===============
101
102      ! Update tracers on open boundaries.
103      CALL obc_tra( kt )
104
105      !                                                ! ===============
106      DO jk = 1, jpkm1                                 ! Horizontal slab
107         !                                             ! ===============
108#endif
109
110
111         ! 2. Time filter and swap of arrays
112         ! ---------------------------------
113
114         IF( ln_dynhpg_imp ) THEN                       ! semi-implicite hpg
115            IF( neuler == 0 .AND. kt == nit000 ) THEN
116               DO jj = 1, jpj
117                  DO ji = 1, jpi
118                     zt = ( ta(ji,jj,jk) + 2. * tn(ji,jj,jk) + tb(ji,jj,jk) ) * 0.25
119                     zs = ( sa(ji,jj,jk) + 2. * sn(ji,jj,jk) + sb(ji,jj,jk) ) * 0.25
120                     tb(ji,jj,jk) = tn(ji,jj,jk)
121                     sb(ji,jj,jk) = sn(ji,jj,jk)
122                     tn(ji,jj,jk) = ta(ji,jj,jk)
123                     sn(ji,jj,jk) = sa(ji,jj,jk)
124                     ta(ji,jj,jk) = zt
125                     sa(ji,jj,jk) = zs
126                  END DO
127               END DO
128            ELSE
129               DO jj = 1, jpj
130                  DO ji = 1, jpi
131                     zt = ( ta(ji,jj,jk) + 2. * tn(ji,jj,jk) + tb(ji,jj,jk) ) * 0.25
132                     zs = ( sa(ji,jj,jk) + 2. * sn(ji,jj,jk) + sb(ji,jj,jk) ) * 0.25
133                     tb(ji,jj,jk) = atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk)
134                     sb(ji,jj,jk) = atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk)
135                     tn(ji,jj,jk) = ta(ji,jj,jk)
136                     sn(ji,jj,jk) = sa(ji,jj,jk)
137                     ta(ji,jj,jk) = zt
138                     sa(ji,jj,jk) = zs
139                  END DO
140               END DO
141            ENDIF
142         ELSE                                          ! Default case
143            IF( neuler == 0 .AND. kt == nit000 ) THEN
144               DO jj = 1, jpj
145                  DO ji = 1, jpi
146                     tb(ji,jj,jk) = tn(ji,jj,jk)
147                     sb(ji,jj,jk) = sn(ji,jj,jk)
148                     tn(ji,jj,jk) = ta(ji,jj,jk)
149                     sn(ji,jj,jk) = sa(ji,jj,jk)
150                  END DO
151               END DO
152            ELSE
153               DO jj = 1, jpj
154                  DO ji = 1, jpi
155                     tb(ji,jj,jk) = atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk)
156                     sb(ji,jj,jk) = atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk)
157                     tn(ji,jj,jk) = ta(ji,jj,jk)
158                     sn(ji,jj,jk) = sa(ji,jj,jk)
159                  END DO
160               END DO
161            ENDIF
162         ENDIF
163         !                                             ! ===============
164      END DO                                           !   End of slab
165      !                                                ! ===============
166
167      IF(l_ctl) THEN         ! print mean field (used for debugging)
168         WRITE(numout,*) ' nxt  - Tn: ', SUM(tn(2:nictl,2:njctl,1:jpkm1)*tmask(2:nictl,2:njctl,1:jpkm1)), &
169         &                      ' Sn: ', SUM(sn(2:nictl,2:njctl,1:jpkm1)*tmask(2:nictl,2:njctl,1:jpkm1)) 
170      ENDIF
171
172   END SUBROUTINE tra_nxt
173
174   !!======================================================================
175END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.