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

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90 @ 2528

Last change on this file since 2528 was 2528, checked in by rblod, 13 years ago

Update NEMOGCM from branch nemo_v3_3_beta

  • Property svn:keywords set to Id
File size: 9.6 KB
Line 
1MODULE tranpc
2   !!==============================================================================
3   !!                       ***  MODULE  tranpc  ***
4   !! Ocean active tracers:  non penetrative convection scheme
5   !!==============================================================================
6   !! History :  1.0  ! 1990-09  (G. Madec)  Original code
7   !!                 ! 1996-01  (G. Madec)  statement function for e3
8   !!   NEMO     1.0  ! 2002-06  (G. Madec)  free form F90
9   !!            3.0  ! 2008-06  (G. Madec)  applied on ta, sa and called before tranxt in step.F90
10   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   tra_npc : apply the non penetrative convection scheme
15   !!----------------------------------------------------------------------
16   USE oce             ! ocean dynamics and active tracers
17   USE dom_oce         ! ocean space and time domain
18   USE zdf_oce         ! ocean vertical physics
19   USE trdmod_oce      ! ocean active tracer trends
20   USE trdtra      ! ocean active tracer trends
21   USE eosbn2          ! equation of state (eos routine)
22   USE lbclnk          ! lateral boundary conditions (or mpp link)
23   USE in_out_manager  ! I/O manager
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   tra_npc    ! routine called by step.F90
29
30   !! * Substitutions
31#  include "domzgr_substitute.h90"
32   !!----------------------------------------------------------------------
33   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
34   !! $Id$
35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
36   !!----------------------------------------------------------------------
37CONTAINS
38
39   SUBROUTINE tra_npc( kt )
40      !!----------------------------------------------------------------------
41      !!                  ***  ROUTINE tranpc  ***
42      !!
43      !! ** Purpose :   Non penetrative convective adjustment scheme. solve
44      !!      the static instability of the water column on after fields
45      !!      while conserving heat and salt contents.
46      !!
47      !! ** Method  :   The algorithm used converges in a maximium of jpk
48      !!      iterations. instabilities are treated when the vertical density
49      !!      gradient is less than 1.e-5.
50      !!      l_trdtra=T: the trend associated with this algorithm is saved.
51      !!
52      !! ** Action  : - (ta,sa) after the application od the npc scheme
53      !!              - save the associated trends (ttrd,strd) ('key_trdtra')
54      !!
55      !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371.
56      !!----------------------------------------------------------------------
57      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
58      !!
59      INTEGER  ::   ji, jj, jk   ! dummy loop indices
60      INTEGER  ::   inpcc        ! number of statically instable water column
61      INTEGER  ::   inpci        ! number of iteration for npc scheme
62      INTEGER  ::   jiter, jkdown, jkp        ! ???
63      INTEGER  ::   ikbot, ik, ikup, ikdown   ! ???
64      REAL(wp) ::   ze3tot, zta, zsa, zraua, ze3dwn
65      REAL(wp), DIMENSION(jpi,jpk)     ::   zwx, zwy, zwz   ! 2D arrays
66      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhop           ! 3D arrays
67      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
68      !!----------------------------------------------------------------------
69
70      IF( MOD( kt, nn_npc ) == 0 ) THEN
71
72         inpcc = 0
73         inpci = 0
74
75         CALL eos( tsa, rhd, zrhop )         ! Potential density
76
77         IF( l_trdtra )   THEN                    !* Save ta and sa trends
78            ALLOCATE( ztrdt(jpi,jpj,jpk) )  ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
79            ALLOCATE( ztrds(jpi,jpj,jpk) )  ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
80         ENDIF
81
82         !                                                ! ===============
83         DO jj = 1, jpj                                   !  Vertical slab
84            !                                             ! ===============
85            !  Static instability pointer
86            ! ----------------------------
87            DO jk = 1, jpkm1
88               DO ji = 1, jpi
89                  zwx(ji,jk) = ( zrhop(ji,jj,jk) - zrhop(ji,jj,jk+1) ) * tmask(ji,jj,jk+1)
90               END DO
91            END DO
92
93            ! 1.1 do not consider the boundary points
94
95            ! even if east-west cyclic b. c. do not considere ji=1 or jpi
96            DO jk = 1, jpkm1
97               zwx( 1 ,jk) = 0.e0
98               zwx(jpi,jk) = 0.e0
99            END DO
100            ! even if south-symmetric b. c. used, do not considere jj=1
101            IF( jj == 1 )   zwx(:,:) = 0.e0
102
103            DO jk = 1, jpkm1
104               DO ji = 1, jpi
105                  zwx(ji,jk) = 1.
106                  IF( zwx(ji,jk) < 1.e-5 ) zwx(ji,jk) = 0.e0
107               END DO
108            END DO
109
110            zwy(:,1) = 0.e0
111            DO ji = 1, jpi
112               DO jk = 1, jpkm1
113                  zwy(ji,1) = zwy(ji,1) + zwx(ji,jk)
114               END DO
115            END DO
116
117            zwz(1,1) = 0.e0
118            DO ji = 1, jpi
119               zwz(1,1) = zwz(1,1) + zwy(ji,1)
120            END DO
121
122            inpcc = inpcc + NINT( zwz(1,1) )
123
124
125            ! 2. Vertical mixing for each instable portion of the density profil
126            ! ------------------------------------------------------------------
127
128            IF( zwz(1,1) /= 0.e0 ) THEN         ! -->> the density profil is statically instable :
129               DO ji = 1, jpi
130                  IF( zwy(ji,1) /= 0.e0 ) THEN
131                     !
132                     ikbot = mbkt(ji,jj)        ! ikbot: ocean bottom T-level
133                     !
134                     DO jiter = 1, jpk          ! vertical iteration
135                        !
136                        ! search of ikup : the first static instability from the sea surface
137                        !
138                        ik = 0
139220                     CONTINUE
140                        ik = ik + 1
141                        IF( ik >= ikbot ) GO TO 200
142                        zwx(ji,ik) = zrhop(ji,jj,ik) - zrhop(ji,jj,ik+1)
143                        IF( zwx(ji,ik) <= 0.e0 ) GO TO 220
144                        ikup = ik
145                        ! the density profil is instable below ikup
146                        ! ikdown : bottom of the instable portion of the density profil
147                        ! search of ikdown and vertical mixing from ikup to ikdown
148                        !
149                        ze3tot= fse3t(ji,jj,ikup)
150                        zta   = tsa  (ji,jj,ikup,jp_tem)
151                        zsa   = tsa  (ji,jj,ikup,jp_sal)
152                        zraua = zrhop(ji,jj,ikup)
153                        !
154                        DO jkdown = ikup+1, ikbot-1
155                           IF( zraua <= zrhop(ji,jj,jkdown) ) THEN
156                              ikdown = jkdown
157                              GO TO 240
158                           ENDIF
159                           ze3dwn =  fse3t(ji,jj,jkdown)
160                           ze3tot =  ze3tot + ze3dwn
161                           zta   = ( zta*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_tem)*ze3dwn )/ze3tot
162                           zsa   = ( zsa*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_sal)*ze3dwn )/ze3tot
163                           zraua = ( zraua*(ze3tot-ze3dwn) + zrhop(ji,jj,jkdown)*ze3dwn )/ze3tot
164                           inpci = inpci+1
165                        END DO
166                        ikdown = ikbot-1
167240                     CONTINUE
168                        !
169                        DO jkp = ikup, ikdown-1
170                           tsa  (ji,jj,jkp,jp_tem) = zta
171                           tsa  (ji,jj,jkp,jp_sal) = zsa
172                           zrhop(ji,jj,jkp       ) = zraua
173                        END DO
174                        IF (ikdown == ikbot-1 .AND. zraua >= zrhop(ji,jj,ikdown) ) THEN
175                           tsa  (ji,jj,jkp,jp_tem) = zta
176                           tsa  (ji,jj,jkp,jp_sal) = zsa
177                           zrhop(ji,jj,ikdown    ) = zraua
178                        ENDIF
179                     END DO
180                  ENDIF
181200               CONTINUE
182               END DO
183               ! <<-- no more static instability on slab jj
184            ENDIF
185            !                                             ! ===============
186         END DO                                           !   End of slab
187         !                                                ! ===============
188         !
189         IF( l_trdtra )   THEN         ! save the Non penetrative mixing trends for diagnostic
190            ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
191            ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
192            CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_npc, ztrdt )
193            CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_npc, ztrds )
194            DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
195         ENDIF
196     
197         ! Lateral boundary conditions on ( ta, sa )   ( Unchanged sign)
198         ! ------------------------------============
199         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )
200         CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
201     
202
203         !  2. non penetrative convective scheme statistics
204         !  -----------------------------------------------
205         IF( nn_npcp /= 0 .AND. MOD( kt, nn_npcp ) == 0 ) THEN
206            IF(lwp) WRITE(numout,*)' kt=',kt, ' number of statically instable',   &
207               &                   ' water column : ',inpcc, ' number of iteration : ',inpci
208         ENDIF
209         !
210      ENDIF
211      !
212   END SUBROUTINE tra_npc
213
214   !!======================================================================
215END MODULE tranpc
Note: See TracBrowser for help on using the repository browser.