My Project
 All Classes Files Functions Variables Macros
psextbar.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4  SUBROUTINE psextbar ( ps, psexbarxy )
5  IMPLICIT NONE
6 
7 c=======================================================================
8 c
9 c Auteur: P. Le Van
10 c -------
11 c
12 c Objet:
13 c ------
14 c
15 c **********************************************************************
16 c calcul des moyennes en x et en y de (pression au sol*aire variable) ..
17 c **********************************************************************
18 c
19 c ps est un argum. d'entree pour le s-pg ..
20 c psexbarxy est un argum. de sortie pour le s-pg ..
21 c
22 c Methode:
23 c --------
24 c
25 c A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
26 c alpha1(i,j) calcule au point ( i+1/4,j-1/4 )
27 c alpha2(i,j) calcule au point ( i+1/4,j+1/4 )
28 c alpha3(i,j) calcule au point ( i-1/4,j+1/4 )
29 c alpha4(i,j) calcule au point ( i-1/4,j-1/4 )
30 c
31 c Avec alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)
32 c
33 c N.B . Pour plus de details, voir s-pg ... iniconst ...
34 c
35 c
36 c
37 c alpha4 . . alpha1 . alpha4
38 c (i,j) (i,j) (i+1,j)
39 c
40 c P . U . . P
41 c (i,j) (i,j) (i+1,j)
42 c
43 c alpha3 . . alpha2 .alpha3
44 c (i,j) (i,j) (i+1,j)
45 c
46 c V . Z . . V
47 c (i,j)
48 c
49 c alpha4 . . alpha1 .alpha4
50 c (i,j+1) (i,j+1) (i+1,j+1)
51 c
52 c P . U . . P
53 c (i,j+1) (i+1,j+1)
54 c
55 c
56 c
57 c
58 c On a :
59 c
60 c pbarx(i,j) = Pext(i ,j) * ( alpha1(i ,j) + alpha2(i,j)) +
61 c Pext(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
62 c localise au point ... U (i,j) ...
63 c
64 c pbary(i,j) = Pext(i,j ) * ( alpha2(i,j ) + alpha3(i,j ) +
65 c Pext(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)
66 c localise au point ... V (i,j) ...
67 c
68 c pbarxy(i,j)= Pext(i,j) *alpha2(i,j) + Pext(i+1,j) *alpha3(i+1,j) +
69 c Pext(i,j+1)*alpha1(i,j+1)+ Pext(i+1,j+1)*alpha4(i+1,j+1)
70 c localise au point ... Z (i,j) ...
71 c
72 c
73 c
74 c=======================================================================
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
84 c
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 
97 c .... correction pour psexbarxy( iip1,j ) ........
98 
99 CDIR$ IVDEP
100 
101  DO 7 ij = iip1, ip1jm, iip1
102  psexbarxy( ij ) = psexbarxy( ij - iim )
103  7 CONTINUE
104 
105 
106  RETURN
107  END