source: trunk/LMDZ.COMMON/libf/dyn3d/dudv2.F @ 3020

Last change on this file since 3020 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
RevLine 
[1]1!
2! $Header$
3!
4      SUBROUTINE dudv2 ( teta, pkf, bern, du, dv  )
5
6      IMPLICIT NONE
7c
8c=======================================================================
9c
10c   Auteur:  P. Le Van
11c   -------
12c
13c   Objet:
14c   ------
15c
16c   *****************************************************************
17c   ..... calcul du terme de pression (gradient de p/densite )   et
18c          du terme de ( -gradient de la fonction de Bernouilli ) ...
19c   *****************************************************************
20c          Ces termes sont ajoutes a  d(ucov)/dt et a d(vcov)/dt  ..
21c
22c
23c    teta , pkf, bern  sont des arguments d'entree  pour le s-pg  ....
24c    du et dv          sont des arguments de sortie pour le s-pg  ....
25c
26c=======================================================================
27c
28#include "dimensions.h"
29#include "paramet.h"
30
31      REAL teta( ip1jmp1,llm ),pkf( ip1jmp1,llm ) ,bern( ip1jmp1,llm ),
32     *         du( ip1jmp1,llm ),  dv( ip1jm,llm )
33      INTEGER  l,ij
34c
35c
36      DO 5 l = 1,llm
37c
38      DO 2  ij  = iip2, ip1jm - 1
39       du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) *
40     * ( pkf( ij,l ) - pkf(ij+1,l) )  + bern(ij,l) - bern(ij+1,l)
41   2  CONTINUE
42c
43c
44c    .....  correction  pour du(iip1,j,l),  j=2,jjm   ......
45c    ...          du(iip1,j,l) = du(1,j,l)                 ...
46c
47CDIR$ IVDEP
48      DO 3 ij = iip1+ iip1, ip1jm, iip1
49      du( ij,l ) = du( ij - iim,l )
50   3  CONTINUE
51c
52c
53      DO 4 ij  = 1,ip1jm
54      dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) *
55     *                             ( pkf(ij+iip1,l) - pkf(  ij,l  ) )
56     *                           +   bern( ij+iip1,l ) - bern( ij  ,l )
57   4  CONTINUE
58c
59   5  CONTINUE
60c
61      RETURN
62      END
Note: See TracBrowser for help on using the repository browser.