1 | ! $Header$ |
---|
2 | |
---|
3 | SUBROUTINE dteta1 (teta, pbaru, pbarv, dteta) |
---|
4 | IMPLICIT NONE |
---|
5 | |
---|
6 | !======================================================================= |
---|
7 | ! |
---|
8 | ! Auteur: P. Le Van |
---|
9 | ! ------- |
---|
10 | ! Modif F.Forget 03/94 (on retire q et dq pour construire dteta1) |
---|
11 | ! |
---|
12 | ! ******************************************************************** |
---|
13 | ! ... calcul du terme de convergence horizontale du flux d'enthalpie |
---|
14 | ! potentielle ...... |
---|
15 | ! ******************************************************************** |
---|
16 | ! .. teta,pbaru et pbarv sont des arguments d'entree pour le s-pg .... |
---|
17 | ! dteta sont des arguments de sortie pour le s-pg .... |
---|
18 | ! |
---|
19 | !======================================================================= |
---|
20 | |
---|
21 | include "dimensions.h" |
---|
22 | include "paramet.h" |
---|
23 | |
---|
24 | REAL :: teta(ip1jmp1, llm), pbaru(ip1jmp1, llm), pbarv(ip1jm, llm) |
---|
25 | REAL :: dteta(ip1jmp1, llm) |
---|
26 | INTEGER :: l, ij |
---|
27 | |
---|
28 | REAL :: hbyv(ip1jm, llm), hbxu(ip1jmp1, llm) |
---|
29 | |
---|
30 | ! |
---|
31 | |
---|
32 | DO l = 1, llm |
---|
33 | |
---|
34 | DO ij = iip2, ip1jm - 1 |
---|
35 | hbxu(ij, l) = pbaru(ij, l) * 0.5 * (teta(ij, l) + teta(ij + 1, l)) |
---|
36 | END DO |
---|
37 | |
---|
38 | ! .... correction pour hbxu(iip1,j,l) ..... |
---|
39 | ! .... hbxu(iip1,j,l)= hbxu(1,j,l) .... |
---|
40 | |
---|
41 | !DIR$ IVDEP |
---|
42 | DO ij = iip1 + iip1, ip1jm, iip1 |
---|
43 | hbxu(ij, l) = hbxu(ij - iim, l) |
---|
44 | END DO |
---|
45 | |
---|
46 | DO ij = 1, ip1jm |
---|
47 | hbyv(ij, l) = pbarv(ij, l) * 0.5 * (teta(ij, l) + teta(ij + iip1, l)) |
---|
48 | END DO |
---|
49 | |
---|
50 | END DO |
---|
51 | |
---|
52 | CALL convflu (hbxu, hbyv, llm, dteta) |
---|
53 | |
---|
54 | |
---|
55 | ! stockage dans dh de la convergence horizont. filtree' du flux |
---|
56 | ! .... ........... |
---|
57 | ! d'enthalpie potentielle . |
---|
58 | |
---|
59 | CALL filtreg(dteta, jjp1, llm, 2, 2, .TRUE., 1) |
---|
60 | |
---|
61 | ! |
---|
62 | |
---|
63 | END SUBROUTINE dteta1 |
---|