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

Last change on this file since 531 was 503, checked in by opalod, 18 years ago

nemo_v1_update_064 : CT : general trends update including the addition of mean windows analysis possibility in the mixed layer
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.3 KB
Line 
1MODULE tranxt
2   !!======================================================================
3   !!                       ***  MODULE  tranxt  ***
4   !! Ocean active tracers:  time stepping on temperature and salinity
5   !!======================================================================
6   !! History :  7.0  !  91-11  (G. Madec)  Original code
7   !!                 !  93-03  (M. Guyon)  symetrical conditions
8   !!                 !  96-02  (G. Madec & M. Imbard)  opa release 8.0
9   !!            8.0  !  96-04  (A. Weaver)  Euler forward step
10   !!            8.2  !  99-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
11   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module
12   !!                 !  02-11  (C. Talandier, A-M Treguier) Open boundaries
13   !!                 !  05-04  (C. Deltel) Add Asselin trend in the ML budget
14   !!            9.0  !  06-02  (L. Debreu, C. Mazauric) Agrif implementation
15   !!----------------------------------------------------------------------
16
17   !!----------------------------------------------------------------------
18   !!   tra_nxt     : time stepping on temperature and salinity
19   !!----------------------------------------------------------------------
20   USE oce             ! ocean dynamics and tracers variables
21   USE dom_oce         ! ocean space and time domain variables
22   USE zdf_oce         ! ???
23   USE in_out_manager  ! I/O manager
24   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
25   USE obctra          ! open boundary condition (obc_tra routine)
26   USE trdmod          ! ocean active tracers trends
27   USE trdmod_oce      ! ocean variables trends
28   USE prtctl          ! Print control
29   USE agrif_opa_update
30   USE agrif_opa_interp
31
32   IMPLICIT NONE
33   PRIVATE
34
35   !! * Routine accessibility
36   PUBLIC   tra_nxt   ! routine called by step.F90
37   !!----------------------------------------------------------------------
38   !!   OPA 9.0 , LOCEAN-IPSL (2006)
39   !! $Header$
40   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42
43CONTAINS
44
45   SUBROUTINE tra_nxt( kt )
46      !!----------------------------------------------------------------------
47      !!                   ***  ROUTINE tranxt  ***
48      !!
49      !! ** Purpose :   Compute the temperature and salinity fields at the
50      !!      next time-step from their temporal trends and swap the fields.
51      !!
52      !! ** Method  :   Apply lateral boundary conditions on (ua,va) through
53      !!      call to lbc_lnk routine
54      !!      After t and s are compute using a leap-frog scheme environment:
55      !!         ta = tb + 2 rdttra(k) * ta
56      !!         sa = sb + 2 rdttra(k) * sa
57      !!      Compute and save in (ta,sa) an average over three time levels
58      !!      (before,now and after) of temperature and salinity which is
59      !!      used to compute rhd in eos routine and thus the hydrostatic
60      !!      pressure gradient (ln_dynhpg_imp = T)
61      !!      Apply an Asselin time filter on now tracers (tn,sn) to avoid
62      !!      the divergence of two consecutive time-steps and swap tracer
63      !!      arrays to prepare the next time_step:
64      !!         (zt,zs) = (ta+2tn+tb,sa+2sn+sb)/4       (ln_dynhpg_imp = T)
65      !!         (zt,zs) = (0,0)                            (default option)
66      !!         (tb,sb) = (tn,vn) + atfp [ (tb,sb) + (ta,sa) - 2 (tn,sn) ]
67      !!         (tn,sn) = (ta,sa)
68      !!         (ta,sa) = (zt,zs)  (NB: reset to 0 after use in eos.F)
69      !!
70      !! ** Action  : - update (tb,sb) and (tn,sn)
71      !!              - (ta,sa) time averaged (t,s)      (ln_dynhpg_imp = T)
72      !!----------------------------------------------------------------------
73      USE oce, ONLY :    ztrdt => ua   ! use ua as 3D workspace   
74      USE oce, ONLY :    ztrds => va   ! use va as 3D workspace   
75      !!
76      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
77      !!
78      INTEGER  ::   ji, jj, jk   ! dummy loop indices
79      REAL(wp) ::   zt, zs       ! temporary scalars
80      REAL(wp) ::   zfact        ! temporary scalar
81      !!----------------------------------------------------------------------
82
83      IF( l_trdtra ) THEN
84         ztrdt(:,:,jpk) = 0.e0
85         ztrds(:,:,jpk) = 0.e0
86      ENDIF
87      ! 0. Lateral boundary conditions on ( ta, sa )   (T-point, unchanged sign)
88      ! ---------------------------------============
89      CALL lbc_lnk( ta, 'T', 1. )   
90      CALL lbc_lnk( sa, 'T', 1. )
91
92      !                                                ! ===============
93      DO jk = 1, jpkm1                                 ! Horizontal slab
94         !                                             ! ===============
95
96         ! 1. Leap-frog scheme (only in explicit case, otherwise the
97         ! -------------------  time stepping is already done in trazdf)
98         IF( ln_zdfexp ) THEN
99            zfact = 2. * rdttra(jk)
100            IF( neuler == 0 .AND. kt == nit000 )   zfact = rdttra(jk)
101            ta(:,:,jk) = ( tb(:,:,jk) + zfact * ta(:,:,jk) ) * tmask(:,:,jk)
102            sa(:,:,jk) = ( sb(:,:,jk) + zfact * sa(:,:,jk) ) * tmask(:,:,jk)
103            IF(l_trdtra)   CALL ctl_stop( 'tranxt: Asselin ML trend not yet accounted for.' )
104         ENDIF
105
106#if defined key_obc
107         !                                             ! ===============
108      END DO                                           !   End of slab
109      !                                                ! ===============
110      ! Update tracers on open boundaries.
111      CALL obc_tra( kt )
112      !                                                ! ===============
113      DO jk = 1, jpkm1                                 ! Horizontal slab
114         !                                             ! ===============
115#endif
116#if defined key_agrif
117         !                                             ! ===============
118      END DO                                           !   End of slab
119      !                                                ! ===============
120      ! Update tracers on open boundaries.
121      CALL Agrif_tra( kt )
122      !                                                ! ===============
123      DO jk = 1, jpkm1                                 ! Horizontal slab
124         !                                             ! ===============
125#endif
126         ! 2. Time filter and swap of arrays
127         ! ---------------------------------
128
129         IF( ln_dynhpg_imp ) THEN                       ! semi-implicite hpg
130            IF( neuler == 0 .AND. kt == nit000 ) THEN
131               DO jj = 1, jpj
132                  DO ji = 1, jpi
133                     zt = ( ta(ji,jj,jk) + 2. * tn(ji,jj,jk) + tb(ji,jj,jk) ) * 0.25
134                     zs = ( sa(ji,jj,jk) + 2. * sn(ji,jj,jk) + sb(ji,jj,jk) ) * 0.25
135                     tb(ji,jj,jk) = tn(ji,jj,jk)
136                     sb(ji,jj,jk) = sn(ji,jj,jk)
137                     tn(ji,jj,jk) = ta(ji,jj,jk)
138                     sn(ji,jj,jk) = sa(ji,jj,jk)
139                     ta(ji,jj,jk) = zt
140                     sa(ji,jj,jk) = zs
141                  END DO
142               END DO
143               IF( l_trdtra ) THEN
144                  ztrdt(:,:,jk) = 0.e0
145                  ztrds(:,:,jk) = 0.e0
146               END IF
147            ELSE
148               DO jj = 1, jpj
149                  DO ji = 1, jpi
150                     zt = ( ta(ji,jj,jk) + 2. * tn(ji,jj,jk) + tb(ji,jj,jk) ) * 0.25
151                     zs = ( sa(ji,jj,jk) + 2. * sn(ji,jj,jk) + sb(ji,jj,jk) ) * 0.25
152                     tb(ji,jj,jk) = atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk)
153                     sb(ji,jj,jk) = atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk)
154                     IF( l_trdtra ) THEN ! ChD ceci est a optimiser, mais ca marche
155                        ztrdt(ji,jj,jk) = tb(ji,jj,jk) - tn(ji,jj,jk)
156                        ztrds(ji,jj,jk) = sb(ji,jj,jk) - sn(ji,jj,jk)
157                     END IF
158                     tn(ji,jj,jk) = ta(ji,jj,jk)
159                     sn(ji,jj,jk) = sa(ji,jj,jk)
160                     ta(ji,jj,jk) = zt
161                     sa(ji,jj,jk) = zs
162                  END DO
163               END DO
164            ENDIF
165         ELSE                                          ! Default case
166            IF( neuler == 0 .AND. kt == nit000 ) THEN
167               DO jj = 1, jpj
168                  DO ji = 1, jpi
169                     tb(ji,jj,jk) = tn(ji,jj,jk)
170                     sb(ji,jj,jk) = sn(ji,jj,jk)
171                     tn(ji,jj,jk) = ta(ji,jj,jk)
172                     sn(ji,jj,jk) = sa(ji,jj,jk)
173                  END DO
174               END DO
175               IF( l_trdtra ) THEN
176                  ztrdt(:,:,jk) = 0.e0
177                  ztrds(:,:,jk) = 0.e0
178               END IF
179            ELSE
180               IF( l_trdtra ) THEN
181                  DO jj = 1, jpj
182                     DO ji = 1, jpi
183                        ztrdt(ji,jj,jk) = atfp * ( tb(ji,jj,jk) - 2*tn(ji,jj,jk) + ta(ji,jj,jk) )
184                        ztrds(ji,jj,jk) = atfp * ( sb(ji,jj,jk) - 2*sn(ji,jj,jk) + sa(ji,jj,jk) )
185                     END DO
186                  END DO
187               END IF
188               DO jj = 1, jpj
189                  DO ji = 1, jpi
190                     tb(ji,jj,jk) = atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk)
191                     sb(ji,jj,jk) = atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk)
192                     tn(ji,jj,jk) = ta(ji,jj,jk)
193                     sn(ji,jj,jk) = sa(ji,jj,jk)
194                  END DO
195               END DO
196            ENDIF
197         ENDIF
198         !                                             ! ===============
199      END DO                                           !   End of slab
200      !                                                ! ===============
201
202      IF( l_trdtra )   THEN      ! Take the Asselin trend into account
203         ztrdt(:,:,:) = ztrdt(:,:,:) / ( 2.*rdt )
204         ztrds(:,:,:) = ztrds(:,:,:) / ( 2.*rdt )         
205         CALL trd_mod( ztrdt, ztrds, jptra_trd_atf, 'TRA', kt )
206      END IF
207
208      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tn, clinfo1=' nxt  - Tn: ', mask1=tmask,   &
209         &                       tab3d_2=sn, clinfo2=       ' Sn: ', mask2=tmask )
210#if defined key_agrif
211      IF (.NOT.Agrif_Root())    CALL Agrif_Update_Tra( kt )
212#endif     
213      !
214   END SUBROUTINE tra_nxt
215
216   !!======================================================================
217END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.