source: codes/icosagcm/trunk/src/theta_rhodz.f90 @ 12

MODULE theta2theta_rhodz_mod

CONTAINS

  SUBROUTINE theta2theta_rhodz(f_ps,f_theta,f_theta_rhodz)
  USE transfert_mod
  USE field_mod
  USE dimensions
  USE geometry
  USE domain_mod
  IMPLICIT NONE
    TYPE(t_field), POINTER :: f_ps(:)
    TYPE(t_field), POINTER :: f_theta(:)
    TYPE(t_field), POINTER :: f_theta_rhodz(:)
  
    REAL(rstd), POINTER :: ps(:)
    REAL(rstd), POINTER :: theta(:,:)
    REAL(rstd), POINTER :: theta_rhodz(:,:)
    INTEGER :: ind

    DO ind=1,ndomain
      CALL swap_dimensions(ind)
      CALL swap_geometry(ind)
      ps=f_ps(ind)
      theta=f_theta(ind)
      theta_rhodz=f_theta_rhodz(ind)
      CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0)
    ENDDO
  
  END SUBROUTINE theta2theta_rhodz
  
  SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset)
  USE dimensions
  USE geometry
  USE metric
  USE pression_mod
  IMPLICIT NONE
    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
    REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm)
    REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm)
    INTEGER,INTENT(IN) :: offset
    INTEGER :: i,j,ij,l
    REAL(rstd) :: p(iim*jjm,llm+1)

    CALL compute_pression(ps,p,offset)
    
    DO    l    = 1, llm
      DO j=jj_begin-offset,jj_end+offset
        DO i=ii_begin-offset,ii_end+offset
          ij=(j-1)*iim+i
          theta_rhodz(ij,l) = theta(ij,l) * (p(ij,l)-p(ij,l+1))/g
        ENDDO
      ENDDO
    ENDDO
    
  END SUBROUTINE compute_theta2theta_rhodz

END MODULE theta2theta_rhodz_mod