source: LMDZ5/branches/testing/libf/dyn3dpar/caladvtrac_p.F @ 3931

Last change on this file since 3931 was 2641, checked in by Laurent Fairhead, 8 years ago

Merged trunk changes r2593:2640 into testing branch

  • 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 2641 2016-09-29 21:26:46Z oboucher $
[630]3!
4c
5c
6            SUBROUTINE caladvtrac_p(q,pbaru,pbarv ,
7     *                   p ,masse, dq ,  teta,
[960]8     *                   flxw, pk, iapptrac)
[1864]9      USE parallel_lmdz
[1454]10      USE infotrac, ONLY : nqtot
11      USE control_mod, ONLY : iapp_tracvl,planet_type
[2641]12      USE comconst_mod, ONLY: dtvr
[630]13c
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)
[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.