text:
module cc_edge_coeffs_module

    use BoxLib
    use ml_layout_module
    use multifab_module
    use bl_error_module

    implicit none

contains

  subroutine cell_to_edge_coeffs(cell_coeffs,edge_coeffs)

    type(multifab ), intent(in   ) :: cell_coeffs
    type(multifab ), intent(inout) :: edge_coeffs(:)

    type(box)                :: bx
    real(kind=dp_t), pointer :: cp(:,:,:,:)
    real(kind=dp_t), pointer :: epx(:,:,:,:)
    real(kind=dp_t), pointer :: epy(:,:,:,:)
    real(kind=dp_t), pointer :: epz(:,:,:,:)

    integer :: i, dm

    dm = cell_coeffs%dim

    do i = 1, nfabs(cell_coeffs)
       bx = get_ibox(cell_coeffs, i)
       cp  => dataptr(cell_coeffs,i)
       epx => dataptr(edge_coeffs(1),i)
       epy => dataptr(edge_coeffs(2),i)
       if (dm.eq.2) then
          call cc_to_edges_2d(cp(:,:,1,1),epx(:,:,1,1),epy(:,:,1,1),bx)
       else if (dm.eq.3) then
          epz => dataptr(edge_coeffs(3),i)
          call cc_to_edges_3d(cp(:,:,:,1),epx(:,:,:,1),epy(:,:,:,1),epz(:,:,:,1),bx)
       end if
    end do

  end subroutine cell_to_edge_coeffs

  subroutine cc_to_edges_2d(cc_coeffs,x_edges,y_edges,bx)

      type(box)       , intent(in   ) :: bx
      double precision, intent(in   ) :: cc_coeffs(bx%lo(1)-1:,bx%lo(2)-1:)
      double precision, intent(inout) :: x_edges(bx%lo(1):,bx%lo(2):)
      double precision, intent(inout) :: y_edges(bx%lo(1):,bx%lo(2):)

      integer :: i,j

      do j = bx%lo(2),bx%hi(2)
      do i = bx%lo(1),bx%hi(1)+1
            x_edges(i,j) = 0.5d0 * (cc_coeffs(i,j) + cc_coeffs(i-1,j))
      end do
      end do

      do i = bx%lo(1),bx%hi(1)
      do j = bx%lo(2),bx%hi(2)+1
            y_edges(i,j) = 0.5d0 * (cc_coeffs(i,j) + cc_coeffs(i,j-1))
      end do
      end do

  end subroutine cc_to_edges_2d

  subroutine cc_to_edges_3d(cc_coeffs,x_edges,y_edges,z_edges,bx)

      type(box)       , intent(in   ) :: bx
      double precision, intent(in   ) :: cc_coeffs(bx%lo(1)-1:,bx%lo(2)-1:,bx%lo(3)-1:)
      double precision, intent(inout) :: x_edges(bx%lo(1):,bx%lo(2):,bx%lo(3):)
      double precision, intent(inout) :: y_edges(bx%lo(1):,bx%lo(2):,bx%lo(3):)
      double precision, intent(inout) :: z_edges(bx%lo(1):,bx%lo(2):,bx%lo(3):)

      integer :: i,j,k

      do k = bx%lo(3),bx%hi(3)
      do j = bx%lo(2),bx%hi(2)
      do i = bx%lo(1),bx%hi(1)+1
            x_edges(i,j,k) = 0.5d0 * (cc_coeffs(i,j,k) + cc_coeffs(i-1,j,k))
      end do
      end do
      end do

      do k = bx%lo(3),bx%hi(3)
      do j = bx%lo(2),bx%hi(2)+1
      do i = bx%lo(1),bx%hi(1)
            y_edges(i,j,k) = 0.5d0 * (cc_coeffs(i,j,k) + cc_coeffs(i,j-1,k))
      end do
      end do
      end do

      do k = bx%lo(3),bx%hi(3)+1
      do j = bx%lo(2),bx%hi(2)
      do i = bx%lo(1),bx%hi(1)
            z_edges(i,j,k) = 0.5d0 * (cc_coeffs(i,j,k) + cc_coeffs(i,j,k-1))
      end do
      end do
      end do

  end subroutine cc_to_edges_3d

end module cc_edge_coeffs_module

max_stars_repo_name: ylunalin/amrex

max_issues_repo_name: ylunalin/amrex

max_forks_repo_name: ylunalin/amrex


text:
       SUBROUTINE ROSSEL(TEMP,Q,QR)
C***********************************************************************
C             SUBROUTINE ROSSEL CALCULATES THE ROSSELAND MEAN EFFICIENCIES
C       USING A REDUCED FORM OF THE PLANCK BB INTENSITY DISTRIBUTION
C       (SEE MENGUC & VISKANTA, COMBUST SCI TECH, 44, 143-159, 1985);
C       INTEGRATION IS PERFORMED USING SIMPSON'S COMPOSITE ALGORITHM
C***********************************************************************
       DIMENSION Q(50)
       DATA PI/3.1415927/,C2/14400.0/
