source: LMDZ4/branches/V3_test/libf/dyn3dpar/caladvtrac_p.F @ 714

Last change on this file since 714 was 709, checked in by Laurent Fairhead, 19 years ago

Nouvelles versions de la dynamique YM
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.8 KB
Line 
1!
2! $Header$
3!
4c
5c
6#ifdef INCA
7            SUBROUTINE caladvtrac_p(q,pbaru,pbarv ,
8     *                   p ,masse, dq ,  teta,
9     *                   flxw,
10     *                   pk,
11     *                   mmt_adj,
12     *                   hadv_flg,iapptrac)
13#else
14            SUBROUTINE caladvtrac_p(q,pbaru,pbarv ,
15     *                   p ,masse, dq ,  teta,
16     *                   pk,iapptrac)
17#endif
18      USE parallel
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_CH4
44cym      INTEGER            :: hadv_flg(nq)
45      INTEGER            :: hadv_flg(nqmx)
46      REAL               :: mmt_adj(iip1,jjp1,llm)
47      REAL               :: flxw(ip1jmp1,llm)
48#endif
49      integer ijb,ije,jjb,jje
50
51c  ..................................................................
52c
53c  .. dq n'est utilise et dimensionne que pour l'eau  vapeur et liqu.
54c
55c  ..................................................................
56c
57c   Local:
58c   ------
59
60      INTEGER ij,l, iq, iapptrac
61      REAL finmasse(ip1jmp1,llm), dtvrtrac
62     
63
64cc
65c
66C initialisation
67cym      ijb=ij_begin
68cym      ije=ij_end
69
70     
71cym      dq(ijb:ije,1:llm,1:2)=q(ijb:ije,1:llm,1:2)
72
73c  test des valeurs minmax
74cc        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
75cc        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
76
77c   advection
78c      print *,'appel a advtrac'
79
80#ifdef INCA_CH4
81      CALL advtrac_p( pbaru,pbarv,
82     *             p,  masse,q,iapptrac, teta,
83     .             flxw,
84     .             pk,
85     .             mmt_adj,
86     .             hadv_flg)
87#else
88      CALL advtrac_p( pbaru,pbarv,
89     *             p,  masse,q,iapptrac, teta,
90     .             pk)
91#endif
92c
93
94         goto 9999
95         IF( iapptrac.EQ.iapp_tracvl ) THEN
96c
97cc          CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur     ')
98cc          CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide    ')
99
100cc     ....  Calcul  de deltap  qu'on stocke dans finmasse   ...
101c
102          DO l = 1, llm
103           DO ij = ijb, ije
104             finmasse(ij,l) =  p(ij,l) - p(ij,l+1)
105           ENDDO
106          ENDDO
107
108          CALL qminimum_p( q, 2, finmasse )
109
110cym   --> le reste ne set a rien
111          goto 9999
112         
113c          CALL SCOPY   ( ip1jmp1*llm, masse, 1, finmasse,       1 )
114          finmasse(ijb:ije,:)=masse(ijb:ije,:)         
115         
116          jjb=jj_begin
117          jje=jj_end
118          CALL filtreg_p ( finmasse ,jjb,jje,  jjp1,  llm,
119     *                     -2, 2, .TRUE., 1 )
120c
121c   *****  Calcul de dq pour l'eau , pour le passer a la physique ******
122c   ********************************************************************
123c
124          dtvrtrac = iapp_tracvl * dtvr
125c
126           DO iq = 1 , 2
127            DO l = 1 , llm
128             DO ij = ijb,ije
129             dq(ij,l,iq) = ( q(ij,l,iq) - dq(ij,l,iq) ) * finmasse(ij,l)
130     *                               /  dtvrtrac
131             ENDDO
132            ENDDO
133           ENDDO
134c
135         ELSE
136cym   --> le reste ne set a rien
137          goto 9999
138         
139           DO iq = 1 , 2
140           DO l  = 1, llm
141             DO ij = ijb,ije
142              dq(ij,l,iq)  = 0.
143             ENDDO
144           ENDDO
145           ENDDO
146
147         ENDIF
148c
149
150
151c  ... On appelle  qminimum uniquement  pour l'eau vapeur et liquide  ..
152
153 
154 9999 RETURN
155      END
156
157
Note: See TracBrowser for help on using the repository browser.