Changeset 709 for LMDZ4/branches/V3_test/libf/dyn3dpar/advtrac_p.F

Timestamp:

Sep 20, 2006, 12:12:39 PM (18 years ago)

Author:

Laurent Fairhead

Message:

Nouvelles versions de la dynamique YM
LF

File:

• LMDZ4/branches/V3_test/libf/dyn3dpar/advtrac_p.F (modified) (21 diffs)

LMDZ4/branches/V3_test/libf/dyn3dpar/advtrac_p.F

@@ -4 +4 @@
 c
 c
-#ifdef INCA_CH4
+#ifdef INCA
       SUBROUTINE advtrac_p(pbaru,pbarv ,
      *                   p,  masse,q,iapptrac,teta,
@@ -25 +25 @@
 c
       USE parallel
+      USE Write_Field_p
       USE Bands
       USE mod_hallo
@@ -56 +57 @@
       REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
       REAL pk(ip1jmp1,llm)
-#ifdef INCA_CH4
+#ifdef INCA
 cym      INTEGER            :: hadv_flg(nq)
          INTEGER            :: hadv_flg(nqmx)
@@ -70 +71 @@
       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 +79 @@
       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 +99 @@
       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 +114 @@
 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 +132 @@
          ENDDO
       ENDDO
+c$OMP END DO NOWAIT
 
 c   selection de la masse instantannee des mailles avant le transport.
@@ -136 +141 @@
           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 +152 @@
 
       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 +212 @@
       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 +229 @@
          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 +259 @@
 
          ENDDO
+c$OMP END DO NOWAIT
 
 c-------------------------------------------------------------------
@@ -253 +272 @@
 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 +333 @@
 
             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)
@@ -328 +352 @@
            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)
@@ -441 +465 @@
        end DO
 
+1234  CONTINUE
+c$OMP BARRIER
+c$OMP MASTER
       ijb=ij_begin
       ije=ij_end
@@ -450 +477 @@
        ENDDO
 
+
        CALL qminimum_p( q, 2, finmasse )
 
@@ -455 +483 @@
 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 +493 @@
         enddo
 
-#ifdef INCA_CH4
+#ifdef INCA
        call Register_SwapFieldHallo(flxw,flxw,ip1jmp1,llm,
      *                             jj_nb_caldyn,0,0,Request_vanleer)
@@ -475 +503 @@
         call VTe(VThallo)
         call resume_timer(timer_caldyn)
-        
+c$OMP END MASTER
+c$OMP BARRIER   
+          iadvtr=0
        ENDIF ! if iadvtr.EQ.iapp_tracvl