SUBROUTINE init_slope !------------------------------------------------------------------------------! ! Current revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: init_slope.f90 484 2010-02-05 07:36:54Z maronga $ ! RCS Log replace by Id keyword, revision history cleaned up ! ! Revision 1.5 2006/02/23 12:35:34 raasch ! nanz_2dh renamed ngp_2dh ! ! Revision 1.1 2000/04/27 07:06:24 raasch ! Initial revision ! ! ! Description: ! ------------ ! Initialization of the temperature field and other variables used in case ! of a sloping surface. ! Remember: when a sloping surface is used, only one constant temperature ! gradient is allowed! !------------------------------------------------------------------------------! USE arrays_3d USE constants USE grid_variables USE indices USE pegrid USE control_parameters IMPLICIT NONE INTEGER :: i, j, k REAL :: alpha, height, pt_value, radius REAL, DIMENSION(:), ALLOCATABLE :: pt_init_local ! !-- Calculate reference temperature field needed for computing buoyancy ALLOCATE( pt_slope_ref(nzb:nzt+1,nxl-1:nxr+1) ) DO i = nxl-1, nxr+1 DO k = nzb, nzt+1 ! !-- Compute height of grid-point relative to lower left corner of !-- the total domain. !-- First compute the distance between the actual grid point and the !-- lower left corner as well as the angle between the line connecting !-- these points and the bottom of the model. IF ( k /= nzb ) THEN radius = SQRT( ( i * dx )**2 + zu(k)**2 ) height = zu(k) ELSE radius = SQRT( ( i * dx )**2 ) height = 0.0 ENDIF IF ( radius /= 0.0 ) THEN alpha = ASIN( height / radius ) ELSE alpha = 0.0 ENDIF ! !-- Compute temperatures in the rotated coordinate system alpha = alpha + alpha_surface / 180.0 * pi pt_value = pt_surface + radius * SIN( alpha ) * & pt_vertical_gradient(1) / 100.0 pt_slope_ref(k,i) = pt_value ENDDO ENDDO ! !-- Temperature difference between left and right boundary of the total domain, !-- used for the cyclic boundary in x-direction pt_slope_offset = (nx+1) * dx * sin_alpha_surface * & pt_vertical_gradient(1) / 100.0 ! !-- Following action must only be executed for initial runs IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN ! !-- Set initial temperature equal to the reference temperature field DO j = nys-1, nyn+1 pt(:,j,:) = pt_slope_ref ENDDO ! !-- Recompute the mean initial temperature profile (mean along x-direction of !-- the rotated coordinate system) ALLOCATE( pt_init_local(nzb:nzt+1) ) pt_init_local = 0.0 DO i = nxl, nxr DO j = nys, nyn DO k = nzb, nzt+1 pt_init_local(k) = pt_init_local(k) + pt(k,j,i) ENDDO ENDDO ENDDO #if defined( __parallel ) CALL MPI_ALLREDUCE( pt_init_local, pt_init, nzt+2-nzb, MPI_REAL, & MPI_SUM, comm2d, ierr ) #else pt_init = pt_init_local #endif pt_init = pt_init / ngp_2dh(0) DEALLOCATE( pt_init_local ) ENDIF END SUBROUTINE init_slope