source: LMDZ.3.3/trunk/libf/dyn3d/flumass.F @ 5455

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