source: LMDZ.3.3/branches/rel-LF/libf/dyn3d/tracvl.F @ 293

Last change on this file since 293 was 232, checked in by lmdzadmin, 23 years ago

Merge par rapport a la branche principale
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 KB
RevLine 
[2]1      SUBROUTINE tracvl(numvanle,iapp_tracvl,nq,pbaru,pbarv ,
[232]2     *                    p, masse , q, iapptrac, iadv1, teta, pk  )
[2]3c
4c     Auteur :  F. Hourdin
5c
6c
7ccc   ..   Modif. P. Le Van  ( 20/12/97 )  ...
[232]8c                 F. Codron     (10/99)
9
[2]10c
11      IMPLICIT NONE
12c
13#include "dimensions.h"
14#include "paramet.h"
15#include "comconst.h"
16#include "comvert.h"
17#include "comgeom.h"
18
[232]19c     .... Arguments  ....
20c
21      INTEGER numvanle, nq, iapp_tracvl, iapptrac, iadv1
[2]22
23      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
24      REAL q(ip1jmp1,llm,nq),masse(ip1jmp1,llm)
[232]25      REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
26      REAL pk(ip1jmp1,llm)
[2]27
[232]28c     ....  var. locales  .....
29c
[2]30      REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
31      REAL massem(ip1jmp1,llm),zdp(ip1jmp1)
32
33      REAL pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm)
34
35
[232]36      INTEGER iadvtr, numvan
[2]37      INTEGER ij,l,iq
38      REAL zdpmin, zdpmax
39      EXTERNAL  minmax
[232]40      SAVE iadvtr, massem, pbaruc, pbarvc, numvan
[2]41      DATA iadvtr/0/
42
[232]43      numvan = numvanle
44
[2]45      IF(iadvtr.EQ.0) THEN
46         CALL initial0(ijp1llm,pbaruc)
47         CALL initial0(ijmllm,pbarvc)
48      ENDIF
49
50c   accumulation des flux de masse horizontaux
51      DO l=1,llm
52         DO ij = 1,ip1jmp1
53            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
54         ENDDO
55         DO ij = 1,ip1jm
56            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
57         ENDDO
58      ENDDO
59
60c   selection de la masse instantannee des mailles avant le transport.
61      IF(iadvtr.EQ.0) THEN
62
63         CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
64ccc         CALL filtreg ( massem ,jjp1, llm,-2, 2, .TRUE., 1 )
65c
66      ENDIF
67
68      iadvtr   = iadvtr+1
69      iapptrac = iadvtr
70
71
72c   Test pour savoir si on advecte a ce pas de temps
73      IF ( iadvtr.EQ.iapp_tracvl ) THEN
74
75cc   ..  Modif P.Le Van  ( 20/12/97 )  ....
76cc
77
78c   traitement des flux de masse avant advection.
79c     1. calcul de w
80c     2. groupement des mailles pres du pole.
81
82        CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
83
84
85c  test sur l'eventuelle creation de valeurs negatives de la masse
86         DO l=1,llm-1
87            DO ij = iip2+1,ip1jm
88              zdp(ij) =    pbarug(ij-1,l)   - pbarug(ij,l)
89     s                  - pbarvg(ij-iip1,l) + pbarvg(ij,l)
90     s                  +       wg(ij,l+1)  - wg(ij,l)
91            ENDDO
92            CALL SCOPY( jjm -1 ,zdp(iip1+iip1),iip1,zdp(iip2),iip1 )
93            DO ij = iip2,ip1jm
94               zdp(ij)= zdp(ij)*dtvr/ massem(ij,l)
95            ENDDO
96
97
98            CALL minmax ( ip1jm-iip1, zdp(iip2), zdpmin,zdpmax )
99
100            IF(MAX(ABS(zdpmin),ABS(zdpmax)).GT.0.5) THEN
101            PRINT*,'WARNING DP/P l=',l,'  MIN:',zdpmin,
102     s        '   MAX:', zdpmax
103            ENDIF
104
105         ENDDO
106
107c   Advection proprement dite.
[232]108c
109c   test sur iadv1 pour le schema de vapeur d'eau
110c
111         IF (numvanle.EQ.1.AND.iadv1.EQ.4) THEN
112           CALL vlspltqs( q(1,1,1), 2., massem, wg ,
113     *                 pbarug,pbarvg,dtvr,p,pk,teta )
114           numvan = 2
115         ENDIF
116
117         DO iq = numvan, nq
[2]118          CALL vlsplt( q(1,1,iq), 2. ,massem,wg,pbarug,pbarvg,dtvr )
119         ENDDO
120
121         iadvtr=0
122
123c   on reinitialise a zero les flux de masse cumules.
124
125      ENDIF ! if iadvtr.EQ.iapp_tracvl
126
127      RETURN
128      END
Note: See TracBrowser for help on using the repository browser.