48
49
50
51
52
53
54
56 USE intbufdef_mod
58
59
60
61#include "implicit_f.inc"
62
63
64
65#include "units_c.inc"
66#include "scr03_c.inc"
67#include "param_c.inc"
68
69
70
71 INTEGER,INTENT(IN) :: SITAB, SITABM1
72 INTEGER,INTENT(IN) :: SICODE
73 INTEGER,INTENT(IN) :: ICODE(SICODE)
74 INTEGER,INTENT(IN) :: NUMMAT,NINTER,SINSCR
75 INTEGER NINT, NUMNOD
76 INTEGER INSCR(*), IXQ(*), IPARI(NPARI), ITAB(SITAB),
77 . (SITABM1), IKINE(*), MWA(*),IPM(NPROPMI,NUMMAT),
78 . KNOD2ELQ(*),NOD2ELQ(*),SEGQUADFR(2,*)
79 my_real x(*), pm(npropm, nummat), geo(*)
80 INTEGER ID
81 CHARACTER(LEN=NCHARTITLE) :: TITR
82 TYPE(INTBUF_STRUCT_) INTBUF_TAB
83
84
85
86 INTEGER NRTS, NRTM, , NMN, NTY, NST, NMT, NOINT, K10, K11, K12,
87 . K13, K14, KFI, J10, J11, J12, JFI, K16, K21, K23, J20, L17,
88 . L20, L22, J21, J22, L16, L21, L23, K15, K17, K18, K19, K20,
89 . K22, J13, J14, J15, J16, J17, J18, J19, IWPENE, K24, K25,K48,
90 . IBIDON,I
91
92
93
94 iwpene = 0
95 nrts = ipari(3)
96 nrtm = ipari(4)
97 nsn = ipari(5)
98 nmn = ipari(6)
99 nty = ipari(7)
100 nst = ipari(8)
101 nmt = ipari(9)
102 noint = ipari(15)
103
104 noint=nint
105 WRITE(iout,2100)noint,nty,nrts,nrtm,nsn,nmn
106 k10=1
107 k11=k10+4*nrts
108 k12=k11+4*nrtm
109 k13=k12+nsn
110 k14=k13+nmn
111 kfi=k14+nsn
112 j10=1
113 j11=j10+1
114 j12=j11+nparir
115 jfi=j12+2*nsn
116
117 IF(nty == 1)THEN
118 k16=kfi
119 k21=k16+nsn
120 k23=k21+1+nmn
121 j20=jfi
122 l17=1
123 l20=l17+nmn
124 l22=l20+1+nsn
125
126
127 intbuf_tab%NRT(1:nmt) = 0
128 CALL inint0(x,intbuf_tab%IRECTM,intbuf_tab%NSEGM,intbuf_tab%NRT,intbuf_tab%MSR,
129 1 intbuf_tab%NSV,intbuf_tab%ILOCS,nsn,nmn,nrtm,intbuf_tab%S_IRECTM, intbuf_tab%S_NRT)
130 CALL i1chk2(x,intbuf_tab%IRECTS,ixq,nrts, nint,
131 1 nsn,intbuf_tab%NSV,noint,
id,titr)
132 CALL i1chk2(x,intbuf_tab%IRECTM,ixq,nrtm,-nint,
133 1 nmn,intbuf_tab%MSR,noint,
id,titr)
134 CALL invoi2(x,intbuf_tab%IRECTM,intbuf_tab%NRT,intbuf_tab%MSR,intbuf_tab%NSV,
135 1 intbuf_tab%ILOCS,intbuf_tab%IRTLM,intbuf_tab%NSEGM,nsn,nrtm)
136 WRITE(iout,2200)
137 CALL i1tid2(x, intbuf_tab%IRECTM, intbuf_tab%CSTS, intbuf_tab%MSR, intbuf_tab%NSV,
138 1 intbuf_tab%ILOCS, intbuf_tab%IRTLM, nsn, itab ,
id, titr, numnod)
139 CALL i1bcs_check(icode, sicode, nsn, intbuf_tab%NSV, sitab, itab, noint, titr, nty)
140
141 ELSEIF(nty == 2)THEN
142 j21=jfi
143 j22=j21+3*max0(nsn,nmn)
144 l16=1
145 l17=l16+nsn
146 l20=l17+nmn
147 l21=l20+1+nsn
148 l22=l21+1+nmn
149 l23=l22+nst
150 k48 = kfi
151 CALL inint0(x,intbuf_tab%IRECTM,inscr(l21),inscr(l23),intbuf_tab%MSR,
152 1 intbuf_tab%NSV,inscr(l16),nsn,nmn,nrtm,intbuf_tab%S_IRECTM, sinscr-l23+1)
153 CALL i1chk2(x,intbuf_tab%IRECTS,ixq,nrts, nint,
154 1 nsn,intbuf_tab%NSV,noint,
id,titr)
155 CALL i1chk2(x,intbuf_tab%IRECTM,ixq,nrtm,-nint,
156 1 nmn,intbuf_tab%MSR,noint,
id,titr)
157
158 CALL invoi2(x,intbuf_tab%IRECTM,inscr(l23),intbuf_tab%MSR,intbuf_tab%NSV,
159 1 inscr(l16),intbuf_tab%IRTLM,inscr(l21),nsn,nrtm)
160 WRITE(iout,2200)
161 CALL i1tid2(x,intbuf_tab%IRECTM,intbuf_tab%CSTS,intbuf_tab%MSR,intbuf_tab%NSV,
162 1 inscr(l16), intbuf_tab%IRTLM, nsn, itab ,
id, titr, numnod)
163
164 DO i=1,nsn
165 intbuf_tab%CSTS_BIS(2*(i-1)+1)=
min(one,
max(-1*one,intbuf_tab%CSTS(2*(i-1)+1)))
166 intbuf_tab%CSTS_BIS(2*(i-1)+2)=intbuf_tab%CSTS(2*(i-1)+2)
167 ENDDO
168
169 CALL i2main(intbuf_tab%NSV,intbuf_tab%MSR,intbuf_tab%IRECTM,ipari,
170 . mwa,mwa(numnod+1),intbuf_tab)
171
172 ELSEIF(nty == 3)THEN
173 k15=kfi
174 k16=k15+nmn
175 k17=k16+nsn
176 k18=k17+nmn
177 k19=k18+nsn
178 k20=k19+nmn
179 k21=k20+1+nsn
180 k22=k21+1+nmn
181 k23=k22+nst
182 j13=jfi
183 j14=j13+2*nmn
184 j15=j14+nsn
185 j16=j15+nmn
186 j17=j16+nrts
187 j18=j17+nrtm
188 j19=j18+3*nsn
189
190
191
192 intbuf_tab%LNSV(1:nst) = 0
193 intbuf_tab%LMSR(1:nmt) = 0
194 intbuf_tab%STFNS(1:nsn) = 0
195 intbuf_tab%STFNM(1:nmn) = 0
196
197 CALL inint0(x,intbuf_tab%IRECTS,intbuf_tab%NSEGS,intbuf_tab%LNSV,intbuf_tab%NSV,
198 1 intbuf_tab%MSR,intbuf_tab%ILOCM,nmn,nsn,nrts,intbuf_tab%S_IRECTS,intbuf_tab%S_LNSV)
199 CALL inint0(x,intbuf_tab%IRECTM,intbuf_tab%NSEGM,intbuf_tab%LMSR,intbuf_tab%MSR,
200 1 intbuf_tab%NSV,intbuf_tab%ILOCS,nsn,nmn,nrtm,intbuf_tab%S_IRECTM,intbuf_tab%S_LMSR)
202 1 x ,intbuf_tab%IRECTS,intbuf_tab%STFS,ixq ,pm ,
203 2 nrts ,intbuf_tab%STFNS,intbuf_tab%NSEGS,intbuf_tab%LNSV,nint ,
204 3 nsn ,intbuf_tab%NSV,intbuf_tab%STFAC ,noint ,ipm ,
205 4
id ,titr ,intbuf_tab%AREAS ,knod2elq ,nod2elq ,
206 5 nty ,ibidon ,ibidon ,segquadfr )
208 1 x ,intbuf_tab%IRECTM,intbuf_tab%STFM,ixq ,pm ,
209 2 nrtm ,intbuf_tab%STFNM,intbuf_tab%NSEGM,intbuf_tab%LMSR,-nint ,
210 3 nmn ,intbuf_tab%MSR,intbuf_tab%STFAC ,noint ,ipm ,
211 4
id ,titr ,intbuf_tab%AREAM ,knod2elq ,nod2elq ,
212 5 nty ,ibidon ,ibidon ,segquadfr )
213
214 CALL invoi2(x,intbuf_tab%IRECTM,intbuf_tab%LMSR,intbuf_tab%MSR,intbuf_tab%NSV,
215 1 intbuf_tab%ILOCS,intbuf_tab%IRTLM,intbuf_tab%NSEGM,nsn,nrtm)
216 CALL invoi2(x,intbuf_tab%IRECTS,intbuf_tab%LNSV,intbuf_tab%NSV,intbuf_tab%MSR,
217 1 intbuf_tab%ILOCM,intbuf_tab%IRTLS,intbuf_tab%NSEGS,nmn,nrts)
218 WRITE(iout,2200)
220 1 (x ,intbuf_tab%IRECTM ,intbuf_tab%MSR,intbuf_tab%NSV,intbuf_tab%ILOCS,
221 2 intbuf_tab%IRTLM,nsn ,intbuf_tab%CSTS,intbuf_tab%IRTLOM,intbuf_tab%FRICOS,
222 3 intbuf_tab%VARIABLES(1),intbuf_tab%VARIABLES(2),iwpene,itab ,
id,titr)
223 WRITE(iout,2300)
225 1 (x ,intbuf_tab%IRECTS ,intbuf_tab%NSV,intbuf_tab%MSR,intbuf_tab%ILOCM,
226 2 intbuf_tab%IRTLS,nmn ,intbuf_tab%CSTM,intbuf_tab%IRTLOS,intbuf_tab%FRICOM,
227 3 intbuf_tab%VARIABLES(1),intbuf_tab%VARIABLES(2),iwpene,itab ,
id,titr)
228
229 ELSEIF(nty == 5)THEN
230 k15=kfi
231 k16=k15+nmn
232 k17=k16+nsn
233 k18=k17+nmn
234 k19=k18+nsn
235 k20=k19+nmn
236 k21=k20+1+nsn
237 k22=k21+1+nmn
238 k23=k22+nst
239 j13=jfi
240 j14=j13+2*nmn
241 j15=j14+nsn
242 j16=j15+nmn
243 j17=j16+nrts
244 j18=j17+nrtm
245 j19=j18+3*nsn
246
247
248
249 intbuf_tab%LNSV(1:nst) = 0
250 intbuf_tab%LMSR(1:nmt) = 0
251 intbuf_tab%STFNM(1:nmn) = 0
252
253 CALL inint0(x,intbuf_tab%IRECTM,intbuf_tab%NSEGM,intbuf_tab%LMSR,intbuf_tab%MSR,
254 1 intbuf_tab%NSV,intbuf_tab%ILOCS,nsn,nmn,nrtm,intbuf_tab%S_IRECTM, intbuf_tab%S_LMSR)
256 1 x ,intbuf_tab%IRECTM,intbuf_tab%STFM,ixq ,pm ,
257 2 nrtm ,intbuf_tab%STFNM,intbuf_tab%NSEGM,intbuf_tab%LMSR,-nint ,
258 3 nmn ,intbuf_tab%MSR,intbuf_tab%STFAC ,noint ,ipm ,
259 4
id ,titr ,intbuf_tab%AREAS ,knod2elq ,nod2elq ,
260 5 nty ,nsn ,intbuf_tab%NSV ,segquadfr )
261 CALL invoi2(x,intbuf_tab%IRECTM,intbuf_tab%LMSR,intbuf_tab%MSR,intbuf_tab%NSV,
262 1 intbuf_tab%ILOCS,intbuf_tab%IRTLM,intbuf_tab%NSEGM,nsn,nrtm)
263 WRITE(iout,2200)
265 1 (x ,intbuf_tab%IRECTM ,intbuf_tab%MSR,intbuf_tab%NSV,intbuf_tab%ILOCS,
266 2 intbuf_tab%IRTLM,nsn ,intbuf_tab%CSTS,intbuf_tab%IRTLOM,intbuf_tab%FRICOS,
267 3 intbuf_tab%VARIABLES(1),intbuf_tab%VARIABLES(2),iwpene,itab ,
id,titr)
268
269 ELSEIF(nty == 9)THEN
270 k15=kfi
271 k16=k15+nmn
272 k17=k16+nsn
273 k18=k17+nmn
274 k19=k18+nsn
275 k20=k19+nmn
276 k21=k20+1+nsn
277 k22=k21+1+nmn
278 k23=k22+nst
279 k24=k23+nmt
280 k25=k24+nrts
281 j13=jfi
282 j14=j13+2*nmn
283 j15=j14+nsn
284 j16=j15+nmn
285 j17=j16+nrts
286 j18=j17+nrtm
287 j19=j18+3*nsn
288
289
290
291 intbuf_tab%LNSV(1:nst) = 0
292 intbuf_tab%LMSR(1:nmt) = 0
293 intbuf_tab%STFNS(1:nsn)= 0
294 intbuf_tab%STFNM(1:nmn)= 0
295
296 CALL inint0(x,intbuf_tab%IRECTS,intbuf_tab%NSEGS,intbuf_tab%LNSV
297 1 intbuf_tab%MSR,intbuf_tab%ILOCM,nmn,nsn,nrts,intbuf_tab%S_IRECTS ,intbuf_tab%S_LNSV)
298 CALL inint0(x,intbuf_tab%IRECTM,intbuf_tab%NSEGM,intbuf_tab%LMSR,intbuf_tab%MSR,
299 1 intbuf_tab%NSV,intbuf_tab%ILOCS,nsn,nmn,nrtm,intbuf_tab%S_IRECTM
301 1 x ,intbuf_tab%IRECTS, ixq ,
302 2 nrts ,nint ,
303 3 nsn ,intbuf_tab%NSV, noint ,intbuf_tab%IELES,
306 1 x ,intbuf_tab%IRECTS, ixq ,
307 2 nrtm ,-nint ,
308 3 nmn ,intbuf_tab%MSR, noint ,intbuf_tab%IELEM,
310 CALL invoi2(x,intbuf_tab%IRECTM,intbuf_tab%LMSR,intbuf_tab%MSR,intbuf_tab%NSV,
311 1 intbuf_tab%ILOCS,intbuf_tab%IRTLM,intbuf_tab%NSEGM,nsn,nrtm)
312 CALL invoi2(x,intbuf_tab%IRECTS,intbuf_tab%LNSV,intbuf_tab%NSV,intbuf_tab%MSR,
313 1 intbuf_tab%ILOCM,intbuf_tab%IRTLS,intbuf_tab%NSEGS,nmn,nrts)
314 IF(nmn>0)THEN
315 WRITE(iout,2200)
317 1 (x ,intbuf_tab%IRECTM ,intbuf_tab%MSR,intbuf_tab%NSV
318 2 intbuf_tab%IRTLM,nsn ,intbuf_tab%CSTS,intbuf_tab%IRTLOM,intbuf_tab%FRICOS,
319 3 intbuf_tab%VARIABLES(1),intbuf_tab%VARIABLES(2),iwpene,itab ,
id,titr)
320 WRITE(iout,2300)
322 1 (x ,intbuf_tab%IRECTS ,intbuf_tab%NSV,intbuf_tab%MSR,intbuf_tab%ILOCM,
323 2 intbuf_tab%IRTLS,nmn ,intbuf_tab%CSTM,intbuf_tab%IRTLOS,intbuf_tab%FRICOM,
324 3 intbuf_tab%VARIABLES(1),intbuf_tab%VARIABLES(2),iwpene,itab ,
id,titr)
325 ENDIF
326 CALL i9bcs_check(icode, sicode, nsn, intbuf_tab%NSV, intbuf_tab%S_ILOCS, intbuf_tab%ILOCS )
327
328 ENDIF
329
330 IF(iwpene/=0) THEN
331 CALL ancmsg(msgid=342,msgtype=msgwarning,anmode=aninfo_blind_1,i1=
id,c1=titr,i2=iwpene)
332 ENDIF
333
334 RETURN
335
336 2100 FORMAT(//
337 . ,5x,'INTERFACE NUMBER. . . . . . . . . . . . . .',i8/
338 . ,5x,'SLIDE LINE TYPE . . . . . . . . . . . . . .',i5/
339 . ,5x,'NUMBER OF SECONDARY SEGMENTS . . . . . . .',i5/
340 . ,5x,'NUMBER OF MAIN SEGMENTS . . . . . . . . . .',i5/
341 . ,5x,'NUMBER OF SECONDARY NODES. . . . . . . . .',i5/
342 . ,5x,'NUMBER OF MAIN NODES. . . . . . . . . . . .',i5/)
343 2200 FORMAT(//' SECONDARY NEAREST NEAREST MAIN S '
344 . / ' node
main segment nodes
' )
345 2300 FORMAT(//' main nearest nearest secondary s
'
346 . / ' node secondary segment nodes ' )
347
348
subroutine i1chk2(x, irect, ixq, nrt, nint, nsn, nsv, noint, id, titr)
subroutine i1tid2(x, irect, crst, msr, nsv, iloc, irtl, nsn, itab, id, titr, numnod)
subroutine i2main(nsv, msr, irectm, ipari, tag, msru, intbuf_tab)
subroutine i3pen2(x, irect, msr, nsv, iloc, irtl, nsn, cst, irtlo, fric0, fric, gap, iwpene, itab, id, titr)
subroutine i3sti2(x, irect, stf, ixq, pm, nrt, stfn, nseg, lnsv, nint, nsn, nsv, slsfac, noint, ipm, id, titr, areas, knod2elq, nod2elq, nty, nsns, nsvs, segquadfr)
subroutine i9sti2(x, irect, ixq, nrt, nint, nsn, nsv, noint, iele, id, titr)
subroutine inint0(x, irect, nseg, nod2seg, nsv, msr, iloc, nmn, nsn, nrt, sirect, s_n2seg)
integer, parameter nchartitle
int main(int argc, char *argv[])
subroutine invoi2(x, irect, lmsr, msr, nsv, iloc, irtl, nseg, nsn, nrt)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)