source: LMDZ5/trunk/libf/dyn3d_common/massbar.F @ 2306

Last change on this file since 2306 was 2197, checked in by Ehouarn Millour, 10 years ago

Added 'implicit none' statements and proper variable definitions where they were missing.
EM

  • 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: 2.8 KB
RevLine 
[524]1!
2! $Header$
3!
4      SUBROUTINE massbar(  masse, massebx, masseby )
[2197]5      IMPLICIT NONE
[524]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 "comconst.h"
23#include "comgeom.h"
24c
25      REAL    masse( ip1jmp1,llm ), massebx( ip1jmp1,llm )  ,
26     *      masseby(   ip1jm,llm )
[2197]27      INTEGER ij,l
[524]28c
29c
30c   Methode pour calculer massebx et masseby .
31c   ----------------------------------------
32c
33c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
34c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
35c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
36c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
37c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
38c
39c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)       
40c
41c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
42c
43c
44c
45c   alpha4 .         . alpha1    . alpha4
46c    (i,j)             (i,j)       (i+1,j)
47c
48c             P .        U .          . P
49c           (i,j)       (i,j)         (i+1,j)
50c
51c   alpha3 .         . alpha2    .alpha3
52c    (i,j)              (i,j)     (i+1,j)
53c
54c             V .        Z .          . V
55c           (i,j)
56c
57c   alpha4 .         . alpha1    .alpha4
58c   (i,j+1)            (i,j+1)   (i+1,j+1)
59c
60c             P .        U .          . P
61c          (i,j+1)                    (i+1,j+1)
62c
63c
64c
65c                       On  a :
66c
67c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
68c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
69c     localise  au point  ... U (i,j) ...
70c
71c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
72c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 
73c     localise  au point  ... V (i,j) ...
74c
75c
76c=======================================================================
77
78      DO   100    l = 1 , llm
79c
80        DO  ij = 1, ip1jmp1 - 1
81         massebx(ij,l) =  masse( ij, l) * alpha1p2( ij  )     +
82     *                   masse(ij+1, l) * alpha3p4(ij+1 )
83        ENDDO
84
85c    .... correction pour massebx( iip1,j) .....
86c    ...    massebx(iip1,j)= massebx(1,j) ...
87c
88CDIR$ IVDEP
89        DO  ij = iip1, ip1jmp1, iip1
90         massebx( ij,l ) = massebx( ij - iim,l )
91        ENDDO
92
93
94         DO  ij = 1,ip1jm
95         masseby( ij,l ) = masse(  ij   , l ) * alpha2p3(   ij    )  +
96     *                     masse(ij+iip1, l ) * alpha1p4( ij+iip1 )
97         ENDDO
98
99100   CONTINUE
100c
101      RETURN
102      END
Note: See TracBrowser for help on using the repository browser.