Changeset 526 for codes/icosagcm/trunk/src

Timestamp:

01/20/17 21:46:09 (7 years ago)

Author:

dubos

Message:

OMP fix for diagnostics

File:

• codes/icosagcm/trunk/src/observable.f90 (modified) (5 diffs)

codes/icosagcm/trunk/src/observable.f90

@@ -77 +77 @@
     END IF
 
-    CALL divide_by_mass(1, f_mass, f_theta_rhodz, f_buf_i)
-    IF(init) THEN
-       CALL output_field("theta_init",f_buf_i)
-    ELSE
-       CALL output_field("theta",f_buf_i)
-    END IF
-
     IF(nqdyn>1) THEN
        CALL divide_by_mass(2, f_mass, f_theta_rhodz, f_buf_i)
@@ -93 +86 @@
     END IF
 
-!    CALL theta_rhodz2temperature(f_ps,f_theta_rhodz,f_buf_i)
-!    CALL Tv2T(f_buf_i,f_q,f_buf1_i)
-    CALL diagnose_temperature(f_ps, f_theta_rhodz, f_q, f_buf_i)
+    CALL divide_by_mass(1, f_mass, f_theta_rhodz, f_buf_i)
+    IF(init) THEN
+       CALL output_field("theta_init",f_buf_i)
+    ELSE
+       CALL output_field("theta",f_buf_i)
+    END IF
+
+    CALL pression_mid(f_ps, f_pmid)
+    CALL diagnose_temperature(f_pmid, f_q, f_buf_i) ! f_buf_i : IN = theta, out = T
 
     IF(init) THEN
@@ -112 +111 @@
     CALL transfert_request(f_buf_uh,req_e1_vect) 
     CALL un2ulonlat(f_buf_uh, f_buf_ulon, f_buf_ulat)
-    CALL pression_mid(f_ps, f_pmid)
     IF(init) THEN
        CALL output_field("uz_init",f_buf_i)
@@ -236 +234 @@
   END SUBROUTINE compute_prognostic_vel_to_horiz
 
-  SUBROUTINE diagnose_temperature(f_ps,f_theta_rhodz,f_q,f_temp)
+  SUBROUTINE diagnose_temperature(f_pmid,f_q,f_temp)
     USE icosa
     USE pression_mod
     IMPLICIT NONE
-    TYPE(t_field), POINTER :: f_ps(:)           ! IN
-    TYPE(t_field), POINTER :: f_theta_rhodz(:)  ! IN
+    TYPE(t_field), POINTER :: f_pmid(:)           ! IN
     TYPE(t_field), POINTER :: f_q(:)            ! IN
-    TYPE(t_field), POINTER :: f_temp(:)         ! OUT
-    
-    REAL(rstd), POINTER :: ps(:)
-    REAL(rstd), POINTER :: theta_rhodz(:,:,:)
+    TYPE(t_field), POINTER :: f_temp(:)         ! INOUT
+    
+    REAL(rstd), POINTER :: pmid(:,:)
     REAL(rstd), POINTER :: q(:,:,:)
     REAL(rstd), POINTER :: temp(:,:)
@@ -255 +251 @@
        CALL swap_dimensions(ind)
        CALL swap_geometry(ind)
-       ps=f_ps(ind)
-       theta_rhodz=f_theta_rhodz(ind)
+       pmid=f_pmid(ind)
        q=f_q(ind)
        temp=f_temp(ind)
-       CALL compute_diagnose_temp(ps,theta_rhodz,q,temp)
+       CALL compute_diagnose_temp(pmid,q,temp)
     END DO
   END SUBROUTINE diagnose_temperature
   
-  SUBROUTINE compute_diagnose_temp(ps,theta_rhodz,q,temp)
+  SUBROUTINE compute_diagnose_temp(pmid,q,temp)
     USE omp_para
     USE pression_mod
-    REAL(rstd),INTENT(IN)  :: ps(iim*jjm)
-    REAL(rstd),INTENT(IN)  :: theta_rhodz(iim*jjm,llm,nqdyn)
-    REAL(rstd),INTENT(IN)  :: q(iim*jjm,llm,nqtot)
-    REAL(rstd),INTENT(OUT) :: temp(iim*jjm,llm)
-
-    REAL(rstd)  :: p(iim*jjm,llm+1)
+    REAL(rstd),INTENT(IN)    :: pmid(iim*jjm,llm)
+    REAL(rstd),INTENT(IN)    :: q(iim*jjm,llm,nqtot)
+    REAL(rstd),INTENT(INOUT) :: temp(iim*jjm,llm)
+
     REAL(rstd) :: Rd, p_ik, theta_ik, temp_ik, qv, chi, Rmix
     INTEGER :: ij,l
 
     Rd = kappa*cpp
-    CALL compute_pression(ps,p,0)
     DO l=ll_begin,ll_end
        DO ij=ij_begin,ij_end
-          p_ik = .5*(p(ij,l)+p(ij,l+1))
-          theta_ik = g*theta_rhodz(ij,l,1)/(p(ij,l)-p(ij,l+1))
+          p_ik = pmid(ij,l)
+          theta_ik = temp(ij,l)
           qv = q(ij,l,1) ! water vaper mixing ratio = mv/md
           SELECT CASE(caldyn_thermo)