source: LMDZ5/trunk/libf/dyn3dmem/caladvtrac_loc.F @ 1673

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

Fin du phasage de la dynamique parallele localisee (petite memoire) avec le tronc LMDZ5 r1671
Il reste quelques routines a verifier (en particulier ce qui touche a l'etude des cas academiques)
et la validation a effectuer


End of the phasing of the localised (low memory) parallel dynamics package with the
LMDZ5 trunk (r1671)
Some routines still need some checking (in particular the academic cases) and some
validation is still required

File size: 5.5 KB
Line 
1!
2! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $
3!
4c
5c
6            SUBROUTINE caladvtrac_loc(q,pbaru,pbarv ,
7     *                   p ,masse, dq ,  teta,
8     *                   flxw, pk, iapptrac)
9      USE parallel
10      USE infotrac, ONLY : nqtot
11      USE control_mod, ONLY : iapp_tracvl,planet_type
12      USE caladvtrac_mod
13      USE mod_hallo
14      USE bands
15      USE times
16      USE Vampir
17      USE write_field_loc
18c
19      IMPLICIT NONE
20c
21c     Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron 
22c
23c     F.Codron (10/99) : ajout humidite specifique pour eau vapeur
24c=======================================================================
25c
26c       Shema de  Van Leer
27c
28c=======================================================================
29
30
31#include "dimensions.h"
32#include "paramet.h"
33#include "comconst.h"
34
35c   Arguments:
36c   ----------
37      REAL :: pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm)
38      REAL :: masse(ijb_u:ije_u,llm)
39      REAL :: p( ijb_u:ije_u,llmp1)
40      REAL :: q( ijb_u:ije_u,llm,nqtot),dq( ijb_u:ije_u,llm, nqtot )
41      REAL :: teta( ijb_u:ije_u,llm),pk( ijb_u:ije_u,llm)
42      REAL :: flxw(ijb_u:ije_u,llm)
43      INTEGER :: iapptrac
44c   Local:
45c   ------
46!      REAL :: pbarug(ijb_u:ije_u,llm)
47!      REAL :: pbarvg(ijb_v:ije_v,llm)
48!      REAL :: wg(ijb_u:ije_u,llm)
49     
50      REAL :: flxw_adv(distrib_vanleer%ijb_u:distrib_vanleer%ije_u,llm)
51      INTEGER,SAVE :: iadvtr=0
52!$OMP THREADPRIVATE(iadvtr)
53      INTEGER ::  ijb,ije,ijbu,ijbv,ijeu,ijev,j
54      INTEGER :: ij,l
55      TYPE(Request) :: Request_vanleer
56
57
58           
59      ijbu=ij_begin
60      ijeu=ij_end
61     
62      ijbv=ij_begin-iip1
63      ijev=ij_end
64      if (pole_nord) ijbv=ij_begin
65      if (pole_sud)  ijev=ij_end-iip1
66
67      IF(iadvtr.EQ.0) THEN
68c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
69        DO l=1,llm   
70          pbaruc(ijbu:ijeu,l)=0.
71          pbarvc(ijbv:ijev,l)=0.
72        ENDDO
73c$OMP END DO NOWAIT 
74      ENDIF
75
76c   accumulation des flux de masse horizontaux
77c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
78      DO l=1,llm
79         DO ij = ijbu,ijeu
80            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
81         ENDDO
82         DO ij = ijbv,ijev
83            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
84         ENDDO
85      ENDDO
86c$OMP END DO NOWAIT
87
88c   selection de la masse instantannee des mailles avant le transport.
89      IF(iadvtr.EQ.0) THEN
90
91          ijb=ij_begin
92          ije=ij_end
93
94c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
95       DO l=1,llm
96          massem(ijb:ije,l)=masse(ijb:ije,l)
97       ENDDO
98c$OMP END DO NOWAIT
99
100      ENDIF
101
102      iadvtr   = iadvtr+1
103
104c$OMP MASTER
105      iapptrac = iadvtr
106c$OMP END MASTER
107
108c   Test pour savoir si on advecte a ce pas de temps
109
110      IF ( iadvtr.EQ.iapp_tracvl ) THEN
111c$OMP MASTER
112        call suspend_timer(timer_caldyn)
113c$OMP END MASTER
114     
115      ijb=ij_begin
116      ije=ij_end
117     
118cc   ..  Modif P.Le Van  ( 20/12/97 )  ....
119cc
120
121c   traitement des flux de masse avant advection.
122c     1. calcul de w
123c     2. groupement des mailles pres du pole.
124        pbarvg(:,:)=-1
125        pbarvg_adv(:,:)=-2
126        CALL groupe_loc( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
127        flxw(ijb:ije,1:llm)=wg(ijb:ije,1:llm)/REAL(iapp_tracvl)
128
129#ifdef DEBUG_IO   
130         CALL WriteField_u('pbarug1',pbarug)
131         CALL WriteField_v('pbarvg1',pbarvg)
132         CALL WriteField_u('wg1',wg)
133#endif
134
135c$OMP BARRIER
136
137
138c$OMP MASTER
139      call VTb(VTHallo)
140c$OMP END MASTER
141
142      call Register_SwapField_u(pbarug,pbarug_adv, distrib_vanleer,
143     &                          Request_vanleer)
144      call Register_SwapField_v(pbarvg,pbarvg_adv, distrib_vanleer,
145     &                          Request_vanleer,up=1)
146      call Register_SwapField_u(massem,massem_adv, distrib_vanleer,
147     &                          Request_vanleer)
148      call Register_SwapField_u(wg,wg_adv,distrib_vanleer,
149     &                          Request_vanleer)
150      call Register_SwapField_u(teta,teta_adv, distrib_vanleer,
151     &                          Request_vanleer,up=1,down=1)
152      call Register_SwapField_u(p,p_adv, distrib_vanleer,
153     &                          Request_vanleer,up=1,down=1)
154      call Register_SwapField_u(pk,pk_adv, distrib_vanleer,
155     &                          Request_vanleer,up=1,down=1)
156      call Register_SwapField_u(q,q_adv, distrib_vanleer,
157     &                          Request_vanleer)
158
159      call SendRequest(Request_vanleer)
160c$OMP BARRIER
161      call WaitRequest(Request_vanleer)
162
163
164c$OMP BARRIER
165c$OMP MASTER     
166      call Set_Distrib(distrib_vanleer)
167      call VTe(VTHallo)
168      call VTb(VTadvection)
169      call start_timer(timer_vanleer)
170c$OMP END MASTER
171c$OMP BARRIER
172!      CALL WriteField_u('pbarug_adv',pbarug_adv)
173!      CALL WriteField_u('',)
174     
175     
176#ifdef DEBUG_IO
177         CALL WriteField_u('pbarug1',pbarug_adv)
178         CALL WriteField_v('pbarvg1',pbarvg_adv)
179         CALL WriteField_u('wg1',wg_adv)
180#endif       
181      CALL advtrac_loc( pbarug_adv,pbarvg_adv,wg_adv,
182     *             p_adv,  massem_adv,q_adv, teta_adv,
183     .             pk_adv)
184
185
186c$OMP MASTER
187        call VTe(VTadvection)
188        call stop_timer(timer_vanleer)
189        call VTb(VThallo)
190c$OMP END MASTER
191
192        call Register_SwapField_u(q_adv,q,distrib_caldyn,
193     *                             Request_vanleer)
194
195        call SendRequest(Request_vanleer)
196c$OMP BARRIER
197        call WaitRequest(Request_vanleer)     
198
199c$OMP BARRIER
200c$OMP MASTER
201        call Set_Distrib(distrib_caldyn)
202        call VTe(VThallo)
203        call resume_timer(timer_caldyn)
204c$OMP END MASTER
205c$OMP BARRIER   
206          iadvtr=0
207       ENDIF ! if iadvtr.EQ.iapp_tracvl
208
209      END
210
211
Note: See TracBrowser for help on using the repository browser.