source: LMDZ5/trunk/libf/dyn3dpar/addfi_p.F @ 2597

Last change on this file since 2597 was 2597, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod.
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
  • 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 2597 2016-07-22 06:44: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
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"
51#include "serre.h"
52c
53c    Arguments :
54c    -----------
55c
56      REAL,INTENT(IN) :: pdt ! time step for the integration (s)
57c
58      REAL,INTENT(INOUT) :: pvcov(ip1jm,llm) ! covariant meridional wind
59      REAL,INTENT(INOUT) :: pucov(ip1jmp1,llm) ! covariant zonal wind
60      REAL,INTENT(INOUT) :: pteta(ip1jmp1,llm) ! potential temperature
61      REAL,INTENT(INOUT) :: pq(ip1jmp1,llm,nqtot) ! tracers
62      REAL,INTENT(INOUT) :: pps(ip1jmp1) ! surface pressure (Pa)
63c respective tendencies (.../s) to add
64      REAL,INTENT(IN) :: pdvfi(ip1jm,llm)
65      REAL,INTENT(IN) :: pdufi(ip1jmp1,llm)
66      REAL,INTENT(IN) :: pdqfi(ip1jmp1,llm,nqtot)
67      REAL,INTENT(IN) :: pdhfi(ip1jmp1,llm)
68      REAL,INTENT(IN) :: pdpfi(ip1jmp1)
69c
70      LOGICAL,INTENT(IN) :: leapf,forward ! not used
71c
72c
73c    Local variables :
74c    -----------------
75c
76      REAL xpn(iim),xps(iim),tpn,tps
77      INTEGER j,k,iq,ij
78      REAL,PARAMETER :: qtestw = 1.0e-15
79      REAL,PARAMETER :: qtestt = 1.0e-40
80
81      REAL SSUM
82      EXTERNAL SSUM
83     
84      INTEGER :: ijb,ije
85c
86c-----------------------------------------------------------------------
87     
88      ijb=ij_begin
89      ije=ij_end
90     
91c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
92      DO k = 1,llm
93         DO j = ijb,ije
94            pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
95         ENDDO
96      ENDDO
97c$OMP END DO NOWAIT
98
99      if (pole_nord) then
100c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
101        DO  k    = 1, llm
102         DO  ij   = 1, iim
103           xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
104         ENDDO
105         tpn      = SSUM(iim,xpn,1)/ apoln
106
107         DO ij   = 1, iip1
108           pteta(   ij   ,k)  = tpn
109         ENDDO
110       ENDDO
111c$OMP END DO NOWAIT
112      endif
113
114      if (pole_sud) then
115c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
116        DO  k    = 1, llm
117         DO  ij   = 1, iim
118           xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
119         ENDDO
120         tps      = SSUM(iim,xps,1)/ apols
121
122         DO ij   = 1, iip1
123           pteta(ij+ip1jm,k)  = tps
124         ENDDO
125       ENDDO
126c$OMP END DO NOWAIT
127      endif
128c
129
130      ijb=ij_begin
131      ije=ij_end
132      if (pole_nord) ijb=ij_begin+iip1
133      if (pole_sud)  ije=ij_end-iip1
134
135c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
136      DO k = 1,llm
137         DO j = ijb,ije
138            pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
139         ENDDO
140      ENDDO
141c$OMP END DO NOWAIT
142
143      if (pole_nord) ijb=ij_begin
144
145c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
146      DO k = 1,llm
147         DO j = ijb,ije
148            pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
149         ENDDO
150      ENDDO
151c$OMP END DO NOWAIT
152
153c
154      if (pole_sud)  ije=ij_end
155c$OMP MASTER
156      DO j = ijb,ije
157         pps(j) = pps(j) + pdpfi(j) * pdt
158      ENDDO
159c$OMP END MASTER
160 
161      if (planet_type=="earth") then
162      ! earth case, special treatment for first 2 tracers (water)
163       DO iq = 1, 2
164c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
165         DO k = 1,llm
166            DO j = ijb,ije
167               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
168               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
169            ENDDO
170         ENDDO
171c$OMP END DO NOWAIT
172       ENDDO
173
174       DO iq = 3, nqtot
175c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
176         DO k = 1,llm
177            DO j = ijb,ije
178               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
179               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
180            ENDDO
181         ENDDO
182c$OMP END DO NOWAIT
183       ENDDO
184      else
185      ! general case, treat all tracers equally)
186       DO iq = 1, nqtot
187c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
188         DO k = 1,llm
189            DO j = ijb,ije
190               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
191               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
192            ENDDO
193         ENDDO
194c$OMP END DO NOWAIT
195       ENDDO
196      endif ! of if (planet_type=="earth")
197
198c$OMP MASTER
199      if (pole_nord) then
200     
201        DO  ij   = 1, iim
202          xpn(ij) = aire(   ij   ) * pps(  ij     )
203        ENDDO
204
205        tpn      = SSUM(iim,xpn,1)/apoln
206
207        DO ij   = 1, iip1
208          pps (   ij     )  = tpn
209        ENDDO
210     
211      endif
212
213      if (pole_sud) then
214     
215        DO  ij   = 1, iim
216          xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
217        ENDDO
218
219        tps      = SSUM(iim,xps,1)/apols
220
221        DO ij   = 1, iip1
222          pps ( ij+ip1jm )  = tps
223        ENDDO
224     
225      endif
226c$OMP END MASTER
227
228      if (pole_nord) then
229        DO iq = 1, nqtot
230c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
231          DO  k    = 1, llm
232            DO  ij   = 1, iim
233              xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
234            ENDDO
235            tpn      = SSUM(iim,xpn,1)/apoln
236 
237            DO ij   = 1, iip1
238              pq (   ij   ,k,iq)  = tpn
239            ENDDO
240          ENDDO
241c$OMP END DO NOWAIT       
242        ENDDO
243      endif
244     
245      if (pole_sud) then
246        DO iq = 1, nqtot
247c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
248          DO  k    = 1, llm
249            DO  ij   = 1, iim
250              xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
251            ENDDO
252            tps      = SSUM(iim,xps,1)/apols
253 
254            DO ij   = 1, iip1
255              pq (ij+ip1jm,k,iq)  = tps
256            ENDDO
257          ENDDO
258c$OMP END DO NOWAIT       
259        ENDDO
260      endif
261     
262     
263      RETURN
264      END
Note: See TracBrowser for help on using the repository browser.