LMDZ
addfi_p.F
Go to the documentation of this file.
1 !
2 ! $Id: addfi_p.F 1987 2014-02-24 15:05:47Z emillour $
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_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(ip1jm,llm) ! covariant meridional wind
60  REAL,INTENT(INOUT) :: pucov(ip1jmp1,llm) ! covariant zonal wind
61  REAL,INTENT(INOUT) :: pteta(ip1jmp1,llm) ! potential temperature
62  REAL,INTENT(INOUT) :: pq(ip1jmp1,llm,nqtot) ! tracers
63  REAL,INTENT(INOUT) :: pps(ip1jmp1) ! surface pressure (Pa)
64 c respective tendencies (.../s) to add
65  REAL,INTENT(IN) :: pdvfi(ip1jm,llm)
66  REAL,INTENT(IN) :: pdufi(ip1jmp1,llm)
67  REAL,INTENT(IN) :: pdqfi(ip1jmp1,llm,nqtot)
68  REAL,INTENT(IN) :: pdhfi(ip1jmp1,llm)
69  REAL,INTENT(IN) :: pdpfi(ip1jmp1)
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
ip1jmp1
!$Header llmm1 INTEGER ip1jmp1
Definition: paramet.h:14
apols
!$Header!CDK comgeom COMMON comgeom apols
Definition: comgeom.h:8
parallel_lmdz::ij_end
integer, save ij_end
Definition: parallel_lmdz.F90:23
parallel_lmdz::pole_sud
logical, save pole_sud
Definition: parallel_lmdz.F90:25
control_mod::planet_type
character(len=10), save planet_type
Definition: control_mod.F90:32
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
aire
!$Header!CDK comgeom COMMON comgeom aire
Definition: comgeom.h:25
infotrac::nqtot
integer, save nqtot
Definition: infotrac.F90:6
ip1jm
!$Header llmm1 INTEGER ip1jm
Definition: paramet.h:14
apoln
!$Header!CDK comgeom COMMON comgeom apoln
Definition: comgeom.h:8
parallel_lmdz::pole_nord
logical, save pole_nord
Definition: parallel_lmdz.F90:24
addfi_p
subroutine addfi_p(pdt, leapf, forward, pucov, pvcov, pteta, pq, pps, pdufi, pdvfi, pdhfi, pdqfi, pdpfi)
Definition: addfi_p.F:7
parallel_lmdz
Definition: parallel_lmdz.F90:4
parallel_lmdz::ij_begin
integer, save ij_begin
Definition: parallel_lmdz.F90:22
iim
c c zjulian c cym CALL iim cym klev iim
Definition: ini_bilKP_ave.h:24
control_mod
Definition: control_mod.F90:5
pq
INTERFACE SUBROUTINE RRTM_ECRT_140GP && pq
Definition: rrtm_ecrt_140gp.intfb.h:3