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 @ 3

Last change on this file since 3 was 3, checked in by opalod, 20 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.8 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 , LODYC-IPSL   (2003)
25   !!----------------------------------------------------------------------
26
27CONTAINS
28
29   SUBROUTINE tra_nxt( kt )
30      !!----------------------------------------------------------------------
31      !!                   ***  ROUTINE tranxt  ***
32      !!
33      !! ** Purpose :   Compute the temperature and salinity fields at the
34      !!      next time-step from their temporal trends and swap the fields.
35      !!
36      !! ** Method  :   Apply lateral boundary conditions on (ua,va) through
37      !!      call to lbc_lnk routine
38      !!      After t and s are compute using a leap-frog scheme environment:
39      !!         ta = tb + 2 rdttra(k) * ta
40      !!         sa = sb + 2 rdttra(k) * sa
41      !!      Compute and save in (ta,sa) an average over three time levels
42      !!      (before,now and after) of temperature and salinity which is
43      !!      used to compute rhd in eos routine and thus the hydrostatic
44      !!      pressure gradient (ln_dynhpg_imp = T)
45      !!      Apply an Asselin time filter on now tracers (tn,sn) to avoid
46      !!      the divergence of two consecutive time-steps and swap tracer
47      !!      arrays to prepare the next time_step:
48      !!         (zt,zs) = (ta+2tn+tb,sa+2sn+sb)/4       (ln_dynhpg_imp = T)
49      !!         (zt,zs) = (0,0)                            (default option)
50      !!         (tb,sb) = (tn,vn) + atfp [ (tb,sb) + (ta,sa) - 2 (tn,sn) ]
51      !!         (tn,sn) = (ta,sa)
52      !!         (ta,sa) = (zt,zs)  (NB: reset to 0 after use in eos.F)
53      !!
54      !! ** Action  : - update (tb,sb) and (tn,sn)
55      !!              - (ta,sa) time averaged (t,s)      (ln_dynhpg_imp = T)
56      !!
57      !! History :
58      !!   7.0  !  91-11  (G. Madec)  Original code
59      !!        !  93-03  (M. Guyon)  symetrical conditions
60      !!        !  96-02  (G. Madec & M. Imbard)  opa release 8.0
61      !!   8.0  !  96-04  (A. Weaver)  Euler forward step
62      !!   8.2  !  99-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
63      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
64      !!        !  02-11  (C. Talandier, A-M Treguier) Open boundaries
65      !!----------------------------------------------------------------------
66      !! * Arguments
67      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
68
69      !! * Local declarations
70      INTEGER ::   ji, jj, jk   ! dummy loop indices
71      REAL(wp) ::   zt, zs      ! temporary scalars
72      REAL(wp) ::   zfact       ! temporary scalar
73      !!----------------------------------------------------------------------
74
75
76      ! 0. Lateral boundary conditions on ( ta, sa )   (T-point, unchanged sign)
77      ! ---------------------------------============
78      CALL lbc_lnk( ta, 'T', 1. )   
79      CALL lbc_lnk( sa, 'T', 1. )
80
81
82      !                                                ! ===============
83      DO jk = 1, jpkm1                                 ! Horizontal slab
84         !                                             ! ===============
85
86         ! 1. Leap-frog scheme (only in explicit case, otherwise the
87         ! -------------------  time stepping is already done in trazdf)
88         IF( l_trazdf_exp ) THEN
89            zfact = 2. * rdttra(jk)
90            IF( neuler == 0 .AND. kt == nit000 ) zfact = rdttra(jk)
91            ta(:,:,jk) = ( tb(:,:,jk) + zfact * ta(:,:,jk) ) * tmask(:,:,jk)
92            sa(:,:,jk) = ( sb(:,:,jk) + zfact * sa(:,:,jk) ) * tmask(:,:,jk)
93         ENDIF
94
95#if defined key_obc
96         !                                             ! ===============
97      END DO                                           !   End of slab
98      !                                                ! ===============
99
100      ! Update tracers on open boundaries.
101      CALL obc_tra( kt )
102
103      !                                                ! ===============
104      DO jk = 1, jpkm1                                 ! Horizontal slab
105         !                                             ! ===============
106#endif
107
108
109         ! 2. Time filter and swap of arrays
110         ! ---------------------------------
111
112         IF( ln_dynhpg_imp ) THEN                       ! semi-implicite hpg
113            IF( neuler == 0 .AND. kt == nit000 ) THEN
114               DO jj = 1, jpj
115                  DO ji = 1, jpi
116                     zt = ( ta(ji,jj,jk) + 2. * tn(ji,jj,jk) + tb(ji,jj,jk) ) * 0.25
117                     zs = ( sa(ji,jj,jk) + 2. * sn(ji,jj,jk) + sb(ji,jj,jk) ) * 0.25
118                     tb(ji,jj,jk) = tn(ji,jj,jk)
119                     sb(ji,jj,jk) = sn(ji,jj,jk)
120                     tn(ji,jj,jk) = ta(ji,jj,jk)
121                     sn(ji,jj,jk) = sa(ji,jj,jk)
122                     ta(ji,jj,jk) = zt
123                     sa(ji,jj,jk) = zs
124                  END DO
125               END DO
126            ELSE
127               DO jj = 1, jpj
128                  DO ji = 1, jpi
129                     zt = ( ta(ji,jj,jk) + 2. * tn(ji,jj,jk) + tb(ji,jj,jk) ) * 0.25
130                     zs = ( sa(ji,jj,jk) + 2. * sn(ji,jj,jk) + sb(ji,jj,jk) ) * 0.25
131                     tb(ji,jj,jk) = atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk)
132                     sb(ji,jj,jk) = atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk)
133                     tn(ji,jj,jk) = ta(ji,jj,jk)
134                     sn(ji,jj,jk) = sa(ji,jj,jk)
135                     ta(ji,jj,jk) = zt
136                     sa(ji,jj,jk) = zs
137                  END DO
138               END DO
139            ENDIF
140         ELSE                                          ! Default case
141            IF( neuler == 0 .AND. kt == nit000 ) THEN
142               DO jj = 1, jpj
143                  DO ji = 1, jpi
144                     tb(ji,jj,jk) = tn(ji,jj,jk)
145                     sb(ji,jj,jk) = sn(ji,jj,jk)
146                     tn(ji,jj,jk) = ta(ji,jj,jk)
147                     sn(ji,jj,jk) = sa(ji,jj,jk)
148                  END DO
149               END DO
150            ELSE
151               DO jj = 1, jpj
152                  DO ji = 1, jpi
153                     tb(ji,jj,jk) = atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk)
154                     sb(ji,jj,jk) = atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk)
155                     tn(ji,jj,jk) = ta(ji,jj,jk)
156                     sn(ji,jj,jk) = sa(ji,jj,jk)
157                  END DO
158               END DO
159            ENDIF
160         ENDIF
161         !                                             ! ===============
162      END DO                                           !   End of slab
163      !                                                ! ===============
164
165      IF( l_ctl .AND. lwp ) THEN         ! print mean field (used for debugging)
166         WRITE(numout,*) ' nxt  - Tn: ', SUM(tn*tmask), ' Sn: ', SUM(sn*tmask)
167      ENDIF
168
169   END SUBROUTINE tra_nxt
170
171   !!======================================================================
172END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.