GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: dyn3d_common/psextbar.F Lines: 10 10 100.0 %
Date: 2023-06-30 12:56:34 Branches: 6 6 100.0 %

Line Branch Exec Source
1
!
2
! $Header$
3
!
4
1729
      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
1884610
      DO ij = 1, ip1jmp1
87
1884610
       pext(ij) = ps(ij) * aire(ij)
88
      ENDDO
89
90
91
1825824
      DO     5     ij = 1, ip1jm - 1
92
      psexbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) +
93
1824095
     *   pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
94
1729
   5  CONTINUE
95
96
97
c    ....  correction pour     psexbarxy( iip1,j )  ........
98
99
CDIR$ IVDEP
100
101
55328
      DO 7 ij = iip1, ip1jm, iip1
102
55328
      psexbarxy( ij ) = psexbarxy( ij - iim )
103
1729
   7  CONTINUE
104
105
106
1729
      RETURN
107
      END