source: LMDZ5/trunk/libf/dyn3dmem/caldyn_loc.F @ 1907

Last change on this file since 1907 was 1907, checked in by lguez, 10 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • 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: 4.6 KB
Line 
1!
2! $Header$
3!
4c
5c
6#undef DEBUG_IO
7!#define DEBUG_IO
8
9      SUBROUTINE caldyn_loc
10     $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
11     $  phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time )
12      USE parallel_lmdz
13      USE Write_Field_loc
14      USE caldyn_mod
15     
16      IMPLICIT NONE
17
18c=======================================================================
19c
20c  Auteur :  P. Le Van
21c
22c   Objet:
23c   ------
24c
25c   Calcul des tendances dynamiques.
26c
27c Modif 04/93 F.Forget
28c=======================================================================
29
30c-----------------------------------------------------------------------
31c   0. Declarations:
32c   ----------------
33
34#include "dimensions.h"
35#include "paramet.h"
36#include "comconst.h"
37#include "comvert.h"
38#include "comgeom.h"
39
40c   Arguments:
41c   ----------
42
43      LOGICAL conser
44
45      INTEGER itau
46      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
47      REAL teta(ijb_u:ije_u,llm)
48      REAL ps(ijb_u:ije_u),phis(ijb_u:ije_u)
49      REAL pk(iip1,jjb_u:jje_u,llm),pkf(ijb_u:ije_u,llm)
50      REAL phi(ijb_u:ije_u,llm),masse(ijb_u:ije_u,llm)
51      REAL dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm)
52      REAL dteta(ijb_u:ije_u,llm),dp(ijb_u:ije_u)
53      REAL w(ijb_u:ije_u,llm)
54      REAL pbaru(ijb_u:ije_u,llm),pbarv(ijb_v:ije_v,llm)
55      REAL time
56
57c   Local:
58c   ------
59
60      INTEGER   ij,l,ijb,ije,ierr
61
62
63c-----------------------------------------------------------------------
64c   Calcul des tendances dynamiques:
65c   --------------------------------
66      CALL covcont_loc  ( llm    , ucov    , vcov , ucont, vcont     )
67      CALL pression_loc ( ip1jmp1, ap      , bp   ,  ps  , p         )
68cym      CALL psextbar (   ps   , psexbarxy                          )
69c$OMP BARRIER
70      CALL massdair_loc (    p   , masse                             )
71      CALL massbar_loc  (   masse, massebx , masseby                 )
72      call massbarxy_loc(   masse, massebxy                          )
73      CALL flumass_loc  ( massebx, masseby,vcont,ucont,pbaru,pbarv   )
74      CALL dteta1_loc   (   teta , pbaru   , pbarv, dteta            )
75      CALL convmas1_loc  (   pbaru, pbarv   , convm                  )
76c$OMP BARRIER     
77      CALL convmas2_loc  (   convm                      )
78c$OMP BARRIER
79#ifdef DEBUG_IO
80      call WriteField_u('ucont',ucont)
81      call WriteField_v('vcont',vcont)
82      call WriteField_u('p',p)
83      call WriteField_u('masse',masse)
84      call WriteField_u('massebx',massebx)
85      call WriteField_v('masseby',masseby)
86      call WriteField_v('massebxy',massebxy)
87      call WriteField_u('pbaru',pbaru)
88      call WriteField_v('pbarv',pbarv)
89      call WriteField_u('dteta',dteta)
90      call WriteField_u('convm',convm)
91#endif     
92
93c$OMP BARRIER
94c$OMP MASTER
95      ijb=ij_begin
96      ije=ij_end
97           
98      DO ij =ijb, ije
99         dp( ij ) = convm( ij,1 ) / airesurg( ij )
100      ENDDO
101c$OMP END MASTER
102c$OMP BARRIER
103      CALL vitvert_loc ( convm  , w                                )
104      CALL tourpot_loc ( vcov   , ucov  , massebxy  , vorpot       )
105      CALL dudv1_loc   ( vorpot , pbaru , pbarv     , du     , dv  )
106
107#ifdef DEBUG_IO     
108      call WriteField_u('w',w)
109      call WriteField_v('vorpot',vorpot)
110      call WriteField_u('du',du)
111      call WriteField_v('dv',dv)
112#endif     
113      CALL enercin_loc ( vcov   , ucov  , vcont   , ucont  , ecin  )
114      CALL bernoui_loc ( ip1jmp1, llm   , phi       , ecin   , bern)
115      CALL dudv2_loc   ( teta   , pkf   , bern      , du     , dv  )
116
117#ifdef DEBUG_IO
118      call WriteField_u('ecin',ecin)
119      call WriteField_u('bern',bern)
120      call WriteField_u('du',du)
121      call WriteField_v('dv',dv)
122      call WriteField_u('pkf',pkf)
123#endif
124     
125      ijb=ij_begin-iip1
126      ije=ij_end+iip1
127     
128      if (pole_nord) ijb=ij_begin
129      if (pole_sud) ije=ij_end
130
131c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
132      DO l=1,llm
133         DO ij=ijb,ije
134            ang(ij,l) = ucov(ij,l) + constang(ij)
135        ENDDO
136      ENDDO
137c$OMP END DO
138
139      CALL advect_new_loc(ang,vcov,teta,w,massebx,masseby,du,dv,dteta)
140
141C  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
142C          probablement. Observe sur le code compile avec pgf90 3.0-1
143      ijb=ij_begin
144      ije=ij_end
145      if (pole_sud) ije=ij_end-iip1
146
147c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
148      DO l = 1, llm
149         DO ij = ijb, ije, iip1
150           IF( dv(ij,l).NE.dv(ij+iim,l) )  THEN
151c         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', 
152c    ,   ' dans caldyn'
153c         PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
154          dv(ij+iim,l) = dv(ij,l)
155          endif
156         enddo
157      enddo
158c$OMP END DO NOWAIT     
159
160
161      RETURN
162      END
Note: See TracBrowser for help on using the repository browser.