Changeset 481

Timestamp:

09/16/16 15:39:08 (8 years ago)

Author:

ymipsl

Message:

Physic column : OpenMP on vertical levsl is managed.

YM

File:

• codes/icosagcm/trunk/src/physics.f90 (modified) (14 diffs)

codes/icosagcm/trunk/src/physics.f90

@@ -9 +9 @@
 
   INTEGER :: phys_type
-  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
+  TYPE(t_field),POINTER,SAVE :: f_extra_physics_2D(:), f_extra_physics_3D(:)
+  TYPE(t_field),POINTER,SAVE :: f_dulon(:), f_dulat(:)
+  TYPE(t_field),POINTER,SAVE :: f_ulon(:), f_ulat(:)
+  TYPE(t_field),POINTER,SAVE :: f_p(:), f_pk(:)
+  TYPE(t_field),POINTER,SAVE :: f_temp(:)
+
+  CHARACTER(LEN=255),SAVE :: physics_type
 !$OMP THREADPRIVATE(physics_type)
 
@@ -55 +57 @@
        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 allocate_field(f_ulon,field_t,type_real,llm, name='ulon')
+       CALL allocate_field(f_ulat,field_t,type_real,llm, name='ulat')
+       CALL allocate_field(f_p,field_t,type_real,llm+1, name='p')
+       CALL allocate_field(f_pk,field_t,type_real,llm, name='pk')
        CALL init_pack_before ! Compute physics_inout%ngrid and offsets used by pack/unpack
        CALL init_physics_dcmip
@@ -63 +69 @@
        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 allocate_field(f_ulon,field_t,type_real,llm, name='ulon')
+       CALL allocate_field(f_ulat,field_t,type_real,llm, name='ulat')
+       CALL allocate_field(f_p,field_t,type_real,llm+1, name='p')
+       CALL allocate_field(f_pk,field_t,type_real,llm, name='pk')
        CALL init_pack_before ! Compute physics_inout%ngrid and offsets used by pack/unpack
        CALL init_physics_dcmip2016
@@ -139 +149 @@
     USE theta2theta_rhodz_mod
     USE mpipara
+    USE omp_para
+    USE checksum_mod
     IMPLICIT NONE
     TYPE(t_field),POINTER :: f_phis(:)
@@ -152 +164 @@
     REAL(rstd),POINTER :: dulat(:,:)
     REAL(rstd),POINTER :: q(:,:,:)
+    REAL(rstd),POINTER :: p(:,:)
+    REAL(rstd),POINTER :: pk(:,:)
+    REAL(rstd),POINTER :: ulon(:,:)
+    REAL(rstd),POINTER :: ulat(:,:)
     INTEGER :: it, ind
 
@@ -165 +181 @@
        ue=f_ue(ind)
        q=f_q(ind)
-       CALL pack_physics(pack_info(ind), phis, ps, temp, ue, q)
+       p=f_p(ind)
+       pk=f_pk(ind)
+       ulon=f_ulon(ind)
+       ulat=f_ulat(ind)
+       CALL pack_physics(pack_info(ind), phis, ps, temp, ue, q, p, pk, ulon, ulat)
     END DO
 
     SELECT CASE(phys_type)
     CASE (phys_DCMIP)
-       CALL full_physics_dcmip
+       IF (is_omp_level_master) CALL full_physics_dcmip
     CASE (phys_DCMIP2016)
-       CALL full_physics_dcmip2016
+       IF (is_omp_level_master) CALL full_physics_dcmip2016
     CASE DEFAULT
-       IF(is_mpi_master) PRINT *,'Internal error : illegal value of phys_type', phys_type
+       IF(is_master) PRINT *,'Internal error : illegal value of phys_type', phys_type
        STOP
     END SELECT
@@ -189 +209 @@
        CALL unpack_physics(pack_info(ind), ps, temp, q, dulon, dulat)
     END DO
+    
     CALL temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
 
@@ -207 +228 @@
   END SUBROUTINE physics_column
 
-  SUBROUTINE pack_physics(info, phis, ps, temp, ue, q )
+  SUBROUTINE pack_physics(info, phis, ps, temp, ue, q, p, pk, ulon, ulat )
     USE icosa
     USE wind_mod
@@ -214 +235 @@
     USE physics_interface_mod
     USE exner_mod
+    USE omp_para
     IMPLICIT NONE
     TYPE(t_pack_info) :: info
@@ -236 +258 @@
     CALL compute_wind_centered(ue,uc)
     CALL compute_wind_centered_lonlat_compound(uc, ulon, ulat)
-
-    CALL pack_domain(info, phis, physics_inout%phis)
-    CALL pack_domain(info, p, physics_inout%p)
-    CALL pack_domain(info, pk, physics_inout%pk)
-    CALL pack_domain(info, Temp, physics_inout%Temp)
-    CALL pack_domain(info, ulon, physics_inout%ulon)
-    CALL pack_domain(info, ulat, physics_inout%ulat)
-    CALL pack_domain(info, q, physics_inout%q)
+!$OMP BARRIER
+    IF (is_omp_level_master) THEN
+      CALL pack_domain(info, phis, physics_inout%phis)
+      CALL pack_domain(info, p, physics_inout%p)
+      CALL pack_domain(info, pk, physics_inout%pk)
+      CALL pack_domain(info, Temp, physics_inout%Temp)
+      CALL pack_domain(info, ulon, physics_inout%ulon)
+      CALL pack_domain(info, ulat, physics_inout%ulat)
+      CALL pack_domain(info, q, physics_inout%q)
+    ENDIF
+!$OMP BARRIER
   END SUBROUTINE pack_physics
 
@@ -250 +275 @@
     USE physics_interface_mod
     USE theta2theta_rhodz_mod
+    USE omp_para
     IMPLICIT NONE
     TYPE(t_pack_info) :: info
@@ -260 +286 @@
     REAL(rstd) :: dq(iim*jjm,llm,nqtot)
     REAL(rstd) :: dTemp(iim*jjm,llm)
-    CALL unpack_domain(info, dulon, physics_inout%dulon)
-    CALL unpack_domain(info, dulat, physics_inout%dulat)
-    CALL unpack_domain(info, dq, physics_inout%dq)
-    CALL unpack_domain(info, Temp, physics_inout%Temp)
-    CALL unpack_domain(info, dTemp, physics_inout%dTemp)
-    q = q + physics_inout%dt_phys * dq
-    Temp = Temp + physics_inout%dt_phys * dTemp
+
+!$OMP BARRIER
+    IF (is_omp_level_master) THEN
+      CALL unpack_domain(info, dulon, physics_inout%dulon)
+      CALL unpack_domain(info, dulat, physics_inout%dulat)
+      CALL unpack_domain(info, dq, physics_inout%dq)
+      CALL unpack_domain(info, Temp, physics_inout%Temp)
+      CALL unpack_domain(info, dTemp, physics_inout%dTemp)
+      q = q + physics_inout%dt_phys * dq
+      Temp = Temp + physics_inout%dt_phys * dTemp
+    ENDIF
+!$OMP BARRIER
+
 !    CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)
   END SUBROUTINE unpack_physics
@@ -274 +306 @@
     USE physics_interface_mod
     USE wind_mod
+    USE omp_para
     IMPLICIT NONE
     REAL(rstd) :: dulon(iim*jjm,llm)
@@ -284 +317 @@
     CALL compute_wind_centered_from_lonlat_compound(dulon,dulat,duc)
     dt2=.5*physics_inout%dt_phys
-    DO l=1,llm
+    DO l=ll_begin,ll_end
       DO j=jj_begin,jj_end
         DO i=ii_begin,ii_end