source: LMDZ5/branches/LMDZ5V1.0-dev/libf/dyn3d/integrd.F @ 2309

Last change on this file since 2309 was 1446, checked in by Ehouarn Millour, 14 years ago

Implemented modifications to enable running with only one tracer for planet types different from "earth". Rem: If flag 'planet_type' is set to "earth" (default behaviour) then there must be at least 2 tracers for the dynamics to function properly.

These updates do not induce any changes in model outputs with respect to previous revisions.

EM

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.8 KB
Line 
1!
2! $Id: integrd.F 1446 2010-10-22 09:27:25Z jyg $
3!
4      SUBROUTINE integrd
5     $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
6     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis,finvmaold )
7
8      use control_mod, only : planet_type
9
10      IMPLICIT NONE
11
12
13c=======================================================================
14c
15c   Auteur:  P. Le Van
16c   -------
17c
18c   objet:
19c   ------
20c
21c   Incrementation des tendances dynamiques
22c
23c=======================================================================
24c-----------------------------------------------------------------------
25c   Declarations:
26c   -------------
27
28#include "dimensions.h"
29#include "paramet.h"
30#include "comconst.h"
31#include "comgeom.h"
32#include "comvert.h"
33#include "logic.h"
34#include "temps.h"
35#include "serre.h"
36
37c   Arguments:
38c   ----------
39
40      INTEGER nq
41
42      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
43      REAL q(ip1jmp1,llm,nq)
44      REAL ps(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1)
45
46      REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
47      REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1),massem1(ip1jmp1,llm)
48
49      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
50      REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
51      REAL dq(ip1jmp1,llm,nq), finvmaold(ip1jmp1,llm)
52
53c   Local:
54c   ------
55
56      REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1)
57      REAL massescr( ip1jmp1,llm ), finvmasse(ip1jmp1,llm)
58      REAL p(ip1jmp1,llmp1)
59      REAL tpn,tps,tppn(iim),tpps(iim)
60      REAL qpn,qps,qppn(iim),qpps(iim)
61      REAL deltap( ip1jmp1,llm )
62
63      INTEGER  l,ij,iq
64
65      REAL SSUM
66
67c-----------------------------------------------------------------------
68
69      DO  l = 1,llm
70        DO  ij = 1,iip1
71         ucov(    ij    , l) = 0.
72         ucov( ij +ip1jm, l) = 0.
73         uscr(     ij      ) = 0.
74         uscr( ij +ip1jm   ) = 0.
75        ENDDO
76      ENDDO
77
78
79c    ............    integration  de       ps         ..............
80
81      CALL SCOPY(ip1jmp1*llm, masse, 1, massescr, 1)
82
83      DO ij = 1,ip1jmp1
84       pscr (ij)    = ps(ij)
85       ps (ij)      = psm1(ij) + dt * dp(ij)
86      ENDDO
87c
88      DO ij = 1,ip1jmp1
89        IF( ps(ij).LT.0. ) THEN
90         PRINT*,' Au point ij = ',ij, ' , pression sol neg. ', ps(ij)
91         STOP' dans integrd'
92        ENDIF
93      ENDDO
94c
95      DO  ij    = 1, iim
96       tppn(ij) = aire(   ij   ) * ps(  ij    )
97       tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
98      ENDDO
99       tpn      = SSUM(iim,tppn,1)/apoln
100       tps      = SSUM(iim,tpps,1)/apols
101      DO ij   = 1, iip1
102       ps(   ij   )  = tpn
103       ps(ij+ip1jm)  = tps
104      ENDDO
105c
106c  ... Calcul  de la nouvelle masse d'air au dernier temps integre t+1 ...
107c
108      CALL pression ( ip1jmp1, ap, bp, ps, p )
109      CALL massdair (     p  , masse         )
110
111      CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
112      CALL filtreg( finvmasse, jjp1, llm, -2, 2, .TRUE., 1  )
113c
114
115c    ............   integration  de  ucov, vcov,  h     ..............
116
117      DO l = 1,llm
118
119       DO ij = iip2,ip1jm
120        uscr( ij )   =  ucov( ij,l )
121        ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
122       ENDDO
123
124       DO ij = 1,ip1jm
125        vscr( ij )   =  vcov( ij,l )
126        vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
127       ENDDO
128
129       DO ij = 1,ip1jmp1
130        hscr( ij )    =  teta(ij,l)
131        teta ( ij,l ) = tetam1(ij,l) *  massem1(ij,l) / masse(ij,l)
132     &                + dt * dteta(ij,l) / masse(ij,l)
133       ENDDO
134
135c   ....  Calcul de la valeur moyenne, unique  aux poles pour  teta    ......
136c
137c
138       DO  ij   = 1, iim
139        tppn(ij) = aire(   ij   ) * teta(  ij    ,l)
140        tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
141       ENDDO
142        tpn      = SSUM(iim,tppn,1)/apoln
143        tps      = SSUM(iim,tpps,1)/apols
144
145       DO ij   = 1, iip1
146        teta(   ij   ,l)  = tpn
147        teta(ij+ip1jm,l)  = tps
148       ENDDO
149c
150
151       IF(leapf)  THEN
152         CALL SCOPY ( ip1jmp1, uscr(1), 1, ucovm1(1, l), 1 )
153         CALL SCOPY (   ip1jm, vscr(1), 1, vcovm1(1, l), 1 )
154         CALL SCOPY ( ip1jmp1, hscr(1), 1, tetam1(1, l), 1 )
155       END IF
156
157      ENDDO ! of DO l = 1,llm
158
159
160c
161c   .......  integration de   q   ......
162c
163c$$$      IF( iadv(1).NE.3.AND.iadv(2).NE.3 )    THEN
164c$$$c
165c$$$       IF( forward. OR . leapf )  THEN
166c$$$        DO iq = 1,2
167c$$$        DO  l = 1,llm
168c$$$        DO ij = 1,ip1jmp1
169c$$$        q(ij,l,iq) = ( q(ij,l,iq)*finvmaold(ij,l) + dtvr *dq(ij,l,iq) )/
170c$$$     $                            finvmasse(ij,l)
171c$$$        ENDDO
172c$$$        ENDDO
173c$$$        ENDDO
174c$$$       ELSE
175c$$$         DO iq = 1,2
176c$$$         DO  l = 1,llm
177c$$$         DO ij = 1,ip1jmp1
178c$$$         q( ij,l,iq ) = q( ij,l,iq ) * finvmaold(ij,l) / finvmasse(ij,l)
179c$$$         ENDDO
180c$$$         ENDDO
181c$$$         ENDDO
182c$$$
183c$$$       END IF
184c$$$c
185c$$$      ENDIF
186
187      if (planet_type.eq."earth") then
188! Earth-specific treatment of first 2 tracers (water)
189        DO l = 1, llm
190          DO ij = 1, ip1jmp1
191            deltap(ij,l) =  p(ij,l) - p(ij,l+1)
192          ENDDO
193        ENDDO
194
195        CALL qminimum( q, nq, deltap )
196
197c
198c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
199c
200
201       DO iq = 1, nq
202        DO l = 1, llm
203
204           DO ij = 1, iim
205             qppn(ij) = aire(   ij   ) * q(   ij   ,l,iq)
206             qpps(ij) = aire(ij+ip1jm) * q(ij+ip1jm,l,iq)
207           ENDDO
208             qpn  =  SSUM(iim,qppn,1)/apoln
209             qps  =  SSUM(iim,qpps,1)/apols
210
211           DO ij = 1, iip1
212             q(   ij   ,l,iq)  = qpn
213             q(ij+ip1jm,l,iq)  = qps
214           ENDDO
215
216        ENDDO
217       ENDDO
218
219
220      CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
221
222      endif ! of if (planet_type.eq."earth")
223c
224c
225c     .....   FIN  de l'integration  de   q    .......
226
227c    .................................................................
228
229
230      IF( leapf )  THEN
231         CALL SCOPY (    ip1jmp1 ,  pscr   , 1,   psm1  , 1 )
232         CALL SCOPY ( ip1jmp1*llm, massescr, 1,  massem1, 1 )
233      END IF
234
235      RETURN
236      END
Note: See TracBrowser for help on using the repository browser.