source: LMDZ5/branches/LF-private/libf/dyn3dmem/flumass.F @ 5456

Last change on this file since 5456 was 1632, checked in by Laurent Fairhead, 13 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT


Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

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.