36
37
38
40 USE output_mod
41
42
43
44
45
46
47
48
49#include "implicit_f.inc"
50
51
52
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "com06_c.inc"
56#include "com08_c.inc"
57#include "scr07_c.inc"
58#include "scr08_a_c.inc"
59#include "scr14_c.inc"
60#include "scr16_c.inc"
61#include "param_c.inc"
62#include "comlock.inc"
63#include "tabsiz_c.inc"
64
65
66
67 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
68 INTEGER,INTENT(INOUT) :: IRECT(4,*), MSR(*), NSV(*), ILOC(*), IRTL(*),LCODE(*), ISKEW(*)
69 my_real,
INTENT(INOUT) :: a(sa), e(*), msm(*), crst(2,*), ms(*),nor(3,*),fsav(*)
70 my_real,
INTENT(INOUT) :: fcont(3,*),fncont(3,*)
71 INTEGER, INTENT(IN) :: NSN,NMN
72 TYPE(H3D_DATABASE) :: H3D_DATA
73
74
75
76 INTEGER NIR, I, J, I3, J3, I2, J2, I1, J1, II, L, JJ, NN, JJ3, JJ2, JJ1, ISK, LCOD
77 my_real h(4), n1, n2, n3, aa(3), sss, ttt, xmss, fxi, fyi, fzi, fsn
78 my_real :: fsn_sav, fxi_sav, fyi_sav, fzi_sav,impx,impy,impz
79 LOGICAL ICONT, IPCONT, IANIM
80
81
82
83 icont = .false.
84 ipcont = .false.
85 ianim = .false.
86 icont = (anim_v(4)+outp_v(4) > 0+h3d_data%N_VECT_CONT)
87 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT > 0)THEN
88 IF( (tt>=output%TANIM .AND. tt<=output%TANIM_STOP) .OR.tt >= toutp.OR.tt >= h3d_data%TH3D.OR.
89 . (manim >= 4.AND.manim <= 15).OR. h3d_data%MH3D /= 0)THEN
90 ipcont = .true.
91 ENDIF
92 ENDIF
93 IF(icont .OR. ipcont)ianim=.true.
94
95 fsn_sav = zero
96 fxi_sav = zero
97 fyi_sav = zero
98 fzi_sav = zero
99
100 nir=2
101 IF(n2d == 0)nir=4
102
103 DO i=1,nmn
104 j=msr(i)
105 i3=3*i
106 i2=i3-1
107 i1=i2-1
108 msm(i)=ms(j)
109 e(i1)=zero
110 e(i2)=zero
111 e(i3)=zero
112 ENDDO
113
114
115 DO ii=1,nsn
116 i=nsv(ii)
117 j=iloc(ii)
118 IF(j >= 1) THEN
119 l=irtl(ii)
120 DO jj=1,nir
121 nn=irect(jj,l)
122 iy(jj)=nn
123 ENDDO
124
125 sss=crst(1,ii)
126 ttt=crst(2,ii)
127
128 n1=nor(1,ii)
129 n2=nor(2,ii)
130 n3=nor(3,ii)
131
132 i3=3*i
133 i2=i3-1
134 i1=i2-1
136 DO jj=1,nir
137 j3=3*iy(jj)
138 j2=j3-1
139 j1=j2-1
140 jj3=3*msr(iy(jj))
141 jj2=jj3-1
142 jj1=jj2-1
143 aa(1)=a(i1)
144 aa(2)=a(i2)
145 aa(3)=a(i3)
146 isk=iskew(iy(jj))
147 lcod=lcode(iy(jj))
148 xmss=ms(i)*h(jj)
149 fxi=aa(1)-a(jj1)
150 fyi=aa(2)-a(jj2)
151 fzi=aa(3)-a(jj3)
152 fsn=(fxi*n1+fyi*n2+fzi*n3)*xmss
153 fsn_sav = fsn_sav + fsn
154 fxi_sav = fxi_sav + fxi*xmss
155 fyi_sav = fyi_sav + fyi*xmss
156 fzi_sav = fzi_sav + fzi*xmss
157 e(j1)=e(j1)+fsn*n1
158 e(j2)=e(j2)+fsn*n2
159 e(j3)=e(j3)+fsn*n3
160 msm(iy(jj))=msm(iy(jj))+xmss
161 enddo
162 ENDIF
163 enddo
164
165
166
167
168
169
170
171 impx = fxi_sav*dt12
172 impy = fyi_sav*dt12
173 impz = fzi_sav*dt12
174 fsn_sav = fsn_sav*dt12
175#include "lockon.inc"
176 fsav(1)=fsav(1) + impx
177 fsav(2)=fsav(2) + impy
178 fsav(3)=fsav(3) + impz
179 fsav(8)=fsav(8) + abs(impx)
180 fsav(9)=fsav(9) + abs(impy)
181 fsav(10)=fsav(10)+ abs(impz)
182 fsav(11)=fsav(11)+ fsn_sav
183#include "lockoff.inc"
184
185
186
187 IF(ianim)THEN
188
189
190
191 IF(icont)THEN
192#include "lockon.inc"
193 DO i=1,nmn
194 j = msr(i)
195 i3 = 3*i
196 i2 = i3-1
197 i1 = i2-1
198 fcont(1,j) = fcont(1,j)+e(i1)
199 fcont(2,j) = fcont(2,j)+e(i2)
200 fcont(3,j) = fcont(3,j)+e(i3)
201 ENDDO
202#include "lockoff.inc"
203 ENDIF
204
205
206
207 IF(ipcont)THEN
208#include "lockon.inc"
209 DO i=1,nmn
210 j = msr(i)
211 i3 = 3*i
212 i2 = i3-1
213 i1 = i2-1
214 fncont(1,j) = fncont(1,j)+e(i1)
215 fncont(2,j) = fncont(2,j)+e(i2)
216 fncont(3,j) = fncont(3,j)+e(i3)
217 ENDDO
218#include "lockoff.inc"
219 ENDIF
220 ENDIF
221
222
223
224
225
226 RETURN
subroutine shapeh(h, s, t)