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

Last change on this file since 1660 was 1632, checked in by Laurent Fairhead, 12 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

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
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.