1 | include(dom.inc)
2 |
3 | SUBROUTINE TAB_CASE(celldata,kabs,wquad,allkabs,DY,nY,DT,nT,nquad,&
4 | & ntcells)
5 |
6 | DOM_INT :: nY,nT,nquad,ntcells
7 | DOM_REAL:: DY,DT
8 | DOM_INT :: iq,icell,i
9 | DOM_REAL, DIMENSION(ntcells,8) :: celldata
10 | DOM_INT, DIMENSION(8,ntcells) :: bornes
11 | DOM_REAL, DIMENSION(nquad,ntcells) :: kabs
12 | DOM_REAL, DIMENSION(nY,nY,nY,nT,nquad) :: allkabs
13 | DOM_REAL, DIMENSION(16,ntcells) :: d
14 | DOM_REAL, DIMENSION(ntcells) :: norm
15 |
16 | DOM_REAL, PARAMETER :: x_min=0.0
17 | DOM_REAL, PARAMETER :: x_max=1.0
18 | DOM_REAL, dimension(nquad) :: x_pts,wquad
19 |
20 | CALL gauleg(x_min,x_max,x_pts,wquad,nquad)
21 |
22 | bornes(1,:) = int((celldata(:,1)-400.d0)/DT)+1
23 | bornes(3:5,:) = int(celldata(:,3:5)/DY)+1
24 |
25 | DO icell=1,ntcells
26 |
27 | IF( modulo(celldata(icell,1)-400.d0,DT).eq.0.) THEN
28 | bornes(2,icell) = bornes(1,icell)
29 | ELSE
30 | bornes(2,icell) = bornes(1,icell)+1
31 | ENDIF
32 |
33 | DO i=0,2
34 | IF( modulo(celldata(icell,3+i),DY).eq.0.) THEN
35 | bornes(6+i,icell) = bornes(3+i,icell)
36 | ELSE
37 | bornes(6+i,icell) = bornes(3+i,icell)+1
38 | ENDIF
39 |
40 | ENDDO
41 |
42 | ENDDO
43 |
44 | !ATTENTION A CELLDATA DANS LE MAUVAIS ORDRE !!!!!
45 | ! d(1,:) = sqrt(
46 | ! &(celldata(1,:)-bornes(1,:))**2.d0 +
47 | ! &(celldata(3,:)-bornes(3,:))**2.d0 +
48 | ! &(celldata(4,:)-bornes(4,:))**2.d0 +
49 | ! &(celldata(5,:)-bornes(5,:))**2.d0 )
50 | !
51 | ! d(2,:) = sqrt(
52 | ! &(celldata(1,:)-bornes(2,:))**2.d0 +
53 | ! &(celldata(3,:)-bornes(3,:))**2.d0 +
54 | ! &(celldata(4,:)-bornes(4,:))**2.d0 +
55 | ! &(celldata(5,:)-bornes(5,:))**2.d0 )
56 | !
57 | ! d(3,:) = sqrt(
58 | ! &(celldata(1,:)-bornes(1,:))**2.d0 +
59 | ! &(celldata(3,:)-bornes(6,:))**2.d0 +
60 | ! &(celldata(4,:)-bornes(4,:))**2.d0 +
61 | ! &(celldata(5,:)-bornes(5,:))**2.d0 )
62 | !
63 | ! d(4,:) = sqrt(
64 | ! &(celldata(1,:)-bornes(2,:))**2.d0 +
65 | ! &(celldata(3,:)-bornes(6,:))**2.d0 +
66 | ! &(celldata(4,:)-bornes(4,:))**2.d0 +
67 | ! &(celldata(5,:)-bornes(5,:))**2.d0 )
68 | !
69 | ! d(5,:) = sqrt(
70 | ! &(celldata(1,:)-bornes(1,:))**2.d0 +
71 | ! &(celldata(3,:)-bornes(3,:))**2.d0 +
72 | ! &(celldata(4,:)-bornes(7,:))**2.d0 +
73 | ! &(celldata(5,:)-bornes(5,:))**2.d0 )
74 | !
75 | ! d(6,:) = sqrt(
76 | ! &(celldata(1,:)-bornes(2,:))**2.d0 +
77 | ! &(celldata(3,:)-bornes(3,:))**2.d0 +
78 | ! &(celldata(4,:)-bornes(7,:))**2.d0 +
79 | ! &(celldata(5,:)-bornes(5,:))**2.d0 )
80 | !
81 | ! d(7,:) = sqrt(
82 | ! &(celldata(1,:)-bornes(1,:))**2.d0 +
83 | ! &(celldata(3,:)-bornes(6,:))**2.d0 +
84 | ! &(celldata(4,:)-bornes(7,:))**2.d0 +
85 | ! &(celldata(5,:)-bornes(5,:))**2.d0 )
86 | !
87 | ! d(8,:) = sqrt(
88 | ! &(celldata(1,:)-bornes(2,:))**2.d0 +
89 | ! &(celldata(3,:)-bornes(6,:))**2.d0 +
90 | ! &(celldata(4,:)-bornes(7,:))**2.d0 +
91 | ! &(celldata(5,:)-bornes(5,:))**2.d0 )
92 | !
93 | ! d(9,:) = sqrt(
94 | ! &(celldata(1,:)-bornes(1,:))**2.d0 +
95 | ! &(celldata(3,:)-bornes(3,:))**2.d0 +
96 | ! &(celldata(4,:)-bornes(4,:))**2.d0 +
97 | ! &(celldata(5,:)-bornes(8,:))**2.d0 )
98 | !
99 | ! d(10,:) = sqrt(
100 | ! &(celldata(1,:)-bornes(2,:))**2.d0 +
101 | ! &(celldata(3,:)-bornes(3,:))**2.d0 +
102 | ! &(celldata(4,:)-bornes(4,:))**2.d0 +
103 | ! &(celldata(5,:)-bornes(8,:))**2.d0 )
104 | !
105 | ! d(11,:) = sqrt(
106 | ! &(celldata(1,:)-bornes(1,:))**2.d0 +
107 | ! &(celldata(3,:)-bornes(6,:))**2.d0 +
108 | ! &(celldata(4,:)-bornes(4,:))**2.d0 +
109 | ! &(celldata(5,:)-bornes(8,:))**2.d0 )
110 | !
111 | ! d(12,:) = sqrt(
112 | ! &(celldata(1,:)-bornes(2,:))**2.d0 +
113 | ! &(celldata(3,:)-bornes(6,:))**2.d0 +
114 | ! &(celldata(4,:)-bornes(4,:))**2.d0 +
115 | ! &(celldata(5,:)-bornes(8,:))**2.d0 )
116 | !
117 | ! d(13,:) = sqrt(
118 | ! &(celldata(1,:)-bornes(1,:))**2.d0 +
119 | ! &(celldata(3,:)-bornes(3,:))**2.d0 +
120 | ! &(celldata(4,:)-bornes(7,:))**2.d0 +
121 | ! &(celldata(5,:)-bornes(8,:))**2.d0 )
122 | !
123 | ! d(14,:) = sqrt(
124 | ! &(celldata(1,:)-bornes(2,:))**2.d0 +
125 | ! &(celldata(3,:)-bornes(3,:))**2.d0 +
126 | ! &(celldata(4,:)-bornes(7,:))**2.d0 +
127 | ! &(celldata(5,:)-bornes(8,:))**2.d0 )
128 | !
129 | ! d(15,:) = sqrt(
130 | ! &(celldata(1,:)-bornes(1,:))**2.d0 +
131 | ! &(celldata(3,:)-bornes(6,:))**2.d0 +
132 | ! &(celldata(4,:)-bornes(7,:))**2.d0 +
133 | ! &(celldata(5,:)-bornes(8,:))**2.d0 )
134 | !
135 | ! d(16,:) = sqrt(
136 | ! &(celldata(1,:)-bornes(2,:))**2.d0 +
137 | ! &(celldata(3,:)-bornes(6,:))**2.d0 +
138 | ! &(celldata(4,:)-bornes(7,:))**2.d0 +
139 | ! &(celldata(5,:)-bornes(8,:))**2.d0 )
140 | !
141 | ! norm =0
142 | ! DO i=1,16
143 | ! norm(:) = norm(:) + 1/d(i,:)
144 | ! ENDDO
145 |
146 | d(:,:) = 16.d0
147 | norm = 1.d0
148 |
149 | DO icell = 1,ntcells
150 | DO iq=1,nquad
151 | kabs(iq,icell) =
152 | & allkabs(bornes(3,icell),bornes(4,icell),bornes(5,icell),
153 | & bornes(1,icell),iq)/d(1,icell) +
154 | & allkabs(bornes(3,icell),bornes(4,icell),bornes(5,icell),
155 | & bornes(2,icell),iq)/d(2,icell) +
156 | & allkabs(bornes(6,icell),bornes(4,icell),bornes(5,icell),
157 | & bornes(1,icell),iq)/d(3,icell) +
158 | & allkabs(bornes(6,icell),bornes(4,icell),bornes(5,icell),
159 | & bornes(2,icell),iq)/d(4,icell) +
160 | & allkabs(bornes(3,icell),bornes(7,icell),bornes(5,icell),
161 | & bornes(1,icell),iq)/d(5,icell) +
162 | & allkabs(bornes(3,icell),bornes(7,icell),bornes(5,icell),
163 | & bornes(2,icell),iq)/d(6,icell) +
164 | & allkabs(bornes(6,icell),bornes(7,icell),bornes(5,icell),
165 | & bornes(1,icell),iq)/d(7,icell) +
166 | & allkabs(bornes(6,icell),bornes(7,icell),bornes(5,icell),
167 | & bornes(2,icell),iq)/d(8,icell) +
168 | & allkabs(bornes(3,icell),bornes(4,icell),bornes(8,icell),
169 | & bornes(1,icell),iq)/d(9,icell) +
170 | & allkabs(bornes(3,icell),bornes(4,icell),bornes(8,icell),
171 | & bornes(2,icell),iq)/d(10,icell) +
172 | & allkabs(bornes(6,icell),bornes(4,icell),bornes(8,icell),
173 | & bornes(1,icell),iq)/d(11,icell) +
174 | & allkabs(bornes(6,icell),bornes(4,icell),bornes(8,icell),
175 | & bornes(2,icell),iq)/d(12,icell) +
176 | & allkabs(bornes(3,icell),bornes(7,icell),bornes(8,icell),
177 | & bornes(1,icell),iq)/d(13,icell) +
178 | & allkabs(bornes(3,icell),bornes(7,icell),bornes(8,icell),
179 | & bornes(2,icell),iq)/d(14,icell) +
180 | & allkabs(bornes(6,icell),bornes(7,icell),bornes(8,icell),
181 | & bornes(1,icell),iq)/d(15,icell) +
182 | & allkabs(bornes(6,icell),bornes(7,icell),bornes(8,icell),
183 | & bornes(2,icell),iq)/d(16,icell)
184 | ENDDO
185 | kabs(:,icell) = kabs(:,icell)/norm(icell)
186 | ENDDO
187 |
188 | END SUBROUTINE TAB_CASE