-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathmapc.f90
executable file
·143 lines (110 loc) · 2.48 KB
/
mapc.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
133
134
135
136
137
138
139
140
141
142
143
module mod_map
use mod_cons
use mod_var
use mod_global
use mod_bou
implicit none
private
!public check_map_c,mapc,check_map_phi, mapphi
public check_map_phi, mapphi,check_map_c,mapc
contains
!
subroutine check_map_c
implicit none
integer i,j,k
! check the range of c to see if we need to use mapping
use_c_map=0.
phi_c_wb=0. !give them zero value
phi_c_diff=0.
outer2: do k=1,kmax
do j=1,jmax
do i=1,imax
if (Phi_c(i,j,k)<0.0 .or. Phi_c(i,j,k)>1.0) then
use_c_map=1
exit outer2
endif
enddo
enddo
enddo outer2
! then begin to use mapping
do k=1,kmax
do j=1,jmax
do i=1,imax
Phi_c_bstar(i,j,k)=PFM_phi(i,j,k)*PFM_c(i,j,k)
phi_c_wb = phi_c_wb + 1.0-(2.0*Phi_c_bstar(i,j,k)-1.0)**2
phi_c_diff = phi_c_diff + (Phi_c(i,j,k)-Phi_c_bstar(i,j,k))
enddo
enddo
enddo
!endif
return
end subroutine check_map_c
!
!
!
!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1
! to force phi_c back to the range of [-1,1]
subroutine mapc
implicit none
integer i,j,k
real coefficient
coefficient=Phi_c_diff/Phi_c_wb
do k=1,kmax
do j=1,jmax
do i=1,imax
Phi_c_b(i,j,k)=Phi_c_bstar(i,j,k) + (1.0-(2.0*Phi_c_bstar(i,j,k)-1.0)**2)*coefficient
enddo
enddo
enddo
return
end subroutine mapc
subroutine check_map_phi
implicit none
integer i,j,k
! check the range of c to see if we need to use mapping
use_phi_map=0.
phi_wb=0. !give them zero value
phi_diff=0.
outer1: do k=1,kmax
do j=1,jmax
do i=1,imax
if (PFM_phi(i,j,k)<0.0 .or. PFM_phi(i,j,k)>1.0) then
use_phi_map=1
exit outer1
endif
enddo
enddo
enddo outer1
! then begin to use mapping
do k=1,kmax
do j=1,jmax
do i=1,imax
! to get the phi_bstar value
phi_bstar(i,j,k)=MIN(MAX(PFM_phi(i,j,k), 0.0),1.0)
phi_wb = phi_wb + 1.0-(2.0*phi_bstar(i,j,k)-1.0)**2
phi_diff = phi_diff + (PFM_phi(i,j,k)-phi_bstar(i,j,k))
enddo
enddo
enddo
!endif
return
end subroutine check_map_phi
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1
!to force c back to the range of [-1,1]
subroutine mapphi
implicit none
integer i,j,k
real coefficient
coefficient=phi_diff/phi_wb
do k=1,kmax
do j=1,jmax
do i=1,imax
phi_b(i,j,k)=phi_bstar(i,j,k) + (1.0-(2.0*phi_bstar(i,j,k)-1.0)**2)*coefficient
enddo
enddo
enddo
return
end subroutine mapphi
end module mod_map