source: LMDZ4/branches/pre_V3/libf/dyn3dpar/caladvtrac_p.F @ 3400

Last change on this file since 3400 was 630, checked in by Laurent Fairhead, 20 years ago

Import d'une version parallele 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_CH4
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      EXTERNAL  advtrac,minmaxq, qminimum
61      INTEGER ij,l, iq, iapptrac
62      REAL finmasse(ip1jmp1,llm), dtvrtrac
63     
64
65cc
66c
67C initialisation
68cym      ijb=ij_begin
69cym      ije=ij_end
70
71     
72cym      dq(ijb:ije,1:llm,1:2)=q(ijb:ije,1:llm,1:2)
73
74c  test des valeurs minmax
75cc        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
76cc        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
77
78c   advection
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.