-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathSEM_module.f90
132 lines (111 loc) · 5.85 KB
/
SEM_module.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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
!------------------------------------------------------------------------------!
! !
! PROGRAM : SEM_module.f90 !
! !
! PURPOSE : Module for SEM inflow generator !
! !
! 2017.03.02 K.Noh !
! !
! VARIABLES : dt : Time step !
! N : The number of eddies !
! SIGMA : Eddy length scale !
! V_b : Volume of box including eddies !
! Nt : The number of iterations !
! !
! Y,Z : Y,Z coordinates !
! U,V,W : Mean velocity arrays !
! T : Mean temperature arrays !
! RS : Reynolds stress !
! SEM_EDDY : Each eddies properties including positions, !
! intensities, length scales. !
! U,V,W,T_INLET : Stochastic components of inflow surface !
! U,V,W,T_COMB : Reconstructed components of inflow !
! !
! U_c : Local convection velocities !
! U_pr : Mean profiles (U,V,W,T) !
! rms_pr : Reynolds stress profiles (uu,vv,ww,tt,uv,ut,vt,wt) !
! !
!------------------------------------------------------------------------------!
MODULE SEM_module
IMPLICIT NONE
TYPE EDDY_CHAR
INTEGER :: eddy_num ! Eddy specification number
REAL(KIND=8) :: eddy_len ! Eddy length scale
REAL(KIND=8) :: X_pos ! Eddy's X position
REAL(KIND=8) :: Y_pos ! Eddy's Y position
REAL(KIND=8) :: Z_pos ! Eddy's Z position
REAL(KIND=8) :: X_int ! Eddy's X intensity
REAL(KIND=8) :: Y_int ! Eddy's Y intensity
REAL(KIND=8) :: Z_int ! Eddy's Z intensity
REAL(KIND=8) :: T_int ! Eddy's T intensity
END TYPE EDDY_CHAR
INTEGER :: N, Ny, Nz, Nt, OUT_NUM
REAL(KIND=8) :: dt, SIGMA, V_b, time, eps
CHARACTER(LEN=65) :: file_name, dir_name, path_name
REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: Y,Z
REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE :: U,V,W,T, &
U_INLET,V_INLET,W_INLET, &
U_COMB,V_COMB,W_COMB, &
T_INLET, T_COMB, &
U_pr, rms_pr, U_c
REAL(KIND=8),DIMENSION(:,:,:),ALLOCATABLE :: RS, THS
TYPE(EDDY_CHAR),DIMENSION(:),ALLOCATABLE :: SEM_EDDY
CONTAINS
!--------------------------------------------------------------------!
! Intensity determination Function !
!--------------------------------------------------------------------!
FUNCTION INTENSITY_det(x_int)
REAL(KIND=8) :: INTENSITY_det
REAL(KIND=8),INTENT(IN) :: x_int
IF ( x_int > 0 ) THEN
INTENSITY_det = 1
ELSE
INTENSITY_det = -1
END IF
END FUNCTION INTENSITY_det
!--------------------------------------------------------------------!
! Cholesky Decomposition Function !
!--------------------------------------------------------------------!
SUBROUTINE CHOL(A,R,N)
IMPLICIT NONE
INTEGER,INTENT(IN) :: N
REAL(KIND=8),INTENT(OUT) :: A(N,N)
REAL(KIND=8),INTENT(IN) :: R(N,N)
INTEGER :: i,j,k
A(1:N,1:N) = 0.0
DO i = 1,N
DO j = 1,i
A(i,j) = R(i,j)
IF (i==j) THEN
DO k = 1,j-1
A(i,j) = A(i,j) - A(j,k)**2
END DO
A(i,j) = sqrt(abs(A(i,j)))
ELSE
DO k = 1,j-1
A(i,j) = A(i,j) - A(i,k)*A(j,k)
END DO
A(i,j) = A(i,j)/(A(j,j) + eps)
END IF
END DO
END DO
END SUBROUTINE
!--------------------------------------------------------------------!
! Matrix multiplication function !
!--------------------------------------------------------------------!
SUBROUTINE MAT_MUL(A,B,AB,Ni,Nj,Nk)
IMPLICIT NONE
INTEGER,INTENT(IN) :: Ni,Nj,Nk
REAL(KIND=8) :: AB(Ni,Nj)
REAL(KIND=8),INTENT(IN) :: A(Ni,Nk),B(Nk,Nj)
INTEGER :: i,j,k
AB(1:Ni,1:Nj) = 0.0
DO i = 1,Ni
DO j = 1,Nj
DO k = 1,Nk
AB(i,j) = AB(i,j) + A(i,k)*B(k,j)
END DO
END DO
END DO
END SUBROUTINE
END MODULE