SUBROUTINE compute_vpt !-------------------------------------------------------------------------------! ! Current revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: compute_vpt.f90 484 2010-02-05 07:36:54Z suehring $ ! 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 ) THEN vpt = pt * ( 1.0 + 0.61 * q ) ELSE 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 ENDIF END SUBROUTINE compute_vpt