source: LMDZ6/branches/cirrus/libf/dyn3d/caldyn.F @ 5405

Last change on this file since 5405 was 2600, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: turn comvert.h into module comvert_mod.F90
EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.3 KB
Line 
1!
2! $Id: caldyn.F 2600 2016-07-23 05:45:38Z abarral $
3!
4      SUBROUTINE caldyn
5     $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
6     $  phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time )
7
8     
9      USE comvert_mod, ONLY: ap, bp
10     
11      IMPLICIT NONE
12
13!=======================================================================
14!
15!  Auteur :  P. Le Van
16!
17!   Objet:
18!   ------
19!
20!   Calcul des tendances dynamiques.
21!
22! Modif 04/93 F.Forget
23!=======================================================================
24
25!-----------------------------------------------------------------------
26!   0. Declarations:
27!   ----------------
28
29      include "dimensions.h"
30      include "paramet.h"
31      include "comgeom.h"
32
33!   Arguments:
34!   ----------
35
36      LOGICAL,INTENT(IN) :: conser ! triggers printing some diagnostics
37      INTEGER,INTENT(IN) :: itau ! time step index
38      REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind
39      REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind
40      REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potential temperature
41      REAL,INTENT(IN) :: ps(ip1jmp1) ! surface pressure
42      REAL,INTENT(IN) :: phis(ip1jmp1) ! geopotential at the surface
43      REAL,INTENT(IN) :: pk(ip1jmp1,llm) ! Exner at mid-layer
44      REAL,INTENT(IN) :: pkf(ip1jmp1,llm) ! filtered Exner
45      REAL,INTENT(IN) :: phi(ip1jmp1,llm) ! geopotential
46      REAL,INTENT(OUT) :: masse(ip1jmp1,llm) ! air mass
47      REAL,INTENT(OUT) :: dv(ip1jm,llm) ! tendency on vcov
48      REAL,INTENT(OUT) :: du(ip1jmp1,llm) ! tendency on ucov
49      REAL,INTENT(OUT) :: dteta(ip1jmp1,llm) ! tenddency on teta
50      REAL,INTENT(OUT) :: dp(ip1jmp1) ! tendency on ps
51      REAL,INTENT(OUT) :: w(ip1jmp1,llm) ! vertical velocity
52      REAL,INTENT(OUT) :: pbaru(ip1jmp1,llm) ! mass flux in the zonal direction
53      REAL,INTENT(OUT) :: pbarv(ip1jm,llm) ! mass flux in the meridional direction
54      REAL,INTENT(IN) :: time ! current time
55
56!   Local:
57!   ------
58
59      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
60      REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
61      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
62      REAL vorpot(ip1jm,llm)
63      REAL ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
64      REAL bern(ip1jmp1,llm)
65      REAL massebxy(ip1jm,llm)
66   
67
68      INTEGER   ij,l
69
70!-----------------------------------------------------------------------
71!   Compute dynamical tendencies:
72!--------------------------------
73
74      ! compute contravariant winds ucont() and vcont
75      CALL covcont  ( llm    , ucov    , vcov , ucont, vcont        )
76      ! compute pressure p()
77      CALL pression ( ip1jmp1, ap      , bp   ,  ps  , p            )
78      ! compute psexbarxy() XY-area weighted-averaged surface pressure (what for?)
79      CALL psextbar (   ps   , psexbarxy                            )
80      ! compute mass in each atmospheric mesh: masse()
81      CALL massdair (    p   , masse                                )
82      ! compute X and Y-averages of mass, massebx() and masseby()
83      CALL massbar  (   masse, massebx , masseby                    )
84      ! compute XY-average of mass, massebxy()
85      call massbarxy(   masse, massebxy                             )
86      ! compute mass fluxes pbaru() and pbarv()
87      CALL flumass  ( massebx, masseby , vcont, ucont ,pbaru, pbarv )
88      ! compute dteta() , horizontal converging flux of theta
89      CALL dteta1   (   teta , pbaru   , pbarv, dteta               )
90      ! compute convm(), horizontal converging flux of mass
91      CALL convmas  (   pbaru, pbarv   , convm                      )
92
93      ! compute pressure variation due to mass convergence
94      DO ij =1, ip1jmp1
95         dp( ij ) = convm( ij,1 ) / airesurg( ij )
96      ENDDO
97
98      ! compute vertical velocity w()
99      CALL vitvert ( convm  , w                                  )
100      ! compute potential vorticity vorpot()
101      CALL tourpot ( vcov   , ucov  , massebxy  , vorpot         )
102      ! compute rotation induced du() and dv()
103      CALL dudv1   ( vorpot , pbaru , pbarv     , du     , dv    )
104      ! compute kinetic energy ecin()
105      CALL enercin ( vcov   , ucov  , vcont     , ucont  , ecin  )
106      ! compute Bernouilli function bern()
107      CALL bernoui ( ip1jmp1, llm   , phi       , ecin   , bern  )
108      ! compute and add du() and dv() contributions from Bernouilli and pressure
109      CALL dudv2   ( teta   , pkf   , bern      , du     , dv    )
110
111
112      DO l=1,llm
113         DO ij=1,ip1jmp1
114            ang(ij,l) = ucov(ij,l) + constang(ij)
115         ENDDO
116      ENDDO
117
118      ! compute vertical advection contributions to du(), dv() and dteta()
119      CALL advect( ang, vcov, teta, w, massebx, masseby, du, dv,dteta )
120
121!  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
122!          probablement. Observe sur le code compile avec pgf90 3.0-1
123
124      DO l = 1, llm
125         DO ij = 1, ip1jm, iip1
126           IF( dv(ij,l).NE.dv(ij+iim,l) )  THEN
127!         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', 
128!    ,   ' dans caldyn'
129!         PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
130          dv(ij+iim,l) = dv(ij,l)
131           ENDIF
132         ENDDO
133      ENDDO
134
135!-----------------------------------------------------------------------
136!   Output some control variables:
137!---------------------------------
138
139      IF( conser )  THEN
140        CALL sortvarc
141     & ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
142      ENDIF
143
144      END
Note: See TracBrowser for help on using the repository browser.