source: LMDZ4/trunk/libf/dyn3d/caladvtrac.F @ 802

Last change on this file since 802 was 762, checked in by Laurent Fairhead, 17 years ago

Merge entre la version V3_conv et le HEAD
YM, JG, LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 KB
Line 
1!
2! $Header$
3!
4c
5c
6#ifdef INCA
7            SUBROUTINE caladvtrac(q,pbaru,pbarv ,
8     *                   p ,masse, dq ,  teta,
9     *                   flxw,
10     *                   pk)
11#else
12            SUBROUTINE caladvtrac(q,pbaru,pbarv ,
13     *                   p ,masse, dq ,  teta,
14     *                   pk)
15#endif
16
17c
18      IMPLICIT NONE
19c
20c     Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron 
21c
22c     F.Codron (10/99) : ajout humidite specifique pour eau vapeur
23c=======================================================================
24c
25c       Shema de  Van Leer
26c
27c=======================================================================
28
29
30#include "dimensions.h"
31#include "paramet.h"
32#include "comconst.h"
33#include "control.h"
34#include "advtrac.h"
35
36c   Arguments:
37c   ----------
38      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm)
39      REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqmx),dq( ip1jmp1,llm,2 )
40      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
41#ifdef INCA
42      REAL               :: flxw(ip1jmp1,llm)
43#endif
44
45c  ..................................................................
46c
47c  .. dq n'est utilise et dimensionne que pour l'eau  vapeur et liqu.
48c
49c  ..................................................................
50c
51c   Local:
52c   ------
53
54      EXTERNAL  advtrac,minmaxq, qminimum
55      INTEGER ij,l, iq, iapptrac
56      REAL finmasse(ip1jmp1,llm), dtvrtrac
57
58cc
59c
60C initialisation
61        dq = 0.
62
63        CALL SCOPY( 2 * ijp1llm, q, 1, dq, 1 )
64
65c  test des valeurs minmax
66cc        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
67cc        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
68
69c   advection
70
71#ifdef INCA
72      CALL advtrac( pbaru,pbarv,
73     *             p,  masse,q,iapptrac, teta,
74     .             flxw,
75     .             pk)
76#else
77      CALL advtrac( pbaru,pbarv,
78     *             p,  masse,q,iapptrac, teta,
79     .             pk)
80#endif
81c
82
83         IF( iapptrac.EQ.iapp_tracvl ) THEN
84c
85cc          CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur     ')
86cc          CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide    ')
87
88cc     ....  Calcul  de deltap  qu'on stocke dans finmasse   ...
89c
90          DO l = 1, llm
91           DO ij = 1, ip1jmp1
92             finmasse(ij,l) =  p(ij,l) - p(ij,l+1)
93           ENDDO
94          ENDDO
95
96          CALL qminimum( q, 2, finmasse )
97
98          CALL SCOPY   ( ip1jmp1*llm, masse, 1, finmasse,       1 )
99          CALL filtreg ( finmasse ,  jjp1,  llm, -2, 2, .TRUE., 1 )
100c
101c   *****  Calcul de dq pour l'eau , pour le passer a la physique ******
102c   ********************************************************************
103c
104          dtvrtrac = iapp_tracvl * dtvr
105c
106           DO iq = 1 , 2
107            DO l = 1 , llm
108             DO ij = 1,ip1jmp1
109             dq(ij,l,iq) = ( q(ij,l,iq) - dq(ij,l,iq) ) * finmasse(ij,l)
110     *                               /  dtvrtrac
111             ENDDO
112            ENDDO
113           ENDDO
114c
115         ELSE
116           DO iq = 1 , 2
117           DO l  = 1, llm
118             DO ij = 1,ip1jmp1
119              dq(ij,l,iq)  = 0.
120             ENDDO
121           ENDDO
122           ENDDO
123
124
125         ENDIF
126
127c
128
129c  ... On appelle  qminimum uniquement  pour l'eau vapeur et liquide  ..
130
131 
132      RETURN
133      END
134
135
Note: See TracBrowser for help on using the repository browser.