Index: LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F
===================================================================
--- LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F	(revision 630)
+++ LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F	(revision 764)
@@ -4,11 +4,9 @@
 c
 c
-#ifdef INCA_CH4
+#ifdef INCA
       SUBROUTINE advtrac_p(pbaru,pbarv ,
      *                   p,  masse,q,iapptrac,teta,
      *                  flxw,
-     *                  pk,
-     *                  mmt_adj,
-     *                  hadv_flg)
+     *                  pk   )
 #else
       SUBROUTINE advtrac_p(pbaru,pbarv ,
@@ -25,4 +23,5 @@
 c
       USE parallel
+      USE Write_Field_p
       USE Bands
       USE mod_hallo
@@ -56,9 +55,5 @@
       REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
       REAL pk(ip1jmp1,llm)
-#ifdef INCA_CH4
-cym      INTEGER            :: hadv_flg(nq)
-         INTEGER            :: hadv_flg(nqmx)
-cym      REAL               :: mmt_adj(ip1jmp1,llm)
-       REAL               :: mmt_adj(ip1jmp1,llm,1)
+#ifdef INCA
        REAL               :: flxw(ip1jmp1,llm)
 #endif
@@ -70,5 +65,5 @@
       REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
       REAL massem(ip1jmp1,llm),zdp(ip1jmp1)
-      REAL pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm) 
+      REAL,SAVE::pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm) 
       REAL (kind=kind(1.d0)) :: t_initial, t_final, tps_cpu
       real cpuadv(nqmx)
@@ -78,7 +73,7 @@
       INTEGER ij,l,iq,iiq
       REAL zdpmin, zdpmax
-      EXTERNAL  minmax
       SAVE iadvtr, massem, pbaruc, pbarvc
       DATA iadvtr/0/
+c$OMP THREADPRIVATE(iadvtr)
 c----------------------------------------------------------
 c     Rajouts pour PPM
@@ -98,7 +93,7 @@
       integer ijb,ije,ijb_u,ijb_v,ije_u,ije_v,j
       type(Request) :: Request_vanleer
-      REAL p_tmp( ip1jmp1,llmp1 )
-      REAL teta_tmp(ip1jmp1,llm)
-      REAL pk_tmp(ip1jmp1,llm)
+      REAL,SAVE :: p_tmp( ip1jmp1,llmp1 )
+      REAL,SAVE :: teta_tmp(ip1jmp1,llm)
+      REAL,SAVE :: pk_tmp(ip1jmp1,llm)
       
       ijb_u=ij_begin
@@ -113,11 +108,14 @@
 c         CALL initial0(ijp1llm,pbaruc)
 c         CALL initial0(ijmllm,pbarvc)
-          
-          pbaruc(ijb_u:ije_u,:)=0.
-          pbarvc(ijb_v:ije_v,:)=0.
-          
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)        
+	DO l=1,llm   
+          pbaruc(ijb_u:ije_u,l)=0.
+          pbarvc(ijb_v:ije_v,l)=0.
+        ENDDO
+c$OMP END DO NOWAIT  
       ENDIF
 
 c   accumulation des flux de masse horizontaux
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
       DO l=1,llm
          DO ij = ijb_u,ije_u
@@ -128,4 +126,5 @@
          ENDDO
       ENDDO
+c$OMP END DO NOWAIT
 
 c   selection de la masse instantannee des mailles avant le transport.
@@ -136,5 +135,10 @@
           ije=ij_end
 
-          massem(ijb:ije,:)=masse(ijb:ije,:)
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+       DO l=1,llm
+          massem(ijb:ije,l)=masse(ijb:ije,l)
+       ENDDO
+c$OMP END DO NOWAIT
+
 ccc         CALL filtreg ( massem ,jjp1, llm,-2, 2, .TRUE., 1 )
 c
@@ -142,29 +146,36 @@
 
       iadvtr   = iadvtr+1
+
+c$OMP MASTER
       iapptrac = iadvtr
-
+c$OMP END MASTER
 
 c   Test pour savoir si on advecte a ce pas de temps
-      
+
       IF ( iadvtr.EQ.iapp_tracvl ) THEN
+c$OMP MASTER
         call suspend_timer(timer_caldyn)
+c$OMP END MASTER
       
       ijb=ij_begin
       ije=ij_end
       
