Skip to content

Commit f212976

Browse files
drjfloyddrjfloyd
authored
Merge pull request #15585 from drjfloyd/master
FDS Source: trying to fix flux mw.
2 parents 98dd89e + ff65161 commit f212976

File tree

2 files changed

+71
-201
lines changed

2 files changed

+71
-201
lines changed

‎Source/func.f90‎

Lines changed: 0 additions & 153 deletions
Original file line numberDiff line numberDiff line change
@@ -1451,159 +1451,6 @@ END FUNCTION MP5
14511451
END SUBROUTINE GET_SCALAR_FACE_VALUE
14521452

14531453

1454-
SUBROUTINE GET_SCALAR_FACE_COEF(A,U,BF,I1,I2,J1,J2,K1,K2,IOR,LIMITER)
1455-
1456-
USE GLOBAL_CONSTANTS, ONLY: CENTRAL_LIMITER,GODUNOV_LIMITER,SUPERBEE_LIMITER,CHARM_LIMITER
1457-
1458-
REAL(EB), INTENT(IN) :: A(0:,0:,0:),U(-1:,-1:,-1:)
1459-
REAL(EB), INTENT(INOUT) :: BF(0:,0:,0:)
1460-
INTEGER, INTENT(IN) :: LIMITER,I1,I2,J1,J2,K1,K2,IOR
1461-
REAL(EB) :: R,B,DU_UP,DU_LOC
1462-
INTEGER :: I,J,K,IM1,JM1,KM1,IP1,JP1,KP1,IP2,JP2,KP2
1463-
1464-
SELECT CASE(LIMITER)
1465-
CASE(GODUNOV_LIMITER,CENTRAL_LIMITER)
1466-
BF=0._EB
1467-
RETURN
1468-
END SELECT
1469-
1470-
SELECT CASE(IOR)
1471-
CASE(1) ; IM1=-1 ; JM1= 0 ; KM1= 0 ; IP1=1 ; JP1=0 ; KP1=0 ; IP2=2 ; JP2=0 ; KP2=0
1472-
CASE(2) ; IM1= 0 ; JM1=-1 ; KM1= 0 ; IP1=0 ; JP1=1 ; KP1=0 ; IP2=0 ; JP2=2 ; KP2=0
1473-
CASE(3) ; IM1= 0 ; JM1= 0 ; KM1=-1 ; IP1=0 ; JP1=0 ; KP1=1 ; IP2=0 ; JP2=0 ; KP2=2
1474-
END SELECT
1475-
1476-
!$OMP PARALLEL DEFAULT(NONE) IF(I2>1) &
1477-
!$OMP& SHARED(U,A,BF,I1,I2,J1,J2,K1,K2,IP1,JP1,KP1,IM1,JM1,KM1,IP2,JP2,KP2,LIMITER) &
1478-
!$OMP& PRIVATE(I,J,K,DU_UP,DU_LOC,B,R)
1479-
1480-
SELECT CASE (LIMITER)
1481-
1482-
CASE (SUPERBEE_LIMITER)
1483-
!$OMP DO COLLAPSE(3) SCHEDULE(STATIC)
1484-
DO K=K1,K2
1485-
DO J=J1,J2
1486-
DO I=I1,I2
1487-
DU_LOC = U(I+IP1,J+JP1,K+KP1) - U(I,J,K)
1488-
IF (A(I,J,K) > 0._EB) THEN
1489-
DU_UP = U(I,J,K) - U(I+IM1,J+JM1,K+KM1)
1490-
ELSE
1491-
DU_UP = U(I+IP2,J+JP2,K+KP2) - U(I+IP1,J+JP1,K+KP1)
1492-
ENDIF
1493-
R = 0._EB ; B = 0._EB
1494-
IF (ABS(DU_LOC) > TWO_EPSILON_EB) R = DU_UP/DU_LOC
1495-
IF (R > TWO_EPSILON_EB) B = MAX(0._EB, MIN(2._EB*R,1._EB), MIN(R,2._EB))
1496-
BF(I,J,K) = MAX(0._EB, MIN(B, BF(I,J,K)))
1497-
ENDDO
1498-
ENDDO
1499-
ENDDO
1500-
!$OMP END DO
1501-
1502-
CASE (CHARM_LIMITER)
1503-
!$OMP DO COLLAPSE(3) SCHEDULE(STATIC)
1504-
DO K=K1,K2
1505-
DO J=J1,J2
1506-
DO I=I1,I2
1507-
DU_LOC = U(I+IP1,J+JP1,K+KP1) - U(I,J,K)
1508-
IF (A(I,J,K) > 0._EB) THEN
1509-
DU_UP = U(I,J,K) - U(I+IM1,J+JM1,K+KM1)
1510-
ELSE
1511-
DU_UP = U(I+IP2,J+JP2,K+KP2) - U(I+IP1,J+JP1,K+KP1)
1512-
ENDIF
1513-
R = 0._EB ; B = 0._EB
1514-
IF (ABS(DU_UP) > TWO_EPSILON_EB) R = DU_LOC/DU_UP
1515-
IF (R > TWO_EPSILON_EB) B = R*(3._EB*R+1._EB)/((R+1._EB)**2)
1516-
BF(I,J,K) = MAX(0._EB, MIN(B, BF(I,J,K)))
1517-
ENDDO
1518-
ENDDO
1519-
ENDDO
1520-
!$OMP END DO
1521-
1522-
END SELECT
1523-
!$OMP END PARALLEL
1524-
1525-
END SUBROUTINE GET_SCALAR_FACE_COEF
1526-
1527-
1528-
SUBROUTINE GET_SCALAR_FACE_VALUE_NEW(A,U,F,BF,I1,I2,J1,J2,K1,K2,IOR,LIMITER)
1529-
1530-
USE GLOBAL_CONSTANTS, ONLY: CENTRAL_LIMITER,GODUNOV_LIMITER,SUPERBEE_LIMITER,CHARM_LIMITER
1531-
1532-
REAL(EB), INTENT(IN) :: A(0:,0:,0:),U(-1:,-1:,-1:),BF(0:,0:,0:)
1533-
REAL(EB), INTENT(OUT) :: F(0:,0:,0:)
1534-
INTEGER, INTENT(IN) :: LIMITER,I1,I2,J1,J2,K1,K2,IOR
1535-
REAL(EB) :: DU_UP,DU_LOC
1536-
INTEGER :: I,J,K,IM1,JM1,KM1,IP1,JP1,KP1,IP2,JP2,KP2
1537-
1538-
SELECT CASE(IOR)
1539-
CASE(1) ; IM1=-1 ; JM1= 0 ; KM1= 0 ; IP1=1 ; JP1=0 ; KP1=0 ; IP2=2 ; JP2=0 ; KP2=0
1540-
CASE(2) ; IM1= 0 ; JM1=-1 ; KM1= 0 ; IP1=0 ; JP1=1 ; KP1=0 ; IP2=0 ; JP2=2 ; KP2=0
1541-
CASE(3) ; IM1= 0 ; JM1= 0 ; KM1=-1 ; IP1=0 ; JP1=0 ; KP1=1 ; IP2=0 ; JP2=0 ; KP2=2
1542-
END SELECT
1543-
1544-
!$OMP PARALLEL IF(I2>1)
1545-
SELECT CASE(LIMITER)
1546-
CASE(CENTRAL_LIMITER) ! central differencing
1547-
!$OMP DO SCHEDULE(STATIC)
1548-
DO K=K1,K2
1549-
DO J=J1,J2
1550-
DO I=I1,I2
1551-
F(I,J,K) = 0.5_EB*(U(I,J,K) + U(I+IP1,J+JP1,K+KP1))
1552-
ENDDO
1553-
ENDDO
1554-
ENDDO
1555-
!$OMP END DO
1556-
CASE(GODUNOV_LIMITER) ! first-order upwinding
1557-
!$OMP DO SCHEDULE(STATIC)
1558-
DO K=K1,K2
1559-
DO J=J1,J2
1560-
DO I=I1,I2
1561-
IF (A(I,J,K)>0._EB) THEN
1562-
F(I,J,K) = U(I,J,K)
1563-
ELSE
1564-
F(I,J,K) = U(I+IP1,J+JP1,K+KP1)
1565-
ENDIF
1566-
ENDDO
1567-
ENDDO
1568-
ENDDO
1569-
!$OMP END DO
1570-
CASE(SUPERBEE_LIMITER) ! SUPERBEE, Roe (1986)
1571-
!$OMP DO SCHEDULE(STATIC) PRIVATE(DU_LOC)
1572-
DO K=K1,K2
1573-
DO J=J1,J2
1574-
DO I=I1,I2
1575-
DU_LOC = U(I+IP1,J+JP1,K+KP1)-U(I,J,K)
1576-
IF (A(I,J,K)>0._EB) THEN
1577-
F(I,J,K) = U(I,J,K) + 0.5_EB*BF(I,J,K)*DU_LOC
1578-
ELSE
1579-
F(I,J,K) = U(I+IP1,J+JP1,K+KP1) - 0.5_EB*BF(I,J,K)*DU_LOC
1580-
ENDIF
1581-
ENDDO
1582-
ENDDO
1583-
ENDDO
1584-
!$OMP END DO
1585-
CASE(CHARM_LIMITER) ! CHARM
1586-
!$OMP DO SCHEDULE(STATIC) PRIVATE(DU_UP)
1587-
DO K=K1,K2
1588-
DO J=J1,J2
1589-
DO I=I1,I2
1590-
IF (A(I,J,K)>0._EB) THEN
1591-
DU_UP = U(I,J,K)-U(I+IM1,J+JM1,K+KM1)
1592-
F(I,J,K) = U(I,J,K) + 0.5_EB*BF(I,J,K)*DU_UP
1593-
ELSE
1594-
DU_UP = U(I+IP2,J+JP2,K+KP2)-U(I+IP1,J+JP1,K+KP1)
1595-
F(I,J,K) = U(I+IP1,J+JP1,K+KP1) - 0.5_EB*BF(I,J,K)*DU_UP
1596-
ENDIF
1597-
ENDDO
1598-
ENDDO
1599-
ENDDO
1600-
!$OMP END DO
1601-
END SELECT
1602-
!$OMP END PARALLEL
1603-
1604-
END SUBROUTINE GET_SCALAR_FACE_VALUE_NEW
1605-
1606-
16071454
!> \brief Random fluctuation, Theta'(t+dt) = R^2*Theta'(t) + Normal(0,sqrt(1-R^2)*SIGMA) ; R = exp(-dt/TAU)
16081455
!> \param SIGMA Standard deviation of time series
16091456
!> \param TAU Time scale or period of the time function (s)

0 commit comments

Comments
 (0)