C***********************************************************************
C       USE SMALL AND LARGE ZETA LIMITS TO APPROXIMATE 0-INF. INTEGRAL,
C       0.01-50.0 SEEMS TO APPROXIMATE THIS WELL WITHOUT RUNNING INTO
C       LARGE NUMBER PROBLEMS WITH EXPONENTIALS - PROPERTY RANGES ARE
C       ASSUMED CONSTANT BEYOND CALCULATED LIMITS TO ALLOW THIS;
C       C2DT IS 2ND RADIATION CONSTANT DIVIDED BY TEMPERATURE - THIS IS
C       USED TO EXTRACT CURRENT WAVELENGTH FOR DIFFERENT TEMPERATURES
C       (E.G., T=1000: C2DT=14.40, T=1500: C2DT=9.60, FOR SI UNITS)
C***********************************************************************
       A = 0.01
       B = 50.0
       C2DT = C2 / TEMP
       H = 0.01
       M = NINT((B - A) / (2. * H))
       FA = (1. / Q(27)) * A**4 * EXP(A) / ((EXP(A) - 1.)**2)
       FB = (1. / Q(1)) * B**4 * EXP(B) / ((EXP(B) - 1.)**2)
       XI0 = FA + FB
       XI1 = 0.0
       XI2 = 0.0
       DO 100 I=1,2*M-1
         Z = A + FLOAT(I)*H
         WL = C2DT / Z
         IF (WL.GE.12.75) THEN
           IW = 27
         ELSE IF (WL.LT.12.75 .AND. WL.GE.12.25) THEN
           IW = 26
         ELSE IF (WL.LT.12.25 .AND. WL.GE.11.75) THEN
           IW = 25
         ELSE IF (WL.LT.11.75 .AND. WL.GE.11.25) THEN
           IW = 24
         ELSE IF (WL.LT.11.25 .AND. WL.GE.10.75) THEN
           IW = 23
         ELSE IF (WL.LT.10.75 .AND. WL.GE.10.25) THEN
           IW = 22
         ELSE IF (WL.LT.10.25 .AND. WL.GE.9.75) THEN
           IW = 21
         ELSE IF (WL.LT.9.75 .AND. WL.GE.9.25) THEN
           IW = 20
         ELSE IF (WL.LT.9.25 .AND. WL.GE.8.75) THEN
           IW = 19
         ELSE IF (WL.LT.8.75 .AND. WL.GE.8.25) THEN
           IW = 18
         ELSE IF (WL.LT.8.25 .AND. WL.GE.7.75) THEN
           IW = 17
         ELSE IF (WL.LT.7.75 .AND. WL.GE.7.25) THEN
           IW = 16
         ELSE IF (WL.LT.7.25 .AND. WL.GE.6.75) THEN
           IW = 15
         ELSE IF (WL.LT.6.75 .AND. WL.GE.6.25) THEN
           IW = 14
         ELSE IF (WL.LT.6.25 .AND. WL.GE.5.75) THEN
           IW = 13
         ELSE IF (WL.LT.5.75 .AND. WL.GE.5.25) THEN
           IW = 12
         ELSE IF (WL.LT.5.25 .AND. WL.GE.4.75) THEN
           IW = 11
         ELSE IF (WL.LT.4.75 .AND. WL.GE.4.25) THEN
           IW = 10
         ELSE IF (WL.LT.4.25 .AND. WL.GE.3.75) THEN
           IW = 9
         ELSE IF (WL.LT.3.75 .AND. WL.GE.3.25) THEN
           IW = 8
         ELSE IF (WL.LT.3.25 .AND. WL.GE.2.75) THEN
           IW = 7
         ELSE IF (WL.LT.2.75 .AND. WL.GE.2.25) THEN
           IW = 6
         ELSE IF (WL.LT.2.25 .AND. WL.GE.1.75) THEN
           IW = 5
         ELSE IF (WL.LT.1.75 .AND. WL.GE.1.25) THEN
           IW = 4
         ELSE IF (WL.LT.1.25 .AND. WL.GE.0.75) THEN
           IW = 3
         ELSE IF (WL.LT.0.75 .AND. WL.GT.0.25) THEN
           IW = 2
         ELSE IF (WL.LE.0.25) THEN
           IW = 1
         END IF
         FX = (1. / Q(IW)) * Z**4 * EXP(Z) / ((EXP(Z) - 1.)**2)
         IF (MOD(I,2).EQ.0) THEN
           XI2 = XI2 + FX
         ELSE
           XI1 = XI1 + FX
         END IF
100    CONTINUE
       QI = H * (XI0 + 2.*XI2 + 4.*XI1) / 3.0
       QR = 1.0 / ((15. / (4. * PI**4)) * QI)
C
       RETURN
       END

ext: f

max_stars_repo_name: abagusetty/Uintah

max_issues_repo_name: abagusetty/Uintah

max_forks_repo_name: abagusetty/Uintah