Changeset 295 for codes/icosagcm/trunk/src/etat0_dcmip3.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/etat0_dcmip3.f90 (modified) (8 diffs)

codes/icosagcm/trunk/src/etat0_dcmip3.f90

@@ -18 +18 @@
   SUBROUTINE etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
   USE icosa
+  USE theta2theta_rhodz_mod
   IMPLICIT NONE
     TYPE(t_field),POINTER :: f_ps(:)
@@ -24 +25 @@
     TYPE(t_field),POINTER :: f_u(:)
     TYPE(t_field),POINTER :: f_q(:)
+    TYPE(t_field),POINTER,SAVE :: f_temp(:)
     
     REAL(rstd),POINTER :: ps(:)
     REAL(rstd),POINTER :: phis(:)
     REAL(rstd),POINTER :: u(:,:)
-    REAL(rstd),POINTER :: theta_rhodz(:,:)
+    REAL(rstd),POINTER :: Temp(:,:)
     REAL(rstd),POINTER :: q(:,:,:)
 
     INTEGER :: ind
+
+    CALL allocate_field(f_temp,field_t,type_real,llm,name='temp') 
 
     DO ind=1,ndomain
@@ -41 +45 @@
       phis=f_phis(ind)
       u=f_u(ind)
-      theta_rhodz=f_theta_rhodz(ind)
       q=f_q(ind)
-      CALL compute_etat0_DCMIP3(ps,phis,u,theta_rhodz,q)
+      temp=f_temp(ind)
+      CALL compute_etat0_DCMIP3(ps,phis,u,Temp,q)
     ENDDO
+
+    CALL temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
+    CALL deallocate_field(f_temp)
             
   END SUBROUTINE etat0
   
 
-  SUBROUTINE compute_etat0_DCMIP3(ps, phis, u, theta_rhodz,q)
+  SUBROUTINE compute_etat0_DCMIP3(ps, phis, u, temp,q)
   USE icosa
   USE pression_mod
@@ -68 +75 @@
   REAL(rstd), INTENT(OUT) :: phis(iim*jjm)
   REAL(rstd), INTENT(OUT) :: u(3*iim*jjm,llm)
-  REAL(rstd), INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
+  REAL(rstd), INTENT(OUT) :: Temp(iim*jjm,llm)
   REAL(rstd), INTENT(OUT) :: q(iim*jjm,llm,nqtot)
   
   REAL(rstd) :: Ts(iim*jjm)
   REAL(rstd) :: s(iim*jjm)
-  REAL(rstd) :: T(iim*jjm,llm)
   REAL(rstd) :: p(iim*jjm,llm+1)
   REAL(rstd) :: theta(iim*jjm,llm)
@@ -125 +131 @@
   END DO
   
+!$OMP BARRIER
   CALL compute_pression(ps,p,0)
+!$OMP BARRIER
   
   DO l=1,llm
@@ -134 +142 @@
            IF(use_dcmip_routine) THEN
               CALL test3_gravity_wave(lon_i(ij),lat_i(ij),pp,dummy,0, &
-                   dummy,dummy,dummy,T(ij,l),dummy,dummy,dummy,dummy)
+                   dummy,dummy,dummy,Temp(ij,l),dummy,dummy,dummy,dummy)
            ELSE
               pspsk=(pp/ps(ij))**kappa
@@ -142 +150 @@
               thetap = dtheta *sin(2*Pi*zz/Lz) * s(ij)                ! perturbation pot. temp.
               theta(ij,l) = thetab + thetap
-              T(ij,l) = theta(ij,l)* ((pp/peq)**kappa)
+              Temp(ij,l) = theta(ij,l)* ((pp/peq)**kappa)
               ! T(ij,l) = Ts(ij)*pspsk / ( Ts(ij) / GG * ( pspsk-1) +1)  ! background temp.
            END IF
@@ -149 +157 @@
   ENDDO
   
-  IF(use_dcmip_routine) THEN
-     CALL compute_temperature2theta_rhodz(ps,T,theta_rhodz,0)
-  ELSE
-     CALL compute_temperature2theta_rhodz(ps,T,theta_rhodz,0)
-  END IF
+!  IF(use_dcmip_routine) THEN
+!     CALL compute_temperature2theta_rhodz(ps,T,theta_rhodz,0)
+!  ELSE
+!     CALL compute_temperature2theta_rhodz(ps,T,theta_rhodz,0)
+!  END IF
   
   pp=peq