source: LMDZ4/trunk/libf/dyn3dpar/caladvtrac_p.F @ 1385

Last change on this file since 1385 was 1279, checked in by Laurent Fairhead, 15 years ago

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

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