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