dmp_cartesian.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Module name: SEND_RECEIVE_CUT_CELL_VARIABLES                        C
!  Purpose: Send/receive all relevant cut cell related variables       C
!                                                                      C
!  Author: Jeff Dietiker                              Date: 21-Feb-08  C
!  Reviewer:                                          Date:            C
!                                                                      C
!  Revision Number #                                  Date: ##-###-##  C
!  Author: #                                                           C
!  Purpose: #                                                          C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
  SUBROUTINE send_receive_cut_cell_variables

      USE param
      USE param1
      USE parallel
      USE constant
      USE run
      USE toleranc
      USE geometry
      USE indices
      USE compar
      USE sendrecv
      USE quadric
      USE cutcell
      USE functions

      USE mpi_utility      !//d pnicol : for gather


      IMPLICIT NONE

      call send_receive_1d_logical(wall_u_at,2)
      call send_receive_1d_logical(wall_v_at,2)
      call send_receive_1d_logical(wall_w_at,2)

      call send_recv(area_cut, 2)
      call send_recv(area_u_cut,2)
      call send_recv(area_v_cut,2)
      call send_recv(area_w_cut,2)

      call send_recv(delx_ue,2)
      call send_recv(delx_uw,2)
      call send_recv(dely_un,2)
      call send_recv(dely_us,2)
      call send_recv(delz_ut,2)
      call send_recv(delz_ub,2)

      call send_recv(delx_ve,2)
      call send_recv(delx_vw,2)
      call send_recv(dely_vn,2)
      call send_recv(dely_vs,2)
      call send_recv(delz_vt,2)
      call send_recv(delz_vb,2)

      call send_recv(delx_we,2)
      call send_recv(delx_ww,2)
      call send_recv(dely_wn,2)
      call send_recv(dely_ws,2)
      call send_recv(delz_wt,2)
      call send_recv(delz_wb,2)

      call send_recv(x_u,2)
      call send_recv(y_u,2)
      call send_recv(z_u,2)

      call send_recv(x_u_ec,2)
      call send_recv(y_u_ec,2)
      call send_recv(z_u_ec,2)

      call send_recv(x_u_nc,2)
      call send_recv(y_u_nc,2)
      call send_recv(z_u_nc,2)

      call send_recv(x_u_tc,2)
      call send_recv(y_u_tc,2)
      call send_recv(z_u_tc,2)

      call send_recv(x_v,2)
      call send_recv(y_v,2)
      call send_recv(z_v,2)

      call send_recv(x_v_ec,2)
      call send_recv(y_v_ec,2)
      call send_recv(z_v_ec,2)

      call send_recv(x_v_nc,2)
      call send_recv(y_v_nc,2)
      call send_recv(z_v_nc,2)

      call send_recv(x_v_tc,2)
      call send_recv(y_v_tc,2)
      call send_recv(z_v_tc,2)

      call send_recv(x_w,2)
      call send_recv(y_w,2)
      call send_recv(z_w,2)

      call send_recv(x_w_ec,2)
      call send_recv(y_w_ec,2)
      call send_recv(z_w_ec,2)

      call send_recv(x_w_nc,2)
      call send_recv(y_w_nc,2)
      call send_recv(z_w_nc,2)

      call send_recv(x_w_tc,2)
      call send_recv(y_w_tc,2)
      call send_recv(z_w_tc,2)

      call send_recv(delh_scalar,2)
      call send_recv(delh_u,2)
      call send_recv(delh_v,2)
      call send_recv(delh_w,2)

      call send_recv(normal_s,2)
      call send_recv(normal_u,2)
      call send_recv(normal_v,2)
      call send_recv(normal_w,2)

      call send_recv(refp_s,2)
      call send_recv(refp_u,2)
      call send_recv(refp_v,2)
      call send_recv(refp_w,2)

      call send_recv(theta_ue,2)
      call send_recv(theta_ue_bar,2)
      call send_recv(theta_u_ne,2)
      call send_recv(theta_u_nw,2)
      call send_recv(theta_u_te,2)
      call send_recv(theta_u_tw,2)
      call send_recv(alpha_ue_c,2)
      call send_recv(noc_u_e,2)
      call send_recv(theta_un,2)
      call send_recv(theta_un_bar,2)
      call send_recv(alpha_un_c,2)
      call send_recv(noc_u_n,2)
      call send_recv(theta_ut,2)
      call send_recv(theta_ut_bar,2)
      call send_recv(alpha_ut_c,2)
      call send_recv(noc_u_t,2)
      call send_recv(a_upg_e,2)
      call send_recv(a_upg_w,2)

      call send_recv(theta_v_ne,2)
      call send_recv(theta_v_se,2)
      call send_recv(theta_vn,2)
      call send_recv(theta_vn_bar,2)
      call send_recv(theta_v_nt,2)
      call send_recv(theta_v_st,2)
      call send_recv(theta_ve,2)
      call send_recv(theta_ve_bar,2)
      call send_recv(alpha_ve_c,2)
      call send_recv(noc_v_e,2)
      call send_recv(alpha_vn_c,2)
      call send_recv(noc_v_n,2)
      call send_recv(theta_vt,2)
      call send_recv(theta_vt_bar,2)
      call send_recv(alpha_vt_c,2)
      call send_recv(noc_v_t,2)
      call send_recv(a_vpg_n,2)
      call send_recv(a_vpg_s,2)

      call send_recv(theta_w_te,2)
      call send_recv(theta_w_be,2)
      call send_recv(theta_w_tn,2)
      call send_recv(theta_w_bn,2)
      call send_recv(theta_wt,2)
      call send_recv(theta_wt_bar,2)
      call send_recv(theta_we,2)
      call send_recv(theta_we_bar,2)
      call send_recv(alpha_we_c,2)
      call send_recv(noc_w_e,2)
      call send_recv(theta_wn,2)
      call send_recv(theta_wn_bar,2)
      call send_recv(alpha_wn_c,2)
      call send_recv(noc_w_n,2)
      call send_recv(alpha_wt_c,2)
      call send_recv(noc_w_t,2)
      call send_recv(a_wpg_t,2)
      call send_recv(a_wpg_b,2)

      call send_recv(oneodx_e_u,2)
      call send_recv(oneody_n_u,2)
      call send_recv(oneodz_t_u,2)

      call send_recv(oneodx_e_v,2)
      call send_recv(oneody_n_v,2)
      call send_recv(oneodz_t_v,2)

      call send_recv(oneodx_e_w,2)
      call send_recv(oneody_n_w,2)
      call send_recv(oneodz_t_w,2)

      call send_receive_1d_logical(cut_treatment_at,2)
      call send_receive_1d_logical(cut_u_treatment_at,2)
      call send_receive_1d_logical(cut_v_treatment_at,2)
      call send_receive_1d_logical(cut_w_treatment_at,2)

      call send_receive_1d_logical(cut_cell_at,2)
      call send_receive_1d_logical(cut_u_cell_at,2)
      call send_receive_1d_logical(cut_v_cell_at,2)
      call send_receive_1d_logical(cut_w_cell_at,2)

      call send_receive_1d_logical(small_cell_at,2)
      call send_recv(small_cell_flag,2)


      call send_receive_1d_logical(blocked_cell_at,2)
      call send_receive_1d_logical(blocked_u_cell_at,2)
      call send_receive_1d_logical(blocked_v_cell_at,2)
      call send_receive_1d_logical(blocked_w_cell_at,2)

      call send_receive_1d_logical(standard_cell_at,2)
      call send_receive_1d_logical(standard_u_cell_at,2)
      call send_receive_1d_logical(standard_v_cell_at,2)
      call send_receive_1d_logical(standard_w_cell_at,2)

      call send_recv(u_master_of,2)
      call send_recv(v_master_of,2)
      call send_recv(w_master_of,2)

      call send_recv(bc_id,2)
      call send_recv(bc_u_id,2)
      call send_recv(bc_v_id,2)
      call send_recv(bc_w_id,2)

      call send_recv(flag,2)
      call send_recv(flag_e,2)
      call send_recv(flag_n,2)
      call send_recv(flag_t,2)

      call send_recv(ayz,2)
      call send_recv(axz,2)
      call send_recv(axy,2)
      call send_recv(vol,2)

      call send_recv(ayz_u,2)
      call send_recv(axz_u,2)
      call send_recv(axy_u,2)
      call send_recv(vol_u,2)

      call send_recv(ayz_v,2)
      call send_recv(axz_v,2)
      call send_recv(axy_v,2)
      call send_recv(vol_v,2)

      call send_recv(ayz_w,2)
      call send_recv(axz_w,2)
      call send_recv(axy_w,2)
      call send_recv(vol_w,2)

      RETURN


      END SUBROUTINE send_receive_cut_cell_variables



