source: LMDZ5/trunk/libf/dyn3dpar/caladvtrac_p.F @ 2225

Last change on this file since 2225 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.4 KB
RevLine 
[630]1!
[1403]2! $Id: caladvtrac_p.F 1907 2013-11-26 13:10:46Z emillour $
[630]3!
4c
5c
6            SUBROUTINE caladvtrac_p(q,pbaru,pbarv ,
7     *                   p ,masse, dq ,  teta,
[960]8     *                   flxw, pk, iapptrac)
[1823]9      USE parallel_lmdz
[1454]10      USE infotrac, ONLY : nqtot
11      USE control_mod, ONLY : iapp_tracvl,planet_type
[630]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)
[1454]32      REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot)
33      real :: dq( ip1jmp1,llm,nqtot)
[630]34      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
35      REAL               :: flxw(ip1jmp1,llm)
[960]36
[630]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
[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
[1279]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
[630]89
[1279]90
[630]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.