source: trunk/LMDZ.COMMON/libf/dyn3dpar/massbar_p.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: 3.1 KB
RevLine 
[1]1      SUBROUTINE massbar_p(  masse, massebx, masseby )
2     
3c
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  ..  massebx,masseby      sont des argum. de sortie pour le s-pg ...
13c     
14c
[1019]15      USE parallel_lmdz
[1]16      IMPLICIT NONE
17c
18#include "dimensions.h"
19#include "paramet.h"
20#include "comgeom.h"
21c
22      REAL    masse( ip1jmp1,llm ), massebx( ip1jmp1,llm )  ,
23     *      masseby(   ip1jm,llm )
24      INTEGER ij,l,ijb,ije
25c
26c
27c   Methode pour calculer massebx et masseby .
28c   ----------------------------------------
29c
30c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
31c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
32c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
33c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
34c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
35c
36c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)       
37c
38c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
39c
40c
41c
42c   alpha4 .         . alpha1    . alpha4
43c    (i,j)             (i,j)       (i+1,j)
44c
45c             P .        U .          . P
46c           (i,j)       (i,j)         (i+1,j)
47c
48c   alpha3 .         . alpha2    .alpha3
49c    (i,j)              (i,j)     (i+1,j)
50c
51c             V .        Z .          . V
52c           (i,j)
53c
54c   alpha4 .         . alpha1    .alpha4
55c   (i,j+1)            (i,j+1)   (i+1,j+1)
56c
57c             P .        U .          . P
58c          (i,j+1)                    (i+1,j+1)
59c
60c
61c
62c                       On  a :
63c
64c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
65c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
66c     localise  au point  ... U (i,j) ...
67c
68c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
69c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 
70c     localise  au point  ... V (i,j) ...
71c
72c
73c=======================================================================
74     
75     
76     
77c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
78      DO   100    l = 1 , llm
79c
80        ijb=ij_begin
81        ije=ij_end+iip1
82        if (pole_sud) ije=ije-iip1
83       
84        DO  ij = ijb, ije - 1
85         massebx(ij,l) =  masse( ij, l) * alpha1p2( ij  )     +
86     *                   masse(ij+1, l) * alpha3p4(ij+1 )
87        ENDDO
88
89c    .... correction pour massebx( iip1,j) .....
90c    ...    massebx(iip1,j)= massebx(1,j) ...
91c
92CDIR$ IVDEP
93
94       
95
96        DO  ij = ijb+iim, ije+iim, iip1
97         massebx( ij,l ) = massebx( ij - iim,l )
98        ENDDO
99
100
101     
102        ijb=ij_begin-iip1
103        ije=ij_end+iip1
104        if (pole_nord) ijb=ij_begin
105        if (pole_sud) ije=ij_end-iip1
106
107         DO  ij = ijb,ije
108         masseby( ij,l ) = masse(  ij   , l ) * alpha2p3(   ij    )  +
109     *                     masse(ij+iip1, l ) * alpha1p4( ij+iip1 )
110         ENDDO
111
112100   CONTINUE
113c$OMP END DO NOWAIT
114c
115      RETURN
116      END
Note: See TracBrowser for help on using the repository browser.