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

Last change on this file since 663 was 616, checked in by lmdzadmin, 20 years ago

Mise a jour pour INCA.2.0 Anne C
MAFi+LF

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