source: LMDZ.3.3/trunk/libf/dyn3d/pbar.F @ 507

Last change on this file since 507 was 2, checked in by lmdz, 25 years ago

Initial revision

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