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.
p4zsink2.F in trunk/NEMO/TOP_SRC/SMS – NEMO

source: trunk/NEMO/TOP_SRC/SMS/p4zsink2.F @ 719

Last change on this file since 719 was 719, checked in by ctlod, 16 years ago

get back to the nemo_v2_3 version for trunk

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.9 KB
Line 
1
2CCC $Header$ 
3CCC  TOP 1.0 , LOCEAN-IPSL (2005) 
4C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
5C ---------------------------------------------------------------------------
6      SUBROUTINE p4zsink2(wstmp,sinktemp,jn)
7CDIR$ LIST
8#if defined key_passivetrc && defined key_trc_pisces
9!!!
10!!!       p4zsink2 : PISCES model
11!!!       ***********************
12!!!
13!!
14!!  PURPOSE :
15!!  ---------
16!!     Compute the sedimentation terms for the various sinking
17!!     particles. The scheme used to compute the trends is based
18!!     on MUSCL.
19!!
20!!   METHOD :
21!!   -------
22!!      this ROUTINE compute not exactly the advection but the
23!!      transport term, i.e.  div(u*tra).
24!!
25!!
26!!   REFERENCES :               
27!!   ----------                 
28!!
29!!   References :
30!!      Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
31!!      IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
32!!
33!!
34!!   MODIFICATIONS:
35!!   --------------
36!!       original :  06-00 (A.Estublier)
37!!       modifications : 2004 (O. Aumont)
38!!       
39!!----------------------------------------------------------------------
40CC ----------------------------------------------------------------
41CC parameters and commons
42CC ======================
43CDIR$ NOLIST
44      USE oce_trc
45      USE trp_trc
46      USE sms
47      IMPLICIT NONE
48#include "domzgr_substitute.h90"
49CDIR$ LIST
50CC-----------------------------------------------------------------
51CC local declarations
52CC ==================
53C
54      INTEGER ji,jj,jk,jn
55      REAL ztraz(jpi,jpj,jpk),zakz(jpi,jpj,jpk)
56      REAL zkz(jpi,jpj,jpk)
57      REAL zigma,zew,zstep,zign
58      REAL wstmp(jpi,jpj,jpk),sinktemp(jpi,jpj,jpk)
59      REAL wstmp2(jpi,jpj,jpk)
60
61!!!---------------------------------------------------------------------
62!!!  OPA8, LODYC (01/00)
63!!!---------------------------------------------------------------------
64! 1. Initialization
65! --------------
66
67        zstep  = rfact2
68
69        ztraz  = 0
70        zkz    = 0
71        zakz   = 0.
72
73        do jk=1,jpk-1
74         wstmp2(:,:,jk+1)=-wstmp(:,:,jk)/rjjss*tmask(:,:,jk+1)
75#    if defined key_off_degrad
76     &      *facvol(:,:,jk)
77#    endif
78        end do
79 
80        wstmp2(:,:,1)=0.
81!
82! 3. Vertical advective flux
83!-------------------------------
84! ... first guess of the slopes
85!   ... interior values
86!
87        DO jk=2,jpkm1
88              ztraz(:,:,jk) = (trn(:,:,jk-1,jn) - trn(:,:,jk,jn))
89     $                          *tmask(:,:,jk)
90        ENDDO
91!
92! slopes
93!
94        DO jk=2,jpkm1
95          DO jj = 1,jpj
96            DO ji = 1, jpi
97            zign = 0.5*(sign(1.,ztraz(ji,jj,jk)*ztraz(ji,jj,jk+1))+1)
98            zakz(ji,jj,jk) = 0.5*(ztraz(ji,jj,jk)
99     $                          +ztraz(ji,jj,jk+1))*zign
100            ENDDO
101          ENDDO
102        ENDDO       
103!
104! Slopes limitation
105!
106        DO jk=2,jpkm1
107          DO jj = 1,jpj
108            DO ji = 1,jpi
109              zakz(ji,jj,jk) = sign(1.,zakz(ji,jj,jk)) * 
110     $                        min(abs(zakz(ji,jj,jk)),
111     $                        2.*abs(ztraz(ji,jj,jk+1)),
112     $                        2.*abs(ztraz(ji,jj,jk)))
113            ENDDO
114          ENDDO
115        ENDDO       
116
117! vertical advective flux
118        DO jk=1,jpkm1
119          DO jj = 1,jpj     
120            DO ji = 1, jpi   
121              zigma = wstmp2(ji,jj,jk+1)*zstep/fse3w(ji,jj,jk+1)
122              zew   = wstmp2(ji,jj,jk+1)
123              sinktemp(ji,jj,jk+1) = -zew*(trn(ji,jj,jk,jn)
124     $           -0.5*(1+zigma)*zakz(ji,jj,jk))*zstep
125            ENDDO
126          ENDDO
127        ENDDO 
128!
129! Boundary conditions
130!
131         sinktemp(:,:,1)=0.
132         sinktemp(:,:,jpk)=0.
133C
134       DO jk=1,jpkm1
135          DO jj = 1,jpj
136            DO ji = 1, jpi
137!
138            trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
139     &        + (sinktemp(ji,jj,jk)-sinktemp(ji,jj,jk+1))
140     &        /fse3t(ji,jj,jk)
141!
142            ENDDO
143          ENDDO
144        ENDDO
145!
146        trb(:,:,:,jn)=trn(:,:,:,jn)
147!
148#endif
149C
150      RETURN
151      END
Note: See TracBrowser for help on using the repository browser.