!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
!                                                                      C
!  Module name: SEND_RECEIVE_2D_LOGICAL                                C
!  Purpose: Emulates send/receive for a 2D logical array               C
!  using temporary integer                                             C
!                                                                      C
!  Author: Jeff Dietiker                              Date: 21-Feb-08  C
!  Reviewer:                                          Date:            C
!                                                                      C
!  Revision Number #                                  Date: ##-###-##  C
!  Author: #                                                           C
!  Purpose: #                                                          C
!                                                                      C
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
  SUBROUTINE send_receive_1d_logical(L1D,NLAYERS)

      USE param
      USE param1
      USE parallel
      USE constant
      USE run
      USE toleranc
      USE geometry
      USE indices
      USE compar
      USE sendrecv
      USE quadric
      USE cutcell

      USE mpi_utility      !//d pnicol : for gather

      IMPLICIT NONE
      INTEGER :: IJK,NLAYERS
      INTEGER, DIMENSION(DIMENSION_3) :: I1D
      LOGICAL, DIMENSION(DIMENSION_3) :: L1D

      IF((nlayers/=1).AND.(nlayers/=2)) THEN
         WRITE(*,*)' NLAYERS=',nlayers
         WRITE(*,*)' SEND_RECEIVE_1D_LOGICAL ERROR: NLAYER MUST BE EQUAL TO 1 or 2'
         CALL mfix_exit(mype)
      ENDIF

      DO ijk = ijkstart3, ijkend3
         IF(l1d(ijk)) THEN
            i1d(ijk) = 1
         ELSE
            i1d(ijk) = 0
         ENDIF
      ENDDO

      call send_recv(i1d,nlayers)

      DO ijk = ijkstart3, ijkend3
         IF(i1d(ijk)==1) THEN
            l1d(ijk) = .true.
         ELSE
            l1d(ijk) = .false.
         ENDIF
      ENDDO


      RETURN


      END SUBROUTINE send_receive_1d_logical