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

codes/icosagcm/trunk/src/physics.f90

@@ -10 +10 @@
   TYPE(t_field),POINTER :: f_extra_physics_2D(:), f_extra_physics_3D(:)
   TYPE(t_field),POINTER :: f_dulon(:), f_dulat(:)
+  TYPE(t_field),POINTER :: f_temp(:)
 
   CHARACTER(LEN=255) :: physics_type
@@ -38 +39 @@
        CALL allocate_field(f_dulon,field_t,type_real,llm, name='dulon')
        CALL allocate_field(f_dulat,field_t,type_real,llm, name='dulat')
+       CALL allocate_field(f_temp,field_t,type_real,llm, name='temp')
        CALL init_pack_before ! Compute physics_inout%ngrid and offsets used by pack/unpack
        CALL init_physics_dcmip
@@ -102 +104 @@
     USE physics_interface_mod
     USE physics_dcmip_mod, ONLY : full_physics_dcmip => full_physics
+    USE theta2theta_rhodz_mod
     USE mpipara
     IMPLICIT NONE
@@ -111 +114 @@
     REAL(rstd),POINTER :: phis(:)
     REAL(rstd),POINTER :: ps(:)
+    REAL(rstd),POINTER :: temp(:,:)
     REAL(rstd),POINTER :: theta_rhodz(:,:)
     REAL(rstd),POINTER :: ue(:,:)
@@ -118 +122 @@
     INTEGER :: it, ind
 
+    CALL theta_rhodz2temperature(f_ps,f_theta_rhodz,f_temp)
+
     DO ind=1,ndomain
        IF (.NOT. assigned_domain(ind)) CYCLE
@@ -124 +130 @@
        phis=f_phis(ind)
        ps=f_ps(ind)
-       theta_rhodz=f_theta_rhodz(ind)
+       temp=f_temp(ind)
        ue=f_ue(ind)
        q=f_q(ind)
-       CALL pack_physics(pack_info(ind), phis, ps, theta_rhodz, ue, q)
+       CALL pack_physics(pack_info(ind), phis, ps, temp, ue, q)
     END DO
 
@@ -134 +140 @@
        CALL full_physics_dcmip
     CASE DEFAULT
-       IF(is_mpi_root) PRINT *,'Internal error : illegal value of phys_type', phys_type
+       IF(is_mpi_master) PRINT *,'Internal error : illegal value of phys_type', phys_type
        STOP
     END SELECT
@@ -143 +149 @@
        CALL swap_geometry(ind)
        ps=f_ps(ind)
-       theta_rhodz=f_theta_rhodz(ind)
+       temp=f_temp(ind)
        q=f_q(ind)
        dulon=f_dulon(ind)
        dulat=f_dulat(ind)
-       CALL unpack_physics(pack_info(ind), ps, theta_rhodz, q, dulon, dulat)
+       CALL unpack_physics(pack_info(ind), ps, temp, q, dulon, dulat)
     END DO
+    CALL temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
 
     ! Transfer dulon, dulat
@@ -166 +173 @@
   END SUBROUTINE physics_column
 
-  SUBROUTINE pack_physics(info, phis, ps, theta_rhodz, ue, q)
+  SUBROUTINE pack_physics(info, phis, ps, temp, ue, q)
     USE icosa
     USE wind_mod
@@ -176 +183 @@
     REAL(rstd) :: phis(iim*jjm)
     REAL(rstd) :: ps(iim*jjm)
-    REAL(rstd) :: theta_rhodz(iim*jjm,llm)
+    REAL(rstd) :: temp(iim*jjm,llm)
     REAL(rstd) :: ue(3*iim*jjm,llm)
     REAL(rstd) :: q(iim*jjm,llm,nqtot)
 
     REAL(rstd) :: p(iim*jjm,llm+1)
-    REAL(rstd) :: Temp(iim*jjm,llm)
     REAL(rstd) :: uc(iim*jjm,3,llm)
     REAL(rstd) :: ulon(iim*jjm,llm)
     REAL(rstd) :: ulat(iim*jjm,llm)
 
+!$OMP BARRIER
     CALL compute_pression(ps,p,0)
-    CALL compute_theta_rhodz2temperature(ps,theta_rhodz,Temp,0)
+!$OMP BARRIER
     CALL compute_wind_centered(ue,uc)
     CALL compute_wind_centered_lonlat_compound(uc, ulon, ulat)
@@ -199 +206 @@
   END SUBROUTINE pack_physics
 
-  SUBROUTINE unpack_physics(info, ps,theta_rhodz, q, dulon, dulat)
+  SUBROUTINE unpack_physics(info, ps,temp, q, dulon, dulat)
     USE icosa
     USE physics_interface_mod
@@ -206 +213 @@
     TYPE(t_pack_info) :: info
     REAL(rstd) :: ps(iim*jjm)
-    REAL(rstd) :: theta_rhodz(iim*jjm,llm)
-    REAL(rstd) :: Temp(iim*jjm,llm)
+    REAL(rstd) :: temp(iim*jjm,llm)
     REAL(rstd) :: q(iim*jjm,llm,nqtot)
     REAL(rstd) :: dulon(iim*jjm,llm)
@@ -221 +227 @@
     q = q + physics_inout%dt_phys * dq
     Temp = Temp + physics_inout%dt_phys * dTemp
-    CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)
+!    CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)
   END SUBROUTINE unpack_physics