source: LMDZ4/branches/LMDZ4-dev/libf/dyn3d/addfi.F @ 1142

Last change on this file since 1142 was 1114, checked in by jghattas, 16 years ago

Creation du module infotrac:

  • contient les variables de advtrac.h
  • contient la subroutine iniadvtrac renommer en infotrac_init
  • le nombre des traceurs est lu dans tracer.def en dynamique (ou par default ou recu par INCA)
  • ce module est utilise dans la dynamique et la physique
  • contient aussi la variable nbtr qui avant etait stockee dans dimphy

Le fichier advtrac.h n'existe plus.
La compilation ne prend plus en compte le nombre de traceur.

/JG
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.9 KB
Line 
1!
2! $Header$
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      IMPLICIT NONE
10c
11c=======================================================================
12c
13c    Addition of the physical tendencies
14c
15c    Interface :
16c    -----------
17c
18c      Input :
19c      -------
20c      pdt                    time step of integration
21c      leapf                  logical
22c      forward                logical
23c      pucov(ip1jmp1,llm)     first component of the covariant velocity
24c      pvcov(ip1ip1jm,llm)    second component of the covariant velocity
25c      pteta(ip1jmp1,llm)     potential temperature
26c      pts(ip1jmp1,llm)       surface temperature
27c      pdufi(ip1jmp1,llm)     |
28c      pdvfi(ip1jm,llm)       |   respective
29c      pdhfi(ip1jmp1)         |      tendencies
30c      pdtsfi(ip1jmp1)        |
31c
32c      Output :
33c      --------
34c      pucov
35c      pvcov
36c      ph
37c      pts
38c
39c
40c=======================================================================
41c
42c-----------------------------------------------------------------------
43c
44c    0.  Declarations :
45c    ------------------
46c
47#include "dimensions.h"
48#include "paramet.h"
49#include "comconst.h"
50#include "comgeom.h"
51#include "serre.h"
52c
53c    Arguments :
54c    -----------
55c
56      REAL pdt
57c
58      REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)
59      REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nqtot),pps(ip1jmp1)
60c
61      REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)
62      REAL pdqfi(ip1jmp1,llm,nqtot),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
63c
64      LOGICAL leapf,forward
65c
66c
67c    Local variables :
68c    -----------------
69c
70      REAL xpn(iim),xps(iim),tpn,tps
71      INTEGER j,k,iq,ij
72      REAL qtestw, qtestt
73      PARAMETER ( qtestw = 1.0e-15 )
74      PARAMETER ( qtestt = 1.0e-40 )
75
76      REAL SSUM
77c
78c-----------------------------------------------------------------------
79
80      DO k = 1,llm
81         DO j = 1,ip1jmp1
82            pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
83         ENDDO
84      ENDDO
85
86      DO  k    = 1, llm
87       DO  ij   = 1, iim
88         xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
89         xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
90       ENDDO
91       tpn      = SSUM(iim,xpn,1)/ apoln
92       tps      = SSUM(iim,xps,1)/ apols
93
94       DO ij   = 1, iip1
95         pteta(   ij   ,k)  = tpn
96         pteta(ij+ip1jm,k)  = tps
97       ENDDO
98      ENDDO
99c
100
101      DO k = 1,llm
102         DO j = iip2,ip1jm
103            pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
104         ENDDO
105      ENDDO
106
107      DO k = 1,llm
108         DO j = 1,ip1jm
109            pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
110         ENDDO
111      ENDDO
112
113c
114      DO j = 1,ip1jmp1
115         pps(j) = pps(j) + pdpfi(j) * pdt
116      ENDDO
117 
118      DO iq = 1, 2
119         DO k = 1,llm
120            DO j = 1,ip1jmp1
121               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
122               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
123            ENDDO
124         ENDDO
125      ENDDO
126
127      DO iq = 3, nqtot
128         DO k = 1,llm
129            DO j = 1,ip1jmp1
130               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
131               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
132            ENDDO
133         ENDDO
134      ENDDO
135
136
137      DO  ij   = 1, iim
138        xpn(ij) = aire(   ij   ) * pps(  ij     )
139        xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
140      ENDDO
141      tpn      = SSUM(iim,xpn,1)/apoln
142      tps      = SSUM(iim,xps,1)/apols
143
144      DO ij   = 1, iip1
145        pps (   ij     )  = tpn
146        pps ( ij+ip1jm )  = tps
147      ENDDO
148
149
150      DO iq = 1, nqtot
151        DO  k    = 1, llm
152          DO  ij   = 1, iim
153            xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
154            xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
155          ENDDO
156          tpn      = SSUM(iim,xpn,1)/apoln
157          tps      = SSUM(iim,xps,1)/apols
158
159          DO ij   = 1, iip1
160            pq (   ij   ,k,iq)  = tpn
161            pq (ij+ip1jm,k,iq)  = tps
162          ENDDO
163        ENDDO
164      ENDDO
165
166      RETURN
167      END
Note: See TracBrowser for help on using the repository browser.