source: LMDZ6/trunk/libf/dyn3dmem/addfi_loc.f90 @ 5408

Last change on this file since 5408 was 5285, checked in by abarral, 7 weeks ago

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