source: LMDZ6/branches/Amaury_dev/libf/dyn3d/caldyn.F90 @ 5114

Last change on this file since 5114 was 5113, checked in by abarral, 4 months ago

Rename modules in misc from *_mod > lmdz_*
Put cbrt.f90, ch*.f90, pch*.f90 in new lmdz_libmath_pch.f90

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