source: palm/trunk/SOURCE/buoyancy.f90 @ 16

 MODULE buoyancy_mod

!------------------------------------------------------------------------------!
! Actual revisions:
! -----------------
! 
!
! Former revisions:
! -----------------
! $Id: buoyancy.f90 4 2007-02-13 11:33:16Z raasch $
! RCS Log replace by Id keyword, revision history cleaned up
!
! Revision 1.19  2006/04/26 12:09:56  raasch
! OpenMP optimization (one dimension added to sums_l)
!
! Revision 1.1  1997/08/29 08:56:48  raasch
! Initial revision
!
!
! Description:
! ------------
! Buoyancy term of the third component of the equation of motion.
! WARNING: humidity is not regarded when using a sloping surface!
!------------------------------------------------------------------------------!

    PRIVATE
    PUBLIC buoyancy, calc_mean_pt_profile

    INTERFACE buoyancy
       MODULE PROCEDURE buoyancy
       MODULE PROCEDURE buoyancy_ij
    END INTERFACE buoyancy

    INTERFACE calc_mean_pt_profile
       MODULE PROCEDURE calc_mean_pt_profile
    END INTERFACE calc_mean_pt_profile

 CONTAINS


!------------------------------------------------------------------------------!
! Call for all grid points
!------------------------------------------------------------------------------!
    SUBROUTINE buoyancy( theta, wind_component, pr )

       USE arrays_3d
       USE control_parameters
       USE indices
       USE pegrid
       USE statistics

       IMPLICIT NONE

       INTEGER ::  i, j, k, pr, wind_component
       REAL, DIMENSION(:,:,:), POINTER  ::  theta


       IF ( .NOT. sloping_surface )  THEN
!
!--       Normal case: horizontal surface
          DO  i = nxl, nxr
             DO  j = nys, nyn
                DO  k = nzb_s_inner(j,i)+1, nzt-1
                    tend(k,j,i) = tend(k,j,i) + g * 0.5 * (                    &
                        ( theta(k,j,i)   - hom(k,1,pr,0)   ) / hom(k,1,pr,0) + &
                        ( theta(k+1,j,i) - hom(k+1,1,pr,0) ) / hom(k+1,1,pr,0) &
                                                          )
                ENDDO
             ENDDO
          ENDDO

       ELSE
!
!--       Buoyancy term for a surface with a slope in x-direction. The equations
!--       for both the u and w velocity-component contain proportionate terms.
!--       Temperature field at time t=0 serves as environmental temperature.
!--       Reference temperature (pt_surface) is the one at the lower left corner
!--       of the total domain.
          IF ( wind_component == 1 )  THEN

             DO  i = nxl, nxr
                DO  j = nys, nyn
                   DO  k = nzb_s_inner(j,i)+1, nzt-1
                      tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *      &
                           0.5 * ( ( pt(k,j,i-1)         + pt(k,j,i)         ) &
                                 - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
                                 ) / pt_surface
                   ENDDO
                ENDDO
             ENDDO

          ELSEIF ( wind_component == 3 )  THEN

             DO  i = nxl, nxr
                DO  j = nys, nyn
                   DO  k = nzb_s_inner(j,i)+1, nzt-1
                      tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *      &
                           0.5 * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
                                 - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
                                 ) / pt_surface
                   ENDDO
                ENDDO
            ENDDO

          ELSE

             IF ( myid == 0 )  PRINT*, '+++ buoyancy: no term for component "',&
                                       wind_component,'"'
             CALL local_stop

          ENDIF

       ENDIF

    END SUBROUTINE buoyancy


!------------------------------------------------------------------------------!
! Call for grid point i,j
!------------------------------------------------------------------------------!
    SUBROUTINE buoyancy_ij( i, j, theta, wind_component, pr )

       USE arrays_3d
       USE control_parameters
       USE indices
       USE pegrid
       USE statistics

       IMPLICIT NONE

       INTEGER ::  i, j, k, pr, wind_component
       REAL, DIMENSION(:,:,:), POINTER  ::  theta


       IF ( .NOT. sloping_surface )  THEN
