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