source: LMDZ5/trunk/libf/dyn3dmem/caladvtrac_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: 5.4 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
11      USE control_mod
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,2 )
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.