My Project
 All Classes Files Functions Variables Macros
caldyn_loc.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4 c
5 c
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
13  USE write_field_loc
14  USE caldyn_mod
15 
16  IMPLICIT NONE
17 
18 c=======================================================================
19 c
20 c Auteur : P. Le Van
21 c
22 c Objet:
23 c ------
24 c
25 c Calcul des tendances dynamiques.
26 c
27 c Modif 04/93 F.Forget
28 c=======================================================================
29 
30 c-----------------------------------------------------------------------
31 c 0. Declarations:
32 c ----------------
33 
34 #include "dimensions.h"
35 #include "paramet.h"
36 #include "comconst.h"
37 #include "comvert.h"
38 #include "comgeom.h"
39 
40 c Arguments:
41 c ----------
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 
57 c Local:
58 c ------
59 
60  INTEGER ij,l,ijb,ije,ierr
61 
62 
63 c-----------------------------------------------------------------------
64 c Calcul des tendances dynamiques:
65 c --------------------------------
66  CALL covcont_loc( llm , ucov , vcov , ucont, vcont )
67  CALL pression_loc( ip1jmp1, ap , bp , ps , p )
68 cym CALL psextbar ( ps , psexbarxy )
69 c$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 )
76 c$OMP BARRIER
77  CALL convmas2_loc( convm )
78 c$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 
93 c$OMP BARRIER
94 c$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
101 c$OMP END MASTER
102 c$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 
131 c$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
137 c$OMP END DO
138 
139  CALL advect_new_loc(ang,vcov,teta,w,massebx,masseby,du,dv,dteta)
140 
141 C WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
142 C 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 
147 c$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
151 c PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',
152 c , ' dans caldyn'
153 c 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
158 c$OMP END DO NOWAIT
159 
160 
161  RETURN
162  END