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

Last change on this file since 4095 was 2597, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod.
EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 5.7 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_lmdz
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
34c   Arguments:
35c   ----------
36      REAL :: pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm)
37      REAL :: masse(ijb_u:ije_u,llm)
38      REAL :: p( ijb_u:ije_u,llmp1)
39      REAL :: q( ijb_u:ije_u,llm,nqtot),dq( ijb_u:ije_u,llm, nqtot )
40      REAL :: teta( ijb_u:ije_u,llm),pk( ijb_u:ije_u,llm)
41      REAL :: flxw(ijb_u:ije_u,llm)
42      INTEGER :: iapptrac
43c   Local:
44c   ------
45!      REAL :: pbarug(ijb_u:ije_u,llm)
46!      REAL :: pbarvg(ijb_v:ije_v,llm)
47!      REAL :: wg(ijb_u:ije_u,llm)
48     
49      REAL :: flxw_adv(distrib_vanleer%ijb_u:distrib_vanleer%ije_u,llm)
50      INTEGER,SAVE :: iadvtr=0
51!$OMP THREADPRIVATE(iadvtr)
52      INTEGER ::  ijb,ije,ijbu,ijbv,ijeu,ijev,j
53      INTEGER :: ij,l
54      TYPE(Request),SAVE :: Request_vanleer
55!$OMP THREADPRIVATE(Request_vanleer)
56
57      !write(*,*) 'caladvtrac 58: entree'     
58      ijbu=ij_begin
59      ijeu=ij_end
60     
61      ijbv=ij_begin-iip1
62      ijev=ij_end
63      if (pole_nord) ijbv=ij_begin
64      if (pole_sud)  ijev=ij_end-iip1
65
66      IF(iadvtr.EQ.0) THEN
67c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
68        DO l=1,llm   
69          pbaruc(ijbu:ijeu,l)=0.
70          pbarvc(ijbv:ijev,l)=0.
71        ENDDO
72c$OMP END DO NOWAIT 
73      ENDIF
74
75c   accumulation des flux de masse horizontaux
76c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
77      DO l=1,llm
78         DO ij = ijbu,ijeu
79            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
80         ENDDO
81         DO ij = ijbv,ijev
82            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
83         ENDDO
84      ENDDO
85c$OMP END DO NOWAIT
86
87c   selection de la masse instantannee des mailles avant le transport.
88      IF(iadvtr.EQ.0) THEN
89
90          ijb=ij_begin
91          ije=ij_end
92
93c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
94       DO l=1,llm
95          massem(ijb:ije,l)=masse(ijb:ije,l)
96       ENDDO
97c$OMP END DO NOWAIT
98
99      ENDIF
100
101      iadvtr   = iadvtr+1
102
103c$OMP MASTER
104      iapptrac = iadvtr
105c$OMP END MASTER
106
107c   Test pour savoir si on advecte a ce pas de temps
108
109      IF ( iadvtr.EQ.iapp_tracvl ) THEN
110      !write(*,*) 'caladvtrac 133'
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
125        CALL groupe_loc( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
126
127c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
128      DO l=1,llm
129        flxw(ijb:ije,l)=wg(ijb:ije,l)/REAL(iapp_tracvl)
130      ENDDO
131c$OMP ENDDO NOWAIT
132
133#ifdef DEBUG_IO   
134         CALL WriteField_u('pbarug1',pbarug)
135         CALL WriteField_v('pbarvg1',pbarvg)
136         CALL WriteField_u('wg1',wg)
137#endif
138
139c$OMP BARRIER
140
141
142c$OMP MASTER
143      call VTb(VTHallo)
144c$OMP END MASTER
145
146      call Register_SwapField_u(pbarug,pbarug_adv, distrib_vanleer,
147     &                          Request_vanleer)
148      call Register_SwapField_v(pbarvg,pbarvg_adv, distrib_vanleer,
149     &                          Request_vanleer,up=1)
150      call Register_SwapField_u(massem,massem_adv, distrib_vanleer,
151     &                          Request_vanleer)
152      call Register_SwapField_u(wg,wg_adv,distrib_vanleer,
153     &                          Request_vanleer)
154      call Register_SwapField_u(teta,teta_adv, distrib_vanleer,
155     &                          Request_vanleer,up=1,down=1)
156      call Register_SwapField_u(p,p_adv, distrib_vanleer,
157     &                          Request_vanleer,up=1,down=1)
158      call Register_SwapField_u(pk,pk_adv, distrib_vanleer,
159     &                          Request_vanleer,up=1,down=1)
160      call Register_SwapField_u(q,q_adv, distrib_vanleer,
161     &                          Request_vanleer)
162
163      call SendRequest(Request_vanleer)
164c$OMP BARRIER
165      call WaitRequest(Request_vanleer)
166
167
168c$OMP BARRIER
169c$OMP MASTER     
170      call Set_Distrib(distrib_vanleer)
171      call VTe(VTHallo)
172      call VTb(VTadvection)
173      call start_timer(timer_vanleer)
174c$OMP END MASTER
175c$OMP BARRIER
176!      CALL WriteField_u('pbarug_adv',pbarug_adv)
177!      CALL WriteField_u('',)
178     
179     
180#ifdef DEBUG_IO
181         CALL WriteField_u('pbarug1',pbarug_adv)
182         CALL WriteField_v('pbarvg1',pbarvg_adv)
183         CALL WriteField_u('wg1',wg_adv)
184#endif       
185      !write(*,*) 'caladvtrac 185' 
186      CALL advtrac_loc( pbarug_adv,pbarvg_adv,wg_adv,
187     *             p_adv,  massem_adv,q_adv, teta_adv,
188     .             pk_adv)     
189      !write(*,*) 'caladvtrac 189'
190
191
192c$OMP MASTER
193        call VTe(VTadvection)
194        call stop_timer(timer_vanleer)
195        call VTb(VThallo)
196c$OMP END MASTER
197
198        call Register_SwapField_u(q_adv,q,distrib_caldyn,
199     *                             Request_vanleer)
200
201        call SendRequest(Request_vanleer)
202c$OMP BARRIER
203        call WaitRequest(Request_vanleer)     
204
205c$OMP BARRIER
206c$OMP MASTER
207        call Set_Distrib(distrib_caldyn)
208        call VTe(VThallo)
209        call resume_timer(timer_caldyn)
210c$OMP END MASTER
211c$OMP BARRIER
212          iadvtr=0
213       ENDIF ! if iadvtr.EQ.iapp_tracvl
214
215      END
216
217
Note: See TracBrowser for help on using the repository browser.