My Project
 All Classes Files Functions Variables Macros
flumass.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4  SUBROUTINE flumass (massebx,masseby, vcont, ucont, pbaru, pbarv )
5 
6  IMPLICIT NONE
7 
8 c=======================================================================
9 c
10 c Auteurs: P. Le Van, F. Hourdin .
11 c -------
12 c
13 c Objet:
14 c ------
15 c
16 c *********************************************************************
17 c .... calcul du flux de masse aux niveaux s ......
18 c *********************************************************************
19 c massebx,masseby,vcont et ucont sont des argum. d'entree pour le s-pg .
20 c pbaru et pbarv sont des argum.de sortie pour le s-pg .
21 c
22 c=======================================================================
23 
24 
25 #include "dimensions.h"
26 #include "paramet.h"
27 #include "comgeom.h"
28 
29  REAL massebx( ip1jmp1,llm ),masseby( ip1jm,llm ) ,
30  * vcont( ip1jm,llm ),ucont( ip1jmp1,llm ),pbaru( ip1jmp1,llm ),
31  * pbarv( ip1jm,llm )
32 
33  REAL apbarun( iip1 ),apbarus( iip1 )
34 
35  REAL sairen,saireun,saires,saireus,ctn,cts,ctn0,cts0
36  INTEGER l,ij,i
37 
38  REAL ssum
39 
40 
41  DO 5 l = 1,llm
42 
43  DO 1 ij = iip2,ip1jm
44  pbaru( ij,l ) = massebx( ij,l ) * ucont( ij,l )
45  1 CONTINUE
46 
47  DO 3 ij = 1,ip1jm
48  pbarv( ij,l ) = masseby( ij,l ) * vcont( ij,l )
49  3 CONTINUE
50 
51  5 CONTINUE
52 
53 c ................................................................
54 c calcul de la composante du flux de masse en x aux poles .......
55 c ................................................................
56 c par la resolution d'1 systeme de 2 equations .
57 
58 c la premiere equat.decrivant le calcul de la divergence en 1 point i
59 c du pole,ce calcul etant itere de i=1 a i=im .
60 c c.a.d ,
61 c ( ( 0.5*pbaru(i)-0.5*pbaru(i-1) - pbarv(i))/aire(i) =
62 c - somme de ( pbarv(n) )/aire pole
63 
64 c l'autre equat.specifiant que la moyenne du flux de masse au pole est =0.
65 c c.a.d somme de pbaru(n)*aire locale(n) = 0.
66 
67 c on en revient ainsi a determiner la constante additive commune aux pbaru
68 c qui representait pbaru(0,j,l) dans l'equat.du calcul de la diverg.au pt
69 c i=1 .
70 c i variant de 1 a im
71 c n variant de 1 a im
72 
73  sairen = ssum( iim, aire( 1 ), 1 )
74  saireun= ssum( iim, aireu( 1 ), 1 )
75  saires = ssum( iim, aire( ip1jm+1 ), 1 )
76  saireus= ssum( iim, aireu( ip1jm+1 ), 1 )
77 
78  DO 20 l = 1,llm
79 
80  ctn = ssum( iim, pbarv( 1 ,l), 1 )/ sairen
81  cts = ssum( iim, pbarv(ip1jmi1+ 1,l), 1 )/ saires
82 
83  pbaru( 1 ,l )= pbarv( 1 ,l ) - ctn * aire( 1 )
84  pbaru( ip1jm+1,l )= - pbarv( ip1jmi1+1,l ) + cts * aire( ip1jm+1 )
85 
86  DO 11 i = 2,iim
87  pbaru( i ,l ) = pbaru( i - 1 ,l ) +
88  * pbarv( i ,l ) - ctn * aire( i )
89 
90  pbaru( i+ ip1jm,l ) = pbaru( i+ ip1jm-1,l ) -
91  * pbarv( i+ ip1jmi1,l ) + cts * aire(i+ ip1jm)
92  11 CONTINUE
93  DO 12 i = 1,iim
94  apbarun(i) = aireu( i ) * pbaru( i , l)
95  apbarus(i) = aireu(i +ip1jm) * pbaru(i +ip1jm, l)
96  12 CONTINUE
97  ctn0 = -ssum( iim,apbarun,1 )/saireun
98  cts0 = -ssum( iim,apbarus,1 )/saireus
99  DO 14 i = 1,iim
100  pbaru( i , l) = 2. * ( pbaru( i , l) + ctn0 )
101  pbaru(i+ ip1jm, l) = 2. * ( pbaru(i +ip1jm, l) + cts0 )
102  14 CONTINUE
103 
104  pbaru( iip1 ,l ) = pbaru( 1 ,l )
105  pbaru( ip1jmp1,l ) = pbaru( ip1jm +1,l )
106  20 CONTINUE
107 
108  RETURN
109  END