My Project
 All Classes Files Functions Variables Macros
caladvtrac_p.F
Go to the documentation of this file.
1 !
2 ! $Id: caladvtrac_p.F 1454 2010-11-18 12:01:24Z fairhead $
3 !
4 c
5 c
6  SUBROUTINE caladvtrac_p(q,pbaru,pbarv ,
7  * p ,masse, dq , teta,
8  * flxw, pk, iapptrac)
9  USE parallel
10  USE infotrac, ONLY : nqtot
11  USE control_mod, ONLY : iapp_tracvl,planet_type
12 c
13  IMPLICIT NONE
14 c
15 c Auteurs: F.Hourdin , P.Le Van, F.Forget, F.Codron
16 c
17 c F.Codron (10/99) : ajout humidite specifique pour eau vapeur
18 c=======================================================================
19 c
20 c Shema de Van Leer
21 c
22 c=======================================================================
23 
24 
25 #include "dimensions.h"
26 #include "paramet.h"
27 #include "comconst.h"
28 
29 c Arguments:
30 c ----------
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 
39 c ..................................................................
40 c
41 c .. dq n'est utilise et dimensionne que pour l'eau vapeur et liqu.
42 c
43 c ..................................................................
44 c
45 c Local:
46 c ------
47 
48  INTEGER ij,l, iq, iapptrac
49  REAL finmasse(ip1jmp1,llm), dtvrtrac
50 
51 cc
52 c
53 C initialisation
54 cym ijb=ij_begin
55 cym ije=ij_end
56 
57 
58 cym dq(ijb:ije,1:llm,1:2)=q(ijb:ije,1:llm,1:2)
59 
60 c test des valeurs minmax
61 cc CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
62 cc CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
63 
64 c advection
65 c 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
73 c
74 cc CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur ')
75 cc CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide ')
76 
77 cc .... Calcul de deltap qu'on stocke dans finmasse ...
78 c
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 
91 cym --> le reste ne set a rien
92  goto 9999
93 
94 c 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 )
101 c
102 c ***** Calcul de dq pour l'eau , pour le passer a la physique ******
103 c ********************************************************************
104 c
105  dtvrtrac = iapp_tracvl * dtvr
106 c
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
115 c
116  ELSE
117 cym --> 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
129 c
130 
131 
132 c ... On appelle qminimum uniquement pour l'eau vapeur et liquide ..
133 
134 
135  9999 RETURN
136  END
137 
138