source: trunk/LMDZ.COMMON/libf/dyn3d/dteta1.F @ 3553

Last change on this file since 3553 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!
2! $Header$
3!
4      SUBROUTINE dteta1 ( teta, pbaru, pbarv, dteta)
5      IMPLICIT NONE
6
7c=======================================================================
8c
9c   Auteur:  P. Le Van
10c   -------
11c Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)
12c
13c   ********************************************************************
14c   ... calcul du terme de convergence horizontale du flux d'enthalpie
15c        potentielle   ......
16c   ********************************************************************
17c  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
18c     dteta               sont des arguments de sortie pour le s-pg ....
19c
20c=======================================================================
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
32c
33
34      DO 5 l = 1,llm
35
36      DO 1  ij = iip2, ip1jm - 1
37      hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l) + teta(ij+1,l) )
38   1  CONTINUE
39
40c    .... correction pour  hbxu(iip1,j,l)  .....
41c    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
42
43CDIR$ IVDEP
44      DO 2 ij = iip1+ iip1, ip1jm, iip1
45      hbxu( ij, l ) = hbxu( ij - iim, l )
46   2  CONTINUE
47
48
49      DO 3 ij = 1,ip1jm
50      hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+ teta(ij +iip1,l) )
51   3  CONTINUE
52
53   5  CONTINUE
54
55
56        CALL  convflu ( hbxu, hbyv, llm, dteta )
57
58
59c    stockage dans  dh de la convergence horizont. filtree' du  flux
60c                  ....                           ...........
61c           d'enthalpie potentielle .
62
63      CALL filtreg( dteta, jjp1, llm, 2, 2, .true., 1)
64
65c
66      RETURN
67      END
Note: See TracBrowser for help on using the repository browser.