libf/dyn3d/advtrac.f90

SUBROUTINE advtrac(pbaru,pbarv,p,masse,q,iapptrac,teta,pk)

  ! From dyn3d/advtrac.F,v 1.4 2005/04/13 08:58:34
  !     Auteur :  F. Hourdin

  !     Modif. P. Le Van     (20/12/97)
  !            F. Codron     (10/99)
  !            D. Le Croller (07/2001)
  !            M.A Filiberti (04/2002)

  USE dimens_m, ONLY : iim, jjm, llm, nqmx
  USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1, &
       llmp1
  USE comconst, ONLY : dtvr
  USE conf_gcm_m, ONLY : iapp_tracvl
  USE iniadvtrac_m, ONLY : iadv

  IMPLICIT NONE


  !-------------------------------------------------------------------
  !     Arguments
  !-------------------------------------------------------------------
  !     Ajout PPM
  !--------------------------------------------------------
  REAL massebx(ip1jmp1,llm), masseby(ip1jm,llm)
  !--------------------------------------------------------
  INTEGER iapptrac
  REAL pbaru(ip1jmp1,llm), pbarv(ip1jm,llm)
  REAL q(ip1jmp1,llm,nqmx), masse(ip1jmp1,llm)
  REAL, intent(in):: p(ip1jmp1,llmp1)
  real teta(ip1jmp1,llm)
  REAL pk(ip1jmp1,llm)

  !-------------------------------------------------------------
  !     Variables locales
  !-------------------------------------------------------------

  REAL pbaruc(ip1jmp1,llm), pbarvc(ip1jm,llm)
  REAL massem(ip1jmp1,llm), zdp(ip1jmp1)
  REAL pbarug(ip1jmp1,llm), pbarvg(ip1jm,llm), wg(ip1jmp1,llm)
  REAL cpuadv(nqmx)
  COMMON /cpuadv/cpuadv

  INTEGER iadvtr
  INTEGER ij, l, iq
  REAL zdpmin, zdpmax
  EXTERNAL minmax
  SAVE iadvtr, massem, pbaruc, pbarvc
  DATA iadvtr/0/
  !----------------------------------------------------------
  !     Rajouts pour PPM
  !----------------------------------------------------------
  INTEGER indice, n
  ! Pas de temps adaptatif pour que CFL<1                
  REAL dtbon
  REAL cflmaxz, aaa, & ! CFL maximum                                
       bbb
  REAL psppm(iim,jjp1) ! pression  au sol                           
  REAL unatppm(iim,jjp1,llm), vnatppm(iim,jjp1,llm)
  REAL qppm(iim*jjp1,llm,nqmx)
  REAL fluxwppm(iim,jjp1,llm)
  REAL apppm(llmp1), bpppm(llmp1)
  LOGICAL dum, fill
  DATA fill/ .TRUE./
  DATA dum/ .TRUE./


  IF (iadvtr==0) THEN
     CALL initial0(ijp1llm,pbaruc)
     CALL initial0(ijmllm,pbarvc)
  END IF

  !   accumulation des flux de masse horizontaux
  DO l = 1, llm
     DO ij = 1, ip1jmp1
        pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
     END DO
     DO ij = 1, ip1jm
        pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
     END DO
  END DO

  !   selection de la masse instantannee des mailles avant le transport.
  IF (iadvtr==0) THEN

     CALL scopy(ip1jmp1*llm,masse,1,massem,1)
     !cc         CALL filtreg ( massem ,jjp1, llm,-2, 2, .TRUE., 1 )

  END IF

  iadvtr = iadvtr + 1
  iapptrac = iadvtr


  !   Test pour savoir si on advecte a ce pas de temps
  IF (iadvtr==iapp_tracvl) THEN

     !c   ..  Modif P.Le Van  ( 20/12/97 )  ....
     !c

     !   traitement des flux de masse avant advection.
     !     1. calcul de w
     !     2. groupement des mailles pres du pole.

     CALL groupe(massem,pbaruc,pbarvc,pbarug,pbarvg,wg)


     !  test sur l'eventuelle creation de valeurs negatives de la masse
     DO l = 1, llm - 1
        DO ij = iip2 + 1, ip1jm
           zdp(ij) = pbarug(ij-1,l) - pbarug(ij,l) - pbarvg(ij-iip1,l) + &
                pbarvg(ij,l) + wg(ij,l+1) - wg(ij,l)
        END DO
        CALL scopy(jjm-1,zdp(iip1+iip1),iip1,zdp(iip2),iip1)
        DO ij = iip2, ip1jm
           zdp(ij) = zdp(ij)*dtvr/massem(ij,l)
        END DO


        CALL minmax(ip1jm-iip1,zdp(iip2),zdpmin,zdpmax)

        IF (max(abs(zdpmin),abs(zdpmax))>0.5) THEN
           PRINT *, 'WARNING DP/P l=', l, '  MIN:', zdpmin, '   MAX:', zdpmax
        END IF

     END DO

     !-------------------------------------------------------------------
     !   Advection proprement dite (Modification Le Croller (07/2001)
     !-------------------------------------------------------------------

     !----------------------------------------------------
     !        Calcul des moyennes basées sur la masse
     !----------------------------------------------------
     CALL massbar(massem,massebx,masseby)

     !-----------------------------------------------------------
     !     Appel des sous programmes d'advection
     !-----------------------------------------------------------
     DO iq = 1, nqmx
        !        call clock(t_initial)
        IF (iadv(iq)==0) CYCLE
        !   ----------------------------------------------------------------
        !   Schema de Van Leer I MUSCL
        !   ----------------------------------------------------------------
        IF (iadv(iq)==10) THEN
           CALL vlsplt(q(1,1,iq),2.,massem,wg,pbarug,pbarvg,dtvr)


           !   ----------------------------------------------------------------
           !   Schema "pseudo amont" + test sur humidite specifique
           !    pour la vapeur d'eau. F. Codron
           !   ----------------------------------------------------------------
        ELSE IF (iadv(iq)==14) THEN

           CALL vlspltqs(q(1,1,1),2.,massem,wg,pbarug,pbarvg,dtvr,p,pk,teta)
           !   ----------------------------------------------------------------
           !   Schema de Frederic Hourdin
           !   ----------------------------------------------------------------
        ELSE IF (iadv(iq)==12) THEN
           !            Pas de temps adaptatif
           CALL adaptdt(iadv(iq),dtbon,n,pbarug,massem)
           IF (n>1) THEN
              WRITE (*,*) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
                   'n=', n
           END IF
           DO indice = 1, n
              CALL advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,1)
           END DO
        ELSE IF (iadv(iq)==13) THEN
           !            Pas de temps adaptatif
           CALL adaptdt(iadv(iq),dtbon,n,pbarug,massem)
           IF (n>1) THEN
              WRITE (*,*) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
                   'n=', n
           END IF
           DO indice = 1, n
              CALL advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,2)
           END DO
           !   ----------------------------------------------------------------
           !   Schema de pente SLOPES
           !   ----------------------------------------------------------------
        ELSE IF (iadv(iq)==20) THEN
           CALL pentes_ini(q(1,1,iq),wg,massem,pbarug,pbarvg,0)

           !   ----------------------------------------------------------------
           !   Schema de Prather
           !   ----------------------------------------------------------------
        ELSE IF (iadv(iq)==30) THEN
           !            Pas de temps adaptatif
           CALL adaptdt(iadv(iq),dtbon,n,pbarug,massem)
           IF (n>1) THEN
              WRITE (*,*) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
                   'n=', n
           END IF
           CALL prather(q(1,1,iq),wg,massem,pbarug,pbarvg,n,dtbon)
           !   ----------------------------------------------------------------
           !   Schemas PPM Lin et Rood
           !   ----------------------------------------------------------------
        ELSE IF (iadv(iq)==11 .OR. (iadv(iq)>=16 .AND. iadv(iq)<=18)) THEN

           !        Test sur le flux horizontal
           !        Pas de temps adaptatif
           CALL adaptdt(iadv(iq),dtbon,n,pbarug,massem)
           IF (n>1) THEN
              WRITE (*,*) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
                   'n=', n
           END IF
           !        Test sur le flux vertical
           cflmaxz = 0.
           DO l = 2, llm
              DO ij = iip2, ip1jm
                 aaa = wg(ij,l)*dtvr/massem(ij,l)
                 cflmaxz = max(cflmaxz,aaa)
                 bbb = -wg(ij,l)*dtvr/massem(ij,l-1)
                 cflmaxz = max(cflmaxz,bbb)
              END DO
           END DO
           IF (cflmaxz>=1) THEN
              WRITE (*,*) 'WARNING vertical', 'CFLmaxz=', cflmaxz
           END IF

           !-----------------------------------------------------------
           !        Ss-prg interface LMDZ.4->PPM3d
           !-----------------------------------------------------------

           CALL interpre(q(1,1,iq),qppm(1,1,iq),wg,fluxwppm,massem,apppm, &
                bpppm,massebx,masseby,pbarug,pbarvg,unatppm,vnatppm,psppm)

           DO indice = 1, n
              !----------------------------------------------------------------
              !                         VL (version PPM) horiz. et PPM vert.
              !---------------------------------------------------------------
              IF (iadv(iq)==11) THEN
                 !                  Ss-prg PPM3d de Lin
                 CALL ppm3d(1,qppm(1,1,iq),psppm,psppm,unatppm,vnatppm, &
                      fluxwppm,dtbon,2,2,2,1,iim,jjp1,2,llm,apppm,bpppm,0.01, &
                      6400000,fill,dum,220.)

                 !-----------------------------------------------------------
                 !                           Monotonic PPM
                 !-------------------------------------------------------
              ELSE IF (iadv(iq)==16) THEN
                 !                  Ss-prg PPM3d de Lin
                 CALL ppm3d(1,qppm(1,1,iq),psppm,psppm,unatppm,vnatppm, &
                      fluxwppm,dtbon,3,3,3,1,iim,jjp1,2,llm,apppm,bpppm,0.01, &
                      6400000,fill,dum,220.)
                 !                           Semi Monotonic PPM
              ELSE IF (iadv(iq)==17) THEN
                 !                  Ss-prg PPM3d de Lin
                 CALL ppm3d(1,qppm(1,1,iq),psppm,psppm,unatppm,vnatppm, &
                      fluxwppm,dtbon,4,4,4,1,iim,jjp1,2,llm,apppm,bpppm,0.01, &
                      6400000,fill,dum,220.)
                 !                         Positive Definite PPM
              ELSE IF (iadv(iq)==18) THEN
                 !                  Ss-prg PPM3d de Lin
                 CALL ppm3d(1,qppm(1,1,iq),psppm,psppm,unatppm,vnatppm, &
                      fluxwppm,dtbon,5,5,5,1,iim,jjp1,2,llm,apppm,bpppm,0.01, &
                      6400000,fill,dum,220.)
              END IF
           END DO
           !-----------------------------------------------------------------
           !               Ss-prg interface PPM3d-LMDZ.4
           !-----------------------------------------------------------------
           CALL interpost(q(1,1,iq),qppm(1,1,iq))
        END IF
        !----------------------------------------------------------------------

        !-----------------------------------------------------------------
        ! On impose une seule valeur du traceur au pôle Sud j=jjm+1=jjp1
        ! et Nord j=1
        !-----------------------------------------------------------------

        !                  call traceurpole(q(1,1,iq),massem)

        ! calcul du temps cpu pour un schema donne

        !                  call clock(t_final)
        !ym                  tps_cpu=t_final-t_initial
        !ym                  cpuadv(iq)=cpuadv(iq)+tps_cpu

     END DO


     !------------------------------------------------------------------
     !   on reinitialise a zero les flux de masse cumules
     !---------------------------------------------------
     iadvtr = 0
  END IF

