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

Annotation of /trunk/dyn3d/caldyn.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (hide 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 guez 3 !
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