source: trunk/libf/dyn3dpar/caldyn_p.F @ 8

Last change on this file since 8 was 8, checked in by emillour, 14 years ago

Debut de mise a jour de la dynamique parallele par rapport aux modifs dans la partie sequentielle.

Mais NON TESTE , car pas (encore) possibilite de compiler et faire tourner cas simple (type newtonien sans physique).

Voir commit_v8.log pour les details.

Ehouarn
File size: 6.0 KB
Line 
1!
2! $Header$
3!
4c
5c
6#undef DEBUG_IO
7c#define DEBUG_IO
8
9      SUBROUTINE caldyn_p
10     $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,tsurpk,phis ,
11     $  phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time )
12      USE parallel
13      USE Write_Field_p
14     
15      IMPLICIT NONE
16
17c=======================================================================
18c
19c  Auteur :  P. Le Van
20c
21c   Objet:
22c   ------
23c
24c   Calcul des tendances dynamiques.
25c
26c Modif 04/93 F.Forget
27c=======================================================================
28
29c-----------------------------------------------------------------------
30c   0. Declarations:
31c   ----------------
32
33#include "dimensions.h"
34#include "paramet.h"
35#include "comconst.h"
36#include "comvert.h"
37#include "comgeom.h"
38
39c   Arguments:
40c   ----------
41
42      LOGICAL conser
43
44      INTEGER itau
45      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
46      REAL ps(ip1jmp1),phis(ip1jmp1)
47      REAL pk(ip1jmp1,llm),pkf(ip1jmp1,llm)
48      REAL tsurpk(ip1jmp1,llm)
49      REAL,SAVE :: vcont(ip1jm,llm),ucont(ip1jmp1,llm)
50      REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
51      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
52      REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
53      REAL w(ip1jmp1,llm)
54      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
55      REAL time
56
57c   Local:
58c   ------
59
60      REAL,SAVE :: ang(ip1jmp1,llm)
61      REAL,SAVE :: p(ip1jmp1,llmp1)
62      REAL,SAVE :: massebx(ip1jmp1,llm),masseby(ip1jm,llm)
63      REAL,SAVE :: psexbarxy(ip1jm)
64      REAL,SAVE :: vorpot(ip1jm,llm)
65      REAL,SAVE :: ecin(ip1jmp1,llm)
66      REAL,SAVE :: bern(ip1jmp1,llm)
67      REAL,SAVE :: massebxy(ip1jm,llm)
68      REAL,SAVE :: convm(ip1jmp1,llm)
69!      REAL,SAVE :: temp(ip1jmp1,llm)
70      INTEGER   ij,l,ijb,ije,ierr
71
72c-----------------------------------------------------------------------
73c   Calcul des tendances dynamiques:
74c   --------------------------------
75      CALL covcont_p  ( llm    , ucov    , vcov , ucont, vcont        )
76      CALL pression_p ( ip1jmp1, ap      , bp   ,  ps  , p            )
77cym      CALL psextbar (   ps   , psexbarxy                          )
78c$OMP BARRIER
79      CALL massdair_p (    p   , masse                                )
80      CALL massbar_p  (   masse, massebx , masseby                    )
81      call massbarxy_p(   masse, massebxy                             )
82      CALL flumass_p  ( massebx, masseby , vcont, ucont ,pbaru, pbarv )
83      CALL dteta1_p   (   teta , pbaru   , pbarv, dteta               )
84      CALL convmas1_p  (   pbaru, pbarv   , convm                      )
85c$OMP BARRIER     
86      CALL convmas2_p  (   convm                      )
87c$OMP BARRIER
88#ifdef DEBUG_IO
89c$OMP BARRIER
90c$OMP MASTER
91      call WriteField_p('ucont',reshape(ucont,(/iip1,jmp1,llm/)))
92      call WriteField_p('vcont',reshape(vcont,(/iip1,jjm,llm/)))
93      call WriteField_p('p',reshape(p,(/iip1,jmp1,llmp1/)))
94      call WriteField_p('masse',reshape(masse,(/iip1,jmp1,llm/)))
95      call WriteField_p('massebx',reshape(massebx,(/iip1,jmp1,llm/)))
96      call WriteField_p('masseby',reshape(masseby,(/iip1,jjm,llm/)))
97      call WriteField_p('massebxy',reshape(massebxy,(/iip1,jjm,llm/)))
98      call WriteField_p('pbaru',reshape(pbaru,(/iip1,jmp1,llm/)))
99      call WriteField_p('pbarv',reshape(pbarv,(/iip1,jjm,llm/)))
100      call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/)))
101      call WriteField_p('convm',reshape(convm,(/iip1,jmp1,llm/)))
102c$OMP END MASTER
103c$OMP BARRIER
104#endif     
105
106c$OMP BARRIER
107c$OMP MASTER
108      ijb=ij_begin
109      ije=ij_end
110           
111      DO ij =ijb, ije
112         dp( ij ) = convm( ij,1 ) / airesurg( ij )
113      ENDDO
114c$OMP END MASTER
115c$OMP BARRIER
116c$OMP FLUSH
117      CALL vitvert_p ( convm  , w                                  )
118      CALL tourpot_p ( vcov   , ucov  , massebxy  , vorpot         )
119      CALL dudv1_p   ( vorpot , pbaru , pbarv     , du     , dv    )
120
121#ifdef DEBUG_IO     
122c$OMP BARRIER
123c$OMP MASTER
124      call WriteField_p('w',reshape(w,(/iip1,jmp1,llm/)))
125      call WriteField_p('vorpot',reshape(vorpot,(/iip1,jjm,llm/)))
126      call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
127      call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))
128c$OMP END MASTER
129c$OMP BARRIER
130#endif     
131      CALL enercin_p ( vcov   , ucov  , vcont     , ucont  , ecin  )
132      CALL bernoui_p ( ip1jmp1, llm   , phi       , ecin   , bern  )
133      CALL dudv2_p   ( tsurpk , pkf   , bern      , du     , dv    )
134
135#ifdef DEBUG_IO
136c$OMP BARRIER
137c$OMP MASTER
138      call WriteField_p('ecin',reshape(ecin,(/iip1,jmp1,llm/)))
139      call WriteField_p('bern',reshape(bern,(/iip1,jmp1,llm/)))
140      call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
141      call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))
142      call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/)))
143c$OMP END MASTER
144c$OMP BARRIER
145#endif
146     
147      ijb=ij_begin-iip1
148      ije=ij_end+iip1
149     
150      if (pole_nord) ijb=ij_begin
151      if (pole_sud) ije=ij_end
152
153c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
154      DO l=1,llm
155         DO ij=ijb,ije
156            ang(ij,l) = ucov(ij,l) + constang(ij)
157        ENDDO
158      ENDDO
159c$OMP END DO
160
161      CALL advect_new_p(ang,vcov,teta,w,massebx,masseby,du,dv,dteta)
162
163C  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi
164C          probablement. Observe sur le code compile avec pgf90 3.0-1
165      ijb=ij_begin
166      ije=ij_end
167      if (pole_sud) ije=ij_end-iip1
168
169c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
170      DO l = 1, llm
171         DO ij = ijb, ije, iip1
172           IF( dv(ij,l).NE.dv(ij+iim,l) )  THEN
173c         PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', 
174c    ,   ' dans caldyn'
175c         PRINT *,' l,  ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
176          dv(ij+iim,l) = dv(ij,l)
177          endif
178         enddo
179      enddo
180c$OMP END DO NOWAIT     
181c-----------------------------------------------------------------------
182c   Sorties eventuelles des variables de controle:
183c   ----------------------------------------------
184
185      IF( conser )  THEN
186c ym ---> exige communication collective ( aussi dans advect)
187        CALL sortvarc
188     $ (itau,ucov,tsurpk,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov)
189
190      ENDIF
191
192      RETURN
193      END
Note: See TracBrowser for help on using the repository browser.