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

codes/icosagcm/trunk/src/etat0.f90

@@ -25 +25 @@
     USE etat0_dcmip4_mod, ONLY : etat0_dcmip4=>etat0  
     USE etat0_heldsz_mod, ONLY : etat0_heldsz=>etat0  
-    USE dynetat0_gcm_mod, ONLY : dynetat0_start=>etat0 
-    USE dynetat0_hz_mod,  ONLY : dynetat0_hz=>etat0 
     USE etat0_start_file_mod, ONLY : etat0_start_file=>etat0  
 
@@ -80 +78 @@
     CASE ('dcmip3')
        CALL etat0_dcmip3(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
-     CASE ('dcmip4')
+    CASE ('dcmip4')
         IF(nqtot<2) THEN
            IF (is_mpi_root)  THEN
@@ -87 +85 @@
            STOP
         END IF
-       CALL etat0_dcmip4(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
-     CASE ('readnf_start') 
-          print*,"readnf_start used"    
-       CALL dynetat0_start(f_ps,f_phis,f_theta_rhodz,f_u,f_q) 
-        CASE ('readnf_hz') 
-          print*,"readnf_hz used"
-       CALL dynetat0_hz(f_ps,f_phis,f_theta_rhodz,f_u,f_q) 
+        CALL etat0_dcmip4(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
    CASE DEFAULT
        PRINT*, 'Bad selector for variable etat0 <',etat0_type, &
@@ -114 +106 @@
 
   SUBROUTINE etat0_collocated(f_phis,f_ps,f_mass,f_theta_rhodz,f_u, f_q)
+    USE theta2theta_rhodz_mod
     IMPLICIT NONE
     TYPE(t_field),POINTER :: f_ps(:)
@@ -119 +112 @@
     TYPE(t_field),POINTER :: f_phis(:)
     TYPE(t_field),POINTER :: f_theta_rhodz(:)
+    TYPE(t_field),POINTER :: f_temp(:)
     TYPE(t_field),POINTER :: f_u(:)
     TYPE(t_field),POINTER :: f_q(:)
@@ -126 +120 @@
     REAL(rstd),POINTER :: phis(:)
     REAL(rstd),POINTER :: theta_rhodz(:,:)
+    REAL(rstd),POINTER :: temp(:,:)
     REAL(rstd),POINTER :: u(:,:)
     REAL(rstd),POINTER :: q(:,:,:)
@@ -138 +133 @@
       phis=f_phis(ind)
       theta_rhodz=f_theta_rhodz(ind)
+      temp=f_temp(ind)
       u=f_u(ind)
       q=f_q(ind)
-      CALL compute_etat0_collocated(ps,mass, phis, theta_rhodz, u, q)
+
+      IF( TRIM(etat0_type)=='williamson91.6' ) THEN 
+       CALL compute_etat0_collocated(ps,mass, phis, theta_rhodz, u, q)
+      ELSE
+       CALL compute_etat0_collocated(ps,mass, phis, temp, u, q)
+      ENDIF
     ENDDO
+    
+    IF( TRIM(etat0_type)/='williamson91.6' ) CALL temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz)
+    
+    
   END SUBROUTINE etat0_collocated
 
-  SUBROUTINE compute_etat0_collocated(ps,mass, phis, theta_rhodz, u, q)
-    USE theta2theta_rhodz_mod
+  SUBROUTINE compute_etat0_collocated(ps,mass, phis, temp_i, u, q)
     USE wind_mod
     USE etat0_jablonowsky06_mod, ONLY : compute_jablonowsky06 => compute_etat0
@@ -154 +158 @@
     REAL(rstd),INTENT(INOUT) :: mass(iim*jjm,llm)
     REAL(rstd),INTENT(OUT) :: phis(iim*jjm)
-    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
+    REAL(rstd),INTENT(OUT) :: temp_i(iim*jjm,llm)
     REAL(rstd),INTENT(OUT) :: u(3*iim*jjm,llm)
     REAL(rstd),INTENT(OUT) :: q(iim*jjm,llm,nqtot)
 
-    REAL(rstd) :: temp_i(iim*jjm,llm)
+    REAL(rstd) :: lon_i(iim*jjm)
+    REAL(rstd) :: lat_i(iim*jjm)
     REAL(rstd) :: ulon_i(iim*jjm,llm)
     REAL(rstd) :: ulat_i(iim*jjm,llm)
 
+    REAL(rstd) :: lon_e(3*iim*jjm)
+    REAL(rstd) :: lat_e(3*iim*jjm)
     REAL(rstd) :: ps_e(3*iim*jjm)
     REAL(rstd) :: mass_e(3*iim*jjm,llm)
@@ -183 +190 @@
        CALL compute_dcmip5(3*iim*jjm,lon_e,lat_e, phis_e, ps_e, temp_e, ulon_e, ulat_e, q_e)
     CASE('williamson91.6')
-       CALL compute_w91_6(iim*jjm,lon_i,lat_i, phis, mass(:,1), theta_rhodz(:,1), ulon_i(:,1), ulat_i(:,1))
+       CALL compute_w91_6(iim*jjm,lon_i,lat_i, phis, mass(:,1), temp_i(:,1), ulon_i(:,1), ulat_i(:,1))
        CALL compute_w91_6(3*iim*jjm,lon_e,lat_e, phis_e, mass_e(:,1), temp_e(:,1), ulon_e(:,1), ulat_e(:,1))
     END SELECT
 
-    SELECT CASE (TRIM(etat0_type))
-    CASE('williamson91.6')
-       ! Do nothing
-    CASE DEFAULT
-       CALL compute_temperature2theta_rhodz(ps,temp_i,theta_rhodz,0)    
-    END SELECT
- 
     CALL compute_wind_perp_from_lonlat_compound(ulon_e, ulat_e, u)