LMDZ
integrd.F
Go to the documentation of this file.
1 !
2 ! $Id: integrd.F 2094 2014-07-16 16:55:47Z lguez $
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 
9  use control_mod, only : planet_type
10 
11  IMPLICIT NONE
12 
13 
14 c=======================================================================
15 c
16 c Auteur: P. Le Van
17 c -------
18 c
19 c objet:
20 c ------
21 c
22 c Incrementation des tendances dynamiques
23 c
24 c=======================================================================
25 c-----------------------------------------------------------------------
26 c Declarations:
27 c -------------
28 
29 #include "dimensions.h"
30 #include "paramet.h"
31 #include "comconst.h"
32 #include "comgeom.h"
33 #include "comvert.h"
34 #include "logic.h"
35 #include "temps.h"
36 #include "serre.h"
37 #include "iniprint.h"
38 
39 c Arguments:
40 c ----------
41 
42  integer,intent(in) :: nq ! number of tracers to handle in this routine
43  real,intent(inout) :: vcov(ip1jm,llm) ! covariant meridional wind
44  real,intent(inout) :: ucov(ip1jmp1,llm) ! covariant zonal wind
45  real,intent(inout) :: teta(ip1jmp1,llm) ! potential temperature
46  real,intent(inout) :: q(ip1jmp1,llm,nq) ! advected tracers
47  real,intent(inout) :: ps(ip1jmp1) ! surface pressure
48  real,intent(inout) :: masse(ip1jmp1,llm) ! atmospheric mass
49  real,intent(in) :: phis(ip1jmp1) ! ground geopotential !!! unused
50  ! values at previous time step
51  real,intent(inout) :: vcovm1(ip1jm,llm)
52  real,intent(inout) :: ucovm1(ip1jmp1,llm)
53  real,intent(inout) :: tetam1(ip1jmp1,llm)
54  real,intent(inout) :: psm1(ip1jmp1)
55  real,intent(inout) :: massem1(ip1jmp1,llm)
56  ! the tendencies to add
57  real,intent(in) :: dv(ip1jm,llm)
58  real,intent(in) :: du(ip1jmp1,llm)
59  real,intent(in) :: dteta(ip1jmp1,llm)
60  real,intent(in) :: dp(ip1jmp1)
61  real,intent(in) :: dq(ip1jmp1,llm,nq) !!! unused
62 ! real,intent(out) :: finvmaold(ip1jmp1,llm) !!! unused
63 
64 c Local:
65 c ------
66 
67  REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1)
68  REAL massescr( ip1jmp1,llm )
69 ! REAL finvmasse(ip1jmp1,llm)
70  REAL p(ip1jmp1,llmp1)
71  REAL tpn,tps,tppn(iim),tpps(iim)
72  REAL qpn,qps,qppn(iim),qpps(iim)
73  REAL deltap( ip1jmp1,llm )
74 
75  INTEGER l,ij,iq,i,j
76 
77  REAL SSUM
78 
79 c-----------------------------------------------------------------------
80 
81  DO l = 1,llm
82  DO ij = 1,iip1
83  ucov( ij , l) = 0.
84  ucov( ij +ip1jm, l) = 0.
85  uscr( ij ) = 0.
86  uscr( ij +ip1jm ) = 0.
87  ENDDO
88  ENDDO
89 
90 
91 c ............ integration de ps ..............
92 
93  CALL scopy(ip1jmp1*llm, masse, 1, massescr, 1)
94 
95  DO ij = 1,ip1jmp1
96  pscr(ij) = ps(ij)
97  ps(ij) = psm1(ij) + dt * dp(ij)
98  ENDDO
99 c
100  DO ij = 1,ip1jmp1
101  IF( ps(ij).LT.0. ) THEN
102  write(lunout,*) "integrd: negative surface pressure ",ps(ij)
103  write(lunout,*) " at node ij =", ij
104  ! since ij=j+(i-1)*jjp1 , we have
105  j=modulo(ij,jjp1)
106  i=1+(ij-j)/jjp1
107  write(lunout,*) " lon = ",rlonv(i)*180./pi, " deg",
108  & " lat = ",rlatu(j)*180./pi, " deg"
109  call abort_gcm("integrd", "", 1)
110  ENDIF
111  ENDDO
112 c
113  DO ij = 1, iim
114  tppn(ij) = aire( ij ) * ps( ij )
115  tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
116  ENDDO
117  tpn = ssum(iim,tppn,1)/apoln
118  tps = ssum(iim,tpps,1)/apols
119  DO ij = 1, iip1
120  ps( ij ) = tpn
121  ps(ij+ip1jm) = tps
122  ENDDO
123 c
124 c ... Calcul de la nouvelle masse d'air au dernier temps integre t+1 ...
125 c
126  CALL pression ( ip1jmp1, ap, bp, ps, p )
127  CALL massdair ( p , masse )
128 
129 ! Ehouarn : we don't use/need finvmaold and finvmasse,
130 ! so might as well not compute them
131 ! CALL SCOPY( ijp1llm , masse, 1, finvmasse, 1 )
132 ! CALL filtreg( finvmasse, jjp1, llm, -2, 2, .TRUE., 1 )
133 c
134 
135 c ............ integration de ucov, vcov, h ..............
136 
137  DO l = 1,llm
138 
139  DO ij = iip2,ip1jm
140  uscr( ij ) = ucov( ij,l )
141  ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
142  ENDDO
143 
144  DO ij = 1,ip1jm
145  vscr( ij ) = vcov( ij,l )
146  vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
147  ENDDO
148 
149  DO ij = 1,ip1jmp1
150  hscr( ij ) = teta(ij,l)
151  teta( ij,l ) = tetam1(ij,l) * massem1(ij,l) / masse(ij,l)
152  & + dt * dteta(ij,l) / masse(ij,l)
153  ENDDO
154 
155 c .... Calcul de la valeur moyenne, unique aux poles pour teta ......
156 c
157 c
158  DO ij = 1, iim
159  tppn(ij) = aire( ij ) * teta( ij ,l)
160  tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
161  ENDDO
162  tpn = ssum(iim,tppn,1)/apoln
163  tps = ssum(iim,tpps,1)/apols
164 
165  DO ij = 1, iip1
166  teta( ij ,l) = tpn
167  teta(ij+ip1jm,l) = tps
168  ENDDO
169 c
170 
171  IF(leapf) THEN
172  CALL scopy ( ip1jmp1, uscr(1), 1, ucovm1(1, l), 1 )
173  CALL scopy ( ip1jm, vscr(1), 1, vcovm1(1, l), 1 )
174  CALL scopy ( ip1jmp1, hscr(1), 1, tetam1(1, l), 1 )
175  END IF
176 
177  ENDDO ! of DO l = 1,llm
178 
179 
180 c
181 c ....... integration de q ......
182 c
183 c$$$ IF( iadv(1).NE.3.AND.iadv(2).NE.3 ) THEN
184 c$$$c
185 c$$$ IF( forward. OR . leapf ) THEN
186 c$$$ DO iq = 1,2
187 c$$$ DO l = 1,llm
188 c$$$ DO ij = 1,ip1jmp1
189 c$$$ q(ij,l,iq) = ( q(ij,l,iq)*finvmaold(ij,l) + dtvr *dq(ij,l,iq) )/
190 c$$$ $ finvmasse(ij,l)
191 c$$$ ENDDO
192 c$$$ ENDDO
193 c$$$ ENDDO
194 c$$$ ELSE
195 c$$$ DO iq = 1,2
196 c$$$ DO l = 1,llm
197 c$$$ DO ij = 1,ip1jmp1
198 c$$$ q( ij,l,iq ) = q( ij,l,iq ) * finvmaold(ij,l) / finvmasse(ij,l)
199 c$$$ ENDDO
200 c$$$ ENDDO
201 c$$$ ENDDO
202 c$$$
203 c$$$ END IF
204 c$$$c
205 c$$$ ENDIF
206 
207  if (planet_type.eq."earth") then
208 ! Earth-specific treatment of first 2 tracers (water)
209  DO l = 1, llm
210  DO ij = 1, ip1jmp1
211  deltap(ij,l) = p(ij,l) - p(ij,l+1)
212  ENDDO
213  ENDDO
214 
215  CALL qminimum( q, nq, deltap )
216 
217 c
218 c ..... Calcul de la valeur moyenne, unique aux poles pour q .....
219 c
220 
221  DO iq = 1, nq
222  DO l = 1, llm
223 
224  DO ij = 1, iim
225  qppn(ij) = aire( ij ) * q( ij ,l,iq)
226  qpps(ij) = aire(ij+ip1jm) * q(ij+ip1jm,l,iq)
227  ENDDO
228  qpn = ssum(iim,qppn,1)/apoln
229  qps = ssum(iim,qpps,1)/apols
230 
231  DO ij = 1, iip1
232  q( ij ,l,iq) = qpn
233  q(ij+ip1jm,l,iq) = qps
234  ENDDO
235 
236  ENDDO
237  ENDDO
238 
239 ! Ehouarn: forget about finvmaold
240 ! CALL SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
241 
242  endif ! of if (planet_type.eq."earth")
243 c
244 c
245 c ..... FIN de l'integration de q .......
246 
247 c .................................................................
248 
249 
250  IF( leapf ) THEN
251  CALL scopy ( ip1jmp1 , pscr , 1, psm1 , 1 )
252  CALL scopy ( ip1jmp1*llm, massescr, 1, massem1, 1 )
253  END IF
254 
255  RETURN
256  END
iip2
!$Header iip2
Definition: paramet.h:14
ip1jmp1
!$Header llmm1 INTEGER ip1jmp1
Definition: paramet.h:14
apols
!$Header!CDK comgeom COMMON comgeom apols
Definition: comgeom.h:8
dq
do llm!au dessus on relaxe vers profil init!on fait l hypothese que dans ce il n y a plus d eau liq au dessus!donc la relaxation en thetal et qt devient relaxation en tempe et qv l dq1 relax dq(l, 1)
integrd
subroutine integrd(nq, vcovm1, ucovm1, tetam1, psm1, massem1, dv, du, dteta, dq, dp, vcov, ucov, teta, q, ps, masse, phis)
Definition: integrd.F:8
llmp1
!$Header llmp1
Definition: paramet.h:14
bp
!$Id bp(llm+1)
dt
!$Id calend INTEGER itaufin INTEGER itau_phy INTEGER day_ref REAL dt
Definition: temps.h:15
control_mod::planet_type
character(len=10), save planet_type
Definition: control_mod.F90:32
abort_gcm
subroutine abort_gcm(modname, message, ierr)
Definition: abort_gcm.F:7
llm
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
Definition: 1D_interp_cases.h:103
pi
!$Id mode_top_bound COMMON comconstr && pi
Definition: comconst.h:7
aire
!$Header!CDK comgeom COMMON comgeom aire
Definition: comgeom.h:25
rlatu
!$Header!CDK comgeom COMMON comgeom rlatu
Definition: comgeom.h:25
scopy
subroutine scopy(n, sx, incx, sy, incy)
Definition: cray.F:9
ip1jm
!$Header llmm1 INTEGER ip1jm
Definition: paramet.h:14
pression
subroutine pression(ngrid, ap, bp, ps, p)
Definition: pression.F90:2
apoln
!$Header!CDK comgeom COMMON comgeom apoln
Definition: comgeom.h:8
jjp1
!$Header jjp1
Definition: paramet.h:14
qminimum
subroutine qminimum(q, nqtot, deltap)
Definition: qminimum.F:5
phis
!$Id ***************************************!ECRITURE DU phis
Definition: write_histrac.h:9
leapf
!$Id leapf
Definition: logic.h:10
iim
c c zjulian c cym CALL iim cym klev iim
Definition: ini_bilKP_ave.h:24
massdair
subroutine massdair(p, masse)
Definition: massdair.F:5
control_mod
Definition: control_mod.F90:5
lunout
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
Definition: iniprint.h:7
rlonv
!$Header!CDK comgeom COMMON comgeom rlonv
Definition: comgeom.h:25