source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/addfi_loc.f90 @ 5153

Last change on this file since 5153 was 5136, checked in by abarral, 8 weeks ago

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