source: LMDZ4/trunk/libf/dyn3dpar/flumass.F @ 4934

Last change on this file since 4934 was 1000, checked in by Laurent Fairhead, 16 years ago
  • Modifs sur le parallelisme: masquage dans la physique
  • Inclusion strato
  • mise en coherence etat0
  • le mode offline fonctionne maintenant en parallele,
  • les fichiers de la dynamiques sont correctement sortis et peuvent etre reconstruit avec rebuild
  • la version parallele de la dynamique peut s'executer sans MPI (sur 1 proc)
  • L'OPENMP fonctionne maintenant sans la parallelisation MPI.

YM
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.4 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE flumass (massebx,masseby, vcont, ucont, pbaru, pbarv )
5
6      IMPLICIT NONE
7
8c=======================================================================
9c
10c   Auteurs:  P. Le Van, F. Hourdin  .
11c   -------
12c
13c   Objet:
14c   ------
15c
16c *********************************************************************
17c     .... calcul du flux de masse  aux niveaux s ......
18c *********************************************************************
19c   massebx,masseby,vcont et ucont sont des argum. d'entree pour le s-pg .
20c       pbaru  et pbarv            sont des argum.de sortie pour le s-pg .
21c
22c=======================================================================
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
53c    ................................................................
54c     calcul de la composante du flux de masse en x aux poles .......
55c    ................................................................
56c     par la resolution d'1 systeme de 2 equations .
57
58c     la premiere equat.decrivant le calcul de la divergence en 1 point i
59c     du pole,ce calcul etant itere de i=1 a i=im .
60c                 c.a.d   ,
61c     ( ( 0.5*pbaru(i)-0.5*pbaru(i-1) - pbarv(i))/aire(i)   =
62c                                           - somme de ( pbarv(n) )/aire pole
63
64c     l'autre equat.specifiant que la moyenne du flux de masse au pole est =0.
65c     c.a.d    somme de pbaru(n)*aire locale(n) = 0.
66
67c     on en revient ainsi a determiner la constante additive commune aux pbaru
68c     qui representait pbaru(0,j,l) dans l'equat.du calcul de la diverg.au pt
69c     i=1 .
70c     i variant de 1 a im
71c     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
Note: See TracBrowser for help on using the repository browser.