+
+cc   ..  Modif P.Le Van  ( 20/12/97 )  ....
+cc
+
+c   traitement des flux de masse avant advection.
+c     1. calcul de w
+c     2. groupement des mailles pres du pole.
+
+c$OMP BARRIER
+        CALL groupe_p( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
+c$OMP BARRIER
+
+c$OMP BARRIER
+c$OMP MASTER      
       p_tmp(ijb:ije,1:llmp1)=p(ijb:ije,1:llmp1)
       pk_tmp(ijb:ije,1:llm)=pk(ijb:ije,1:llm)
       teta_tmp(ijb:ije,1:llm)=teta(ijb:ije,1:llm)
-      
-
-cc   ..  Modif P.Le Van  ( 20/12/97 )  ....
-cc
-
-c   traitement des flux de masse avant advection.
-c     1. calcul de w
-c     2. groupement des mailles pres du pole.
-
-        CALL groupe_p( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
-
       call VTb(VTHallo)
       call Register_SwapFieldHallo(pbarug,pbarug,ip1jmp1,llm,
@@ -195,7 +206,8 @@
       call VTb(VTadvection)
       call start_timer(timer_vanleer)
-
-      
-#ifdef INCA_CH4
+c$OMP END MASTER
+c$OMP BARRIER
+      
+#ifdef INCA
       ! ... Flux de masse diaganostiques traceurs
 c      flxw = wg / FLOAT(iapp_tracvl)
@@ -211,5 +223,5 @@
          if (pole_sud) ije=ij_end-iip1
          
-          
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)          
          DO l=1,llm-1
             DO ij = ijb+1,ije
@@ -241,4 +253,5 @@
 
          ENDDO
+c$OMP END DO NOWAIT
 
 c-------------------------------------------------------------------
@@ -253,6 +266,11 @@
 cym      ----> Revérifier lors de la parallélisation des autres schemas
    
-          call massbar_p(massem,massebx,masseby)          
-
+cym          call massbar_p(massem,massebx,masseby)          
+
+          call vlspltgen_p( q,iadv, 2., massem, wg ,
+     *                    pbarug,pbarvg,dtvr,p_tmp,pk_tmp,teta_tmp )
+
+         
+	  GOTO 1234     
 c-----------------------------------------------------------
 c     Appel des sous programmes d'advection
@@ -309,7 +327,7 @@
 
             call pentes_ini (q(1,1,iq),wg,massem,pbarug,pbarvg,0)
-#ifdef INCA_CH4
+#ifdef INCA
        do iiq = iq+1, iq+3
-         q(:,:,iiq)=q(:,:,iiq)*mmt_adj(:,:,1)
+         q(:,:,iiq)=q(:,:,iiq)*1
        enddo
 #endif
@@ -328,7 +346,7 @@
            call  prather(q(1,1,iq),wg,massem,pbarug,pbarvg,
      s                     n,dtbon)
-#ifdef INCA_CH4
+#ifdef INCA
        do iiq = iq+1, iq+9
-         q(:,:,iiq)=q(:,:,iiq)*mmt_adj(:,:,1)
+         q(:,:,iiq)=q(:,:,iiq)*1
        enddo
 #endif
@@ -441,4 +459,7 @@
        end DO
 
+1234  CONTINUE
+c$OMP BARRIER
+c$OMP MASTER
       ijb=ij_begin
       ije=ij_end
@@ -450,4 +471,5 @@
        ENDDO
 
+
        CALL qminimum_p( q, 2, finmasse )
 
@@ -455,5 +477,5 @@
 c   on reinitialise a zero les flux de masse cumules
 c---------------------------------------------------
-          iadvtr=0
+c          iadvtr=0
 	call VTe(VTadvection)
         call stop_timer(timer_vanleer)
@@ -465,5 +487,5 @@
         enddo
 
-#ifdef INCA_CH4
+#ifdef INCA
        call Register_SwapFieldHallo(flxw,flxw,ip1jmp1,llm,
      *                             jj_nb_caldyn,0,0,Request_vanleer)
@@ -475,5 +497,7 @@
 	call VTe(VThallo)
 	call resume_timer(timer_caldyn)
-	
+c$OMP END MASTER
+c$OMP BARRIER	
+          iadvtr=0
        ENDIF ! if iadvtr.EQ.iapp_tracvl
 
