2 c---------------------------------------------------------------------
3 c---------------------------------------------------------------------
7 c---------------------------------------------------------------------
8 c---------------------------------------------------------------------
10 c---------------------------------------------------------------------
11 c This function computes the left hand side for the three z-factors
12 c---------------------------------------------------------------------
19 c---------------------------------------------------------------------
21 c---------------------------------------------------------------------
23 c---------------------------------------------------------------------
24 c first fill the lhs for the u-eigenvalue
25 c---------------------------------------------------------------------
26 do j = start(2,c), cell_size(2,c)-end(2,c)-1
27 do i = start(1,c), cell_size(1,c)-end(1,c)-1
29 do k = start(3,c)-1, cell_size(3,c)-end(3,c)
30 ru1 = c3c4*rho_i(i,j,k,c)
32 rhos(k) = dmax1(dz4 + con43 * ru1,
38 do k = start(3,c), cell_size(3,c)-end(3,c)-1
39 lhs(i,j,k,1,c) = 0.0d0
40 lhs(i,j,k,2,c) = -dttz2 * cv(k-1) - dttz1 * rhos(k-1)
41 lhs(i,j,k,3,c) = 1.0 + c2dttz1 * rhos(k)
42 lhs(i,j,k,4,c) = dttz2 * cv(k+1) - dttz1 * rhos(k+1)
43 lhs(i,j,k,5,c) = 0.0d0
48 c---------------------------------------------------------------------
49 c add fourth order dissipation
50 c---------------------------------------------------------------------
51 if (start(3,c) .gt. 0) then
53 do j = start(2,c), cell_size(2,c)-end(2,c)-1
54 do i = start(1,c), cell_size(1,c)-end(1,c)-1
55 lhs(i,j,k,3,c) = lhs(i,j,k,3,c) + comz5
56 lhs(i,j,k,4,c) = lhs(i,j,k,4,c) - comz4
57 lhs(i,j,k,5,c) = lhs(i,j,k,5,c) + comz1
59 lhs(i,j,k+1,2,c) = lhs(i,j,k+1,2,c) - comz4
60 lhs(i,j,k+1,3,c) = lhs(i,j,k+1,3,c) + comz6
61 lhs(i,j,k+1,4,c) = lhs(i,j,k+1,4,c) - comz4
62 lhs(i,j,k+1,5,c) = lhs(i,j,k+1,5,c) + comz1
67 do k = 3*start(3,c), cell_size(3,c)-3*end(3,c)-1
68 do j = start(2,c), cell_size(2,c)-end(2,c)-1
69 do i = start(1,c), cell_size(1,c)-end(1,c)-1
70 lhs(i,j,k,1,c) = lhs(i,j,k,1,c) + comz1
71 lhs(i,j,k,2,c) = lhs(i,j,k,2,c) - comz4
72 lhs(i,j,k,3,c) = lhs(i,j,k,3,c) + comz6
73 lhs(i,j,k,4,c) = lhs(i,j,k,4,c) - comz4
74 lhs(i,j,k,5,c) = lhs(i,j,k,5,c) + comz1
79 if (end(3,c) .gt. 0) then
81 do j = start(2,c), cell_size(2,c)-end(2,c)-1
82 do i = start(1,c), cell_size(1,c)-end(1,c)-1
83 lhs(i,j,k,1,c) = lhs(i,j,k,1,c) + comz1
84 lhs(i,j,k,2,c) = lhs(i,j,k,2,c) - comz4
85 lhs(i,j,k,3,c) = lhs(i,j,k,3,c) + comz6
86 lhs(i,j,k,4,c) = lhs(i,j,k,4,c) - comz4
88 lhs(i,j,k+1,1,c) = lhs(i,j,k+1,1,c) + comz1
89 lhs(i,j,k+1,2,c) = lhs(i,j,k+1,2,c) - comz4
90 lhs(i,j,k+1,3,c) = lhs(i,j,k+1,3,c) + comz5
96 c---------------------------------------------------------------------
97 c subsequently, fill the other factors (u+c), (u-c)
98 c---------------------------------------------------------------------
99 do k = start(3,c), cell_size(3,c)-end(3,c)-1
100 do j = start(2,c), cell_size(2,c)-end(2,c)-1
101 do i = start(1,c), cell_size(1,c)-end(1,c)-1
102 lhs(i,j,k,1+5,c) = lhs(i,j,k,1,c)
103 lhs(i,j,k,2+5,c) = lhs(i,j,k,2,c) -
104 > dttz2 * speed(i,j,k-1,c)
105 lhs(i,j,k,3+5,c) = lhs(i,j,k,3,c)
106 lhs(i,j,k,4+5,c) = lhs(i,j,k,4,c) +
107 > dttz2 * speed(i,j,k+1,c)
108 lhs(i,j,k,5+5,c) = lhs(i,j,k,5,c)
109 lhs(i,j,k,1+10,c) = lhs(i,j,k,1,c)
110 lhs(i,j,k,2+10,c) = lhs(i,j,k,2,c) +
111 > dttz2 * speed(i,j,k-1,c)
112 lhs(i,j,k,3+10,c) = lhs(i,j,k,3,c)
113 lhs(i,j,k,4+10,c) = lhs(i,j,k,4,c) -
114 > dttz2 * speed(i,j,k+1,c)
115 lhs(i,j,k,5+10,c) = lhs(i,j,k,5,c)