source: LMDZ5/trunk/libf/dyn3dpar/massdair_p.F @ 5371

Last change on this file since 5371 was 2597, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod.
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: 3.2 KB
RevLine 
[630]1      SUBROUTINE massdair_p( p, masse )
[1823]2      USE parallel_lmdz
[630]3c
4c *********************************************************************
5c       ....  Calcule la masse d'air  dans chaque maille   ....
6c *********************************************************************
7c
8c    Auteurs : P. Le Van , Fr. Hourdin  .
9c   ..........
10c
11c  ..    p                      est  un argum. d'entree pour le s-pg ...
12c  ..  masse                    est un  argum.de sortie pour le s-pg ...
13c     
14c  ....  p est defini aux interfaces des llm couches   .....
15c
16      IMPLICIT NONE
17c
18#include "dimensions.h"
19#include "paramet.h"
20#include "comgeom.h"
21c
22c  .....   arguments  ....
23c
24      REAL p(ip1jmp1,llmp1), masse(ip1jmp1,llm)
25
26c   ....  Variables locales  .....
27
28      INTEGER l,ij
29      INTEGER ijb,ije
30      REAL massemoyn, massemoys
31
32      REAL SSUM
33      EXTERNAL SSUM
34c
35c
36c   Methode pour calculer massebx et masseby .
37c   ----------------------------------------
38c
39c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
40c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
41c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
42c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
43c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
44c
45c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)       
46c
47c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
48c
49c
50c
51c   alpha4 .         . alpha1    . alpha4
52c    (i,j)             (i,j)       (i+1,j)
53c
54c             P .        U .          . P
55c           (i,j)       (i,j)         (i+1,j)
56c
57c   alpha3 .         . alpha2    .alpha3
58c    (i,j)              (i,j)     (i+1,j)
59c
60c             V .        Z .          . V
61c           (i,j)
62c
63c   alpha4 .         . alpha1    .alpha4
64c   (i,j+1)            (i,j+1)   (i+1,j+1)
65c
66c             P .        U .          . P
67c          (i,j+1)                    (i+1,j+1)
68c
69c
70c
71c                       On  a :
72c
73c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
74c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
75c     localise  au point  ... U (i,j) ...
76c
77c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
78c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 
79c     localise  au point  ... V (i,j) ...
80c
81c
82c=======================================================================
83
84     
85
86     
87      ijb=ij_begin-iip1
88      ije=ij_end+2*iip1
89     
90      if (pole_nord) ijb=ij_begin
91      if (pole_sud)  ije=ij_end
92
[764]93c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
[630]94      DO   100    l = 1 , llm
95c
96        DO    ij     = ijb, ije
97         masse(ij,l) = airesurg(ij) * ( p(ij,l) - p(ij,l+1) )
98        ENDDO
99c
100        DO   ij = ijb, ije,iip1
101         masse(ij+ iim,l) = masse(ij,l)
102        ENDDO
103c
104c       DO    ij     = 1,  iim
105c        masse(   ij   ,l) = masse(   ij   ,l) * aire(  ij    )
106c        masse(ij+ip1jm,l) = masse(ij+ip1jm,l) * aire(ij+ip1jm)
107c       ENDDO
108c        massemoyn         = SSUM(iim,masse(   1   ,l),1)/ apoln
109c        massemoys         = SSUM(iim,masse(ip1jm+1,l),1)/ apols
110c       DO    ij     = 1, iip1
111c        masse(   ij   ,l )    = massemoyn
112c        masse(ij+ip1jm,l )    = massemoys
113c       ENDDO
114       
115100   CONTINUE
[764]116c$OMP END DO NOWAIT
[630]117c
118      RETURN
119      END
Note: See TracBrowser for help on using the repository browser.