source: trunk/LMDZ.COMMON/libf/dyn3d_common/massbar.F @ 1455

Last change on this file since 1455 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: 2.8 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE massbar(  masse, massebx, masseby )
5      IMPLICIT NONE
6c
7c **********************************************************************
8c
9c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
10c **********************************************************************
11c    Auteurs : P. Le Van , Fr. Hourdin  .
12c   ..........
13c
14c  ..  masse                 est  un argum. d'entree  pour le s-pg ...
15c  ..  massebx,masseby      sont des argum. de sortie pour le s-pg ...
16c     
17c
18c     IMPLICIT NONE
19c
20#include "dimensions.h"
21#include "paramet.h"
22#include "comgeom.h"
23c
24      REAL    masse( ip1jmp1,llm ), massebx( ip1jmp1,llm )  ,
25     *      masseby(   ip1jm,llm )
26      INTEGER ij,l
27c
28c
29c   Methode pour calculer massebx et masseby .
30c   ----------------------------------------
31c
32c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
33c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
34c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
35c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
36c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
37c
38c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)       
39c
40c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
41c
42c
43c
44c   alpha4 .         . alpha1    . alpha4
45c    (i,j)             (i,j)       (i+1,j)
46c
47c             P .        U .          . P
48c           (i,j)       (i,j)         (i+1,j)
49c
50c   alpha3 .         . alpha2    .alpha3
51c    (i,j)              (i,j)     (i+1,j)
52c
53c             V .        Z .          . V
54c           (i,j)
55c
56c   alpha4 .         . alpha1    .alpha4
57c   (i,j+1)            (i,j+1)   (i+1,j+1)
58c
59c             P .        U .          . P
60c          (i,j+1)                    (i+1,j+1)
61c
62c
63c
64c                       On  a :
65c
66c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
67c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
68c     localise  au point  ... U (i,j) ...
69c
70c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
71c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 
72c     localise  au point  ... V (i,j) ...
73c
74c
75c=======================================================================
76
77      DO   100    l = 1 , llm
78c
79        DO  ij = 1, ip1jmp1 - 1
80         massebx(ij,l) =  masse( ij, l) * alpha1p2( ij  )     +
81     *                   masse(ij+1, l) * alpha3p4(ij+1 )
82        ENDDO
83
84c    .... correction pour massebx( iip1,j) .....
85c    ...    massebx(iip1,j)= massebx(1,j) ...
86c
87CDIR$ IVDEP
88        DO  ij = iip1, ip1jmp1, iip1
89         massebx( ij,l ) = massebx( ij - iim,l )
90        ENDDO
91
92
93         DO  ij = 1,ip1jm
94         masseby( ij,l ) = masse(  ij   , l ) * alpha2p3(   ij    )  +
95     *                     masse(ij+iip1, l ) * alpha1p4( ij+iip1 )
96         ENDDO
97
98100   CONTINUE
99c
100      RETURN
101      END
Note: See TracBrowser for help on using the repository browser.