source: LMDZ5/trunk/libf/dyn3dpar/massbarxy_p.F @ 1907

Last change on this file since 1907 was 1907, checked in by lguez, 10 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.4 KB
Line 
1      SUBROUTINE massbarxy_p(  masse, massebxy )
2      USE parallel_lmdz
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 "comconst.h"
20#include "comgeom.h"
21c
22       REAL  masse( ip1jmp1,llm ), massebxy( ip1jm,llm )
23c
24      INTEGER ij,l,ijb,ije
25
26     
27      ijb=ij_begin-iip1
28      ije=ij_end
29     
30      if (pole_nord) ijb=ijb+iip1
31      if (pole_sud)  ije=ije-iip1
32
33c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
34      DO   100    l = 1 , llm
35c
36      DO 5 ij = ijb, ije - 1
37      massebxy( ij,l ) = masse(    ij  ,l ) * alpha2(   ij    )   +
38     +                   masse(   ij+1 ,l ) * alpha3(  ij+1   )   +
39     +                   masse( ij+iip1,l ) * alpha1( ij+iip1 )   +
40     +                   masse( ij+iip2,l ) * alpha4( ij+iip2 )
41   5  CONTINUE
42
43c    ....  correction pour     massebxy( iip1,j )  ........
44
45CDIR$ IVDEP
46
47      DO 7 ij = ijb+iip1-1, ije+iip1-1, iip1
48      massebxy( ij,l ) = massebxy( ij - iim,l )
49   7  CONTINUE
50
51100   CONTINUE
52c$OMP END DO NOWAIT
53c
54      RETURN
55      END
Note: See TracBrowser for help on using the repository browser.