source: LMDZ5/branches/testing/libf/dyn3dpar/addfi_p.F

Last change on this file was 2641, checked in by Laurent Fairhead, 8 years ago

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