source: trunk/LMDZ.GENERIC/libf/dyn3d/dteta1.F @ 1422

Last change on this file since 1422 was 1422, checked in by milmd, 10 years ago

In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).

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