SUBROUTINE compute_vpt !-------------------------------------------------------------------------------! ! Current revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: compute_vpt.f90 804 2012-01-16 16:12:22Z raasch $ ! ! 803 2012-01-16 15:48:46Z franke ! Bugfix: wrong factor in calculation of vpt in case of cloud droplets ! ! 799 2011-12-21 17:48:03Z franke ! Bugfix: ql is now included in calculation of vpt in case of ! cloud droplets ! ! RCS Log replace by Id keyword, revision history cleaned up ! ! Revision 1.5 2001/03/30 06:58:52 raasch ! Translation of remaining German identifiers (variables, subroutines, etc.) ! ! Revision 1.1 2000/04/13 14:40:53 schroeter ! Initial revision ! ! ! Description: ! ------------- ! Computation of the virtual potential temperature !-------------------------------------------------------------------------------! USE arrays_3d USE indices USE cloud_parameters USE control_parameters IMPLICIT NONE INTEGER :: k IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN vpt = pt * ( 1.0 + 0.61 * q ) ELSE IF (cloud_physics) THEN DO k = nzb, nzt+1 vpt(k,:,:) = ( pt(k,:,:) + pt_d_t(k) * l_d_cp * ql(k,:,:) ) * & ( 1.0 + 0.61 * q(k,:,:) - 1.61 * ql(k,:,:) ) ENDDO ELSE vpt = pt * ( 1.0 + 0.61 * q - ql ) ENDIF END SUBROUTINE compute_vpt