!
!--       Normal case: horizontal surface
          DO  k = nzb_s_inner(j,i)+1, nzt-1
              tend(k,j,i) = tend(k,j,i) + g * 0.5 * (                          &
                        ( theta(k,j,i)   - hom(k,1,pr,0)   ) / hom(k,1,pr,0) + &
                        ( theta(k+1,j,i) - hom(k+1,1,pr,0) ) / hom(k+1,1,pr,0) &
                                                    )
          ENDDO

       ELSE
!
!--       Buoyancy term for a surface with a slope in x-direction. The equations
!--       for both the u and w velocity-component contain proportionate terms.
!--       Temperature field at time t=0 serves as environmental temperature.
!--       Reference temperature (pt_surface) is the one at the lower left corner
!--       of the total domain.
          IF ( wind_component == 1 )  THEN

             DO  k = nzb_s_inner(j,i)+1, nzt-1
                tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface *            &
                           0.5 * ( ( pt(k,j,i-1)         + pt(k,j,i)         ) &
                                 - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
                                 ) / pt_surface
             ENDDO

          ELSEIF ( wind_component == 3 )  THEN

             DO  k = nzb_s_inner(j,i)+1, nzt-1
                tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface *            &
                           0.5 * ( ( pt(k,j,i)         + pt(k+1,j,i)         ) &
                                 - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
                                 ) / pt_surface
             ENDDO

          ELSE

             IF ( myid == 0 )  PRINT*, '+++ buoyancy: no term for component "',&
                                       wind_component,'"'
             CALL local_stop

          ENDIF

       ENDIF

    END SUBROUTINE buoyancy_ij


    SUBROUTINE calc_mean_pt_profile( theta, pr )

!------------------------------------------------------------------------------!
! Description:
! ------------
! Calculate the horizontally averaged vertical temperature profile (pr=4 in case
! of potential temperature and 44 in case of virtual potential temperature).
!------------------------------------------------------------------------------!

       USE control_parameters
       USE indices
       USE pegrid
       USE statistics

       IMPLICIT NONE

       INTEGER ::  i, j, k, omp_get_thread_num, pr, tn
       REAL, DIMENSION(:,:,:), POINTER  ::  theta

!
!--    Computation of the horizontally averaged temperature profile, unless
!--    already done by the relevant call from flow_statistics. The calculation
!--    is done only for the first respective intermediate timestep in order to
!--    spare communication time and to produce identical model results with jobs
!--    which are calling flow_statistics at different time intervals.
!--    Although this calculation is not required for model runs with a slope,
!--    it is nevertheless also computed.
       IF ( .NOT. flow_statistics_called  .AND. &
            intermediate_timestep_count == 1 )  THEN

!
!--       Horizontal average of the potential temperature
          tn           =   0  ! Default thread number in case of one thread
          !$OMP PARALLEL PRIVATE( i, j, k, tn )
!$        tn = omp_get_thread_num()
          sums_l(:,pr,tn) = 0.0
          !$OMP DO
          DO  i = nxl, nxr
             DO  j =  nys, nyn
                DO  k = nzb_s_outer(j,i), nzt+1
                   sums_l(k,pr,tn) = sums_l(k,pr,tn) + theta(k,j,i)
                ENDDO
             ENDDO
          ENDDO
          !$OMP END PARALLEL

          DO  i = 1, threads_per_task-1
             sums_l(:,pr,0) = sums_l(:,pr,0) + sums_l(:,pr,i)
          ENDDO

#if defined( __parallel )

          CALL MPI_ALLREDUCE( sums_l(nzb,pr,0), sums(nzb,pr), nzt+2-nzb, &
                              MPI_REAL, MPI_SUM, comm2d, ierr )

#else

          sums(:,pr) = sums_l(:,pr,0)

#endif

          hom(:,1,pr,0) = sums(:,pr) / ngp_2dh_outer(:,0)

       ENDIF

    END SUBROUTINE calc_mean_pt_profile

 END MODULE buoyancy_mod