source: LMDZ4/branches/V3_test/libf/dyn3dpar/caladvtrac_p.F @ 1798

Last change on this file since 1798 was 726, checked in by Laurent Fairhead, 18 years ago

Modifications pour rendre INCA plus independant de LMDZ ACo
LF

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