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

source: trunk/NEMO/OPA_SRC/TRA/tranpc.F90 @ 2007

Last change on this file since 2007 was 1537, checked in by ctlod, 15 years ago

ensure the restartability of the 2nd order advection scheme,see ticket: 489

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 9.2 KB
RevLine 
[3]1MODULE tranpc
2   !!==============================================================================
3   !!                       ***  MODULE  tranpc  ***
4   !! Ocean active tracers:  non penetrative convection scheme
5   !!==============================================================================
[1537]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
[503]10   !!----------------------------------------------------------------------
[3]11
12   !!----------------------------------------------------------------------
[1537]13   !!   tra_npc : apply the non penetrative convection scheme
[3]14   !!----------------------------------------------------------------------
15   USE oce             ! ocean dynamics and active tracers
16   USE dom_oce         ! ocean space and time domain
[1537]17   USE zdf_oce         ! ocean vertical physics
[216]18   USE trdmod          ! ocean active tracer trends
19   USE trdmod_oce      ! ocean variables trends
[3]20   USE eosbn2          ! equation of state (eos routine)
21   USE lbclnk          ! lateral boundary conditions (or mpp link)
[216]22   USE in_out_manager  ! I/O manager
[3]23
24   IMPLICIT NONE
25   PRIVATE
26
[503]27   PUBLIC   tra_npc    ! routine called by step.F90
[3]28
29   !! * Substitutions
30#  include "domzgr_substitute.h90"
31   !!----------------------------------------------------------------------
[1537]32   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
[1146]33   !! $Id$
[503]34   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
[3]35   !!----------------------------------------------------------------------
36
37CONTAINS
38
39   SUBROUTINE tra_npc( kt )
40      !!----------------------------------------------------------------------
41      !!                  ***  ROUTINE tranpc  ***
42      !!
43      !! ** Purpose :   Non penetrative convective adjustment scheme. solve
[1111]44      !!      the static instability of the water column on after fields
[3]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.
[503]50      !!      l_trdtra=T: the trend associated with this algorithm is saved.
[3]51      !!
[1111]52      !! ** Action  : - (ta,sa) after the application od the npc scheme
[3]53      !!              - save the associated trends (ttrd,strd) ('key_trdtra')
54      !!
[503]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
[3]61      !!
[503]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
[3]70      !!----------------------------------------------------------------------
[216]71
[1537]72      IF( MOD( kt, nn_npc ) == 0 ) THEN
[3]73
74         inpcc = 0
75         inpci = 0
76
[1111]77         CALL eos( ta, sa, rhd, zrhop )         ! Potential density
[3]78
79
[1111]80         IF( l_trdtra )   THEN                  ! Save ta and sa trends
81            ztrdt(:,:,:) = ta(:,:,:) 
82            ztrds(:,:,:) = sa(:,:,:) 
[216]83         ENDIF
84
[3]85         !                                                ! ===============
86         DO jj = 1, jpj                                   !  Vertical slab
87            !                                             ! ===============
[503]88            !  Static instability pointer
89            ! ----------------------------
[3]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
[503]104            IF( jj == 1 )   zwx(:,:) = 0.e0
[3]105
106            DO jk = 1, jpkm1
107               DO ji = 1, jpi
108                  zwx(ji,jk) = 1.
[503]109                  IF( zwx(ji,jk) < 1.e-5 ) zwx(ji,jk) = 0.e0
[3]110               END DO
111            END DO
112
[503]113            zwy(:,1) = 0.e0
[3]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
[503]120            zwz(1,1) = 0.e0
[3]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
[503]131            IF( zwz(1,1) /= 0.e0 ) THEN         ! -->> the density profil is statically instable :
[3]132               DO ji = 1, jpi
[503]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                        !
[3]139                        ! search of ikup : the first static instability from the sea surface
[503]140                        !
[3]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)
[503]146                        IF( zwx(ji,ik) <= 0.e0 ) GO TO 220
[3]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
[503]151                        !
[3]152                        ze3tot= fse3t(ji,jj,ikup)
[1111]153                        zta   = ta   (ji,jj,ikup)
154                        zsa   = sa   (ji,jj,ikup)
[3]155                        zraua = zrhop(ji,jj,ikup)
[503]156                        !
[3]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
[1111]164                           zta   = ( zta*(ze3tot-ze3dwn) + ta(ji,jj,jkdown)*ze3dwn )/ze3tot
165                           zsa   = ( zsa*(ze3tot-ze3dwn) + sa(ji,jj,jkdown)*ze3dwn )/ze3tot
[3]166                           zraua = ( zraua*(ze3tot-ze3dwn) + zrhop(ji,jj,jkdown)*ze3dwn )/ze3tot
167                           inpci = inpci+1
168                        END DO
169                        ikdown = ikbot-1
170240                     CONTINUE
[503]171                        !
[3]172                        DO jkp = ikup, ikdown-1
[1111]173                           ta(ji,jj,jkp) = zta
174                           sa(ji,jj,jkp) = zsa
[3]175                           zrhop(ji,jj,jkp) = zraua
176                        END DO
177                        IF (ikdown == ikbot-1 .AND. zraua >= zrhop(ji,jj,ikdown) ) THEN
[1111]178                           ta(ji,jj,ikdown) = zta
179                           sa(ji,jj,ikdown) = zsa
[3]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         !                                                ! ===============
[503]191         !
192         IF( l_trdtra )   THEN         ! save the Non penetrative mixing trends for diagnostic
[1111]193            ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
194            ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
[503]195            CALL trd_mod(ztrdt, ztrds, jptra_trd_npc, 'TRA', kt)
[216]196         ENDIF
[3]197     
[1111]198         ! Lateral boundary conditions on ( ta, sa )   ( Unchanged sign)
[3]199         ! ------------------------------============
[1111]200         CALL lbc_lnk( ta, 'T', 1. )
201         CALL lbc_lnk( sa, 'T', 1. )
[3]202     
203
204         !  2. non penetrative convective scheme statistics
205         !  -----------------------------------------------
[1537]206         IF( nn_npcp /= 0 .AND. MOD( kt, nn_npcp ) == 0 ) THEN
[3]207            IF(lwp) WRITE(numout,*)' kt=',kt, ' number of statically instable',   &
[503]208               &                   ' water column : ',inpcc, ' number of iteration : ',inpci
[3]209         ENDIF
[503]210         !
[3]211      ENDIF
[503]212      !
[3]213   END SUBROUTINE tra_npc
214
215   !!======================================================================
216END MODULE tranpc
Note: See TracBrowser for help on using the repository browser.