source: LMDZ.3.3/trunk/libf/dyn3d/tracvl.F @ 57

Last change on this file since 57 was 2, checked in by lmdz, 25 years ago

Initial revision

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