source: trunk/LMDZ.GENERIC/libf/dyn3d/massbar.F @ 773

Last change on this file since 773 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET

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