source: LMDZ5/branches/LF-private/libf/dyn3dpar/caladvtrac_p.F @ 4400

Last change on this file since 4400 was 1823, checked in by Ehouarn Millour, 11 years ago

Remplacement de parallel.F90 (en conflit avec orchidée) par parallel_lmdz.F90.
UG
.........................................
Renaming parallel.F90 (conflicting with orchidée) into parallel_lmdz.F90.
UG

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.4 KB
Line 
1!
2! $Id: caladvtrac_p.F 1823 2013-07-31 10:38:37Z dcugnet $
3!
4c
5c
6            SUBROUTINE caladvtrac_p(q,pbaru,pbarv ,
7     *                   p ,masse, dq ,  teta,
8     *                   flxw, pk, iapptrac)
9      USE parallel_lmdz
10      USE infotrac, ONLY : nqtot
11      USE control_mod, ONLY : iapp_tracvl,planet_type
12c
13      IMPLICIT NONE
14c
15c     Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron 
16c
17c     F.Codron (10/99) : ajout humidite specifique pour eau vapeur
18c=======================================================================
19c
20c       Shema de  Van Leer
21c
22c=======================================================================
23
24
25#include "dimensions.h"
26#include "paramet.h"
27#include "comconst.h"
28
29c   Arguments:
30c   ----------
31      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm)
32      REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot)
33      real :: dq( ip1jmp1,llm,nqtot)
34      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
35      REAL               :: flxw(ip1jmp1,llm)
36
37      integer ijb,ije,jjb,jje
38
39c  ..................................................................
40c
41c  .. dq n'est utilise et dimensionne que pour l'eau  vapeur et liqu.
42c
43c  ..................................................................
44c
45c   Local:
46c   ------
47
48      INTEGER ij,l, iq, iapptrac
49      REAL finmasse(ip1jmp1,llm), dtvrtrac
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
65c      print *,'appel a advtrac'
66
67      CALL advtrac_p( pbaru,pbarv,
68     *             p,  masse,q,iapptrac, teta,
69     .             flxw, pk)
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          if (planet_type.eq."earth") then
86! Earth-specific treatment of first 2 tracers (water)
87            CALL qminimum_p( q, 2, finmasse )
88          endif
89
90
91cym   --> le reste ne set a rien
92          goto 9999
93         
94c          CALL SCOPY   ( ip1jmp1*llm, masse, 1, finmasse,       1 )
95          finmasse(ijb:ije,:)=masse(ijb:ije,:)         
96         
97          jjb=jj_begin
98          jje=jj_end
99          CALL filtreg_p ( finmasse ,jjb,jje,  jjp1,  llm,
100     *                     -2, 2, .TRUE., 1 )
101c
102c   *****  Calcul de dq pour l'eau , pour le passer a la physique ******
103c   ********************************************************************
104c
105          dtvrtrac = iapp_tracvl * dtvr
106c
107           DO iq = 1 , 2
108            DO l = 1 , llm
109             DO ij = ijb,ije
110             dq(ij,l,iq) = ( q(ij,l,iq) - dq(ij,l,iq) ) * finmasse(ij,l)
111     *                               /  dtvrtrac
112             ENDDO
113            ENDDO
114           ENDDO
115c
116         ELSE
117cym   --> le reste ne set a rien
118          goto 9999
119         
120           DO iq = 1 , 2
121           DO l  = 1, llm
122             DO ij = ijb,ije
123              dq(ij,l,iq)  = 0.
124             ENDDO
125           ENDDO
126           ENDDO
127
128         ENDIF
129c
130
131
132c  ... On appelle  qminimum uniquement  pour l'eau vapeur et liquide  ..
133
134 
135 9999 RETURN
136      END
137
138
Note: See TracBrowser for help on using the repository browser.