source: LMDZ5/branches/IPSLCM5A2.1/libf/dyn3d_common/psextbar.F @ 5081

Last change on this file since 5081 was 1945, checked in by lguez, 11 years ago

Duplicated files moved to dyn3d_common.

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