My Project
 All Classes Files Functions Variables Macros
caladvtrac_loc.F
Go to the documentation of this file.
1 !
2 ! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $
3 !
4 c
5 c
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
18 c
19  IMPLICIT NONE
20 c
21 c Auteurs: F.Hourdin , P.Le Van, F.Forget, F.Codron
22 c
23 c F.Codron (10/99) : ajout humidite specifique pour eau vapeur
24 c=======================================================================
25 c
26 c Shema de Van Leer
27 c
28 c=======================================================================
29 
30 
31 #include "dimensions.h"
32 #include "paramet.h"
33 #include "comconst.h"
34 
35 c Arguments:
36 c ----------
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
44 c Local:
45 c ------
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
68 c$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
73 c$OMP END DO NOWAIT
74  ENDIF
75 
76 c accumulation des flux de masse horizontaux
77 c$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
86 c$OMP END DO NOWAIT
87 
88 c 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 
94 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
95  DO l=1,llm
96  massem(ijb:ije,l)=masse(ijb:ije,l)
97  ENDDO
98 c$OMP END DO NOWAIT
99 
100  ENDIF
101 
102  iadvtr = iadvtr+1
103 
104 c$OMP MASTER
105  iapptrac = iadvtr
106 c$OMP END MASTER
107 
108 c Test pour savoir si on advecte a ce pas de temps
109 
110  IF ( iadvtr.EQ.iapp_tracvl ) THEN
111 c$OMP MASTER
112  call suspend_timer(timer_caldyn)
113 c$OMP END MASTER
114 
115  ijb=ij_begin
116  ije=ij_end
117 
118 cc .. Modif P.Le Van ( 20/12/97 ) ....
119 cc
120 
121 c traitement des flux de masse avant advection.
122 c 1. calcul de w
123 c 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 
135 c$OMP BARRIER
136 
137 
138 c$OMP MASTER
139  call vtb(vthallo)
140 c$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)
160 c$OMP BARRIER
161  call waitrequest(request_vanleer)
162 
163 
164 c$OMP BARRIER
165 c$OMP MASTER
166  call set_distrib(distrib_vanleer)
167  call vte(vthallo)
168  call vtb(vtadvection)
169  call start_timer(timer_vanleer)
170 c$OMP END MASTER
171 c$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 
186 c$OMP MASTER
187  call vte(vtadvection)
188  call stop_timer(timer_vanleer)
189  call vtb(vthallo)
190 c$OMP END MASTER
191 
192  call register_swapfield_u(q_adv,q,distrib_caldyn,
193  * request_vanleer)
194 
195  call sendrequest(request_vanleer)
196 c$OMP BARRIER
197  call waitrequest(request_vanleer)
198 
199 c$OMP BARRIER
200 c$OMP MASTER
201  call set_distrib(distrib_caldyn)
202  call vte(vthallo)
203  call resume_timer(timer_caldyn)
204 c$OMP END MASTER
205 c$OMP BARRIER
206  iadvtr=0
207  ENDIF ! if iadvtr.EQ.iapp_tracvl
208 
209  END
210 
211