source: trunk/LMDZ.COMMON/libf/dyn3dpar/massbarxy_p.F @ 3567

Last change on this file since 3567 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.4 KB
RevLine 
[1]1      SUBROUTINE massbarxy_p(  masse, massebxy )
[1019]2      USE parallel_lmdz
[1]3      implicit none
4c **********************************************************************
5c
6c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
7c **********************************************************************
8c    Auteurs : P. Le Van , Fr. Hourdin  .
9c   ..........
10c
11c  ..  masse          est  un  argum. d'entree  pour le s-pg ...
12c  ..  massebxy       est  un  argum. de sortie pour le s-pg ...
13c     
14c
15c     IMPLICIT NONE
16c
17#include "dimensions.h"
18#include "paramet.h"
19#include "comgeom.h"
20c
21       REAL  masse( ip1jmp1,llm ), massebxy( ip1jm,llm )
22c
23      INTEGER ij,l,ijb,ije
24
25     
26      ijb=ij_begin-iip1
27      ije=ij_end
28     
29      if (pole_nord) ijb=ijb+iip1
30      if (pole_sud)  ije=ije-iip1
31
32c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
33      DO   100    l = 1 , llm
34c
35      DO 5 ij = ijb, ije - 1
36      massebxy( ij,l ) = masse(    ij  ,l ) * alpha2(   ij    )   +
37     +                   masse(   ij+1 ,l ) * alpha3(  ij+1   )   +
38     +                   masse( ij+iip1,l ) * alpha1( ij+iip1 )   +
39     +                   masse( ij+iip2,l ) * alpha4( ij+iip2 )
40   5  CONTINUE
41
42c    ....  correction pour     massebxy( iip1,j )  ........
43
44CDIR$ IVDEP
45
46      DO 7 ij = ijb+iip1-1, ije+iip1-1, iip1
47      massebxy( ij,l ) = massebxy( ij - iim,l )
48   7  CONTINUE
49
50100   CONTINUE
51c$OMP END DO NOWAIT
52c
53      RETURN
54      END
Note: See TracBrowser for help on using the repository browser.