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 tags/nemo_v3_2/nemo_v3_2/NEMO/OPA_SRC/TRA – NEMO

source: tags/nemo_v3_2/nemo_v3_2/NEMO/OPA_SRC/TRA/tranpc.F90 @ 1878

Last change on this file since 1878 was 1878, checked in by flavoni, 14 years ago

initial test for nemogcm
File size: 9.3 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   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   tra_npc : apply the non penetrative convection scheme
14   !!----------------------------------------------------------------------
15   USE oce             ! ocean dynamics and active tracers
16   USE dom_oce         ! ocean space and time domain
17   USE zdf_oce         ! ocean vertical physics
18   USE trdmod          ! ocean active tracer trends
19   USE trdmod_oce      ! ocean variables trends
20   USE eosbn2          ! equation of state (eos routine)
21   USE lbclnk          ! lateral boundary conditions (or mpp link)
22   USE in_out_manager  ! I/O manager
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   tra_npc    ! routine called by step.F90
28
29   !! * Substitutions
30#  include "domzgr_substitute.h90"
31   !!----------------------------------------------------------------------
32   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
33   !! $Id: tranpc.F90 1537 2009-07-24 14:22:23Z ctlod $
34   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
35   !!----------------------------------------------------------------------
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      USE oce, ONLY :    ztrdt => ua   ! use ua as 3D workspace   
58      USE oce, ONLY :    ztrds => va   ! use va as 3D workspace   
59      !!
60      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
61      !!
62      INTEGER  ::   ji, jj, jk   ! dummy loop indices
63      INTEGER  ::   inpcc        ! number of statically instable water column
64      INTEGER  ::   inpci        ! number of iteration for npc scheme
65      INTEGER  ::   jiter, jkdown, jkp        ! ???
66      INTEGER  ::   ikbot, ik, ikup, ikdown   ! ???
67      REAL(wp) ::   ze3tot, zta, zsa, zraua, ze3dwn
68      REAL(wp), DIMENSION(jpi,jpk)     ::   zwx, zwy, zwz   ! 2D arrays
69      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhop           ! 3D arrays
70      !!----------------------------------------------------------------------
71
72      IF( MOD( kt, nn_npc ) == 0 ) THEN
73
74         inpcc = 0
75         inpci = 0
76
77         CALL eos( ta, sa, rhd, zrhop )         ! Potential density
78
79
80         IF( l_trdtra )   THEN                  ! Save ta and sa trends
81            ztrdt(:,:,:) = ta(:,:,:) 
82            ztrds(:,:,:) = sa(:,:,:) 
83         ENDIF
84
85         !                                                ! ===============
86         DO jj = 1, jpj                                   !  Vertical slab
87            !                                             ! ===============
88            !  Static instability pointer
89            ! ----------------------------
90            DO jk = 1, jpkm1
91               DO ji = 1, jpi
92                  zwx(ji,jk) = ( zrhop(ji,jj,jk) - zrhop(ji,jj,jk+1) ) * tmask(ji,jj,jk+1)
93               END DO
94            END DO
95
96            ! 1.1 do not consider the boundary points
97
98            ! even if east-west cyclic b. c. do not considere ji=1 or jpi
99            DO jk = 1, jpkm1
100               zwx( 1 ,jk) = 0.e0
101               zwx(jpi,jk) = 0.e0
102            END DO
103            ! even if south-symmetric b. c. used, do not considere jj=1
104            IF( jj == 1 )   zwx(:,:) = 0.e0
105
106            DO jk = 1, jpkm1
107               DO ji = 1, jpi
108                  zwx(ji,jk) = 1.
109                  IF( zwx(ji,jk) < 1.e-5 ) zwx(ji,jk) = 0.e0
110               END DO
111            END DO
112
113            zwy(:,1) = 0.e0
114            DO ji = 1, jpi
115               DO jk = 1, jpkm1
116                  zwy(ji,1) = zwy(ji,1) + zwx(ji,jk)
117               END DO
118            END DO
119
120            zwz(1,1) = 0.e0
121            DO ji = 1, jpi
122               zwz(1,1) = zwz(1,1) + zwy(ji,1)
123            END DO
124
125            inpcc = inpcc + NINT( zwz(1,1) )
126
127
128            ! 2. Vertical mixing for each instable portion of the density profil
129            ! ------------------------------------------------------------------
130
131            IF( zwz(1,1) /= 0.e0 ) THEN         ! -->> the density profil is statically instable :
132               DO ji = 1, jpi
133                  IF( zwy(ji,1) /= 0.e0 ) THEN
134                     !
135                     ikbot = mbathy(ji,jj)      ! ikbot: ocean bottom level
136                     !
137                     DO jiter = 1, jpk          ! vertical iteration
138                        !
139                        ! search of ikup : the first static instability from the sea surface
140                        !
141                        ik = 0
142220                     CONTINUE
143                        ik = ik + 1
144                        IF( ik >= ikbot-1 ) GO TO 200
145                        zwx(ji,ik) = zrhop(ji,jj,ik) - zrhop(ji,jj,ik+1)
146                        IF( zwx(ji,ik) <= 0.e0 ) GO TO 220
147                        ikup = ik
148                        ! the density profil is instable below ikup
149                        ! ikdown : bottom of the instable portion of the density profil
150                        ! search of ikdown and vertical mixing from ikup to ikdown
151                        !
152                        ze3tot= fse3t(ji,jj,ikup)
153                        zta   = ta   (ji,jj,ikup)
154                        zsa   = sa   (ji,jj,ikup)
155                        zraua = zrhop(ji,jj,ikup)
156                        !
157                        DO jkdown = ikup+1, ikbot-1
158                           IF( zraua <= zrhop(ji,jj,jkdown) ) THEN
159                              ikdown = jkdown
160                              GO TO 240
161                           ENDIF
162                           ze3dwn =  fse3t(ji,jj,jkdown)
163                           ze3tot =  ze3tot + ze3dwn
164                           zta   = ( zta*(ze3tot-ze3dwn) + ta(ji,jj,jkdown)*ze3dwn )/ze3tot
165                           zsa   = ( zsa*(ze3tot-ze3dwn) + sa(ji,jj,jkdown)*ze3dwn )/ze3tot
166                           zraua = ( zraua*(ze3tot-ze3dwn) + zrhop(ji,jj,jkdown)*ze3dwn )/ze3tot
167                           inpci = inpci+1
168                        END DO
169                        ikdown = ikbot-1
170240                     CONTINUE
171                        !
172                        DO jkp = ikup, ikdown-1
173                           ta(ji,jj,jkp) = zta
174                           sa(ji,jj,jkp) = zsa
175                           zrhop(ji,jj,jkp) = zraua
176                        END DO
177                        IF (ikdown == ikbot-1 .AND. zraua >= zrhop(ji,jj,ikdown) ) THEN
178                           ta(ji,jj,ikdown) = zta
179                           sa(ji,jj,ikdown) = zsa
180                           zrhop(ji,jj,ikdown) = zraua
181                        ENDIF
182                     END DO
183                  ENDIF
184200               CONTINUE
185               END DO
186               ! <<-- no more static instability on slab jj
187            ENDIF
188            !                                             ! ===============
189         END DO                                           !   End of slab
190         !                                                ! ===============
191         !
192         IF( l_trdtra )   THEN         ! save the Non penetrative mixing trends for diagnostic
193            ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
194            ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
195            CALL trd_mod(ztrdt, ztrds, jptra_trd_npc, 'TRA', kt)
196         ENDIF
197     
198         ! Lateral boundary conditions on ( ta, sa )   ( Unchanged sign)
199         ! ------------------------------============
200         CALL lbc_lnk( ta, 'T', 1. )
201         CALL lbc_lnk( sa, 'T', 1. )
202     
203
204         !  2. non penetrative convective scheme statistics
205         !  -----------------------------------------------
206         IF( nn_npcp /= 0 .AND. MOD( kt, nn_npcp ) == 0 ) THEN
207            IF(lwp) WRITE(numout,*)' kt=',kt, ' number of statically instable',   &
208               &                   ' water column : ',inpcc, ' number of iteration : ',inpci
209         ENDIF
210         !
211      ENDIF
212      !
213   END SUBROUTINE tra_npc
214
215   !!======================================================================
216END MODULE tranpc
Note: See TracBrowser for help on using the repository browser.