source: LMDZ4/branches/pre_V3/libf/dyn3dpar/caldyn.F @ 1280

Last change on this file since 1280 was 630, checked in by Laurent Fairhead, 20 years ago

Import d'une version parallele de la dynamique YM
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.6 KB
Line 
1!
2! $Header$
3!
4c
5c
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
12c=======================================================================
13c
14c  Auteur :  P. Le Van
15c
16c   Objet:
17c   ------
18c
19c   Calcul des tendances dynamiques.
20c
21c Modif 04/93 F.Forget
22c=======================================================================
23
24c-----------------------------------------------------------------------
25c   0. Declarations:
26c   ----------------
27
28#include "dimensions.h"
29#include "paramet.h"
30#include "comconst.h"
31#include "comvert.h"
32#include "comgeom.h"
33
34c   Arguments:
35c   ----------
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
50c   Local:
51c   ------
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
63c-----------------------------------------------------------------------
64c   Calcul des tendances dynamiques:
65c   --------------------------------
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
98C  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
99C          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
104c         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', 
105c    ,   ' dans caldyn'
106c         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
111c-----------------------------------------------------------------------
112c   Sorties eventuelles des variables de controle:
113c   ----------------------------------------------
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
Note: See TracBrowser for help on using the repository browser.