source: LMDZ6/trunk/libf/dyn3dmem/caldyn_loc.f90

Last change on this file was 5324, checked in by abarral, 2 weeks ago

[WIP] Remove uses of DEBUGIO cpp key (deprecated)

  • 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
File size: 5.2 KB
Line 
1SUBROUTINE caldyn_loc &
2        (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis , &
3        phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time )
4  USE comgeom_mod_h
5  USE parallel_lmdz
6  USE Write_Field_loc
7  USE caldyn_mod, ONLY: vcont, ucont, ang, p, massebx, masseby, &
8        vorpot, ecin, bern, massebxy, convm
9  USE comvert_mod, ONLY: ap, bp
10  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
11USE paramet_mod_h
12IMPLICIT NONE
13
14  !=======================================================================
15  !
16  !  Auteur :  P. Le Van
17  !
18  !   Objet:
19  !   ------
20  !
21  !   Calcul des tendances dynamiques.
22  !
23  ! Modif 04/93 F.Forget
24  !=======================================================================
25
26  !-----------------------------------------------------------------------
27  !   0. Declarations:
28  !   ----------------
29
30
31
32
33  !   Arguments:
34  !   ----------
35
36  LOGICAL,INTENT(IN) :: conser ! triggers printing some diagnostics ! not used
37  INTEGER,INTENT(IN) :: itau ! time step index ! not used
38  REAL,INTENT(IN) :: vcov(ijb_v:ije_v,llm) ! covariant meridional wind
39  REAL,INTENT(IN) :: ucov(ijb_u:ije_u,llm) ! covariant zonal wind
40  REAL,INTENT(IN) :: teta(ijb_u:ije_u,llm) ! potential temperature
41  REAL,INTENT(IN) :: ps(ijb_u:ije_u) ! surface pressure
42  REAL,INTENT(IN) :: phis(ijb_u:ije_u) ! geopotential at the surface
43  REAL,INTENT(IN) :: pk(iip1,jjb_u:jje_u,llm) ! Exner at mid-layer
44  REAL,INTENT(IN) :: pkf(ijb_u:ije_u,llm) ! filtered Exner
45  REAL,INTENT(IN) :: phi(ijb_u:ije_u,llm) ! geopotential
46  REAL,INTENT(OUT) :: masse(ijb_u:ije_u,llm) ! air mass
47  REAL,INTENT(OUT) :: dv(ijb_v:ije_v,llm) ! tendency on vcov
48  REAL,INTENT(OUT) :: du(ijb_u:ije_u,llm) ! tendency on ucov
49  REAL,INTENT(OUT) :: dteta(ijb_u:ije_u,llm) ! tenddency on teta
50  REAL,INTENT(OUT) :: dp(ijb_u:ije_u) ! tendency on ps
51  REAL,INTENT(OUT) :: w(ijb_u:ije_u,llm) ! vertical velocity
52  REAL,INTENT(OUT) :: pbaru(ijb_u:ije_u,llm) ! mass flux in the zonal direction
53  REAL,INTENT(OUT) :: pbarv(ijb_v:ije_v,llm) ! mass flux in the meridional direction
54  REAL,INTENT(IN) :: time ! current time
55
56  !   Local:
57  !   ------
58
59  INTEGER :: ij,l,ijb,ije,ierr
60
61
62  !-----------------------------------------------------------------------
63  !   Compute dynamical tendencies:
64  !--------------------------------
65
66  ! ! compute contravariant winds ucont() and vcont
67  CALL covcont_loc  ( llm    , ucov    , vcov , ucont, vcont     )
68  ! ! compute pressure p()
69  CALL pression_loc ( ip1jmp1, ap      , bp   ,  ps  , p         )
70  !ym      CALL psextbar (   ps   , psexbarxy                          )
71!$OMP BARRIER
72  ! ! compute mass in each atmospheric mesh: masse()
73  CALL massdair_loc (    p   , masse                             )
74  ! ! compute X and Y-averages of mass, massebx() and masseby()
75  CALL massbar_loc  (   masse, massebx , masseby                 )
76  ! ! compute XY-average of mass, massebxy()
77  call massbarxy_loc(   masse, massebxy                          )
78  ! ! compute mass fluxes pbaru() and pbarv()
79  CALL flumass_loc  ( massebx, masseby,vcont,ucont,pbaru,pbarv   )
80  ! ! compute dteta() , horizontal converging flux of theta
81  CALL dteta1_loc   (   teta , pbaru   , pbarv, dteta            )
82  ! ! compute convm(), horizontal converging flux of mass
83  CALL convmas1_loc  (   pbaru, pbarv   , convm                  )
84!$OMP BARRIER
85  CALL convmas2_loc  (   convm                      )
86!$OMP BARRIER
87
88!$OMP BARRIER
89!$OMP MASTER
90  ijb=ij_begin
91  ije=ij_end
92  ! ! compute pressure variation due to mass convergence
93  DO ij =ijb, ije
94     dp( ij ) = convm( ij,1 ) / airesurg( ij )
95  ENDDO
96!$OMP END MASTER
97!$OMP BARRIER
98
99  ! ! compute vertical velocity w()
100  CALL vitvert_loc ( convm  , w                                )
101  ! ! compute potential vorticity vorpot()
102  CALL tourpot_loc ( vcov   , ucov  , massebxy  , vorpot       )
103  ! ! compute rotation induced du() and dv()
104  CALL dudv1_loc   ( vorpot , pbaru , pbarv     , du     , dv  )
105
106  ! ! compute kinetic energy ecin()
107  CALL enercin_loc ( vcov   , ucov  , vcont   , ucont  , ecin  )
108  ! ! compute Bernouilli function bern()
109  CALL bernoui_loc ( ip1jmp1, llm   , phi       , ecin   , bern)
110  ! ! compute and add du() and dv() contributions from Bernouilli and pressure
111  CALL dudv2_loc   ( teta   , pkf   , bern      , du     , dv  )
112
113  ijb=ij_begin-iip1
114  ije=ij_end+iip1
115
116  if (pole_nord) ijb=ij_begin
117  if (pole_sud) ije=ij_end
118
119!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
120  DO l=1,llm
121     DO ij=ijb,ije
122        ang(ij,l) = ucov(ij,l) + constang(ij)
123    ENDDO
124  ENDDO
125!$OMP END DO
126
127  ! ! compute vertical advection contributions to du(), dv() and dteta()
128  CALL advect_new_loc(ang,vcov,teta,w,massebx,masseby,du,dv,dteta)
129
130  !  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
131       ! probablement. Observe sur le code compile avec pgf90 3.0-1
132  ijb=ij_begin
133  ije=ij_end
134  if (pole_sud) ije=ij_end-iip1
135
136!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
137  DO l = 1, llm
138     DO ij = ijb, ije, iip1
139       IF( dv(ij,l).NE.dv(ij+iim,l) )  THEN
140      ! PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',
141  !    ,   ' dans caldyn'
142      ! PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
143      dv(ij+iim,l) = dv(ij,l)
144      endif
145     enddo
146  enddo
147!$OMP END DO NOWAIT
148
149  ! Ehouarn: NB: output of control variables not implemented...
150
151  RETURN
152END SUBROUTINE caldyn_loc
Note: See TracBrowser for help on using the repository browser.