Context Navigation

addfi_p.F @ 3084

Last change on this file since 3084 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.

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 6.0 KB

Line
1	!
2	! $Id: addfi_p.F 1446 2010-10-22 09:27:25Z oboucher $
3	!
4	SUBROUTINE addfi_p(pdt, leapf, forward,
5	S pucov, pvcov, pteta, pq , pps ,
6	S pdufi, pdvfi, pdhfi,pdqfi, pdpfi )
7	USE parallel
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 pdt
58	c
59	REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)
60	REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nqtot),pps(ip1jmp1)
61	c
62	REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)
63	REAL pdqfi(ip1jmp1,llm,nqtot),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
64	c
65	LOGICAL leapf,forward
66	c
67	c
68	c Local variables :
69	c -----------------
70	c
71	REAL xpn(iim),xps(iim),tpn,tps
72	INTEGER j,k,iq,ij
73	REAL qtestw, qtestt
74	PARAMETER ( qtestw = 1.0e-15 )
75	PARAMETER ( qtestt = 1.0e-40 )
76
77	REAL SSUM
78	EXTERNAL SSUM
79
80	INTEGER :: ijb,ije
81	c
82	c-----------------------------------------------------------------------
83
84	ijb=ij_begin
85	ije=ij_end
86
87	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
88	DO k = 1,llm
89	DO j = ijb,ije
90	pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
91	ENDDO
92	ENDDO
93	c$OMP END DO NOWAIT
94
95	if (pole_nord) then
96	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
97	DO k = 1, llm
98	DO ij = 1, iim
99	xpn(ij) = aire( ij ) * pteta( ij ,k)
100	ENDDO
101	tpn = SSUM(iim,xpn,1)/ apoln
102
103	DO ij = 1, iip1
104	pteta( ij ,k) = tpn
105	ENDDO
106	ENDDO
107	c$OMP END DO NOWAIT
108	endif
109
110	if (pole_sud) then
111	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
112	DO k = 1, llm
113	DO ij = 1, iim
114	xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
115	ENDDO
116	tps = SSUM(iim,xps,1)/ apols
117
118	DO ij = 1, iip1
119	pteta(ij+ip1jm,k) = tps
120	ENDDO
121	ENDDO
122	c$OMP END DO NOWAIT
123	endif
124	c
125
126	ijb=ij_begin
127	ije=ij_end
128	if (pole_nord) ijb=ij_begin+iip1
129	if (pole_sud) ije=ij_end-iip1
130
131	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
132	DO k = 1,llm
133	DO j = ijb,ije
134	pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
135	ENDDO
136	ENDDO
137	c$OMP END DO NOWAIT
138
139	if (pole_nord) ijb=ij_begin
140
141	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
142	DO k = 1,llm
143	DO j = ijb,ije
144	pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
145	ENDDO
146	ENDDO
147	c$OMP END DO NOWAIT
148
149	c
150	if (pole_sud) ije=ij_end
151	c$OMP MASTER
152	DO j = ijb,ije
153	pps(j) = pps(j) + pdpfi(j) * pdt
154	ENDDO
155	c$OMP END MASTER
156
157	if (planet_type=="earth") then
158	! earth case, special treatment for first 2 tracers (water)
159	DO iq = 1, 2
160	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
161	DO k = 1,llm
162	DO j = ijb,ije
163	pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
164	pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
165	ENDDO
166	ENDDO
167	c$OMP END DO NOWAIT
168	ENDDO
169
170	DO iq = 3, nqtot
171	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
172	DO k = 1,llm
173	DO j = ijb,ije
174	pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
175	pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
176	ENDDO
177	ENDDO
178	c$OMP END DO NOWAIT
179	ENDDO
180	else
181	! general case, treat all tracers equally)
182	DO iq = 1, nqtot
183	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
184	DO k = 1,llm
185	DO j = ijb,ije
186	pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
187	pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
188	ENDDO
189	ENDDO
190	c$OMP END DO NOWAIT
191	ENDDO
192	endif ! of if (planet_type=="earth")
193
194	c$OMP MASTER
195	if (pole_nord) then
196
197	DO ij = 1, iim
198	xpn(ij) = aire( ij ) * pps( ij )
199	ENDDO
200
201	tpn = SSUM(iim,xpn,1)/apoln
202
203	DO ij = 1, iip1
204	pps ( ij ) = tpn
205	ENDDO
206
207	endif
208
209	if (pole_sud) then
210
211	DO ij = 1, iim
212	xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
213	ENDDO
214
215	tps = SSUM(iim,xps,1)/apols
216
217	DO ij = 1, iip1
218	pps ( ij+ip1jm ) = tps
219	ENDDO
220
221	endif
222	c$OMP END MASTER
223
224	if (pole_nord) then
225	DO iq = 1, nqtot
226	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
227	DO k = 1, llm
228	DO ij = 1, iim
229	xpn(ij) = aire( ij ) * pq( ij ,k,iq)
230	ENDDO
231	tpn = SSUM(iim,xpn,1)/apoln
232
233	DO ij = 1, iip1
234	pq ( ij ,k,iq) = tpn
235	ENDDO
236	ENDDO
237	c$OMP END DO NOWAIT
238	ENDDO
239	endif
240
241	if (pole_sud) then
242	DO iq = 1, nqtot
243	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
244	DO k = 1, llm
245	DO ij = 1, iim
246	xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
247	ENDDO
248	tps = SSUM(iim,xps,1)/apols
249
250	DO ij = 1, iip1
251	pq (ij+ip1jm,k,iq) = tps
252	ENDDO
253	ENDDO
254	c$OMP END DO NOWAIT
255	ENDDO
256	endif
257
258
259	RETURN
260	END

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

Download in other formats:

Original Format