source: LMDZ4/trunk/libf/dyn3dpar/caladvtrac_p.F @ 1085

Last change on this file since 1085 was 960, checked in by lsce, 16 years ago
  • Ajoute du parametre config_inca dans conf_gcm.F config_inca='none'(sans INCA, par defaut) config_inca='chem'(avec INCA config chemie) config_inca='aero'(avec INCA config aerosol)
  • Menage parmis les cles CPP INCA
  • Enleve le calcul d'omega dans calfis.F et active le calcul correspondant dans advtrac.F(avant uniquement pour INCA).

JG

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