-
Notifications
You must be signed in to change notification settings - Fork 0
/
m_misc.f90
executable file
·118 lines (82 loc) · 2.88 KB
/
m_misc.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Module containing miscellaneous subroutines
!
! Last update: January 21, 2010
! Author: Keita Ando
! Department of Mechanical Engineering
! Division of Engineering and Applied Science
! California Institute of Technology, Pasadena CA 91125
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE m_misc
USE m_globalvar
USE mpi_setup
IMPLICIT NONE
CONTAINS
!========================================================================
SUBROUTINE s_quad( func,mom )
REAL(KIND(0.D0)), DIMENSION(NR0), INTENT(IN) :: func
REAL(KIND(0.D0)), INTENT(OUT) :: mom
mom = DOT_PRODUCT( weight,func )
END SUBROUTINE s_quad
!========================================================================
SUBROUTINE s_comp_n( vftmp,nRtmp,ntmp )
REAL(KIND(0.D0)), INTENT(IN) :: vftmp
REAL(KIND(0.D0)), DIMENSION(NR0), INTENT(IN) :: nRtmp
REAL(KIND(0.D0)), INTENT(OUT) :: ntmp
REAL(KIND(0.D0)) :: nR3
CALL s_quad( nRtmp**3,nR3 )
ntmp = DSQRT( pi43*nR3/vftmp )
END SUBROUTINE s_comp_n
!========================================================================
SUBROUTINE s_NaN_rhs( qgvn )
TYPE(coordinate), DIMENSION(Nv), INTENT(IN) :: qgvn
INTEGER :: i
INTEGER :: iv
DO i = i_nopad_mn,i_nopad_mx
DO iv = 1,Nv
IF ( qgvn(iv)%f(i)/=qgvn(iv)%f(i) ) THEN
PRINT*, 'NaN in flux (w/o ptilde) at (i,it,iv):', i, it, iv
PRINT*, 'x =', xgrid(i)
PRINT*, 'mpi_rank =', mpi_rank
PRINT*, 'Computation stopped.'
STOP
END IF
END DO
END DO
END SUBROUTINE s_NaN_rhs
!========================================================================
SUBROUTINE s_NaN_src( qgvn )
TYPE(coordinate), DIMENSION(Nv), INTENT(IN) :: qgvn
INTEGER :: i
INTEGER :: iv
DO i = i_nopad_mn,i_nopad_mx
DO iv = 1,Nv
IF ( qgvn(iv)%f(i)/=qgvn(iv)%f(i) ) THEN
PRINT*, 'NaN in sources (w/ ptilde) at (i,it,iv):', i, it, iv
PRINT*, 'x =', xgrid(i)
PRINT*, 'mpi_rank =', mpi_rank
PRINT*, 'Computation stopped.'
STOP
END IF
END DO
END DO
END SUBROUTINE s_NaN_src
!========================================================================
SUBROUTINE s_check_sign( qgvn )
TYPE(coordinate), DIMENSION(Nv), INTENT(IN) :: qgvn
INTEGER :: i
INTEGER :: iv
DO i = i_nopad_mn,i_nopad_mx
DO iv = Nveul,Nveul+1
IF ( qgvn(iv)%f(i)<0.D0 ) THEN
PRINT*, 'Negative sign at (i,it,iv):', i, it, iv
PRINT*, 'x =', xgrid(i)
PRINT*, 'mpi_rank =', mpi_rank
END IF
END DO
END DO
END SUBROUTINE s_check_sign
!========================================================================
END MODULE m_misc