My Project
 All Classes Files Functions Variables Macros
caldyn.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4 c
5 c
6  SUBROUTINE caldyn
7  $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
8  $ phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time )
9 
10  IMPLICIT NONE
11 
12 c=======================================================================
13 c
14 c Auteur : P. Le Van
15 c
16 c Objet:
17 c ------
18 c
19 c Calcul des tendances dynamiques.
20 c
21 c Modif 04/93 F.Forget
22 c=======================================================================
23 
24 c-----------------------------------------------------------------------
25 c 0. Declarations:
26 c ----------------
27 
28 #include "dimensions.h"
29 #include "paramet.h"
30 #include "comconst.h"
31 #include "comvert.h"
32 #include "comgeom.h"
33 
34 c Arguments:
35 c ----------
36 
37  LOGICAL conser
38 
39  INTEGER itau
40  REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
41  REAL ps(ip1jmp1),phis(ip1jmp1)
42  REAL pk(iip1,jjp1,llm),pkf(ip1jmp1,llm)
43  REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
44  REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
45  REAL dv(ip1jm,llm),du(ip1jmp1,llm)
46  REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
47  REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
48  REAL time
49 
50 c Local:
51 c ------
52 
53  REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
54  REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
55  REAL vorpot(ip1jm,llm)
56  REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
57  REAL bern(ip1jmp1,llm)
58  REAL massebxy(ip1jm,llm)
59 
60 
61  INTEGER ij,l
62 
63 c-----------------------------------------------------------------------
64 c Calcul des tendances dynamiques:
65 c --------------------------------
66 
67  CALL covcont( llm , ucov , vcov , ucont, vcont )
68  CALL pression( ip1jmp1, ap , bp , ps , p )
69  CALL psextbar( ps , psexbarxy )
70  CALL massdair( p , masse )
71  CALL massbar( masse, massebx , masseby )
72  call massbarxy( masse, massebxy )
73  CALL flumass( massebx, masseby , vcont, ucont ,pbaru, pbarv )
74  CALL dteta1( teta , pbaru , pbarv, dteta )
75  CALL convmas( pbaru, pbarv , convm )
76 
77  DO ij =1, ip1jmp1
78  dp( ij ) = convm( ij,1 ) / airesurg( ij )
79  ENDDO
80 
81  CALL vitvert( convm , w )
82  CALL tourpot( vcov , ucov , massebxy , vorpot )
83  CALL dudv1( vorpot , pbaru , pbarv , du , dv )
84  CALL enercin( vcov , ucov , vcont , ucont , ecin )
85  CALL bernoui( ip1jmp1, llm , phi , ecin , bern )
86  CALL dudv2( teta , pkf , bern , du , dv )
87 
88 
89  DO l=1,llm
90  DO ij=1,ip1jmp1
91  ang(ij,l) = ucov(ij,l) + constang(ij)
92  ENDDO
93  ENDDO
94 
95 
96  CALL advect( ang, vcov, teta, w, massebx, masseby, du, dv,dteta )
97 
98 C WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
99 C probablement. Observe sur le code compile avec pgf90 3.0-1
100 
101  DO l = 1, llm
102  DO ij = 1, ip1jm, iip1
103  IF( dv(ij,l).NE.dv(ij+iim,l) ) THEN
104 c PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',
105 c , ' dans caldyn'
106 c PRINT *,' l, ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
107  dv(ij+iim,l) = dv(ij,l)
108  endif
109  enddo
110  enddo
111 c-----------------------------------------------------------------------
112 c Sorties eventuelles des variables de controle:
113 c ----------------------------------------------
114 
115  IF( conser ) THEN
116  CALL sortvarc
117  $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
118 
119  ENDIF
120 
121  RETURN
122  END