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

Last change on this file since 2496 was 2286, checked in by Ehouarn Millour, 9 years ago
  • fix in dyn3d the array out of bound issue (in qminimum) that was only corrected in dyn3dmem in rev 2285.
  • comment out many invasive debug writes.

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#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),SAVE :: Request_vanleer
56!$OMP THREADPRIVATE(Request_vanleer)
57
58      !write(*,*) 'caladvtrac 58: entree'     
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
111      !write(*,*) 'caladvtrac 133'
112c$OMP MASTER
113        call suspend_timer(timer_caldyn)
114c$OMP END MASTER
115     
116      ijb=ij_begin
117      ije=ij_end
118     
119cc   ..  Modif P.Le Van  ( 20/12/97 )  ....
120cc
121
122c   traitement des flux de masse avant advection.
123c     1. calcul de w
124c     2. groupement des mailles pres du pole.
125
126        CALL groupe_loc( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
127
128c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
129      DO l=1,llm
130        flxw(ijb:ije,l)=wg(ijb:ije,l)/REAL(iapp_tracvl)
131      ENDDO
132c$OMP ENDDO NOWAIT
133
134#ifdef DEBUG_IO   
135         CALL WriteField_u('pbarug1',pbarug)
136         CALL WriteField_v('pbarvg1',pbarvg)
137         CALL WriteField_u('wg1',wg)
138#endif
139
140c$OMP BARRIER
141
142
143c$OMP MASTER
144      call VTb(VTHallo)
145c$OMP END MASTER
146
147      call Register_SwapField_u(pbarug,pbarug_adv, distrib_vanleer,
148     &                          Request_vanleer)
149      call Register_SwapField_v(pbarvg,pbarvg_adv, distrib_vanleer,
150     &                          Request_vanleer,up=1)
151      call Register_SwapField_u(massem,massem_adv, distrib_vanleer,
152     &                          Request_vanleer)
153      call Register_SwapField_u(wg,wg_adv,distrib_vanleer,
154     &                          Request_vanleer)
155      call Register_SwapField_u(teta,teta_adv, distrib_vanleer,
156     &                          Request_vanleer,up=1,down=1)
157      call Register_SwapField_u(p,p_adv, distrib_vanleer,
158     &                          Request_vanleer,up=1,down=1)
159      call Register_SwapField_u(pk,pk_adv, distrib_vanleer,
160     &                          Request_vanleer,up=1,down=1)
161      call Register_SwapField_u(q,q_adv, distrib_vanleer,
162     &                          Request_vanleer)
163
164      call SendRequest(Request_vanleer)
165c$OMP BARRIER
166      call WaitRequest(Request_vanleer)
167
168
169c$OMP BARRIER
170c$OMP MASTER     
171      call Set_Distrib(distrib_vanleer)
172      call VTe(VTHallo)
173      call VTb(VTadvection)
174      call start_timer(timer_vanleer)
175c$OMP END MASTER
176c$OMP BARRIER
177!      CALL WriteField_u('pbarug_adv',pbarug_adv)
178!      CALL WriteField_u('',)
179     
180     
181#ifdef DEBUG_IO
182         CALL WriteField_u('pbarug1',pbarug_adv)
183         CALL WriteField_v('pbarvg1',pbarvg_adv)
184         CALL WriteField_u('wg1',wg_adv)
185#endif       
186      !write(*,*) 'caladvtrac 185' 
187      CALL advtrac_loc( pbarug_adv,pbarvg_adv,wg_adv,
188     *             p_adv,  massem_adv,q_adv, teta_adv,
189     .             pk_adv)     
190      !write(*,*) 'caladvtrac 189'
191
192
193c$OMP MASTER
194        call VTe(VTadvection)
195        call stop_timer(timer_vanleer)
196        call VTb(VThallo)
197c$OMP END MASTER
198
199        call Register_SwapField_u(q_adv,q,distrib_caldyn,
200     *                             Request_vanleer)
201
202        call SendRequest(Request_vanleer)
203c$OMP BARRIER
204        call WaitRequest(Request_vanleer)     
205
206c$OMP BARRIER
207c$OMP MASTER
208        call Set_Distrib(distrib_caldyn)
209        call VTe(VThallo)
210        call resume_timer(timer_caldyn)
211c$OMP END MASTER
212c$OMP BARRIER   
213          iadvtr=0
214       ENDIF ! if iadvtr.EQ.iapp_tracvl
215
216      END
217
218
Note: See TracBrowser for help on using the repository browser.