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