Changeset 764 for LMDZ4/trunk/libf/dyn3dpar/caldyn_p.F

Timestamp:

Jun 4, 2007, 4:13:10 PM (17 years ago)

Author:

Laurent Fairhead

Message:

Merge entre la version V3_conv et le HEAD
YM, JG, LF

File:

• LMDZ4/trunk/libf/dyn3dpar/caldyn_p.F (modified) (12 diffs)

LMDZ4/trunk/libf/dyn3dpar/caldyn_p.F

@@ -46 +46 @@
       REAL ps(ip1jmp1),phis(ip1jmp1)
       REAL pk(iip1,jjp1,llm),pkf(ip1jmp1,llm)
-      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
+      REAL,SAVE :: vcont(ip1jm,llm),ucont(ip1jmp1,llm)
       REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
       REAL dv(ip1jm,llm),du(ip1jmp1,llm)
       REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
+      REAL w(ip1jmp1,llm)
       REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
       REAL time
@@ -56 +57 @@
 c   ------
 
-      REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
-      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
-      REAL vorpot(ip1jm,llm)
-      REAL w(ip1jmp1,llm),ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
-      REAL bern(ip1jmp1,llm)
-      REAL massebxy(ip1jm,llm)
-    
-
+      REAL,SAVE :: ang(ip1jmp1,llm)
+      REAL,SAVE :: p(ip1jmp1,llmp1)
+      REAL,SAVE :: massebx(ip1jmp1,llm),masseby(ip1jm,llm)
+      REAL,SAVE :: psexbarxy(ip1jm)
+      REAL,SAVE :: vorpot(ip1jm,llm)
+      REAL,SAVE :: ecin(ip1jmp1,llm)
+      REAL,SAVE :: bern(ip1jmp1,llm)
+      REAL,SAVE :: massebxy(ip1jm,llm)
+      REAL,SAVE :: convm(ip1jmp1,llm)
       INTEGER   ij,l,ijb,ije,ierr
 
@@ -72 +74 @@
       CALL pression_p ( ip1jmp1, ap      , bp   ,  ps  , p            )
 cym      CALL psextbar (   ps   , psexbarxy                          )
+c$OMP BARRIER
       CALL massdair_p (    p   , masse                                )
       CALL massbar_p  (   masse, massebx , masseby                    )
@@ -77 +80 @@
       CALL flumass_p  ( massebx, masseby , vcont, ucont ,pbaru, pbarv )
       CALL dteta1_p   (   teta , pbaru   , pbarv, dteta               )
-      CALL convmas_p  (   pbaru, pbarv   , convm                      )
-
+      CALL convmas1_p  (   pbaru, pbarv   , convm                      )
+c$OMP BARRIER      
+      CALL convmas2_p  (   convm                      )
+c$OMP BARRIER
 #ifdef DEBUG_IO
+c$OMP BARRIER
+c$OMP MASTER
       call WriteField_p('ucont',reshape(ucont,(/iip1,jmp1,llm/)))
       call WriteField_p('vcont',reshape(vcont,(/iip1,jjm,llm/)))
@@ -91 +98 @@
       call WriteField_p('dteta',reshape(dteta,(/iip1,jmp1,llm/)))
       call WriteField_p('convm',reshape(convm,(/iip1,jmp1,llm/)))
+c$OMP END MASTER
+c$OMP BARRIER
 #endif      
 
+c$OMP BARRIER
+c$OMP MASTER
       ijb=ij_begin
       ije=ij_end
@@ -99 +110 @@
          dp( ij ) = convm( ij,1 ) / airesurg( ij )
       ENDDO
-
+c$OMP END MASTER
+c$OMP BARRIER
+c$OMP FLUSH
       CALL vitvert_p ( convm  , w                                  )
       CALL tourpot_p ( vcov   , ucov  , massebxy  , vorpot         )
@@ -105 +118 @@
 
 #ifdef DEBUG_IO      
+c$OMP BARRIER
+c$OMP MASTER
       call WriteField_p('w',reshape(w,(/iip1,jmp1,llm/)))
       call WriteField_p('vorpot',reshape(vorpot,(/iip1,jjm,llm/)))
       call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
       call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))
+c$OMP END MASTER
+c$OMP BARRIER
 #endif      
       CALL enercin_p ( vcov   , ucov  , vcont     , ucont  , ecin  )
@@ -115 +132 @@
 
 #ifdef DEBUG_IO
+c$OMP BARRIER
+c$OMP MASTER
       call WriteField_p('ecin',reshape(ecin,(/iip1,jmp1,llm/)))
       call WriteField_p('bern',reshape(bern,(/iip1,jmp1,llm/)))
       call WriteField_p('du',reshape(du,(/iip1,jmp1,llm/)))
       call WriteField_p('dv',reshape(dv,(/iip1,jjm,llm/)))
+      call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/)))
+c$OMP END MASTER
+c$OMP BARRIER
 #endif
       
@@ -126 +148 @@
       if (pole_nord) ijb=ij_begin
       if (pole_sud) ije=ij_end
-      
+
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
       DO l=1,llm
          DO ij=ijb,ije
@@ -132 +155 @@
         ENDDO
       ENDDO
+c$OMP END DO
 
-
-      CALL advect_p( ang, vcov, teta, w, massebx, masseby,du,dv,dteta) 
+      CALL advect_new_p(ang,vcov,teta,w,massebx,masseby,du,dv,dteta) 
 
 C  WARNING probleme de peridocite de dv sur les PC/linux. Pb d'arrondi 
@@ -142 +165 @@
       if (pole_sud) ije=ij_end-iip1
 
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
       DO l = 1, llm
          DO ij = ijb, ije, iip1
@@ -152 +176 @@
          enddo
       enddo
+c$OMP END DO NOWAIT      
 c-----------------------------------------------------------------------
 c   Sorties eventuelles des variables de controle: