Changeset 428 for codes/icosagcm/trunk/src/theta_rhodz.f90

Timestamp:

06/14/16 21:54:26 (8 years ago)

Author:

dubos

Message:

theta-related cleanup

File:

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

codes/icosagcm/trunk/src/theta_rhodz.f90

@@ -1 +1 @@
 MODULE theta2theta_rhodz_mod
   USE field_mod
-  
+  PRIVATE
   TYPE(t_field), POINTER, SAVE  :: f_p(:)
-  TYPE(t_field), POINTER, SAVE  :: f_pks(:)
-  TYPE(t_field), POINTER, SAVE  :: f_pk(:)
-
-  PRIVATE :: f_p,f_pk,f_pks 
+
+  PUBLIC :: init_theta2theta_rhodz, theta_rhodz2theta, &
+       theta_rhodz2temperature, temperature2theta_rhodz, &
+       theta2theta_rhodz, &
+       compute_theta2theta_rhodz, compute_theta_rhodz2theta
 
 CONTAINS
@@ -14 +15 @@
   USE field_mod
   IMPLICIT NONE
-    CALL allocate_field(f_p,field_t,type_real,llm+1,name='p (theta2theta_rhodz_mod)')
-    CALL allocate_field(f_pk,field_t,type_real,llm,name='pk (theta2theta_rhodz_mod)')
-    CALL allocate_field(f_pks,field_t,type_real,name='pks (theta2theta_rhodz_mod)')
-    
+    CALL allocate_field(f_p,field_t,type_real,llm+1,name='p (theta2theta_rhodz_mod)')    
   END SUBROUTINE init_theta2theta_rhodz
-
 
 
@@ -61 +58 @@
     REAL(rstd), POINTER :: temp(:,:)
     REAL(rstd), POINTER :: p(:,:)
-    REAL(rstd), POINTER :: pk(:,:)
-    REAL(rstd), POINTER :: pks(:)
     INTEGER :: ind
 
@@ -71 +66 @@
       ps=f_ps(ind)
       p=f_p(ind)
-      pks=f_pks(ind)
-      pk=f_pk(ind)
       theta_rhodz=f_theta_rhodz(ind)
       temp=f_temp(ind)
@@ -79 +72 @@
       CALL compute_pression(ps,p,0)
 !$OMP BARRIER
-      CALL compute_exner(ps,p,pks,pk,0)
-!$OMP BARRIER
-      CALL compute_theta_rhodz2temperature(p, pk, theta_rhodz(:,:,1),temp,0)
+      CALL compute_theta_rhodz2temperature(p, theta_rhodz(:,:,1),temp,0)
     ENDDO
 !$OMP BARRIER
@@ -100 +91 @@
     REAL(rstd), POINTER :: temp(:,:)
     REAL(rstd), POINTER :: p(:,:)
-    REAL(rstd), POINTER :: pk(:,:)
-    REAL(rstd), POINTER :: pks(:)
     INTEGER :: ind
 
@@ -110 +99 @@
       ps=f_ps(ind)
       p=f_p(ind)
-      pks=f_pks(ind)
-      pk=f_pk(ind)
       theta_rhodz=f_theta_rhodz(ind)
       temp=f_temp(ind)
@@ -118 +105 @@
       CALL compute_pression(ps,p,0)
 !$OMP BARRIER
-      CALL compute_exner(ps,p,pks,pk,0)
-!$OMP BARRIER
-      CALL compute_temperature2theta_rhodz(p, pk, temp, theta_rhodz(:,:,1), 0)
+      CALL compute_temperature2theta_rhodz(p, temp, theta_rhodz(:,:,1), 0)
     ENDDO
 !$OMP BARRIER
@@ -213 +198 @@
 
 
-  SUBROUTINE compute_theta_rhodz2temperature(p,pk,theta_rhodz,temp,offset)
+  SUBROUTINE compute_theta_rhodz2temperature(p,theta_rhodz,temp,offset)
   USE icosa
   USE pression_mod
@@ -220 +205 @@
   IMPLICIT NONE
     REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
-    REAL(rstd),INTENT(IN) :: pk(iim*jjm,llm)
     REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm)
     REAL(rstd),INTENT(OUT) :: temp(iim*jjm,llm)
     INTEGER,INTENT(IN) :: offset
+    REAL(rstd) :: pk_ij
     INTEGER :: i,j,ij,l
         
@@ -232 +217 @@
         DO i=ii_begin-offset,ii_end+offset
           ij=(j-1)*iim+i
-          temp(ij,l) = ( theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g) ) * pk(ij,l) / cpp
+          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
+          temp(ij,l) = ( theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g) ) * pk_ij
         ENDDO
       ENDDO
@@ -241 +227 @@
   END SUBROUTINE compute_theta_rhodz2temperature
 
-  SUBROUTINE compute_temperature2theta_rhodz(p,pk,temp,theta_rhodz,offset)
+  SUBROUTINE compute_temperature2theta_rhodz(p,temp,theta_rhodz,offset)
   USE icosa
   USE pression_mod
@@ -248 +234 @@
   IMPLICIT NONE
     REAL(rstd),INTENT(IN)  :: p(iim*jjm,llm+1)
-    REAL(rstd),INTENT(IN)  :: pk(iim*jjm,llm)
     REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
     REAL(rstd),INTENT(IN)  :: temp(iim*jjm,llm)
     INTEGER,INTENT(IN) :: offset
+    REAL(rstd) :: pk_ij
     INTEGER :: i,j,ij,l
 
@@ -262 +248 @@
         DO i=ii_begin-offset,ii_end+offset
           ij=(j-1)*iim+i
-          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / (pk(ij,l) / cpp )
+          pk_ij=((.5/preff)*(p(ij,l)+p(ij,l+1)))**kappa
+          theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / pk_ij
         ENDDO
       ENDDO