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

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

Cleanup in the dynamics: turn serre.h into module serre_mod.F90
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
RevLine 
[774]1!
[1454]2! $Id: addfi_p.F 2598 2016-07-22 09:28:39Z idelkadi $
[774]3!
[1146]4      SUBROUTINE addfi_p(pdt, leapf, forward,
[630]5     S          pucov, pvcov, pteta, pq   , pps ,
6     S          pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
[1823]7      USE parallel_lmdz
[1146]8      USE infotrac, ONLY : nqtot
[1454]9      USE control_mod, ONLY : planet_type
[630]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
[1987]55      REAL,INTENT(IN) :: pdt ! time step for the integration (s)
[630]56c
[1987]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)
[630]68c
[1987]69      LOGICAL,INTENT(IN) :: leapf,forward ! not used
[630]70c
71c
72c    Local variables :
73c    -----------------
74c
75      REAL xpn(iim),xps(iim),tpn,tps
76      INTEGER j,k,iq,ij
[1987]77      REAL,PARAMETER :: qtestw = 1.0e-15
78      REAL,PARAMETER :: qtestt = 1.0e-40
[630]79
80      REAL SSUM
81      EXTERNAL SSUM
82     
83      INTEGER :: ijb,ije
84c
85c-----------------------------------------------------------------------
86     
87      ijb=ij_begin
88      ije=ij_end
89     
[764]90c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
[630]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
[764]96c$OMP END DO NOWAIT
[630]97
98      if (pole_nord) then
[764]99c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]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
[764]110c$OMP END DO NOWAIT
[630]111      endif
112
113      if (pole_sud) then
[764]114c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]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
[764]125c$OMP END DO NOWAIT
[630]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
[764]133
134c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]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
[764]140c$OMP END DO NOWAIT
[630]141
142      if (pole_nord) ijb=ij_begin
143
[764]144c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]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
[764]150c$OMP END DO NOWAIT
[630]151
152c
153      if (pole_sud)  ije=ij_end
[764]154c$OMP MASTER
[630]155      DO j = ijb,ije
156         pps(j) = pps(j) + pdpfi(j) * pdt
157      ENDDO
[764]158c$OMP END MASTER
[630]159 
[1454]160      if (planet_type=="earth") then
161      ! earth case, special treatment for first 2 tracers (water)
162       DO iq = 1, 2
[764]163c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]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
[764]170c$OMP END DO NOWAIT
[1454]171       ENDDO
[630]172
[1454]173       DO iq = 3, nqtot
[764]174c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]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
[764]181c$OMP END DO NOWAIT
[1454]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")
[630]196
[764]197c$OMP MASTER
[630]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
[764]225c$OMP END MASTER
[630]226
227      if (pole_nord) then
[1146]228        DO iq = 1, nqtot
[764]229c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]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
[764]240c$OMP END DO NOWAIT       
[630]241        ENDDO
242      endif
243     
244      if (pole_sud) then
[1146]245        DO iq = 1, nqtot
[764]246c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]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
[764]257c$OMP END DO NOWAIT       
[630]258        ENDDO
259      endif
260     
261     
262      RETURN
263      END
Note: See TracBrowser for help on using the repository browser.