source: LMDZ5/branches/LMDZ6_rc0/libf/dyn3d/addfi.F @ 3365

Last change on this file since 3365 was 1999, checked in by Laurent Fairhead, 11 years ago

Merged trunk changes r1920:1997 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: 4.8 KB
Line 
1!
2! $Id: addfi.F 1999 2014-03-20 09:57:19Z idelkadi $
3!
4      SUBROUTINE addfi(pdt, leapf, forward,
5     S          pucov, pvcov, pteta, pq   , pps ,
6     S          pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
7
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 "comconst.h"
51#include "comgeom.h"
52#include "serre.h"
53c
54c    Arguments :
55c    -----------
56c
57      REAL,INTENT(IN) :: pdt ! time step for the integration (s)
58c
59      REAL,INTENT(INOUT) :: pvcov(ip1jm,llm) ! covariant meridional wind
60      REAL,INTENT(INOUT) :: pucov(ip1jmp1,llm) ! covariant zonal wind
61      REAL,INTENT(INOUT) :: pteta(ip1jmp1,llm) ! potential temperature
62      REAL,INTENT(INOUT) :: pq(ip1jmp1,llm,nqtot) ! tracers
63      REAL,INTENT(INOUT) :: pps(ip1jmp1) ! surface pressure (Pa)
64c respective tendencies (.../s) to add
65      REAL,INTENT(IN) :: pdvfi(ip1jm,llm)
66      REAL,INTENT(IN) :: pdufi(ip1jmp1,llm)
67      REAL,INTENT(IN) :: pdqfi(ip1jmp1,llm,nqtot)
68      REAL,INTENT(IN) :: pdhfi(ip1jmp1,llm)
69      REAL,INTENT(IN) :: pdpfi(ip1jmp1)
70c
71      LOGICAL,INTENT(IN) :: leapf,forward ! not used
72c
73c
74c    Local variables :
75c    -----------------
76c
77      REAL xpn(iim),xps(iim),tpn,tps
78      INTEGER j,k,iq,ij
79      REAL,PARAMETER :: qtestw = 1.0e-15
80      REAL,PARAMETER :: qtestt = 1.0e-40
81
82      REAL SSUM
83c
84c-----------------------------------------------------------------------
85
86      DO k = 1,llm
87         DO j = 1,ip1jmp1
88            pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
89         ENDDO
90      ENDDO
91
92      DO  k    = 1, llm
93       DO  ij   = 1, iim
94         xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
95         xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
96       ENDDO
97       tpn      = SSUM(iim,xpn,1)/ apoln
98       tps      = SSUM(iim,xps,1)/ apols
99
100       DO ij   = 1, iip1
101         pteta(   ij   ,k)  = tpn
102         pteta(ij+ip1jm,k)  = tps
103       ENDDO
104      ENDDO
105c
106
107      DO k = 1,llm
108         DO j = iip2,ip1jm
109            pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
110         ENDDO
111      ENDDO
112
113      DO k = 1,llm
114         DO j = 1,ip1jm
115            pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
116         ENDDO
117      ENDDO
118
119c
120      DO j = 1,ip1jmp1
121         pps(j) = pps(j) + pdpfi(j) * pdt
122      ENDDO
123 
124      if (planet_type=="earth") then
125      ! earth case, special treatment for first 2 tracers (water)
126       DO iq = 1, 2
127         DO k = 1,llm
128            DO j = 1,ip1jmp1
129               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
130               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
131            ENDDO
132         ENDDO
133       ENDDO
134
135       DO iq = 3, nqtot
136         DO k = 1,llm
137            DO j = 1,ip1jmp1
138               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
139               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
140            ENDDO
141         ENDDO
142       ENDDO
143      else
144      ! general case, treat all tracers equally)
145       DO iq = 1, nqtot
146         DO k = 1,llm
147            DO j = 1,ip1jmp1
148               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
149               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
150            ENDDO
151         ENDDO
152       ENDDO
153      endif ! of if (planet_type=="earth")
154
155
156      DO  ij   = 1, iim
157        xpn(ij) = aire(   ij   ) * pps(  ij     )
158        xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
159      ENDDO
160      tpn      = SSUM(iim,xpn,1)/apoln
161      tps      = SSUM(iim,xps,1)/apols
162
163      DO ij   = 1, iip1
164        pps (   ij     )  = tpn
165        pps ( ij+ip1jm )  = tps
166      ENDDO
167
168
169      DO iq = 1, nqtot
170        DO  k    = 1, llm
171          DO  ij   = 1, iim
172            xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
173            xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
174          ENDDO
175          tpn      = SSUM(iim,xpn,1)/apoln
176          tps      = SSUM(iim,xps,1)/apols
177
178          DO ij   = 1, iip1
179            pq (   ij   ,k,iq)  = tpn
180            pq (ij+ip1jm,k,iq)  = tps
181          ENDDO
182        ENDDO
183      ENDDO
184
185      RETURN
186      END
Note: See TracBrowser for help on using the repository browser.