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	guez	3	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	guez	23	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	guez	3	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	guez	10	REAL, intent(in):: p(ip1jmp1,llmp1)
32			real teta(ip1jmp1,llm)
33	guez	3	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	guez	23	END IF
291	guez	3
292			END SUBROUTINE advtrac