40
41
42
43 USE elbufdef_mod
44
45
46
47#include "implicit_f.inc"
48
49
50
51#include "com01_c.inc"
52#include "com04_c.inc"
53#include "com08_c.inc"
54#include "param_c.inc"
55#include "parit_c.inc"
56
57
58
59 INTEGER FXBIPM(*), FXBNOD(*), NME, NMOD, ITN, FXBELM(*),
60 . IPARG(NPARG,*), NFX, NSN, IAD_ELEM(2,*), FR_ELEM(*),
61 . NSNT, IADN, IADSKY(*)
63 . fxbrpm(*), fxbmod(*), fxbdep(*), fxbvit(*), fxbacc(*),
64 . a(3,*), ar(3,*), fxbsig(*), elbuf(*), partsav(npsav,*),
65 . x(3,*), d(3,*), mfext(*), fskyfxb(nsnt,*)
66 TYPE (ELBUF_STRUCT_), DIMENSION (NGROUP) :: ELBUF_TAB
67
68
69
70 INTEGER IFILE, LMOD, ISH, NELS, NELC, NELT, NELP, NELTG, LVSIG,
71 . IRCS, DN, IRCM, I, IAD, II, N, IFAC(NUMNOD), J, JJ
73 . rt(9)
74
75
76 CALL fxbmajp1(fxbdep, fxbvit, fxbacc, fxbrpm, dt1 ,
77 . nme , nmod , rt )
78
79 ifile=fxbipm(29)
80 IF (ifile==0) THEN
81 lmod=fxbipm(3)*6
82 ELSEIF (ifile==1) THEN
83 lmod=nsn*6
84 ENDIF
85 ish=fxbipm(16)
86
87 nels=fxbipm(21)
88 nelc=fxbipm(22)
89 nelt=fxbipm(34)
90 nelp=fxbipm(35)
91 neltg=fxbipm(23)
92 lvsig=nels*7+nelc*10+nelt*2+nelp*8+neltg*10
93 ircs=fxbipm(31)
94 CALL fxbsgmaj(elbuf, fxbelm, fxbsig, fxbdep, fxbipm,
95 . fxbrpm(15), partsav, rt , itn , iparg ,
96 . nfx , lvsig , ircs ,elbuf_tab)
97 IF (itn==0) THEN
98 dn=fxbipm(3)-fxbipm(18)
99 ircm=fxbipm(30)
100 CALL fxbdepla(fxbdep, fxbrpm, x, d, dn,
101 . nsn, fxbnod, nme, nmod, fxbmod,
102 . ish , ifile , nfx, ircm)
103 ENDIF
104
105
106
107 DO i=1,numnod
108 ifac(i)=1
109 ENDDO
110 IF (nspmd>1) THEN
111 DO i=1,nspmd
112 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
113 jj=fr_elem(j)
114 ifac(jj)=ifac(jj)+1
115 ENDDO
116 ENDDO
117 ENDIF
118
119 IF (iparit==0) THEN
120 DO i=1,12
121 mfext(i)=zero
122 iad=(i-1)*lmod
123 DO ii=1,nsn
124 n=fxbnod(ii)
125 mfext(i)=mfext(i)+(a(1,n)*fxbmod(iad+1)
126 . +a(2,n)*fxbmod(iad+2)
127 . +a(3,n)*fxbmod(iad+3))/ifac(n)
128 iad=iad+6
129 ENDDO
130 ENDDO
131 IF (ish>0) THEN
132 DO i=13,nme
133 mfext(i)=zero
134 iad=(i-1)*lmod
135 DO ii=1,nsn
136 n=fxbnod(ii)
137 mfext(i)=mfext(i)+(ar(1,n)*fxbmod(iad+4)
138 . +ar(2,n)*fxbmod(iad+5)
139 . +ar(3,n)*fxbmod(iad+6))/ifac(n)
140 iad=iad+6
141 ENDDO
142 ENDDO
143 ENDIF
144
145 IF (nmod>0) THEN
146 DO i=1,nmod
147 mfext(nme+i)=zero
148 iad=(nme+i-1)*lmod
149 DO ii=1,nsn
150 n=fxbnod(ii)
151 mfext(nme+i)=mfext(nme+i)+
152 . (a(1,n)*(fxbrpm(2)*fxbmod(iad+1)+fxbrpm(3)*fxbmod(iad+2)+
153 . fxbrpm(4)*fxbmod(iad+3))
154 . +a(2,n)*(fxbrpm(5)*fxbmod(iad+1)+fxbrpm(6)*fxbmod(iad+2)+
155 . fxbrpm(7)*fxbmod(iad+3))
156 . +a(3,n)*(fxbrpm(8)*fxbmod(iad+1)+fxbrpm(9)*fxbmod(iad+2)+
157 . fxbrpm(10)*fxbmod(iad+3))
158 . +ar(1,n)*(fxbrpm(2)*fxbmod(iad+4)+fxbrpm(3)*fxbmod(iad+5)+
159 . fxbrpm(4)*fxbmod(iad+6))
160 . +ar(2,n)*(fxbrpm(5)*fxbmod(iad+4)+fxbrpm(6)*fxbmod(iad+5)+
161 . fxbrpm(7)*fxbmod(iad+6))
162 . +ar(3,n)*(fxbrpm(8)*fxbmod(iad+4)+fxbrpm(9)*fxbmod(iad+5)+
163 . fxbrpm(10)*fxbmod(iad+6)))/ifac(n)
164 iad=iad+6
165 ENDDO
166 ENDDO
167 ENDIF
168 ELSE
169 DO i=1,nsn
170 fskyfxb(iadn+i,1)=iadsky(i)
171 ENDDO
172
173 DO i=1,12
174 iad=(i-1)*lmod
175 DO ii=1,nsn
176 n=fxbnod(ii)
177 fskyfxb(iadn+ii,1+i)=a(1,n)*fxbmod(iad+1)
178 . +a(2,n)*fxbmod(iad+2)
179 . +a(3,n)*fxbmod(iad+3)
180 iad=iad+6
181 ENDDO
182 ENDDO
183 IF (ish>0) THEN
184 DO i=13,nme
185 iad=(i-1)*lmod
186 DO ii=1,nsn
187 n=fxbnod(ii)
188 fskyfxb(iadn+ii,1+i)=ar(1,n)*fxbmod(iad+4)
189 . +ar(2,n)*fxbmod(iad+5)
190 . +ar(3,n)*fxbmod(iad+6)
191 iad=iad+6
192 ENDDO
193 ENDDO
194 ENDIF
195
196 IF (nmod>0) THEN
197 DO i=1,nmod
198 iad=(nme+i-1)*lmod
199 DO ii=1,nsn
200 n=fxbnod(ii)
201 fskyfxb(iadn+ii,1+nme+i)=
202 . a(1,n)*(fxbrpm(2)*fxbmod(iad+1)+fxbrpm(3)*fxbmod(iad+2)+
203 . fxbrpm(4)*fxbmod(iad+3))
204 . +a(2,n)*(fxbrpm(5)*fxbmod(iad+1)+fxbrpm(6)*fxbmod(iad+2)+
205 . fxbrpm(7)*fxbmod(iad+3))
206 . +a(3,n)*(fxbrpm(8)*fxbmod(iad+1)+fxbrpm(9)*fxbmod(iad+2)+
207 . fxbrpm(10)*fxbmod(iad+3))
208 . +ar(1,n)*(fxbrpm(2)*fxbmod(iad+4)+fxbrpm(3)*fxbmod(iad+5)+
209 . fxbrpm(4)*fxbmod(iad+6))
210 . +ar(2,n)*(fxbrpm(5)*fxbmod(iad+4)+fxbrpm(6)*fxbmod(iad+5)+
211 . fxbrpm(7)*fxbmod(iad+6))
212 . +ar(3,n)*(fxbrpm(8)*fxbmod(iad+4)+fxbrpm(9)*fxbmod(iad+5)+
213 . fxbrpm(10)*fxbmod(iad+6))
214 iad=iad+6
215 ENDDO
216 ENDDO
217 ENDIF
218 ENDIF
219
220 RETURN
subroutine fxbdepla(fxbdep, fxbrpm, x, d, dn, nsn, fxbnod, nme, nmod, fxbmod, ish, ifile, nfx, ircm)
subroutine fxbmajp1(fxbdep, fxbvit, fxbacc, fxbrpm, dt1, nme, nmod, tmrot)
subroutine fxbsgmaj(elbuf, fxbelm, fxbsig, fxbdep, fxbipm, eiel, partsav, rt, itn, iparg, nfx, lvsig, ircs, elbuf_tab)