/[lmdze]/trunk/dyn3d/flumass.f
ViewVC logotype

Annotation of /trunk/dyn3d/flumass.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 76 - (hide annotations)
Fri Nov 15 18:45:49 2013 UTC (10 years, 6 months ago) by guez
File size: 3588 byte(s)
Moved everything out of libf.
1 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/flumass.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $
3     !
4     SUBROUTINE flumass (massebx,masseby, vcont, ucont, pbaru, pbarv )
5    
6     use dimens_m
7     use paramet_m
8     use comgeom
9     IMPLICIT NONE
10    
11     c=======================================================================
12     c
13     c Auteurs: P. Le Van, F. Hourdin .
14     c -------
15     c
16     c Objet:
17     c ------
18     c
19     c *********************************************************************
20     c .... calcul du flux de masse aux niveaux s ......
21     c *********************************************************************
22     c massebx,masseby,vcont et ucont sont des argum. d'entree pour le s-pg .
23     c pbaru et pbarv sont des argum.de sortie pour le s-pg .
24     c
25     c=======================================================================
26    
27    
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

  ViewVC Help
Powered by ViewVC 1.1.21