source: trunk/LMDZ.COMMON/libf/dyn3d/caladvtrac.F @ 1422

Last change on this file since 1422 was 1422, checked in by milmd, 10 years ago

In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).

File size: 3.2 KB
Line 
1!
2! $Id: caladvtrac.F 1446 2010-10-22 09:27:25Z emillour $
3!
4c
5c
6            SUBROUTINE caladvtrac(q,pbaru,pbarv ,
7     *                   p ,masse, dq ,  teta,
8     *                   flxw, pk)
9c
10      USE infotrac, ONLY : nqtot
11      USE control_mod, ONLY : iapp_tracvl,planet_type
12      USE comconst_mod, ONLY: dtvr
13 
14      IMPLICIT NONE
15c
16c     Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron 
17c
18c     F.Codron (10/99) : ajout humidite specifique pour eau vapeur
19c=======================================================================
20c
21c       Shema de  Van Leer
22c
23c=======================================================================
24
25
26#include "dimensions.h"
27#include "paramet.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
37c  ..................................................................
38c
39c  .. dq n'est utilise et dimensionne que pour l'eau  vapeur et liqu.
40c
41c  ..................................................................
42c
43c   Local:
44c   ------
45
46      EXTERNAL  advtrac,minmaxq, qminimum
47      INTEGER ij,l, iq, iapptrac
48      REAL finmasse(ip1jmp1,llm), dtvrtrac
49
50cc
51c
52! Earth-specific stuff for the first 2 tracers (water)
53      if (planet_type.eq."earth") then
54C initialisation
55        dq(:,:,1:2)=q(:,:,1:2)
56       
57c  test des valeurs minmax
58cc        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
59cc        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
60      endif ! of if (planet_type.eq."earth")
61c   advection
62
63        CALL advtrac( pbaru,pbarv,
64     *       p,  masse,q,iapptrac, teta,
65     .       flxw, pk)
66
67c
68
69      IF( iapptrac.EQ.iapp_tracvl ) THEN
70        if (planet_type.eq."earth") then
71! Earth-specific treatment for the first 2 tracers (water)
72c
73cc          CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur     ')
74cc          CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide    ')
75
76cc     ....  Calcul  de deltap  qu'on stocke dans finmasse   ...
77c
78          DO l = 1, llm
79           DO ij = 1, ip1jmp1
80             finmasse(ij,l) =  p(ij,l) - p(ij,l+1)
81           ENDDO
82          ENDDO
83         
84          CALL qminimum( q, 2, finmasse )
85
86          CALL SCOPY   ( ip1jmp1*llm, masse, 1, finmasse,       1 )
87          CALL filtreg ( finmasse ,  jjp1,  llm, -2, 2, .TRUE., 1 )
88c
89c   *****  Calcul de dq pour l'eau , pour le passer a la physique ******
90c   ********************************************************************
91c
92          dtvrtrac = iapp_tracvl * dtvr
93c
94           DO iq = 1 , 2
95            DO l = 1 , llm
96             DO ij = 1,ip1jmp1
97             dq(ij,l,iq) = ( q(ij,l,iq) - dq(ij,l,iq) ) * finmasse(ij,l)
98     *                               /  dtvrtrac
99             ENDDO
100            ENDDO
101           ENDDO
102c
103        endif ! of if (planet_type.eq."earth")
104      ELSE
105        if (planet_type.eq."earth") then
106! Earth-specific treatment for the first 2 tracers (water)
107          dq(:,:,1:2)=0.
108        endif ! of if (planet_type.eq."earth")
109      ENDIF ! of IF( iapptrac.EQ.iapp_tracvl )
110
111      END
112
113
Note: See TracBrowser for help on using the repository browser.