source: LMDZ5/trunk/libf/dyn3d/addfi.F @ 1907

Last change on this file since 1907 was 1907, checked in by lguez, 10 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • 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.4 KB
Line 
1!
2! $Id: addfi.F 1907 2013-11-26 13:10:46Z lguez $
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 pdt
58c
59      REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)
60      REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nqtot),pps(ip1jmp1)
61c
62      REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)
63      REAL pdqfi(ip1jmp1,llm,nqtot),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
64c
65      LOGICAL leapf,forward
66c
67c
68c    Local variables :
69c    -----------------
70c
71      REAL xpn(iim),xps(iim),tpn,tps
72      INTEGER j,k,iq,ij
73      REAL qtestw, qtestt
74      PARAMETER ( qtestw = 1.0e-15 )
75      PARAMETER ( qtestt = 1.0e-40 )
76
77      REAL SSUM
78c
79c-----------------------------------------------------------------------
80
81      DO k = 1,llm
82         DO j = 1,ip1jmp1
83            pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
84         ENDDO
85      ENDDO
86
87      DO  k    = 1, llm
88       DO  ij   = 1, iim
89         xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
90         xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
91       ENDDO
92       tpn      = SSUM(iim,xpn,1)/ apoln
93       tps      = SSUM(iim,xps,1)/ apols
94
95       DO ij   = 1, iip1
96         pteta(   ij   ,k)  = tpn
97         pteta(ij+ip1jm,k)  = tps
98       ENDDO
99      ENDDO
100c
101
102      DO k = 1,llm
103         DO j = iip2,ip1jm
104            pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
105         ENDDO
106      ENDDO
107
108      DO k = 1,llm
109         DO j = 1,ip1jm
110            pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
111         ENDDO
112      ENDDO
113
114c
115      DO j = 1,ip1jmp1
116         pps(j) = pps(j) + pdpfi(j) * pdt
117      ENDDO
118 
119      if (planet_type=="earth") then
120      ! earth case, special treatment for first 2 tracers (water)
121       DO iq = 1, 2
122         DO k = 1,llm
123            DO j = 1,ip1jmp1
124               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
125               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
126            ENDDO
127         ENDDO
128       ENDDO
129
130       DO iq = 3, nqtot
131         DO k = 1,llm
132            DO j = 1,ip1jmp1
133               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
134               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
135            ENDDO
136         ENDDO
137       ENDDO
138      else
139      ! general case, treat all tracers equally)
140       DO iq = 1, nqtot
141         DO k = 1,llm
142            DO j = 1,ip1jmp1
143               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
144               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
145            ENDDO
146         ENDDO
147       ENDDO
148      endif ! of if (planet_type=="earth")
149
150
151      DO  ij   = 1, iim
152        xpn(ij) = aire(   ij   ) * pps(  ij     )
153        xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
154      ENDDO
155      tpn      = SSUM(iim,xpn,1)/apoln
156      tps      = SSUM(iim,xps,1)/apols
157
158      DO ij   = 1, iip1
159        pps (   ij     )  = tpn
160        pps ( ij+ip1jm )  = tps
161      ENDDO
162
163
164      DO iq = 1, nqtot
165        DO  k    = 1, llm
166          DO  ij   = 1, iim
167            xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
168            xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
169          ENDDO
170          tpn      = SSUM(iim,xpn,1)/apoln
171          tps      = SSUM(iim,xps,1)/apols
172
173          DO ij   = 1, iip1
174            pq (   ij   ,k,iq)  = tpn
175            pq (ij+ip1jm,k,iq)  = tps
176          ENDDO
177        ENDDO
178      ENDDO
179
180      RETURN
181      END
Note: See TracBrowser for help on using the repository browser.