END SUBROUTINE advtrac
1	SUBROUTINE advtrac(pbaru,pbarv,p,masse,q,iapptrac,teta,pk)
2
3	! From dyn3d/advtrac.F,v 1.4 2005/04/13 08:58:34
4	! Auteur : F. Hourdin
5
6	! Modif. P. Le Van (20/12/97)
7	! F. Codron (10/99)
8	! D. Le Croller (07/2001)
9	! M.A Filiberti (04/2002)
10
11	USE dimens_m, ONLY : iim, jjm, llm, nqmx
12	USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1, &
13	llmp1
14	USE comconst, ONLY : dtvr
15	USE conf_gcm_m, ONLY : iapp_tracvl
16	USE iniadvtrac_m, ONLY : iadv
17
18	IMPLICIT NONE
19
20
21	!-------------------------------------------------------------------
22	! Arguments
23	!-------------------------------------------------------------------
24	! Ajout PPM
25	!--------------------------------------------------------
26	REAL massebx(ip1jmp1,llm), masseby(ip1jm,llm)
27	!--------------------------------------------------------
28	INTEGER iapptrac
29	REAL pbaru(ip1jmp1,llm), pbarv(ip1jm,llm)
30	REAL q(ip1jmp1,llm,nqmx), masse(ip1jmp1,llm)
31	REAL, intent(in):: p(ip1jmp1,llmp1)
32	real teta(ip1jmp1,llm)
33	REAL pk(ip1jmp1,llm)
34
35	!-------------------------------------------------------------
36	! Variables locales
37	!-------------------------------------------------------------
38
39	REAL pbaruc(ip1jmp1,llm), pbarvc(ip1jm,llm)
40	REAL massem(ip1jmp1,llm), zdp(ip1jmp1)
41	REAL pbarug(ip1jmp1,llm), pbarvg(ip1jm,llm), wg(ip1jmp1,llm)
42	REAL cpuadv(nqmx)
43	COMMON /cpuadv/cpuadv
44
45	INTEGER iadvtr
46	INTEGER ij, l, iq
47	REAL zdpmin, zdpmax
48	EXTERNAL minmax
49	SAVE iadvtr, massem, pbaruc, pbarvc
50	DATA iadvtr/0/
51	!----------------------------------------------------------
52	! Rajouts pour PPM
53	!----------------------------------------------------------
54	INTEGER indice, n
55	! Pas de temps adaptatif pour que CFL<1
56	REAL dtbon
57	REAL cflmaxz, aaa, & ! CFL maximum
58	bbb
59	REAL psppm(iim,jjp1) ! pression au sol
60	REAL unatppm(iim,jjp1,llm), vnatppm(iim,jjp1,llm)
61	REAL qppm(iim*jjp1,llm,nqmx)
62	REAL fluxwppm(iim,jjp1,llm)
63	REAL apppm(llmp1), bpppm(llmp1)
64	LOGICAL dum, fill
65	DATA fill/ .TRUE./
66	DATA dum/ .TRUE./
67
68
69	IF (iadvtr==0) THEN
70	CALL initial0(ijp1llm,pbaruc)
71	CALL initial0(ijmllm,pbarvc)
72	END IF
73
74	! accumulation des flux de masse horizontaux
75	DO l = 1, llm
76	DO ij = 1, ip1jmp1
77	pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
78	END DO
79	DO ij = 1, ip1jm
80	pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
81	END DO
82	END DO
83
84	! selection de la masse instantannee des mailles avant le transport.
85	IF (iadvtr==0) THEN
86
87	CALL scopy(ip1jmp1*llm,masse,1,massem,1)
88	!cc CALL filtreg ( massem ,jjp1, llm,-2, 2, .TRUE., 1 )
89
90	END IF
91
92	iadvtr = iadvtr + 1
93	iapptrac = iadvtr
94
95
96	! Test pour savoir si on advecte a ce pas de temps
97	IF (iadvtr==iapp_tracvl) THEN
98
99	!c .. Modif P.Le Van ( 20/12/97 ) ....
100	!c
101
102	! traitement des flux de masse avant advection.
103	! 1. calcul de w
104	! 2. groupement des mailles pres du pole.
105
106	CALL groupe(massem,pbaruc,pbarvc,pbarug,pbarvg,wg)
107
108
109	! test sur l'eventuelle creation de valeurs negatives de la masse
110	DO l = 1, llm - 1
111	DO ij = iip2 + 1, ip1jm
112	zdp(ij) = pbarug(ij-1,l) - pbarug(ij,l) - pbarvg(ij-iip1,l) + &
113	pbarvg(ij,l) + wg(ij,l+1) - wg(ij,l)
114	END DO
115	CALL scopy(jjm-1,zdp(iip1+iip1),iip1,zdp(iip2),iip1)
116	DO ij = iip2, ip1jm
117	zdp(ij) = zdp(ij)*dtvr/massem(ij,l)
118	END DO
119
120
121	CALL minmax(ip1jm-iip1,zdp(iip2),zdpmin,zdpmax)
122
123	IF (max(abs(zdpmin),abs(zdpmax))>0.5) THEN
124	PRINT *, 'WARNING DP/P l=', l, ' MIN:', zdpmin, ' MAX:', zdpmax
125	END IF
126
127	END DO
128
129	!-------------------------------------------------------------------
130	! Advection proprement dite (Modification Le Croller (07/2001)
131	!-------------------------------------------------------------------
132
133	!----------------------------------------------------
134	! Calcul des moyennes basées sur la masse
135	!----------------------------------------------------
136	CALL massbar(massem,massebx,masseby)
137
138	!-----------------------------------------------------------
139	! Appel des sous programmes d'advection
140	!-----------------------------------------------------------
141	DO iq = 1, nqmx
142	! call clock(t_initial)
143	IF (iadv(iq)==0) CYCLE
144	! ----------------------------------------------------------------
145	! Schema de Van Leer I MUSCL
146	! ----------------------------------------------------------------
147	IF (iadv(iq)==10) THEN
148	CALL vlsplt(q(1,1,iq),2.,massem,wg,pbarug,pbarvg,dtvr)
149
150
151	! ----------------------------------------------------------------
152	! Schema "pseudo amont" + test sur humidite specifique
153	! pour la vapeur d'eau. F. Codron
154	! ----------------------------------------------------------------
155	ELSE IF (iadv(iq)==14) THEN
156
157	CALL vlspltqs(q(1,1,1),2.,massem,wg,pbarug,pbarvg,dtvr,p,pk,teta)
158	! ----------------------------------------------------------------
159	! Schema de Frederic Hourdin
160	! ----------------------------------------------------------------
161	ELSE IF (iadv(iq)==12) THEN
162	! Pas de temps adaptatif
163	CALL adaptdt(iadv(iq),dtbon,n,pbarug,massem)
164	IF (n>1) THEN
165	WRITE (,) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
166	'n=', n
167	END IF
168	DO indice = 1, n
169	CALL advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,1)
170	END DO
171	ELSE IF (iadv(iq)==13) THEN
172	! Pas de temps adaptatif
173	CALL adaptdt(iadv(iq),dtbon,n,pbarug,massem)
174	IF (n>1) THEN
175	WRITE (,) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
176	'n=', n
177	END IF
178	DO indice = 1, n
179	CALL advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,2)
180	END DO
181	! ----------------------------------------------------------------
182	! Schema de pente SLOPES
183	! ----------------------------------------------------------------
184	ELSE IF (iadv(iq)==20) THEN
185	CALL pentes_ini(q(1,1,iq),wg,massem,pbarug,pbarvg,0)
186
187	! ----------------------------------------------------------------
188	! Schema de Prather
189	! ----------------------------------------------------------------
190	ELSE IF (iadv(iq)==30) THEN
191	! Pas de temps adaptatif
192	CALL adaptdt(iadv(iq),dtbon,n,pbarug,massem)
193	IF (n>1) THEN
194	WRITE (,) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
195	'n=', n
196	END IF
197	CALL prather(q(1,1,iq),wg,massem,pbarug,pbarvg,n,dtbon)
198	! ----------------------------------------------------------------
199	! Schemas PPM Lin et Rood
200	! ----------------------------------------------------------------
201	ELSE IF (iadv(iq)==11 .OR. (iadv(iq)>=16 .AND. iadv(iq)<=18)) THEN
202
203	! Test sur le flux horizontal
204	! Pas de temps adaptatif
205	CALL adaptdt(iadv(iq),dtbon,n,pbarug,massem)
206	IF (n>1) THEN
207	WRITE (,) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, &
208	'n=', n
209	END IF
210	! Test sur le flux vertical
211	cflmaxz = 0.
212	DO l = 2, llm
213	DO ij = iip2, ip1jm
214	aaa = wg(ij,l)*dtvr/massem(ij,l)
215	cflmaxz = max(cflmaxz,aaa)
216	bbb = -wg(ij,l)*dtvr/massem(ij,l-1)
217	cflmaxz = max(cflmaxz,bbb)
218	END DO
219	END DO
220	IF (cflmaxz>=1) THEN
221	WRITE (,) 'WARNING vertical', 'CFLmaxz=', cflmaxz
222	END IF
223
224	!-----------------------------------------------------------
225	! Ss-prg interface LMDZ.4->PPM3d
226	!-----------------------------------------------------------
227
228	CALL interpre(q(1,1,iq),qppm(1,1,iq),wg,fluxwppm,massem,apppm, &
229	bpppm,massebx,masseby,pbarug,pbarvg,unatppm,vnatppm,psppm)
230
231	DO indice = 1, n
232	!----------------------------------------------------------------
233	! VL (version PPM) horiz. et PPM vert.
234	!---------------------------------------------------------------
235	IF (iadv(iq)==11) THEN
236	! Ss-prg PPM3d de Lin
237	CALL ppm3d(1,qppm(1,1,iq),psppm,psppm,unatppm,vnatppm, &
238	fluxwppm,dtbon,2,2,2,1,iim,jjp1,2,llm,apppm,bpppm,0.01, &
239	6400000,fill,dum,220.)
240
241	!-----------------------------------------------------------
242	! Monotonic PPM
243	!-------------------------------------------------------
244	ELSE IF (iadv(iq)==16) THEN
245	! Ss-prg PPM3d de Lin
246	CALL ppm3d(1,qppm(1,1,iq),psppm,psppm,unatppm,vnatppm, &
247	fluxwppm,dtbon,3,3,3,1,iim,jjp1,2,llm,apppm,bpppm,0.01, &
248	6400000,fill,dum,220.)
249	! Semi Monotonic PPM
250	ELSE IF (iadv(iq)==17) THEN
251	! Ss-prg PPM3d de Lin
252	CALL ppm3d(1,qppm(1,1,iq),psppm,psppm,unatppm,vnatppm, &
253	fluxwppm,dtbon,4,4,4,1,iim,jjp1,2,llm,apppm,bpppm,0.01, &
254	6400000,fill,dum,220.)
255	! Positive Definite PPM
256	ELSE IF (iadv(iq)==18) THEN
257	! Ss-prg PPM3d de Lin
258	CALL ppm3d(1,qppm(1,1,iq),psppm,psppm,unatppm,vnatppm, &
259	fluxwppm,dtbon,5,5,5,1,iim,jjp1,2,llm,apppm,bpppm,0.01, &
260	6400000,fill,dum,220.)
261	END IF
262	END DO
263	!-----------------------------------------------------------------
264	! Ss-prg interface PPM3d-LMDZ.4
265	!-----------------------------------------------------------------
266	CALL interpost(q(1,1,iq),qppm(1,1,iq))
267	END IF
268	!----------------------------------------------------------------------
269
270	!-----------------------------------------------------------------
271	! On impose une seule valeur du traceur au pôle Sud j=jjm+1=jjp1
272	! et Nord j=1
273	!-----------------------------------------------------------------
274
275	! call traceurpole(q(1,1,iq),massem)
276
277	! calcul du temps cpu pour un schema donne
278
279	! call clock(t_final)
280	!ym tps_cpu=t_final-t_initial
281	!ym cpuadv(iq)=cpuadv(iq)+tps_cpu
282
283	END DO
284
285
286	!------------------------------------------------------------------
287	! on reinitialise a zero les flux de masse cumules
288	!---------------------------------------------------
289	iadvtr = 0
290	END IF
291
292	END SUBROUTINE advtrac