source: LMDZ6/branches/DYNAMICO-conv/libf/dyn3d/addfi.F @ 4976

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