39
40
41
42 USE sensor_mod
43
44
45
46#include "implicit_f.inc"
47
48
49
50#include "mvsiz_p.inc"
51
52
53
54#include "param_c.inc"
55#include "vect01_c.inc"
56
57
58
59
61 . partsav(npsav,*), eint(*), rho(*), rk(*), vol(*),
62 . vxa(*), vya(*), vza(*), va2(*),
63 . vnew(*), gresav(*), off(mvsiz), eintth(*), fill(*),
64 . xx(*), yy(*), zz(*),
65 . xx2(mvsiz), yy2(mvsiz), zz2(mvsiz),
66 . xy(mvsiz), yz(mvsiz), zx(mvsiz)
67 INTEGER IEXPAN,ITASK,
68 . (*),GRTH(*),IGRTH(*),IPARG(*)
69 my_real,
INTENT(IN) :: offg(mvsiz)
70 type (sensors_),INTENT(INOUT) :: SENSORS
71 INTEGER, INTENT(IN) :: NEL,G_WPLA
72 my_real,
DIMENSION(NEL*G_WPLA),
INTENT(IN) :: wpla
73
74
75
76 INTEGER I, M, FLAG
77
79 . xmas(mvsiz),
80 . ei(mvsiz) , ek(mvsiz),
81 . xm(mvsiz) , ym(mvsiz) , zm(mvsiz),
82 . xcg(mvsiz), ycg(mvsiz), zcg(mvsiz),
83 . xxm(mvsiz), yym(mvsiz), zzm(mvsiz),
84 . ixx(mvsiz), iyy(mvsiz), izz(mvsiz),
85 . ixy(mvsiz), iyz(mvsiz), izx(mvsiz),
86 . rei(mvsiz), rek(mvsiz), off_l(mvsiz)
87
88 flag = iparg(80)
89
90
91
92 DO i=lft,llt
93 vxa(i) = vxa(i)*one_over_6
94 vya(i) = vya(i)*one_over_6
95 vza(i) = vza(i)*one_over_6
96 va2(i) = va2(i)*one_over_6
97 ENDDO
98
99 DO i=lft,llt
100 xmas(i)=fill(i)*rho(i)*vnew(i)
101 ei(i) = fill(i)*eint(i)*vol(i)
102 ek(i) = xmas(i)*va2(i)*half
103 xm(i) = xmas(i)*vxa(i)
104 ym(i) = xmas(i)*vya(i)
105 zm(i) = xmas(i)*vza(i)
106 ENDDO
107
108 DO i=lft,llt
109 m=iparts(i)
110 partsav(1,m)=partsav(1,m) + ei(i)
111 partsav(2,m)=partsav(2,m) + ek(i)
112 partsav(3,m)=partsav(3,m) + xm(i)
113 partsav(4,m)=partsav(4,m) + ym(i)
114 partsav(5,m)=partsav(5,m) + zm(i)
115 IF (offg(i) >= one) partsav(6,m)=partsav(6,m) + xmas(i)
116 IF (g_wpla > 0) partsav(29,m)=partsav(29,m) + wpla(i)
117 END DO
118
119
120
121
122 IF(flag==1) THEN
123 DO i=lft,llt
124 xx(i) = xx(i)*one_over_6
125 yy(i) = yy(i)*one_over_6
126 zz(i) = zz(i)*one_over_6
127 xy(i) = xy(i)*one_over_6
128 yz(i) = yz(i)*one_over_6
129 zx(i) = zx(i)*one_over_6
130 xx2(i)= xx2(i)*one_over_6
131 yy2(i)= yy2(i)*one_over_6
132 zz2(i)= zz2(i)*one_over_6
133 ENDDO
134
135 DO i=lft,llt
136 xcg(i)= xmas(i)*xx(i)
137 ycg(i)= xmas(i)*yy(i)
138 zcg(i)= xmas(i)*zz(i)
139 ixy(i)= -xmas(i)*xy(i)
140 iyz(i)= -xmas(i)*yz(i)
141 izx(i)= -xmas(i)*zx(i)
142 ixx(i)= xmas(i)*(yy2(i) + zz2(i))
143 iyy(i)= xmas(i)*(zz2(i) + xx2(i))
144 izz(i)= xmas(i)*(xx2(i) + yy2(i))
145 xxm(i)= vza(i)*ycg(i)-vya(i)*zcg(i)
146 yym(i)= vxa(i)*zcg(i)-vza(i)*xcg(i)
147 zzm(i)= vya(i)*xcg(i)-vxa(i)*ycg(i)
148 rei(i)= zero
149 rek(i)= zero
150 ENDDO
151
152 DO i=lft,llt
153 IF(off(i) < one) cycle
154 m=iparts(i)
155 partsav(9,m) =partsav(9,m) + xcg(i)
156 partsav(10,m)=partsav(10,m) + ycg(i)
157 partsav(11,m)=partsav(11,m) + zcg(i)
158 partsav(12,m)=partsav(12,m) + xxm(i)
159 partsav(13,m)=partsav(13,m) + yym(i)
160 partsav(14,m)=partsav(14,m) + zzm(i)
161 partsav(15,m)=partsav(15,m) + ixx(i)
162 partsav(16,m)=partsav(16,m) + iyy(i)
163 partsav(17,m)=partsav(17,m) + izz(i)
164 partsav(18,m)=partsav(18,m) + ixy(i)
165 partsav(19,m)=partsav(19,m) + iyz(i)
166 partsav(20,m)=partsav(20,m) + izx(i)
167 partsav(21,m)=partsav(21,m) + rei(i)
168 partsav(22,m)=partsav(22,m) + rek(i)
169
170
171 END DO
172 ENDIF
173
174
175 IF (igre /= 0) THEN
176 CALL grelem_sav(lft ,llt ,gresav,igrth ,grth ,
177 2 off ,ei ,ek ,xm ,ym ,
178 3 zm ,xmas ,xcg ,ycg ,zcg ,
179 4 xxm ,yym ,zzm ,ixx ,iyy ,
180 5 izz ,ixy ,iyz ,izx ,rei ,
181 6 rek ,flag )
182 ENDIF
183
184
185 IF(jtur/=0)THEN
186 DO 50 i=lft,llt
187 m=iparts(i)
188 partsav(7,m)=partsav(7,m) + rk(i)*vol(i)
189 50 CONTINUE
190 ENDIF
191
192 IF(iexpan/=0)THEN
193 DO i=lft,llt
194 m=iparts(i)
195 partsav(27,m)=partsav(27,m) + eintth(i)*vol(i)
196 ENDDO
197 ENDIF
198
199 DO i=lft,llt
200 IF(off(i) < one) THEN
201 off_l(i) = zero
202 ELSE
203 off_l(i) = one
204 ENDIF
205 ENDDO
206
207 DO i = lft,llt
208 m=iparts(i)
209 IF (offg(i) < one) THEN
210 partsav(25,m) = partsav(25,m) + one
211 ENDIF
212 ENDDO
213
215
216 RETURN
subroutine grelem_sav(jft, jlt, gresav, igrth, grth, off, ei, ek, xm, ym, zm, xmas, xcg, ycg, zcg, xxm, yym, zzm, ixx, iyy, izz, ixy, iyz, izx, rei, rek, flag)
subroutine sensor_energy_bilan(jft, jlt, ei, ek, off, ipart, itask, sensors)