source: LMDZ6/trunk/libf/dyn3d/caldyn.f90 @ 5447

Last change on this file since 5447 was 5285, checked in by abarral, 8 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

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