Changeset 295 for codes/icosagcm/trunk/src/omega.f90

Timestamp:

10/31/14 14:52:01 (10 years ago)

Author:

ymipsl

Message:

Merging OpenMP parallisme mode : by subdomain and on vertical level.
This feature is actually experimental but may be retro-compatible with the last method based only on subdomain

YM

File:

• codes/icosagcm/trunk/src/omega.f90 (modified) (4 diffs)

codes/icosagcm/trunk/src/omega.f90

@@ -23 +23 @@
   END SUBROUTINE W_omega
 
+
+
   SUBROUTINE compute_omega(ps,u, w)
     USE disvert_mod, ONLY : ap,bp
+    USE omp_para
+    IMPLICIT NONE
     REAL(rstd),INTENT(IN) :: u(iim*3*jjm,llm), ps(iim*jjm)
     REAL(rstd),INTENT(OUT):: w(iim*jjm,llm)
@@ -30 +34 @@
     REAL(rstd):: p(iim*jjm,llm+1), rhodz(iim*jjm,llm), Fe(iim*3*jjm,llm)
     REAL(rstd):: ugradps
-    DO    l    = 1, llm+1
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
-             ij=(j-1)*iim+i
-             p(ij,l) = ap(l) + bp(l) * ps(ij)
-          ENDDO
-       ENDDO
-    ENDDO
+    
+    INTEGER :: i,j,l,ij
+
+!$OMP BARRIER    
+    IF (is_omp_level_master) THEN
+      DO    l    = 1, llm+1
+         DO j=jj_begin-1,jj_end+1
+           DO i=ii_begin-1,ii_end+1
+               ij=(j-1)*iim+i
+               p(ij,l) = ap(l) + bp(l) * ps(ij)
+            ENDDO
+         ENDDO
+      ENDDO
     
 !!! Compute mass
-    DO l = 1, llm
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
-             ij=(j-1)*iim+i
-             rhodz(ij,l) = ( p(ij,l) - p(ij,l+1) ) / g
-          ENDDO
-       ENDDO
-    ENDDO
+      DO l = 1, llm
+         DO j=jj_begin-1,jj_end+1
+            DO i=ii_begin-1,ii_end+1
+               ij=(j-1)*iim+i
+               rhodz(ij,l) = ( p(ij,l) - p(ij,l+1) ) / g
+            ENDDO
+         ENDDO
+      ENDDO
     
 !!!  Compute mass flux
-    DO l = 1, llm
-       DO j=jj_begin-1,jj_end+1
-          DO i=ii_begin-1,ii_end+1
-             ij=(j-1)*iim+i
-             Fe(ij+u_right,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_right,l))*u(ij+u_right,l)*le(ij+u_right)
-             Fe(ij+u_lup,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_lup,l))*u(ij+u_lup,l)*le(ij+u_lup)
-             Fe(ij+u_ldown,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_ldown,l))*u(ij+u_ldown,l)*le(ij+u_ldown)
-          ENDDO
-       ENDDO
-    ENDDO
+      DO l = 1, llm
+         DO j=jj_begin-1,jj_end+1
+            DO i=ii_begin-1,ii_end+1
+               ij=(j-1)*iim+i
+               Fe(ij+u_right,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_right,l))*u(ij+u_right,l)*le(ij+u_right)
+               Fe(ij+u_lup,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_lup,l))*u(ij+u_lup,l)*le(ij+u_lup)
+               Fe(ij+u_ldown,l)=0.5*(rhodz(ij,l)+rhodz(ij+t_ldown,l))*u(ij+u_ldown,l)*le(ij+u_ldown)
+            ENDDO
+         ENDDO
+      ENDDO
     
 !!! mass flux convergence computation  
     
     ! horizontal convergence
-    DO l = 1, llm
-       DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-             ij=(j-1)*iim+i
-             ! convm = +div(mass flux), sign convention as in Ringler et al. 2012, eq. 21
-             convm(ij,l)= 1./Ai(ij)*(ne(ij,right)*Fe(ij+u_right,l)   +  &
-                  ne(ij,rup)*Fe(ij+u_rup,l)       +  &  
-                  ne(ij,lup)*Fe(ij+u_lup,l)       +  &  
-                  ne(ij,left)*Fe(ij+u_left,l)     +  &  
-                  ne(ij,ldown)*Fe(ij+u_ldown,l)   +  &  
-                  ne(ij,rdown)*Fe(ij+u_rdown,l))
-          ENDDO
-       ENDDO
-    ENDDO
+      DO l = 1, llm
+         DO j=jj_begin,jj_end
+            DO i=ii_begin,ii_end
+               ij=(j-1)*iim+i
+               ! convm = +div(mass flux), sign convention as in Ringler et al. 2012, eq. 21
+               convm(ij,l)= 1./Ai(ij)*(ne(ij,right)*Fe(ij+u_right,l)   +  &
+                    ne(ij,rup)*Fe(ij+u_rup,l)       +  &  
+                    ne(ij,lup)*Fe(ij+u_lup,l)       +  &  
+                    ne(ij,left)*Fe(ij+u_left,l)     +  &  
+                    ne(ij,ldown)*Fe(ij+u_ldown,l)   +  &  
+                    ne(ij,rdown)*Fe(ij+u_rdown,l))
+            ENDDO
+         ENDDO
+      ENDDO
     
-    ! vertical integration from up to down
-    DO  l = llm-1, 1, -1
-       DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-             ij=(j-1)*iim+i
-             convm(ij,l) = convm(ij,l) + convm(ij,l+1)
-          ENDDO
-       ENDDO
-    ENDDO
-    convm(:,llm+1)=0.
+      ! vertical integration from up to down
+      DO  l = llm-1, 1, -1
+         DO j=jj_begin,jj_end
+            DO i=ii_begin,ii_end
+               ij=(j-1)*iim+i
+               convm(ij,l) = convm(ij,l) + convm(ij,l+1)
+            ENDDO
+         ENDDO
+      ENDDO
+      convm(:,llm+1)=0.
 
 !!! Compute dps
@@ -125 +134 @@
     ! -grad ps : ( ne(ij,ldown)*ps(ij,l) + ne(ij+t_ldown,rup)*ps(ij+t_ldown,l) ) ) / de(ij+u_ldown)
 
-    DO l = 1,llm
-       DO j=jj_begin,jj_end
-          DO i=ii_begin,ii_end
-             toto = 1
+       DO l = 1,llm
+         DO j=jj_begin,jj_end 
+           DO i=ii_begin,ii_end
              ij=(j-1)*iim+i
              ugradps = &
@@ -140 +148 @@
              w( ij, l) =  ugradps - .5*(convm( ij,l+1)+convm(ij,l)) 
           ENDDO
-       ENDDO
-    ENDDO
+        ENDDO
+      ENDDO
+    ENDIF
+!$OMP BARRIER
     
   END SUBROUTINE compute_omega