Context Navigation

addfi_loc.F @ 5444

Last change on this file since 5444 was 1987, checked in by Ehouarn Millour, 11 years ago
Add updating pressure, mass and Exner function (ie: all variables which depend on surface pressure) after adding physics tendencies (which include a surface pressure tendency). Note that this change induces slight changes in GCM results with respect to previous svn version of the code, even if surface pressure tendency is zero (because of recomputation of polar values as an average over polar points on the dynamics grid). EM
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory
File size: 6.5 KB

Line
1	!
2	! $Id$
3	!
4	SUBROUTINE addfi_loc(pdt, leapf, forward,
5	S pucov, pvcov, pteta, pq , pps ,
6	S pdufi, pdvfi, pdhfi,pdqfi, pdpfi )
7	USE parallel_lmdz
8	USE infotrac, ONLY : nqtot
9	USE control_mod, ONLY : planet_type
10	IMPLICIT NONE
11	c
12	c=======================================================================
13	c
14	c Addition of the physical tendencies
15	c
16	c Interface :
17	c -----------
18	c
19	c Input :
20	c -------
21	c pdt time step of integration
22	c leapf logical
23	c forward logical
24	c pucov(ip1jmp1,llm) first component of the covariant velocity
25	c pvcov(ip1ip1jm,llm) second component of the covariant velocity
26	c pteta(ip1jmp1,llm) potential temperature
27	c pts(ip1jmp1,llm) surface temperature
28	c pdufi(ip1jmp1,llm) \|
29	c pdvfi(ip1jm,llm) \| respective
30	c pdhfi(ip1jmp1) \| tendencies
31	c pdtsfi(ip1jmp1) \|
32	c
33	c Output :
34	c --------
35	c pucov
36	c pvcov
37	c ph
38	c pts
39	c
40	c
41	c=======================================================================
42	c
43	c-----------------------------------------------------------------------
44	c
45	c 0. Declarations :
46	c ------------------
47	c
48	#include "dimensions.h"
49	#include "paramet.h"
50	#include "comconst.h"
51	#include "comgeom.h"
52	#include "serre.h"
53	c
54	c Arguments :
55	c -----------
56	c
57	REAL,INTENT(IN) :: pdt ! time step for the integration (s)
58	c
59	REAL,INTENT(INOUT) :: pvcov(ijb_v:ije_v,llm) ! covariant meridional wind
60	REAL,INTENT(INOUT) :: pucov(ijb_u:ije_u,llm) ! covariant zonal wind
61	REAL,INTENT(INOUT) :: pteta(ijb_u:ije_u,llm) ! potential temperature
62	REAL,INTENT(INOUT) :: pq(ijb_u:ije_u,llm,nqtot) ! tracers
63	REAL,INTENT(INOUT) :: pps(ijb_u:ije_u) ! surface pressure (Pa)
64	c respective tendencies (.../s) to add
65	REAL,INTENT(IN) :: pdvfi(ijb_v:ije_v,llm)
66	REAL,INTENT(IN) :: pdufi(ijb_u:ije_u,llm)
67	REAL,INTENT(IN) :: pdqfi(ijb_u:ije_u,llm,nqtot)
68	REAL,INTENT(IN) :: pdhfi(ijb_u:ije_u,llm)
69	REAL,INTENT(IN) :: pdpfi(ijb_u:ije_u)
70	c
71	LOGICAL,INTENT(IN) :: leapf,forward ! not used
72	c
73	c
74	c Local variables :
75	c -----------------
76	c
77	REAL xpn(iim),xps(iim),tpn,tps
78	INTEGER j,k,iq,ij
79	REAL,PARAMETER :: qtestw = 1.0e-15
80	REAL,PARAMETER :: qtestt = 1.0e-40
81
82	REAL SSUM
83	EXTERNAL SSUM
84
85	INTEGER :: ijb,ije
86	c
87	c-----------------------------------------------------------------------
88
89	ijb=ij_begin
90	ije=ij_end
91
92	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
93	DO k = 1,llm
94	DO j = ijb,ije
95	pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
96	ENDDO
97	ENDDO
98	c$OMP END DO NOWAIT
99
100	if (pole_nord) then
101	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
102	DO k = 1, llm
103	DO ij = 1, iim
104	xpn(ij) = aire( ij ) * pteta( ij ,k)
105	ENDDO
106	tpn = SSUM(iim,xpn,1)/ apoln
107
108	DO ij = 1, iip1
109	pteta( ij ,k) = tpn
110	ENDDO
111	ENDDO
112	c$OMP END DO NOWAIT
113	endif
114
115	if (pole_sud) then
116	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
117	DO k = 1, llm
118	DO ij = 1, iim
119	xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
120	ENDDO
121	tps = SSUM(iim,xps,1)/ apols
122
123	DO ij = 1, iip1
124	pteta(ij+ip1jm,k) = tps
125	ENDDO
126	ENDDO
127	c$OMP END DO NOWAIT
128	endif
129	c
130
131	ijb=ij_begin
132	ije=ij_end
133	if (pole_nord) ijb=ij_begin+iip1
134	if (pole_sud) ije=ij_end-iip1
135
136	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
137	DO k = 1,llm
138	DO j = ijb,ije
139	pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
140	ENDDO
141	ENDDO
142	c$OMP END DO NOWAIT
143
144	if (pole_nord) ijb=ij_begin
145
146	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
147	DO k = 1,llm
148	DO j = ijb,ije
149	pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
150	ENDDO
151	ENDDO
152	c$OMP END DO NOWAIT
153
154	c
155	if (pole_sud) ije=ij_end
156	c$OMP MASTER
157	DO j = ijb,ije
158	pps(j) = pps(j) + pdpfi(j) * pdt
159	ENDDO
160	c$OMP END MASTER
161
162	if (planet_type=="earth") then
163	! earth case, special treatment for first 2 tracers (water)
164	DO iq = 1, 2
165	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
166	DO k = 1,llm
167	DO j = ijb,ije
168	pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
169	pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
170	ENDDO
171	ENDDO
172	c$OMP END DO NOWAIT
173	ENDDO
174
175	DO iq = 3, nqtot
176	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
177	DO k = 1,llm
178	DO j = ijb,ije
179	pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
180	pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
181	ENDDO
182	ENDDO
183	c$OMP END DO NOWAIT
184	ENDDO
185	else
186	! general case, treat all tracers equally)
187	DO iq = 1, nqtot
188	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
189	DO k = 1,llm
190	DO j = ijb,ije
191	pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
192	pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
193	ENDDO
194	ENDDO
195	c$OMP END DO NOWAIT
196	ENDDO
197	endif ! of if (planet_type=="earth")
198
199	c$OMP MASTER
200	if (pole_nord) then
201
202	DO ij = 1, iim
203	xpn(ij) = aire( ij ) * pps( ij )
204	ENDDO
205
206	tpn = SSUM(iim,xpn,1)/apoln
207
208	DO ij = 1, iip1
209	pps ( ij ) = tpn
210	ENDDO
211
212	endif
213
214	if (pole_sud) then
215
216	DO ij = 1, iim
217	xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
218	ENDDO
219
220	tps = SSUM(iim,xps,1)/apols
221
222	DO ij = 1, iip1
223	pps ( ij+ip1jm ) = tps
224	ENDDO
225
226	endif
227	c$OMP END MASTER
228
229	if (pole_nord) then
230	DO iq = 1, nqtot
231	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
232	DO k = 1, llm
233	DO ij = 1, iim
234	xpn(ij) = aire( ij ) * pq( ij ,k,iq)
235	ENDDO
236	tpn = SSUM(iim,xpn,1)/apoln
237
238	DO ij = 1, iip1
239	pq ( ij ,k,iq) = tpn
240	ENDDO
241	ENDDO
242	c$OMP END DO NOWAIT
243	ENDDO
244	endif
245
246	if (pole_sud) then
247	DO iq = 1, nqtot
248	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
249	DO k = 1, llm
250	DO ij = 1, iim
251	xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
252	ENDDO
253	tps = SSUM(iim,xps,1)/apols
254
255	DO ij = 1, iip1
256	pq (ij+ip1jm,k,iq) = tps
257	ENDDO
258	ENDDO
259	c$OMP END DO NOWAIT
260	ENDDO
261	endif
262
263
264	RETURN
265	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format