38
39
40
44 USE output_mod, ONLY : output_
45
46
47
48#include "implicit_f.inc"
49#include "comlock.inc"
50
51
52
53#include "com04_c.inc"
54#include "com06_c.inc"
55#include "com08_c.inc"
56#include "scr07_c.inc"
57#include "scr14_c.inc"
58#include "scr16_c.inc"
59#include "parit_c.inc"
60#include "param_c.inc"
61#include "scr18_c.inc"
62
63
64
65 TYPE(), INTENT(INOUT) :: OUTPUT
66 INTEGER KSURF,ISKY(*),NNC,(*)
68 . af(*) , x(3,*), v(3,*),bufsf(*),
69 . stifn(*), fs(nthvki),
70 . fcont(3,*),fskyi(lskyi,nfskyi), de,
71 . wnf(3,*) ,wtf(3,*) ,wns(*) ,
72 . fnormx,fnormy,fnormz,ftangx,ftangy,ftangz
73 TYPE(H3D_DATABASE) :: H3D_DATA
74 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
75
76
77
78 INTEGER ADRBUF, I, IN, I3, I2, I1
79 INTEGER NFORC , NISKYL
80 INTEGER NDEB, NREST
82 . rot(9), xk , yk, zk, fx, fy, fz, am1, am2, am3,
83 . fn1, fn2, fn3, ft1, ft2, ft3,
84 . stf, dd
85
86 adrbuf=igrsurf(ksurf)%IAD_BUFR
87 DO i=1,9
88 rot(i)=bufsf(adrbuf+7+i-1)
89 END DO
90
91
92
93 fn1=rot(1)*fnormx+rot(4)*fnormy+rot(7)*fnormz
94 fn2=rot(2)*fnormx+rot(5)*fnormy+rot(8)*fnormz
95 fn3=rot(3)*fnormx+rot(6)*fnormy+rot(9)*fnormz
96 fs(1)=fs(1)-fn1*dt1
97 fs(2)=fs(2)-fn2*dt1
98 fs(3)=fs(3)-fn3*dt1
99 ft1=rot(1)*ftangx+rot(4)*ftangy+rot(7)*ftangz
100 ft2=rot(2)*ftangx+rot(5)*ftangy+rot(8)*ftangz
101 ft3=rot(3)*ftangx+rot(6)*ftangy+rot(9)*ftangz
102 fs(4)=fs(4)-ft1*dt1
103 fs(5)=fs(5)-ft2*dt1
104 fs(6)=fs(6)-ft3*dt1
105
106
107
108#include "vectorize.inc"
109 DO i=1,nnc
110 in=knc(i)
111 fx=wnf(1,in)+wtf(1,in)
112 fy=wnf(2,in)+wtf(2,in)
113 fz=wnf(3,in)+wtf(3,in)
114 wnf(1,in)=rot(1)*fx+rot(4)*fy+rot(7)*fz
115 wnf(2,in)=rot(2)*fx+rot(5)*fy+rot(8)*fz
116 wnf(3,in)=rot(3)*fx+rot(6)*fy+rot(9)*fz
117 ENDDO
118
119
120
121 DO i=1,nnc
122 in=knc(i)
123 xk=x(1,in)-bufsf(adrbuf+16)
124 yk=x(2,in)-bufsf(adrbuf+17)
125 zk=x(3,in)-bufsf(adrbuf+18)
126 fx =wnf(1,in)
127 fy =wnf(2,in)
128 fz =wnf(3,in)
129 am1=yk*fz-zk*fy
130 am2=zk*fx-xk*fz
131 am3=xk*fy-yk*fx
132
133 bufsf(adrbuf+25)=bufsf(adrbuf+25)-fx
134 bufsf(adrbuf+26)=bufsf(adrbuf+26)-fy
135 bufsf(adrbuf+27)=bufsf(adrbuf+27)-fz
136 bufsf(adrbuf+28)=bufsf(adrbuf+28)-am1
137 bufsf(adrbuf+29)=bufsf(adrbuf+29)-am2
138 bufsf(adrbuf+30)=bufsf(adrbuf+30)-am3
139
140 stf=wns(in)
141 bufsf(adrbuf+31)=bufsf(adrbuf+31)+stf
142 dd = xk**2+yk**2+zk**2
143 bufsf(adrbuf+32)=bufsf(adrbuf+32)+dd*stf
144 ENDDO
145
146
147
148 IF (iparit/=0) THEN
149#include "lockon.inc"
150 niskyl = nisky
151 nisky = nisky+nnc
152#include "lockoff.inc"
153 END IF
154 IF (iparit==0) THEN
155#include "vectorize.inc"
156 DO 300 i=1,nnc
157 in=knc(i)
158 fx=wnf(1,in)
159 fy=wnf(2,in)
160 fz=wnf(3,in)
161 i3=3*in
162 i2=i3-1
163 i1=i2-1
164 af(i1)=af(i1)+fx
165 af(i2)=af(i2)+fy
166 af(i3)=af(i3)+fz
167 stifn(in)=stifn(in)+wns(in)
168 300 CONTINUE
169 ELSE
170 IF(kdtint==0)THEN
171 DO 350 i=1,nnc
172 in=knc(i)
173 fx=wnf(1,in)
174 fy=wnf(2,in)
175 fz=wnf(3,in)
176 niskyl = niskyl + 1
177 fskyi(niskyl,1)=fx
178 fskyi(niskyl,2)=fy
179 fskyi(niskyl,3)=fz
180 fskyi(niskyl,4)=wns(in)
181 isky(niskyl) =in
182 350 CONTINUE
183 ELSE
184 DO i=1,nnc
185 in=knc(i)
186 fx=wnf(1,in)
187 fy=wnf(2,in)
188 fz=wnf(3,in)
189 niskyl = niskyl + 1
190 fskyi(niskyl,1)=fx
191 fskyi(niskyl,2)=fy
192 fskyi(niskyl,3)=fz
193 fskyi(niskyl,4)=wns(in)
194 fskyi(niskyl,5)=zero
195 isky(niskyl) =in
196 ENDDO
197 ENDIF
198 ENDIF
199
200
201
202 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0.AND.
203 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
204 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
205#include "lockon.inc"
206#include "vectorize.inc"
207 DO 400 i=1,nnc
208 in=knc(i)
209 fcont(1,in) =fcont(1,in) + wnf(1,in)
210 fcont(2,in) =fcont(2,in) + wnf(2,in)
211 fcont(3,in) =fcont(3,in) + wnf(3,in)
212 400 CONTINUE
213#include "lockoff.inc"
214 ENDIF
215
216
217
218
219
220 DO 450 i=1,nnc
221 in=knc(i)
222 fx=wnf(1,in)
223 fy=wnf(2,in)
224 fz=wnf(3,in)
225 de=de+fx*v(1,in)+fy*v(2,in)+fz*v(3,in)
226 450 CONTINUE
227
228
229
230 fs(7)=fs(7)+de*dt1*half
231 IF (igrsurf(ksurf)%TYPE==100) THEN
232
233
234 output%TH%WFEXT=output%TH%WFEXT+de*dt1*half
235 ENDIF
236
237 RETURN