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

Contents of /trunk/dyn3d/caldyn.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (show annotations)
Wed Feb 27 13:16:39 2008 UTC (16 years, 3 months ago) by guez
Original Path: trunk/libf/dyn3d/caldyn.f
File size: 3860 byte(s)
Initial import
1 !
2 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/caldyn.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $
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 use dimens_m
11 use paramet_m
12 use comconst
13 use comvert
14 use comgeom
15 use pression_m, only: pression
16
17 IMPLICIT NONE
18
19 c=======================================================================
20 c
21 c Auteur : P. Le Van
22 c
23 c Objet:
24 c ------
25 c
26 c Calcul des tendances dynamiques.
27 c
28 c Modif 04/93 F.Forget
29 c=======================================================================
30
31 c-----------------------------------------------------------------------
32 c 0. Declarations:
33 c ----------------
34
35
36 c Arguments:
37 c ----------
38
39 LOGICAL conser
40
41 INTEGER, intent(in):: itau
42 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
43 REAL ps(ip1jmp1),phis(ip1jmp1)
44 REAL, intent(in):: pk(iip1,jjp1,llm)
45 real pkf(ip1jmp1,llm)
46 REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
47 REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
48 REAL dv(ip1jm,llm),du(ip1jmp1,llm)
49 REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
50 REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
51 REAL time
52
53 c Local:
54 c ------
55
56 REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
57 REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
58 REAL vorpot(ip1jm,llm)
59 REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
60 REAL bern(ip1jmp1,llm)
61 REAL massebxy(ip1jm,llm)
62
63
64 INTEGER ij,l
65
66 c-----------------------------------------------------------------------
67 c Calcul des tendances dynamiques:
68 c --------------------------------
69
70 CALL covcont ( llm , ucov , vcov , ucont, vcont )
71 CALL pression ( ip1jmp1, ap , bp , ps , p )
72 CALL psextbar ( ps , psexbarxy )
73 CALL massdair ( p , masse )
74 CALL massbar ( masse, massebx , masseby )
75 call massbarxy( masse, massebxy )
76 CALL flumass ( massebx, masseby , vcont, ucont ,pbaru, pbarv )
77 CALL dteta1 ( teta , pbaru , pbarv, dteta )
78 CALL convmas ( pbaru, pbarv , convm )
79
80 DO ij =1, ip1jmp1
81 dp( ij ) = convm( ij,1 ) / airesurg( ij )
82 ENDDO
83
84 CALL vitvert ( convm , w )
85 CALL tourpot ( vcov , ucov , massebxy , vorpot )
86 CALL dudv1 ( vorpot , pbaru , pbarv , du , dv )
87 CALL enercin ( vcov , ucov , vcont , ucont , ecin )
88 CALL bernoui ( ip1jmp1, llm , phi , ecin , bern )
89 CALL dudv2 ( teta , pkf , bern , du , dv )
90
91
92 DO l=1,llm
93 DO ij=1,ip1jmp1
94 ang(ij,l) = ucov(ij,l) + constang(ij)
95 ENDDO
96 ENDDO
97
98
99 CALL advect( ang, vcov, teta, w, massebx, masseby, du, dv,dteta )
100
101 C WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
102 C probablement. Observe sur le code compile avec pgf90 3.0-1
103
104 DO l = 1, llm
105 DO ij = 1, ip1jm, iip1
106 IF( dv(ij,l).NE.dv(ij+iim,l) ) THEN
107 c PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',
108 c , ' dans caldyn'
109 c PRINT *,' l, ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
110 dv(ij+iim,l) = dv(ij,l)
111 endif
112 enddo
113 enddo
114 c-----------------------------------------------------------------------
115 c Sorties eventuelles des variables de controle:
116 c ----------------------------------------------
117
118 IF( conser ) THEN
119 CALL sortvarc
120 $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
121
122 ENDIF
123
124 RETURN
125 END

  ViewVC Help
Powered by ViewVC 1.1.21