OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_sect.F File Reference
#include "implicit_f.inc"
#include "analyse_name.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "param_c.inc"
#include "sphcom.inc"
#include "r2r_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine lecsec42 (ixs, ixq, ixc, ixt, ixp, ixr, ixtg, x0, itab, itabm1, igrnod, secbuf, ipari, ixs10, ixs20, ixs16, unitab, iskn, xframe, isolnod, nom_sect, rtrans, lsubmodel, nom_opt, igrbric, igrquad, igrsh4n, igrtruss, igrbeam, igrspring, igrsh3n, seatbelt_shell_to_spring, nb_seatbelt_shells)
subroutine secstri (nseg, isecbuf, ixs, ixs10, ixs16, ixs20, nod, nnod, noprint)
subroutine sec_tri (nseg, isecbuf, ix, nix, nne, nod, nnod)
subroutine lecsec0 (lsubmodel)
subroutine sec_nodes (igu1, istyp, ngrele, igrele, x0, a, b, c, d, e, f, ix, nix, nnod, nstrf, nbinter, k1, nbnodes, j, nodtag, tagelems, x1, y1, z1, x2, y2, z2, r)
subroutine sec_nodes_sol (igu1, istyp, igrbric, x0, a, b, c, d, e, f, ixs, ixs10, ixs16, ixs20, nix, nnod, nstrf, nbinter, k1, j, nodtag, isolnod, tagelems, x1, y1, z1, x2, y2, z2, r)

Function/Subroutine Documentation

◆ lecsec0()

subroutine lecsec0 ( type(submodel_data), dimension(nsubmod), intent(in) lsubmodel)

Definition at line 995 of file hm_read_sect.F.

996C-----------------------------------------------
997C M o d u l e s
998C-----------------------------------------------
999 USE submodel_mod
1000 USE hm_option_read_mod
1001 USE names_and_titles_mod , ONLY : ncharline
1002C-----------------------------------------------
1003C I m p l i c i t T y p e s
1004C-----------------------------------------------
1005#include "implicit_f.inc"
1006C-----------------------------------------------
1007C C o m m o n B l o c k s
1008C-----------------------------------------------
1009#include "com01_c.inc"
1010#include "com04_c.inc"
1011C-----------------------------------------------
1012C D u m m y A r g u m e n t s
1013C-----------------------------------------------
1014 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(NSUBMOD)
1015C-----------------------------------------------
1016C L o c a l V a r i a b l e s
1017C-----------------------------------------------
1018 INTEGER I, TYPE, NBINTER
1019 LOGICAL IS_AVAILABLE
1020 INTEGER ID
1021 CHARACTER(LEN=NCHARLINE) :: TITR
1022C-----------------------------------------------
1023C S o u r c e F i l e s
1024C-----------------------------------------------
1025
1026 isecut=0
1027
1028 IF(nsect /= 0)CALL hm_option_start('/SECT')
1029 DO i=1,nsect
1030 CALL hm_option_read_key(lsubmodel,option_id = id,option_titr = titr)
1031 CALL hm_get_intv('ISAVE', TYPE, IS_AVAILABLE, LSUBMODEL)
1032 CALL hm_get_intv('Niter', nbinter, is_available, lsubmodel)
1033 IF(TYPE > 0)isecut=1
1034 IF(nbinter > 0)isecut=1
1035 ENDDO
1036
1037 RETURN
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
id
initmumps id
Definition multiplerhs_example.m:4
hm_option_read_mod
Definition hm_option_read_mod.F:412
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1006
submodel_mod
Definition submodel_mod.F:717

◆ lecsec42()

subroutine lecsec42 ( integer, dimension(nixs,numels) ixs,
integer, dimension(nixq,numelq) ixq,
integer, dimension(nixc,numelc) ixc,
integer, dimension(nixt,numelt) ixt,
integer, dimension(nixp,numelp) ixp,
integer, dimension(nixr,numelr) ixr,
integer, dimension(nixtg,numeltg) ixtg,
x0,
integer, dimension(numnod) itab,
integer, dimension(*) itabm1,
type (group_), dimension(ngrnod) igrnod,
secbuf,
integer, dimension(npari,ninter) ipari,
integer, dimension(6,*) ixs10,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
type (unit_type_), intent(in) unitab,
integer, dimension(liskn,*) iskn,
xframe,
integer, dimension(*) isolnod,
integer, dimension(*) nom_sect,
rtrans,
type(submodel_data), dimension(nsubmod) lsubmodel,
integer, dimension(lnopt1,*) nom_opt,
type (group_), dimension(ngrbric) igrbric,
type (group_), dimension(ngrquad) igrquad,
type (group_), dimension(ngrshel) igrsh4n,
type (group_), dimension(ngrtrus) igrtruss,
type (group_), dimension(ngrbeam) igrbeam,
type (group_), dimension(ngrspri) igrspring,
type (group_), dimension(ngrsh3n) igrsh3n,
integer, dimension(numelc,2), intent(in) seatbelt_shell_to_spring,
integer, intent(in) nb_seatbelt_shells )

Definition at line 59 of file hm_read_sect.F.

67C-----------------------------------------------
68C M o d u l e s
69C-----------------------------------------------
70 use extend_array_mod
71 USE message_mod
72 USE r2r_mod
73 USE submodel_mod
74 USE groupdef_mod
75 USE hm_option_read_mod
76 USE unitab_mod
77 USE names_and_titles_mod , ONLY : nchartitle, ncharline, ncharfield
78 USE restmod, ONLY : nstrf
79 use element_mod , only : nixs,nixq,nixc,nixp,nixt,nixr,nixtg
80C-----------------------------------------------
81C I m p l i c i t T y p e s
82C-----------------------------------------------
83#include "implicit_f.inc"
84C-----------------------------------------------
85C A n a l y s e M o d u l e
86C-----------------------------------------------
87#include "analyse_name.inc"
88C-----------------------------------------------
89C C o m m o n B l o c k s
90C-----------------------------------------------
91#include "units_c.inc"
92#include "com04_c.inc"
93#include "scr17_c.inc"
94#include "param_c.inc"
95#include "sphcom.inc"
96#include "r2r_c.inc"
97C-----------------------------------------------
98C D u m m y A r g u m e n t s
99C-----------------------------------------------
100 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
101 INTEGER IXC(NIXC,NUMELC), IXTG(NIXTG,NUMELTG), ITAB(NUMNOD),
102 . ITABM1(*),IXS(NIXS,NUMELS), IXQ(NIXQ,NUMELQ), IXT(NIXT,NUMELT),
103 . IXP(NIXP,NUMELP), IXR(NIXR,NUMELR), IPARI(NPARI,NINTER),
104 . IXS10(6,*),IXS20(12,*),IXS16(8,*),ISKN(LISKN,*),
105 . ISOLNOD(*),NOM_SECT(*)
106 INTEGER NOM_OPT(LNOPT1,*)
107 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
108 my_real x0(3,*),secbuf(*),xframe(nxframe,numfram+1), rtrans(ntransf,nrtrans)
109 INTEGER,INTENT(IN):: NB_SEATBELT_SHELLS
110 INTEGER,INTENT(IN)::SEATBELT_SHELL_TO_SPRING(NUMELC,2)
111C-----------------------------------------------
112 TYPE (GROUP_) ,DIMENSION(NGRNOD) :: IGRNOD
113 TYPE (GROUP_) ,DIMENSION(NGRBRIC) :: IGRBRIC
114 TYPE (GROUP_) ,DIMENSION(NGRQUAD) :: IGRQUAD
115 TYPE (GROUP_) ,DIMENSION(NGRSHEL) :: IGRSH4N
116 TYPE (GROUP_) ,DIMENSION(NGRTRUS) :: IGRTRUSS
117 TYPE (GROUP_) ,DIMENSION(NGRBEAM) :: IGRBEAM
118 TYPE (GROUP_) ,DIMENSION(NGRSPRI) :: IGRSPRING
119 TYPE (GROUP_) ,DIMENSION(NGRSH3N) :: IGRSH3N
120C-----------------------------------------------
121C L o c a l V a r i a b l e s
122C-----------------------------------------------
123 INTEGER ,DIMENSION(NSECT) :: SECTIDS
124 INTEGER K1, I, J, L, KK, K2, K,LREC,
125 . NNOD, NBINTER,K0,K3,K4,K5,K6,K7,K8,K9,KR0,
126 . NSEGQ,NSEGS,NSEGC,NSEGT,NSEGP,NSEGR,NSEGTG,ID,
127 . IGU,IGS,IGUS,IGUQ,IGUC,IGUT,IGUP,IGUR,IGUTG,IFRAM,
128 . UID,IFLAGUNIT,
129 . NFRAM,JJ,IUN,
130 . N1,CPT,
131 . NG,NOPRINT
132 INTEGER L0,ISTYP,SUB_ID,ILEN
133 my_real deltat,alpha,fac_t,a,b,c,d,e,f,r,maxdt
134 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGNODES !NUMNOD*2+NPART
135 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGNDOUBL !NUMNOD
136 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGELEMS ! 1+NUMELC+NUMELS+NUMELT+NUMELQ+NUMELP+NUMELR+NUMELTG
137 INTEGER, DIMENSION(:), ALLOCATABLE :: NODTAG ! NUMNOD
138
139 CHARACTER MESS*40
140 CHARACTER(LEN=NCHARTITLE) :: TITR
141 CHARACTER(LEN=NCHARLINE) ::CHAR8
142 CHARACTER(LEN=NCHARFIELD) :: KEY2
143 my_real bid, xm, ym, zm, x1, y1, z1, x2, y2, z2, norm
144 my_real x3, y3, z3, n3, pnor1, pnor2, pnorm1, det, det1, det2, det3
145 LOGICAL :: IS_AVAILABLE
146 INTEGER :: SNSTRF1
147 integer :: max_extension
148C-----------------------------------------------
149C E x t e r n a l F u n c t i o n s
150C-----------------------------------------------
151 INTEGER USR2SYS,NODGRNR5,ELEGROR,ELEGROR_SEATBELT,GRSIZE_ELE_TRANS,GRSIZE_ELE
152 EXTERNAL usr2sys,nodgrnr5,elegror,elegror_seatbelt,grsize_ele_trans,grsize_ele
153
154C
155 DATA mess/'SECTION DEFINITION '/
156 DATA iun/1/
157C-----------------------------------------------
158C S o u r c e F i l e s
159C-----------------------------------------------
160 ALLOCATE(tagnodes( numnod*2+npart))
161 ALLOCATE(tagndoubl(numnod))
162 ALLOCATE(tagelems(1+numelc+numels+numelt+numelq+numelp+numelr+numeltg))
163 ALLOCATE(nodtag(numnod))
164 snstrf1 = 0
165 noprint = 0
166 nfram = 0
167 nodtag = 0
168 tagelems = 0
169C GENERIC WRITE FLAG
170 nstrf(1)=0
171C GENERIC READ FLAG
172 nstrf(2)=0
173C file flip/flop
174 nstrf(3)=0
175C file run number
176 nstrf(4)=1
177C file next run number
178 nstrf(5)=2
179C File Rec Length
180 lrec=0
181C file record flip/flop
182
183 nstrf(7)=0
184 k0 = 31
185 kr0= 11
186 nstrf(25)=k0
187 nstrf(26)=kr0
188 l0 = 7
189 ng = 0
190
191
192 CALL hm_option_start('/SECT')
193
194 DO i=1,nsect
195C
196 istyp = 0
197 ng=ng+1
198 igu=0
199 nfram=0
200 xm=zero
201 ym=zero
202 zm=zero
203 x1=zero
204 y1=zero
205 x2=zero
206 y2=zero
207 z2=zero
208 a=zero
209 b=zero
210 c=zero
211 r=zero
212 igus=0
213 iguq=0
214 iguc=0
215 igut=0
216 igup=0
217 igur=0
218 igutg=0
219 nbinter=0
220 ifram=0
221C----------Multidomaines --> skip sections which are not taged----
222 IF(nsubdom > 0) THEN
223 IF((tagsec(ng) == 0))CALL hm_sz_r2r(tagsec,ng,lsubmodel)
224 ENDIF
225C-----------------------------------------------------------------
226C
227 lrec = lrec+3
228 k1 = k0+30
229 call extend_array(nstrf,SIZE(nstrf),k0+30)
230 CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr, unit_id=uid, submodel_id=sub_id, keyword2=key2)
231
232 nom_opt(1,i)=id
233 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1, i),ltitr)
234
235 CALL hm_get_intv('Axis_Origin_Node_N1', nstrf(k0+3), is_available, lsubmodel)
236 CALL hm_get_intv('Axis_Node_N2', nstrf(k0+4), is_available, lsubmodel)
237 CALL hm_get_intv('Axis_Node_N3', nstrf(k0+5), is_available, lsubmodel)
238 CALL hm_get_intv('ISAVE', nstrf(k0), is_available, lsubmodel)
239C
240 IF (sub_id > 0) THEN
241C-- Warning for use with submodels
242 IF ((nstrf(k0) == 1).OR.(nstrf(k0) == 2)) THEN
243 CALL ancmsg(msgid=1743, msgtype=msgwarning, anmode=aninfo_blind_1, i1=id, c1=titr)
244 ELSEIF ((nstrf(k0) == 100).OR.(nstrf(k0) == 101)) THEN
245 CALL ancmsg(msgid=1744, msgtype=msgwarning, anmode=aninfo_blind_1, i1=id, c1=titr)
246 ENDIF
247 ENDIF
248C
249 CALL hm_get_string('file_name', char8, ncharline, is_available)
250 ilen=len_trim(char8)
251 ilen=max(0,ilen)
252 IF(ilen >= 0 .AND. ilen < ncharline)THEN
253 DO k=ilen+1,ncharline
254 char8(k:k)=' '
255 ENDDO
256 ENDIF
257
258 IF(key2(1:5) == 'PARAL') THEN
259 istyp = 1
260 ELSEIF(key2(1:6) == 'CIRCLE') THEN
261 istyp = 2
262 ELSE
263 istyp = 0
264 CALL hm_get_intv('Grnod_ID', igu, is_available, lsubmodel)
265 CALL hm_get_intv('System_Id', nfram, is_available, lsubmodel)
266 ENDIF
267
268 iflagunit = 0
269 DO j=1,unitab%NUNITS
270 IF (unitab%UNIT_ID(j) == uid) THEN
271 fac_t = unitab%FAC_T(j)
272 iflagunit = 1
273 EXIT
274 ENDIF
275 ENDDO
276 IF (uid /= 0.AND.iflagunit == 0) THEN
277 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
278 . i2=uid,i1=id,c1='SECTION',
279 . c2='SECTION',
280 . c3=titr)
281 ENDIF
282
283 sectids(i)=id
284
285 CALL hm_get_floatv('detltaT', deltat, is_available, lsubmodel, unitab)
286 CALL hm_get_floatv('alpha', alpha, is_available, lsubmodel, unitab)
287
288 IF(igu == 0 .AND. nfram == 0 .AND. istyp == 0) THEN
289 CALL ancmsg(msgid=507, msgtype=msgwarning, anmode=aninfo_blind_1, i1=id, c1=titr)
290 ENDIF
291
292 DO j=1,ncharline
293 nom_sect((i-1)*ncharline+j) = ichar(char8(j:j))
294 ENDDO
295
296 iguq = 0
297 CALL hm_get_intv('grbrick_id', igus, is_available, lsubmodel)
298 CALL hm_get_intv('grshel_id', iguc, is_available, lsubmodel)
299 CALL hm_get_intv('grtrus_id', igut, is_available, lsubmodel)
300 CALL hm_get_intv('grbeam_id', igup, is_available, lsubmodel)
301 CALL hm_get_intv('grsprg_id', igur, is_available, lsubmodel)
302 CALL hm_get_intv('grtria_id', igutg, is_available, lsubmodel)
303 CALL hm_get_intv('Niter', nbinter, is_available, lsubmodel)
304 CALL hm_get_intv('Iframe', ifram, is_available, lsubmodel)
305
306 IF (nbinter < 0 .OR. nbinter > 10) THEN
307 CALL ancmsg(msgid=124,anmode=aninfo,msgtype=msgerror,i1=id,c1=titr)
308 ENDIF
309
310 IF((igus == 0).AND.(iguq == 0).AND.(iguc == 0).AND.(igut == 0).
311 . and.(igup == 0).AND.(igur == 0).AND.(igutg == 0).AND.
312 . (nbinter == 0))THEN
313 CALL ancmsg(msgid=600,
314 . msgtype=msgwarning,
315 . anmode=aninfo_blind_1,
316 . i1=id,
317 . c1=titr)
318 END IF
319
320 call extend_array(nstrf,SIZE(nstrf),k1-1+nbinter)
321 DO j=1,nbinter
322 CALL hm_get_int_array_index('int_id' ,nstrf(k1-1+j) ,j ,is_available, lsubmodel)
323 ENDDO
324
325 IF (istyp == 1) THEN
326 CALL hm_get_floatv('XTail', xm, is_available, lsubmodel, unitab)
327 CALL hm_get_floatv('YTail', ym, is_available, lsubmodel, unitab)
328 CALL hm_get_floatv('ZTail', zm, is_available, lsubmodel, unitab)
329 IF(sub_id /= 0)CALL subrotpoint(xm,ym,zm,rtrans,sub_id,lsubmodel)
330
331 CALL hm_get_floatv('cnode1_x', x1, is_available, lsubmodel, unitab)
332 CALL hm_get_floatv('cnode1_y', y1, is_available, lsubmodel, unitab)
333 CALL hm_get_floatv('cnode1_z', z1, is_available, lsubmodel, unitab)
334 IF(sub_id /= 0)CALL subrotpoint(x1,y1,z1,rtrans,sub_id,lsubmodel)
335
336 CALL hm_get_floatv('cnode2_x', x2, is_available, lsubmodel, unitab)
337 CALL hm_get_floatv('cnode2_y', y2, is_available, lsubmodel, unitab)
338 CALL hm_get_floatv('cnode2_z', z2, is_available, lsubmodel, unitab)
339 IF(sub_id /= 0)CALL subrotpoint(x2,y2,z2,rtrans,sub_id,lsubmodel)
340 d = xm
341 e = ym
342 f = zm
343 a = ((y1-ym)*(z2-zm))-((y2-ym)*(z1-zm))
344 b = ((x2-xm)*(z1-zm))-((x1-xm)*(z2-zm))
345 c = ((x1-xm)*(y2-ym))-((x2-xm)*(y1-ym))
346 norm = a*a+b*b+c*c
347 a = a/sqrt(norm)
348 b = b/sqrt(norm)
349 c = c/sqrt(norm)
350 ELSEIF (istyp == 2) THEN
351 CALL hm_get_floatv('XTail', xm, is_available, lsubmodel, unitab)
352 CALL hm_get_floatv('YTail', ym, is_available, lsubmodel, unitab)
353 CALL hm_get_floatv('ZTail', zm, is_available, lsubmodel, unitab)
354 IF(sub_id /= 0)CALL subrotpoint(xm,ym,zm,rtrans,sub_id,lsubmodel)
355
356 CALL hm_get_floatv('Normal_x', a, is_available, lsubmodel, unitab)
357 CALL hm_get_floatv('Normal_y', b, is_available, lsubmodel, unitab)
358 CALL hm_get_floatv('Normal_z', c, is_available, lsubmodel, unitab)
359 IF(sub_id /= 0)CALL subrotvect(a,b,c,rtrans,sub_id,lsubmodel)
360
361 CALL hm_get_floatv('Radius', r, is_available, lsubmodel, unitab)
362
363 d = xm
364 e = ym
365 f = zm
366 norm = a*a+b*b+c*c
367 a = a/sqrt(norm)
368 b = b/sqrt(norm)
369 c = c/sqrt(norm)
370 ENDIF
371
372 WRITE (iout,2900)i,id,trim(titr),nstrf(k0),char8(1:ilen),deltat,alpha,ifram,nbinter
373 WRITE (iout,'(10I10)')(nstrf(k1-1+j),j=1,max(0,min(10,nbinter)))
374 DO j=1,nbinter
375 DO l=1,ninter
376 IF(nstrf(k1-1+j) == ipari(15,l))THEN
377 ipari(28,l) = ipari(28,l) + 1
378C internal identifier NSTRF(K1-1+J) = L o
379 ENDIF
380 ENDDO
381 ENDDO
382C
383C Nodes related to section (if NFRAM /= 0)
384C over plane N2N3 (along +Z direction)
385C & in plane N2N3 for the given frame
386C
387 IF (istyp >= 1 .OR. nfram > 0) THEN
388 IF(istyp == 0) THEN
389 DO k=1,numfram
390 j=k+1
391 jj=(numskw+1)+nsubmod+min(iun,nspcond)*numsph+k+1
392 IF(nfram == iskn(4,jj)) THEN
393 a = xframe(7,j)
394 b = xframe(8,j)
395 c = xframe(9,j)
396 d = xframe(10,j)
397 e = xframe(11,j)
398 f = xframe(12,j)
399 n1 = iskn(1,jj)
400 IF (nstrf(k0+3) == 0 ) THEN
401 IF (iskn(1,jj) /= 0) THEN
402 nstrf(k0+3) = itab(iskn(1,jj))
403 ELSE
404 CALL ancmsg(msgid=742, msgtype=msgerror, anmode=aninfo,
405 . i1=id,
406 . c1=titr,
407 . c2='N1',
408 . i2=nfram)
409 ENDIF
410 ENDIF
411 IF (nstrf(k0+4) == 0 ) THEN
412 IF (iskn(2,jj) /= 0) THEN
413 nstrf(k0+4) = itab(iskn(2,jj))
414 ELSE
415 CALL ancmsg(msgid=742, msgtype=msgerror, anmode=aninfo,
416 . i1=id,
417 . c1=titr,
418 . c2='N2',
419 . i2=nfram)
420 ENDIF
421 ENDIF
422 IF (nstrf(k0+5) == 0 ) THEN
423 IF (iskn(3,jj) /= 0) THEN
424 nstrf(k0+5) = itab(iskn(3,jj))
425 ELSE
426 CALL ancmsg(msgid=742, msgtype=msgerror, anmode=aninfo,
427 . i1=id,
428 . c1=titr,
429 . c2='N3',
430 . i2=nfram)
431 ENDIF
432 ENDIF
433 ENDIF
434 ENDDO
435 ENDIF
436 kk=1+ngrnod
437 nnod = 0
438 cpt = 1
439 max_extension = 22 * grsize_ele(igus,igrbric,ngrbric)
440 call extend_array(nstrf,size(nstrf),k0 + max_extension)
441 CALL sec_nodes_sol(igus,istyp,igrbric,x0,a,
442 2 b,c,d,e,f,ixs,ixs10,ixs16,ixs20,
443 3 nixs,nnod,nstrf,nbinter,k1,
444 4 cpt,nodtag,isolnod,tagelems,
445 5 x1,y1,z1,x2,y2,z2,r)
446
447 kk=kk+ngrbric
448 max_extension = 6 * grsize_ele(iguq,igrquad,ngrquad)
449 call extend_array(nstrf,size(nstrf),cpt + max_extension)
450 CALL sec_nodes(iguq,istyp,ngrquad,igrquad,x0,a,
451 2 b,c,d,e,f,ixq,nixq,nnod,nstrf,
452 3 nbinter,k1,4,cpt,nodtag,tagelems(1+numels),
453 4 x1,y1,z1,x2,y2,z2,r)
454
455 kk=kk+ngrquad
456 max_extension = 6 * grsize_ele(iguc,igrsh4n,ngrshel)
457 call extend_array(nstrf,size(nstrf),cpt + max_extension)
458 CALL sec_nodes(iguc,istyp,ngrshel,igrsh4n,x0,a,
459 2 b,c,d,e,f,ixc,nixc,nnod,nstrf,
460 3 nbinter,k1,4,cpt,nodtag,tagelems(1+numels
461 . +numelq),
462 4 x1,y1,z1,x2,y2,z2,r)
463 kk=kk+ngrshel
464
465 max_extension = 4 * grsize_ele(igut,igrtruss,ngrtrus)
466 call extend_array(nstrf,size(nstrf),cpt + max_extension)
467 CALL sec_nodes(igut,istyp,ngrtrus,igrtruss,x0,a,
468 2 b,c,d,e,f,ixt,nixt,nnod,nstrf,
469 3 nbinter,k1,2,cpt,nodtag,tagelems(1+numels
470 . +numelq+numelc),
471 4 x1,y1,z1,x2,y2,z2,r)
472 kk=kk+ngrtrus
473
474
475 max_extension = 4 * grsize_ele(igup,igrbeam,ngrbeam)
476 call extend_array(nstrf,size(nstrf),cpt + max_extension)
477 CALL sec_nodes(igup,istyp,ngrbeam,igrbeam,x0,a,
478 2 b,c,d,e,f,ixp,nixp,nnod,nstrf,
479 3 nbinter,k1,2,cpt,nodtag,tagelems(1+numels
480 . +numelq+numelc+numelt),
481 4 x1,y1,z1,x2,y2,z2,r)
482 kk=kk+ngrbeam
483
484 max_extension = 4 * grsize_ele(igur,igrspring,ngrspri)
485 call extend_array(nstrf,size(nstrf),cpt + max_extension)
486 CALL sec_nodes(igur,istyp,ngrspri,igrspring,x0,a,
487 2 b,c,d,e,f,ixr,nixr,nnod,nstrf,
488 3 nbinter,k1,2,cpt,nodtag,tagelems(1+numels
489 . +numelq+numelc+numelt+numelp),
490 4 x1,y1,z1,x2,y2,z2,r)
491 kk=kk+ngrspri
492
493 max_extension = 6 * grsize_ele(igutg,igrsh3n,ngrsh3n)
494 call extend_array(nstrf,size(nstrf),cpt + max_extension)
495 CALL sec_nodes(igutg,istyp,ngrsh3n,igrsh3n,x0,a,
496 2 b,c,d,e,f,ixtg,nixtg,nnod,nstrf,
497 3 nbinter,k1,3,cpt,nodtag,tagelems(1+numels
498 . +numelq+numelc+numelt+numelp+numelr),
499 4 x1,y1,z1,x2,y2,z2,r)
500 ENDIF
501
502 k2=k1+nbinter
503 call extend_array(nstrf,size(nstrf),k2+numnod)
504 IF (nfram == 0 .AND. istyp == 0) THEN
505 nnod=nodgrnr5(igu,igs,nstrf(k2),igrnod,itabm1,mess)
506 ENDIF
507
508 WRITE (iout,3000)nnod
509 WRITE (iout,'(10I10)')(itab(nstrf(k2+j-1)),j=1,nnod)
510 IF (nnod == 0)
511 . CALL ancmsg(msgid=1113,
512 . msgtype=msgwarning,
513 . anmode=aninfo_blind_1,
514 . i1=id,
515 . c1=titr)
516
517
518 k3=k2+nnod
519 call extend_array(nstrf,SIZE(nstrf),k3+2* grsize_ele(igus,igrbric,ngrbric))
520 nsegs=elegror(igus,igrbric,ngrbric,'BRIC',
521 . nstrf(k3),2,mess,nfram,tagelems,istyp,
522 . id,titr)
523 k4=k3+2*nsegs
524 call extend_array(nstrf,SIZE(nstrf),k4+2* grsize_ele(iguq,igrquad,ngrquad))
525 nsegq=elegror(iguq,igrquad,ngrquad,'QUAD',
526 . nstrf(k4),2,mess,nfram,tagelems(1+numels),istyp,
527 . id,titr)
528 k5=k4+2*nsegq
529 call extend_array(nstrf,SIZE(nstrf),k5+2* grsize_ele(iguc,igrsh4n,ngrshel))
530 nsegc=elegror(iguc,igrsh4n,ngrshel,'SHEL',
531 . nstrf(k5),2,mess,nfram,tagelems(1+numels
532 . +numelq),istyp,
533 . id,titr)
534 k6=k5+2*nsegc
535 call extend_array(nstrf,SIZE(nstrf),k6+2* grsize_ele(igut,igrtruss,ngrtrus))
536 nsegt=elegror(igut,igrtruss,ngrtrus,'TRUS',
537 . nstrf(k6),2,mess,nfram,tagelems(1+numels
538 . +numelq+numelc),istyp,
539 . id,titr)
540 k7=k6+2*nsegt
541 call extend_array(nstrf,SIZE(nstrf),k7+2* grsize_ele(igup,igrbeam,ngrbeam))
542 nsegp=elegror(igup,igrbeam,ngrbeam,'BEAM',
543 . nstrf(k7),2,mess,nfram,tagelems(1+numels
544 . +numelq+numelc+numelt),istyp,
545 . id,titr)
546 k8=k7+2*nsegp
547 call extend_array(nstrf,SIZE(nstrf),k8+2* grsize_ele(igur,igrspring,ngrspri))
548 nsegr=elegror(igur,igrspring,ngrspri,'SPRI',
549 . nstrf(k8),2,mess,nfram,tagelems(1+numels
550 . +numelq+numelc+numelt+numelp),istyp,
551 . id,titr)
552
553 IF (nb_seatbelt_shells /=0) THEN
554 snstrf1 = grsize_ele_trans(iguc,igrsh4n,ngrshel,seatbelt_shell_to_spring)
555 call extend_array(nstrf,SIZE(nstrf),k8+2*nsegr+2*snstrf1)
556 nsegr=nsegr+elegror_seatbelt(iguc,igrsh4n,ngrshel,
557 . nstrf(k8),2,snstrf1,nfram,tagelems(1+numels
558 . +numelq),istyp,
559 . seatbelt_shell_to_spring)
560 ENDIF
561
562 k9=k8+2*nsegr
563 call extend_array(nstrf,SIZE(nstrf),k9+2* grsize_ele(igutg,igrsh3n,ngrsh3n))
564 nsegtg=elegror(igutg,igrsh3n,ngrsh3n,'SH3N',
565 . nstrf(k9),2,mess,nfram,tagelems(1+numels
566 . +numelq+numelc+numelt+numelp+numelr),istyp,
567 . id,titr)
568C
569 IF(nsegs+nsegq+nsegc+nsegt+nsegp+nsegr+nsegtg==0)THEN
570 CALL ancmsg(msgid=1813, msgtype=msgwarning, anmode=aninfo,
571 . i1= id,
572 . c1= titr)
573 END IF
574C
575C-------------------------------------------------------------------------
576C
577C
578 nstrf(k0+14)=nbinter
579 nstrf(k0+6)=nnod
580 nstrf(k0+7)=nsegs
581 nstrf(k0+8)=nsegq
582 nstrf(k0+9)=nsegc
583 nstrf(k0+10)=nsegt
584 nstrf(k0+11)=nsegp
585 nstrf(k0+12)=nsegr
586 nstrf(k0+13)=nsegtg
587 nstrf(k0+26)=ifram
588 DO l=k0+3,k0+5
589 IF (nstrf(l) /= 0) THEN
590 nstrf(l)=usr2sys(nstrf(l),itabm1,mess,id)
591 CALL anodset(nstrf(l), check_used)
592 ENDIF
593 ENDDO
594 !NNSK1=ITAB(NSTRF(K0+3))
595 !NNSK2=ITAB(NSTRF(K0+4))
596 !NNSK3=ITAB(NSTRF(K0+5))
597 IF(nstrf(k0+3)/=0 .AND. nstrf(k0+3)/=0 .AND. nstrf(k0+3)/=0)THEN
598 x1=x0(1,nstrf(k0+4))-x0(1,nstrf(k0+3))
599 y1=x0(2,nstrf(k0+4))-x0(2,nstrf(k0+3))
600 z1=x0(3,nstrf(k0+4))-x0(3,nstrf(k0+3))
601 x2=x0(1,nstrf(k0+5))-x0(1,nstrf(k0+4))
602 y2=x0(2,nstrf(k0+5))-x0(2,nstrf(k0+4))
603 z2=x0(3,nstrf(k0+5))-x0(3,nstrf(k0+4))
604 x3=y1*z2-z1*y2
605 y3=z1*x2-z2*x1
606 z3=x1*y2-x2*y1
607 n3=x3*x3+y3*y3+z3*z3
608 pnor1=sqrt(x1*x1+y1*y1+z1*z1)
609 IF (pnor1 < em20) THEN
610 CALL ancmsg(msgid=508,msgtype=msgerror,anmode=aninfo_blind_1,i1=id,c1=titr)
611 ELSE
612 pnor2=sqrt(n3)
613 IF (pnor2 > em20) THEN
614 pnorm1=one/(pnor1*pnor2)
615 det1=abs((y3*z1-z3*y1)*pnorm1)
616 det2=abs((z3*x1-x3*z1)*pnorm1)
617 det3=abs((x3*y1-y3*x1)*pnorm1)
618 det= max(det1,det2,det3)
619 ELSE
620 det=zero
621 ENDIF
622 IF (det < em5) THEN
623 CALL ancmsg(msgid=508,msgtype=msgerror,anmode=aninfo_blind_1,i1=id,c1=titr)
624 ENDIF
625 ENDIF
626 ENDIF
627C
628C-------------------------------------------------------------------------
629C SOLIDES
630C--------------------------------------------------------------
631 WRITE (iout,3300) nsegs
632 CALL secstri(nsegs,nstrf(k3),ixs,ixs10,ixs16,ixs20,
633 . nstrf(k2),nnod,noprint)
634C-------------------------------------------------------------
635C QUADS
636C--------------------------------------------------------------
637 WRITE (iout,3400) nsegq
638 CALL sec_tri(nsegq,nstrf(k4),ixq,nixq,4,nstrf(k2),
639 . nnod)
640C-------------------------------------------------------------
641C COQUES
642C--------------------------------------------------------------
643 WRITE (iout,3100) nsegc
644 CALL sec_tri(nsegc,nstrf(k5),ixc,nixc,4,nstrf(k2),
645 . nnod)
646C-------------------------------------------------------------
647C BARRES
648C--------------------------------------------------------------
649 WRITE (iout,3500) nsegt
650 CALL sec_tri(nsegt,nstrf(k6),ixt,nixt,2,nstrf(k2),
651 . nnod)
652C-------------------------------------------------------------
653C POUTRES
654C--------------------------------------------------------------
655 WRITE (iout,3600) nsegp
656 CALL sec_tri(nsegp,nstrf(k7),ixp,nixp,2,nstrf(k2),
657 . nnod)
658C-------------------------------------------------------------
659C RESSORTS
660C--------------------------------------------------------------
661 WRITE (iout,3700) nsegr
662 CALL sec_tri(nsegr,nstrf(k8),ixr,nixr,2,nstrf(k2),
663 . nnod)
664C-------------------------------------------------------------
665C COQUES 3N
666C--------------------------------------------------------------
667 WRITE (iout,3200) nsegtg
668 CALL sec_tri(nsegtg,nstrf(k9),ixtg,nixtg,3,nstrf(k2),
669 . nnod)
670
671C-------------------------------------------------------------
672C
673 IF(nstrf(k0) >= 102)THEN
674 CALL zerore(1,10+30*nnod,secbuf(kr0))
675 ELSEIF(nstrf(k0) >= 101)THEN
676 CALL zerore(1,10+24*nnod,secbuf(kr0))
677 ELSEIF(nstrf(k0) >= 100)THEN
678 CALL zerore(1,10+12*nnod,secbuf(kr0))
679 ELSE
680 CALL zerore(1,10,secbuf(kr0))
681 ENDIF
682 secbuf(kr0) = deltat
683 secbuf(kr0+1) = zero
684 secbuf(kr0+2) = alpha
685 secbuf(kr0+3) = zero
686C
687 IF(nstrf(k0) == 1.OR.nstrf(k0) == 2)THEN
688 IF(secbuf(1) == zero)THEN
689 secbuf(1) = deltat
690 ELSE
691 maxdt=max(secbuf(1),deltat)
692 IF(abs((secbuf(1)-deltat)/secbuf(1)) > em06 )THEN
693 CALL ancmsg(msgid=356,
694 . msgtype=msgerror,
695 . anmode=aninfo_blind_2,
696 . i1=id,
697 . c1=titr)
698 ENDIF
699 ENDIF
700 ENDIF
701C
702 IF(nstrf(k0) >= 1.AND.nstrf(k0) <= 10)THEN
703 nstrf(1)=nstrf(1)+1
704 ELSEIF(nstrf(k0) >= 100.AND.nstrf(k0) <= 200)THEN
705 nstrf(2)=nstrf(2)+1
706 DO j=1,8
707 nstrf(15+j)=nstrf(k0+14+j)
708 ENDDO
709 ENDIF
710 IF(nstrf(k0) == 1)THEN
711 lrec = lrec+6*nnod
712 ELSEIF(nstrf(k0) == 2)THEN
713 lrec = lrec+12*nnod
714 ENDIF
715C
716 nstrf(k0+23) = id
717 nstrf(k0+24) = k9+2*nsegtg
718 nstrf(k0+25) = kr0+10
719 IF(nstrf(k0) >= 100)nstrf(k0+25) = nstrf(k0+25)+12*nnod
720 IF(nstrf(k0) >= 101)nstrf(k0+25) = nstrf(k0+25)+12*nnod
721 IF(nstrf(k0) >= 102)nstrf(k0+25) = nstrf(k0+25)+6*nnod
722C
723 kr0 = nstrf(k0+25)
724 k0 = nstrf(k0+24)
725C-------------------------------------------------------------
726 nodtag = 0
727 tagelems = 0
728 ENDDO
729 CALL udouble(sectids,1,nsect,mess,0,bid)
730
731C File Rec Length
732 nstrf(6)=lrec*4
733 DEALLOCATE(tagnodes)
734 DEALLOCATE(tagndoubl)
735 DEALLOCATE(tagelems)
736 DEALLOCATE(nodtag)
737
738
739C-------------------------------------------------------------
740 2900 FORMAT(/' SECTION',i10,' ID',i10/
741 + ' ---------------'/
742 + ,a/,
743 + ' TYPE . . . . . . . . . . . . . . .',i10/
744 + ' FILENAME . . . . . . . . . . . . .',a/
745 + ' DELTAT . . . . . . . . . . . . . .',1pg20.13/
746 + ' ALPHA. . . . . . . . . . . . . . .',1pg20.13/
747 + ' FRAME TYPE . . . . . . . . . . . .',i10/
748 + ' NUMBER OF INTERFACES . . . . . . .',i10/
749 + ' INTERFACES:')
750 3000 FORMAT(/
751 + ' NUMBER OF NODES. . . . . . . . . .',i10/
752 + ' NODES:')
753 3100 FORMAT(/
754 + ' NUMBER OF SHELL ELEMENTS . . . . .',i10/
755 + ' SHELL N1 N2 N3 N4')
756 3200 FORMAT(/
757 + ' NUMBER OF 3 NODES SHELL ELEMENTS .',i10/
758 + ' SHELL N1 N2 N3')
759 3300 FORMAT(/
760 + ' NUMBER OF BRICK ELEMENTS . . . . .',i10/
761 + ' BRICK N1 N2 N3 N4',
762 + ' N5 N6 N7 N8')
763 3400 FORMAT(/
764 + ' NUMBER OF QUAD ELEMENTS . . . . .',i10/
765 + ' QUAD N1 N2 N3 N4')
766 3500 FORMAT(/
767 + ' NUMBER OF TRUSS ELEMENTS . . . . .',i10/
768 + ' TRUSS N1 N2')
769 3600 FORMAT(/
770 + ' NUMBER OF BEAM ELEMENTS . . . . .',i10/
771 + ' BEAM N1 N2')
772 3700 FORMAT(/
773 + ' NUMBER OF SPRING ELEMENTS . . . . .',i8/
774 + ' SPRING N1 N2')
775C
776 RETURN
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
elegror
integer function elegror(igu, igrele, ngrele, mot, ibuf, nib, mess, nfram, tagelems, istyp, id, titr)
Definition elegror.F:34
elegror_seatbelt
integer function elegror_seatbelt(igu, igrele, ngrele, ibuf, nib, sibuf, nfram, tagelems, istyp, seatbelt_shell_to_spring)
Definition elegror_seatbelt.F:32
alpha
#define alpha
Definition eval.h:35
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:78
sec_nodes_sol
subroutine sec_nodes_sol(igu1, istyp, igrbric, x0, a, b, c, d, e, f, ixs, ixs10, ixs16, ixs20, nix, nnod, nstrf, nbinter, k1, j, nodtag, isolnod, tagelems, x1, y1, z1, x2, y2, z2, r)
Definition hm_read_sect.F:1210
sec_tri
subroutine sec_tri(nseg, isecbuf, ix, nix, nne, nod, nnod)
Definition hm_read_sect.F:918
secstri
subroutine secstri(nseg, isecbuf, ixs, ixs10, ixs16, ixs20, nod, nnod, noprint)
Definition hm_read_sect.F:788
sec_nodes
subroutine sec_nodes(igu1, istyp, ngrele, igrele, x0, a, b, c, d, e, f, ix, nix, nnod, nstrf, nbinter, k1, nbnodes, j, nodtag, tagelems, x1, y1, z1, x2, y2, z2, r)
Definition hm_read_sect.F:1050
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagsec
integer, dimension(:), allocatable tagsec
Definition r2r_mod.F:137
restmod::ixs
integer, dimension(:), allocatable, target ixs
Definition restart_mod.F:60
restmod::unitab
type(unit_type_) unitab
Definition restart_mod.F:211
restmod::ipari
integer, dimension(:), allocatable, target ipari
Definition restart_mod.F:60
restmod::ixt
integer, dimension(:), allocatable ixt
Definition restart_mod.F:60
restmod::ixr
integer, dimension(:), allocatable ixr
Definition restart_mod.F:60
restmod::ixtg
integer, dimension(:), allocatable, target ixtg
Definition restart_mod.F:60
restmod::itabm1
integer, dimension(:), allocatable, target itabm1
Definition restart_mod.F:60
restmod::itab
integer, dimension(:), allocatable itab
Definition restart_mod.F:60
restmod::ixp
integer, dimension(:), allocatable ixp
Definition restart_mod.F:60
restmod::nom_opt
integer, dimension(:), allocatable, target nom_opt
Definition restart_mod.F:60
restmod::nstrf
integer, dimension(:), allocatable nstrf
Definition restart_mod.F:60
restmod::ixq
integer, dimension(:), allocatable ixq
Definition restart_mod.F:60
restmod::nom_sect
integer, dimension(:), allocatable nom_sect
Definition restart_mod.F:60
restmod::ixc
integer, dimension(:), allocatable ixc
Definition restart_mod.F:60
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
unitab_mod
Definition unitab_mod.F:517
grsize_ele
integer function grsize_ele(igu, igrelem, ngrelem)
Definition nintrr.F:535
grsize_ele_trans
integer function grsize_ele_trans(igu, igrelem, ngrelem, seatbelt_shell_to_spring)
Definition nintrr.F:575
hm_sz_r2r
subroutine hm_sz_r2r(tag, val, lsubmodel)
Definition routines_r2r.F:299
ancmsg
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)
Definition message.F:895
nodgrnr5
integer function nodgrnr5(igu, igs, ibuf, igrnod, itabm1, mess)
Definition freform.F:298
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:615
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:573
subrotvect
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:54
subrotpoint
subroutine subrotpoint(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:180
zerore
subroutine zerore(n1, n2, am)
Definition zerore.F:31

◆ sec_nodes()

subroutine sec_nodes ( integer igu1,
integer istyp,
integer ngrele,
type (group_), dimension(ngrele) igrele,
x0,
a,
b,
c,
d,
e,
f,
integer, dimension(nix,*) ix,
integer nix,
integer nnod,
integer, dimension(*) nstrf,
integer nbinter,
integer k1,
integer nbnodes,
integer j,
integer, dimension(numnod) nodtag,
integer, dimension(*) tagelems,
x1,
y1,
z1,
x2,
y2,
z2,
r )

Definition at line 1046 of file hm_read_sect.F.

1050C-----------------------------------------------
1051C M o d u l e s
1052C-----------------------------------------------
1053 USE groupdef_mod
1054C-----------------------------------------------
1055C I m p l i c i t T y p e s
1056C-----------------------------------------------
1057#include "implicit_f.inc"
1058C-----------------------------------------------
1059C C o m m o n B l o c k s
1060C-----------------------------------------------
1061#include "com04_c.inc"
1062C-----------------------------------------------
1063C D u m m y A r g u m e n t s
1064C-----------------------------------------------
1065 INTEGER IGU1,ISTYP,NGRELE,NIX,NNOD,NBINTER,K1,NBNODES,J
1066 INTEGER IX(NIX,*), NSTRF(*), NODTAG(NUMNOD),TAGELEMS(*)
1067 my_real x0(3,*),a,b,c,d,e,f,x1,y1,z1,x2,y2,z2,r
1068C-----------------------------------------------
1069 TYPE (GROUP_) ,DIMENSION(NGRELE) :: IGRELE
1070C-----------------------------------------------
1071C L o c a l V a r i a b l e s
1072C-----------------------------------------------
1073 INTEGER K,L,ISU,IE,TAGELEM1,TAGELEM2,TAGELEM3,NBPROJOK
1074 !TAGNDOUBL(NUMNOD),TAGNODES(NUMNOD*2+NPART)
1075 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGNDOUBL, TAGNODES
1076 my_real pos,projx,projy,projz,p1,p2
1077C-----------------------------------------------
1078C S o u r c e F i l e s
1079C-----------------------------------------------
1080C
1081C List nodes related to section.
1082C
1083 ALLOCATE(tagndoubl(numnod))
1084 ALLOCATE(tagnodes(numnod*2+npart))
1085 projx = zero
1086 projy = zero
1087 projz = zero
1088 p1 = zero
1089 p2 = zero
1090 isu = -huge(isu)
1091 tagndoubl = 0
1092 tagnodes = 0
1093 IF (igu1 /= 0) THEN
1094 DO l=1,ngrele
1095 IF ( igrele(l)%ID == igu1 )THEN
1096 isu = l
1097 ENDIF
1098 ENDDO
1099 DO l=1,igrele(isu)%NENTITY
1100 ie=igrele(isu)%ENTITY(l)
1101 IF (ie /= 0) THEN
1102 tagelem1=0
1103 tagelem2=0
1104 tagelem3=0
1105 nbprojok = 0
1106 DO k=2,nbnodes+1
1107C taging nodes connected to elem
1108 p1 = zero
1109 p2 = zero
1110 pos = (x0(1,ix(k,ie))-d)*a + (x0(2,ix(k,ie))-e)*b + (x0(3,ix(k,ie))-f)*c
1111 IF (istyp == 1) THEN
1112 projx = x0(1,ix(k,ie))-pos*a
1113 projy = x0(2,ix(k,ie))-pos*b
1114 projz = x0(3,ix(k,ie))-pos*c
1115 projx = projx-d
1116 projy = projy-e
1117 projz = projz-f
1118c
1119 IF ( (x2-d) /= zero .AND. (y1-e)-(x1-d)*(y2-e) /= zero)THEN
1120 p1 = (projy-projx*(y2-e)/(x2-d))/ ((y1-e)-(x1-d)*(y2-e)/(x2-d))
1121 ELSEIF( (y2-e) /= zero .AND. (z1-f)-(y1-e)*(z2-f) /= zero)THEN
1122 p1 = (projz-projy*(z2-f)/(y2-e))/ ((z1-f)-(y1-e)*(z2-f)/(y2-e))
1123 ELSEIF( (z2-f) /= zero .AND. (x1-d)-(z1-f)*(x2-d) /= zero)THEN
1124 p1 = (projx-projz*(x2-d)/(z2-f))/ ((x1-d)-(z1-f)*(x2-d)/(z2-f))
1125 ENDIF
1126 IF ( (x1-d) /= zero .AND. (y2-e)-(x2-d)*(y1-e) /= zero)THEN
1127 p2 = (projy-projx*(y1-e)/(x1-d))/ ((y2-e)-(x2-d)*(y1-e)/(x1-d))
1128 ELSEIF ( (y1-e) /= zero .AND. (z2-f)-(y2-e)*(z1-f) /= zero)THEN
1129 p2 = (projz-projy*(z1-f)/(y1-e))/ ((z2-f)-(y2-e)*(z1-f)/(y1-e))
1130 ELSEIF ( (z1-f) /= zero .AND. (x2-d)-(z2-f)*(x1-d) /= zero)THEN
1131 p2 = (projx-projz*(x1-d)/(z1-f))/ ((x2-d)-(z2-f)*(x1-d)/(z1-f))
1132 ENDIF
1133c
1134 IF((x2-d)== zero .AND. (x1-d)/= zero) p1 = projx / (x1-d)
1135 IF((x1-d)== zero .AND. (x2-d)/= zero) p2 = projx / (x2-d)
1136 IF((y2-e)== zero .AND. (y1-e)/= zero) p1 = projy / (y1-e)
1137 IF((y1-e)== zero .AND. (y2-e)/= zero) p2 = projy / (y2-e)
1138 IF((z2-f)== zero .AND. (z1-f)/= zero) p1 = projz / (z1-f)
1139 IF((z1-f)== zero .AND. (z2-f)/= zero) p2 = projz / (z2-f)
1140
1141 IF( p1 <= 1 .AND. p1 >= 0 .AND. p2 <= 1 .AND. p2 >= 0) nbprojok = nbprojok + 1
1142
1143 ELSEIF (istyp == 2) THEN
1144 projx = x0(1,ix(k,ie))-pos*a
1145 projy = x0(2,ix(k,ie))-pos*b
1146 projz = x0(3,ix(k,ie))-pos*c
1147 projx = projx-d
1148 projy = projy-e
1149 projz = projz-f
1150 p1 = sqrt(projx**2+projy**2+projz**2)
1151 IF( p1 <= r) nbprojok = nbprojok + 1
1152 ENDIF
1153
1154 IF ( pos < zero) THEN
1155 tagnodes(ix(k,ie))= -1
1156 tagndoubl(ix(k,ie)) = tagndoubl(ix(k,ie)) + 1
1157 tagelem1 = 1
1158 ELSEIF ( pos == zero) THEN
1159 tagnodes(ix(k,ie))= 0
1160 tagndoubl(ix(k,ie)) = tagndoubl(ix(k,ie)) + 1
1161 tagelem2 = 1
1162 ELSE
1163 tagnodes(ix(k,ie))= 1
1164 tagndoubl(ix(k,ie)) = tagndoubl(ix(k,ie)) + 1
1165 tagelem3 = 1
1166 ENDIF
1167 ENDDO
1168 IF ( (istyp == 0 .OR. nbprojok >= 1) .AND.
1169 . ( tagelem1+tagelem3 /= 1
1170 . .OR. ( tagelem2 == 1 .AND. tagelem3 == 1 )))
1171 . tagelems(ie) = 1
1172 ENDIF
1173 ENDDO
1174 DO l=1,igrele(isu)%NENTITY
1175 ie=igrele(isu)%ENTITY(l)
1176 IF (ie /= 0) THEN
1177 IF (tagelems(ie) == 1) THEN
1178 DO k=2,nbnodes+1
1179 IF ( tagndoubl(ix(k,ie)) >= 1
1180 . .AND. tagnodes(ix(k,ie)) > 0
1181 . .AND. nodtag(ix(k,ie)) == 0) THEN
1182 nstrf(k1+nbinter+j-1) = ix(k,ie)
1183 tagndoubl(ix(k,ie)) = 0
1184 nodtag(ix(k,ie)) = 1
1185 j = j + 1
1186 nnod = nnod + 1
1187 ENDIF
1188 ENDDO
1189 ENDIF
1190 ENDIF
1191 ENDDO
1192 ENDIF
1193 DEALLOCATE(tagndoubl)
1194 DEALLOCATE(tagnodes)
1195 RETURN

◆ sec_nodes_sol()

subroutine sec_nodes_sol ( integer igu1,
integer istyp,
type (group_), dimension(ngrbric) igrbric,
x0,
a,
b,
c,
d,
e,
f,
integer, dimension(nix,numels) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer nix,
integer nnod,
integer, dimension(*) nstrf,
integer nbinter,
integer k1,
integer j,
integer, dimension(numnod) nodtag,
integer, dimension(*) isolnod,
integer, dimension(*) tagelems,
x1,
y1,
z1,
x2,
y2,
z2,
r )

Definition at line 1205 of file hm_read_sect.F.

1210C-----------------------------------------------
1211C M o d u l e s
1212C-----------------------------------------------
1213 USE groupdef_mod
1214C-----------------------------------------------
1215C I m p l i c i t T y p e s
1216C-----------------------------------------------
1217#include "implicit_f.inc"
1218C-----------------------------------------------
1219C C o m m o n B l o c k s
1220C-----------------------------------------------
1221#include "com04_c.inc"
1222C-----------------------------------------------
1223C D u m m y A r g u m e n t s
1224C-----------------------------------------------
1225 INTEGER IGU1,ISTYP,NIX,NNOD,NBINTER,K1,J
1226 INTEGER IXS(NIX,NUMELS), NSTRF(*),
1227 . NODTAG(NUMNOD), IXS10(6,*),IXS16(8,*),IXS20(12,*),
1228 . ISOLNOD(*),TAGELEMS(*)
1229 my_real x0(3,*),a,b,c,d,e,f,x1,y1,z1,x2,y2,z2,r
1230C-----------------------------------------------
1231 TYPE (GROUP_) ,DIMENSION(NGRBRIC) :: IGRBRIC
1232C-----------------------------------------------
1233C L o c a l V a r i a b l e s
1234C-----------------------------------------------
1235 INTEGER K,L,ISU,IE,TAGELEM1,TAGELEM2,TAGELEM3, NBNODES,NBPROJOK,OFFSET
1236 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGNDOUBL,TAGNODES
1237 my_real pos,projx,projy,projz,p1,p2
1238C-----------------------------------------------
1239C S o u r c e F i l e s
1240C-----------------------------------------------
1241C
1242C List nodes related to section if frame is used
1243C
1244 ALLOCATE( tagndoubl(numnod),tagnodes(numnod*2+npart) )
1245 tagndoubl = 0
1246 tagnodes = 0
1247 IF (igu1 /= 0) THEN
1248 DO l=1,ngrbric
1249 IF ( igrbric(l)%ID == igu1 )THEN
1250 isu = l
1251 ENDIF
1252 ENDDO
1253 DO l=1,igrbric(isu)%NENTITY
1254 ie=igrbric(isu)%ENTITY(l)
1255 IF (ie /= 0) THEN
1256 nbnodes = isolnod(ie)
1257 IF (nbnodes == 4 .OR. nbnodes == 6) nbnodes = 8
1258 tagelem1=0
1259 tagelem2=0
1260 tagelem3=0
1261 nbprojok = 0
1262 DO k=2,nbnodes+1
1263C tag nodes connected to the element
1264 IF (nbnodes == 10 .AND. k > 5) THEN
1265 offset = numels8
1266 pos = (x0(1,ixs10(k-5,ie-offset))-d)*a +
1267 . (x0(2,ixs10(k-5,ie-offset))-e)*b +
1268 . (x0(3,ixs10(k-5,ie-offset))-f)*c
1269 IF (istyp >= 1) THEN
1270 projx = x0(1,ixs10(k-5,ie-offset))-pos*a
1271 projy = x0(2,ixs10(k-5,ie-offset))-pos*b
1272 projz = x0(3,ixs10(k-5,ie-offset))-pos*c
1273 ENDIF
1274 ELSEIF (nbnodes == 16 .AND. k > 9) THEN
1275 offset = numels8+numels10+numels20
1276 pos = (x0(1,ixs16(k-9,ie-offset))-d)*a +
1277 . (x0(2,ixs16(k-9,ie-offset))-e)*b +
1278 . (x0(3,ixs16(k-9,ie-offset))-f)*c
1279 IF (istyp >= 1) THEN
1280 projx = x0(1,ixs16(k-9,ie-offset))-pos*a
1281 projy = x0(2,ixs16(k-9,ie-offset))-pos*b
1282 projz = x0(3,ixs16(k-9,ie-offset))-pos*c
1283 ENDIF
1284 ELSEIF (nbnodes == 20 .AND. k > 9) THEN
1285 offset = numels8+numels10
1286 pos = (x0(1,ixs20(k-9,ie-offset))-d)*a +
1287 . (x0(2,ixs20(k-9,ie-offset))-e)*b +
1288 . (x0(3,ixs20(k-9,ie-offset))-f)*c
1289 IF (istyp >= 1) THEN
1290 projx = x0(1,ixs20(k-9,ie-offset))-pos*a
1291 projy = x0(2,ixs20(k-9,ie-offset))-pos*b
1292 projz = x0(3,ixs20(k-9,ie-offset))-pos*c
1293 ENDIF
1294 ELSE
1295 pos = (x0(1,ixs(k,ie))-d)*a +
1296 . (x0(2,ixs(k,ie))-e)*b +
1297 . (x0(3,ixs(k,ie))-f)*c
1298 IF (istyp >= 1) THEN
1299 projx = x0(1,ixs(k,ie))-pos*a
1300 projy = x0(2,ixs(k,ie))-pos*b
1301 projz = x0(3,ixs(k,ie))-pos*c
1302 ENDIF
1303 ENDIF
1304 IF (istyp == 1) THEN
1305 projx = projx - d
1306 projy = projy - e
1307 projz = projz - f
1308c
1309 IF ( (x2-d) /= zero .AND.
1310 . (y1-e)-(x1-d)*(y2-e) /= zero)THEN
1311 p1 = (projy-projx*(y2-e)/(x2-d))/
1312 . ((y1-e)-(x1-d)*(y2-e)/(x2-d))
1313 ELSEIF( (y2-e) /= zero .AND.
1314 . (z1-f)-(y1-e)*(z2-f) /= zero)THEN
1315 p1 = (projz-projy*(z2-f)/(y2-e))/
1316 . ((z1-f)-(y1-e)*(z2-f)/(y2-e))
1317 ELSEIF( (z2-f) /= zero .AND.
1318 . (x1-d)-(z1-f)*(x2-d) /= zero)THEN
1319 p1 = (projx-projz*(x2-d)/(z2-f))/
1320 . ((x1-d)-(z1-f)*(x2-d)/(z2-f))
1321 ENDIF
1322 IF ( (x1-d) /= zero .AND.
1323 . (y2-e)-(x2-d)*(y1-e) /= zero)THEN
1324 p2 = (projy-projx*(y1-e)/(x1-d))/
1325 . ((y2-e)-(x2-d)*(y1-e)/(x1-d))
1326 ELSEIF ( (y1-e) /= zero .AND.
1327 . (z2-f)-(y2-e)*(z1-f) /= zero)THEN
1328 p2 = (projz-projy*(z1-f)/(y1-e))/
1329 . ((z2-f)-(y2-e)*(z1-f)/(y1-e))
1330 ELSEIF ( (z1-f) /= zero .AND.
1331 . (x2-d)-(z2-f)*(x1-d) /= zero)THEN
1332 p2 = (projx-projz*(x1-d)/(z1-f))/
1333 . ((x2-d)-(z2-f)*(x1-d)/(z1-f))
1334 ENDIF
1335c
1336 IF((x2-d)== zero .AND. (x1-d)/= zero) p1 = projx / (x1-d)
1337 IF((x1-d)== zero .AND. (x2-d)/= zero) p2 = projx / (x2-d)
1338 IF((y2-e)== zero .AND. (y1-e)/= zero) p1 = projy / (y1-e)
1339 IF((y1-e)== zero .AND. (y2-e)/= zero) p2 = projy / (y2-e)
1340 IF((z2-f)== zero .AND. (z1-f)/= zero) p1 = projz / (z1-f)
1341 IF((z1-f)== zero .AND. (z2-f)/= zero) p2 = projz / (z2-f)
1342 IF( p1 <= 1 .AND. p1 >= 0 .AND. p2 <= 1 .AND. p2 >= 0)nbprojok = nbprojok + 1
1343
1344 ELSEIF (istyp == 2) THEN
1345 projx = projx - d
1346 projy = projy - e
1347 projz = projz - f
1348 p1 = sqrt(projx**2+projy**2+projz**2)
1349 IF( p1 <= r) nbprojok = nbprojok + 1
1350 ENDIF
1351 IF ( pos < zero) THEN
1352 IF (nbnodes == 10 .AND. k>5) THEN
1353 offset = numels8
1354 tagnodes(ixs10(k-5,ie-offset))= -1
1355 tagndoubl(ixs10(k-5,ie-offset)) = tagndoubl(ixs10(k-5,ie-offset)) + 1
1356 ELSEIF (nbnodes == 16 .AND. k>9) THEN
1357 offset = numels8+numels10+numels20
1358 tagnodes(ixs16(k-9,ie-offset))= -1
1359 tagndoubl(ixs16(k-9,ie-offset)) = tagndoubl(ixs16(k-9,ie-offset)) + 1
1360 ELSEIF (nbnodes == 20 .AND. k>9) THEN
1361 offset = numels8+numels10
1362 tagnodes(ixs20(k-9,ie-offset))= -1
1363 tagndoubl(ixs20(k-9,ie-offset)) = tagndoubl(ixs20(k-9,ie-offset)) + 1
1364 ELSE
1365 tagnodes(ixs(k,ie))= -1
1366 tagndoubl(ixs(k,ie)) = tagndoubl(ixs(k,ie)) + 1
1367 ENDIF
1368 tagelem1 = 1
1369 ELSEIF ( pos == zero) THEN
1370 IF(nbnodes == 10 .AND. k>5) THEN
1371 offset = numels8
1372 tagnodes(ixs10(k-5,ie-offset))= 0
1373 tagndoubl(ixs10(k-5,ie-offset)) = tagndoubl(ixs10(k-5,ie-offset)) + 1
1374 ELSEIF (nbnodes == 16 .AND. k>9) THEN
1375 offset = numels8+numels10+numels20
1376 tagnodes(ixs16(k-9,ie-offset))= 0
1377 tagndoubl(ixs16(k-9,ie-offset)) = tagndoubl(ixs16(k-9,ie-offset)) + 1
1378 ELSEIF (nbnodes == 20 .AND. k>9) THEN
1379 offset = numels8+numels10
1380 tagnodes(ixs20(k-9,ie-offset))= 0
1381 tagndoubl(ixs20(k-9,ie-offset)) = tagndoubl(ixs20(k-9,ie-offset)) + 1
1382 ELSE
1383 tagnodes(ixs(k,ie))= 0
1384 tagndoubl(ixs(k,ie)) = tagndoubl(ixs(k,ie)) + 1
1385 ENDIF
1386 tagelem2 = 1
1387 ELSE
1388 IF (nbnodes == 10 .AND. k>5) THEN
1389 offset = numels8
1390 tagnodes(ixs10(k-5,ie-offset))= 1
1391 tagndoubl(ixs10(k-5,ie-offset)) = tagndoubl(ixs10(k-5,ie-offset)) + 1
1392 ELSEIF (nbnodes == 16 .AND. k>9) THEN
1393 offset = numels8+numels10+numels20
1394 tagnodes(ixs16(k-9,ie-offset))= 1
1395 tagndoubl(ixs16(k-9,ie-offset)) = tagndoubl(ixs16(k-9,ie-offset)) + 1
1396 ELSEIF (nbnodes == 20 .AND. k>9) THEN
1397 offset = numels8+numels10
1398 tagnodes(ixs20(k-9,ie-offset))= 1
1399 tagndoubl(ixs20(k-9,ie-offset)) = tagndoubl(ixs20(k-9,ie-offset)) + 1
1400 ELSE
1401 tagnodes(ixs(k,ie))= 1
1402 tagndoubl(ixs(k,ie)) = tagndoubl(ixs(k,ie)) + 1
1403 ENDIF
1404 tagelem3 = 1
1405 ENDIF
1406 ENDDO
1407 IF ( (istyp == 0 .OR. nbprojok >= 1) .AND.
1408 . ( tagelem1+tagelem3 /= 1
1409 . .OR. ( tagelem2 == 1 .AND. tagelem3 == 1 )))
1410 . tagelems(ie) = 1
1411 ENDIF
1412 ENDDO
1413!
1414 DO l=1,igrbric(isu)%NENTITY
1415 ie=igrbric(isu)%ENTITY(l)
1416 IF (ie /= 0) THEN
1417 nbnodes = isolnod(ie)
1418 IF (nbnodes == 4 .OR. nbnodes == 6) nbnodes = 8
1419 IF (tagelems(ie) == 1) THEN
1420 DO k=2,nbnodes+1
1421 IF (nbnodes == 10 .AND. k > 5) THEN
1422 offset = numels8
1423 IF ( tagndoubl(ixs10(k-5,ie-offset)) >= 1
1424 . .AND. tagnodes(ixs10(k-5,ie-offset)) > 0
1425 . .AND. nodtag(ixs10(k-5,ie-offset)) == 0) THEN
1426 nstrf(k1+nbinter+j-1) = ixs10(k-5,ie-offset)
1427 tagndoubl(ixs10(k-5,ie-offset)) = 0
1428 nodtag(ixs10(k-5,ie-offset)) = 1
1429 j = j + 1
1430 nnod = nnod + 1
1431 ENDIF
1432 ELSEIF (nbnodes == 16 .AND. k > 9) THEN
1433 offset = numels8+numels10+numels20
1434 IF ( tagndoubl(ixs16(k-9,ie-offset)) >= 1
1435 . .AND. tagnodes(ixs16(k-9,ie-offset)) > 0
1436 . .AND. nodtag(ixs16(k-9,ie-offset)) == 0) THEN
1437 nstrf(k1+nbinter+j-1) = ixs16(k-9,ie-offset)
1438 tagndoubl(ixs16(k-9,ie-offset)) = 0
1439 nodtag(ixs16(k-9,ie-offset)) = 1
1440 j = j + 1
1441 nnod = nnod + 1
1442 ENDIF
1443 ELSEIF (nbnodes == 20 .AND. k > 9) THEN
1444 offset = numels8+numels10
1445 IF ( tagndoubl(ixs20(k-9,ie-offset)) >= 1
1446 . .AND. tagnodes(ixs20(k-9,ie-offset)) > 0
1447 . .AND. nodtag(ixs20(k-9,ie-offset)) == 0) THEN
1448 nstrf(k1+nbinter+j-1) = ixs20(k-9,ie-offset)
1449 tagndoubl(ixs20(k-9,ie-offset)) = 0
1450 nodtag(ixs20(k-9,ie-offset)) = 1
1451 j = j + 1
1452 nnod = nnod + 1
1453 ENDIF
1454 ELSE
1455 IF ( tagndoubl(ixs(k,ie)) >= 1
1456 . .AND. tagnodes(ixs(k,ie)) > 0
1457 . .AND. nodtag(ixs(k,ie)) == 0) THEN
1458 nstrf(k1+nbinter+j-1) = ixs(k,ie)
1459 tagndoubl(ixs(k,ie)) = 0
1460 nodtag(ixs(k,ie)) = 1
1461 j = j + 1
1462 nnod = nnod + 1
1463 ENDIF
1464 ENDIF
1465 ENDDO
1466 ENDIF
1467 ENDIF
1468 ENDDO
1469 ENDIF
1470
1471 DEALLOCATE( tagndoubl,tagnodes )
1472 RETURN

◆ sec_tri()

subroutine sec_tri ( integer nseg,
integer, dimension(2,*) isecbuf,
integer, dimension(nix,*) ix,
integer nix,
integer nne,
integer, dimension(*) nod,
integer nnod )

Definition at line 916 of file hm_read_sect.F.

918C-----------------------------------------------
919C I m p l i c i t T y p e s
920C-----------------------------------------------
921#include "implicit_f.inc"
922C-----------------------------------------------
923C C o m m o n B l o c k s
924C-----------------------------------------------
925#include "units_c.inc"
926C
927 INTEGER NIX,NSEG,ISECBUF(2,*),IX(NIX,*),NNE,NOD(*),NNOD
928 INTEGER I,J,JJ,K,N,NN,L,POWER2(10),UNPACK(0:1023,10),IFIRST
929C
930 DATA power2/1,2,4,8,16,32,64,128,256,512/
931 DATA ifirst/0/
932 SAVE ifirst,unpack
933C-----------------------------------------------
934C S o u r c e F i l e s
935C-----------------------------------------------
936 IF(ifirst == 0)THEN
937 ifirst=1
938 DO i=1,10
939 DO j=0,1023
940 unpack(j,i)=mod(j/power2(i),2)
941 ENDDO
942 ENDDO
943 ENDIF
944
945C-------------------------------------------------------------
946C sort by internal numbers
947C--------------------------------------------------------------
948 DO j=1,nseg-1
949 n = isecbuf(1,j)
950 DO jj=j,nseg
951 nn = isecbuf(1,jj)
952 IF(nn < n)THEN
953 isecbuf(1,j) = nn
954 isecbuf(1,jj) = n
955 n = isecbuf(1,j)
956 ENDIF
957 ENDDO
958 ENDDO
959C-------------------------------------------------------------
960C search for the nodes of the section elements
961C--------------------------------------------------------------
962 DO j=1,nseg
963 n = isecbuf(1,j)
964 isecbuf(2,j) = 0
965 DO l=1,nne
966 DO nn=1,nnod
967 IF(ix(l+1,n) == nod(nn))THEN
968 isecbuf(2,j) = isecbuf(2,j) + power2(l)
969 GOTO 70
970 ENDIF
971 ENDDO
972 70 CONTINUE
973 ENDDO
974 ENDDO
975 DO j=1,nseg
976 WRITE (iout,'(11I10)')ix(nix,isecbuf(1,j)),
977 . (unpack(isecbuf(2,j),k),k=1,nne)
978 ENDDO
979C
980 RETURN

◆ secstri()

subroutine secstri ( integer nseg,
integer, dimension(2,*) isecbuf,
integer, dimension(nixs,numels) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(*) nod,
integer nnod,
integer noprint )

Definition at line 786 of file hm_read_sect.F.

788 use element_mod , only : nixs
789C-----------------------------------------------
790C I m p l i c i t T y p e s
791C-----------------------------------------------
792#include "implicit_f.inc"
793#include "com04_c.inc"
794C-----------------------------------------------
795C C o m m o n B l o c k s
796C-----------------------------------------------
797#include "units_c.inc"
798
799 INTEGER NSEG,ISECBUF(2,*),IXS(NIXS,NUMELS),
800 . IXS10(6,*),IXS16(8,*),IXS20(12,*),
801 . NOD(*),NNOD,NOPRINT
802 INTEGER J,JJ,K,N,NN,L,POWER2(20)
803
804 DATA power2/1,2,4,8,16,32,64,128,256,512,
805 . 1024,2048,4096,8192,16384,
806 . 32768,65536,131072,262144,524288/
807C
808C-------------------------------------------------------------
809C sort by internal numbers
810C--------------------------------------------------------------
811 DO j=1,nseg-1
812 n = isecbuf(1,j)
813 DO jj=j,nseg
814 nn = isecbuf(1,jj)
815 IF(nn < n)THEN
816 isecbuf(1,j) = nn
817 isecbuf(1,jj) = n
818 n = isecbuf(1,j)
819 ENDIF
820 ENDDO
821 ENDDO
822C-------------------------------------------------------------
823C search for the nodes of the section elements
824C--------------------------------------------------------------
825 DO j=1,nseg
826 n = isecbuf(1,j)
827 isecbuf(2,j) = 0
828 DO l=1,8
829 DO nn=1,nnod
830 IF(ixs(l+1,n) == nod(nn))THEN
831 isecbuf(2,j) = isecbuf(2,j) + power2(l)
832 GOTO 70
833 ENDIF
834 ENDDO
835 70 CONTINUE
836 ENDDO
837 IF(n > numels8)THEN
838 n=n-numels8
839 IF(n <= numels10)THEN
840 DO l=1,6
841 DO nn=1,nnod
842 IF(ixs10(l,n) == nod(nn))THEN
843 isecbuf(2,j) = isecbuf(2,j) + power2(l+8)
844 GOTO 80
845 ENDIF
846 ENDDO
847 80 CONTINUE
848 ENDDO
849 ELSE
850 n=n-numels10
851 IF(n <= numels20)THEN
852 DO l=1,12
853 DO nn=1,nnod
854 IF(ixs20(l,n) == nod(nn))THEN
855 isecbuf(2,j) = isecbuf(2,j) + power2(l+8)
856 GOTO 90
857 ENDIF
858 ENDDO
859 90 CONTINUE
860 ENDDO
861 ELSE
862 DO l=1,8
863 DO nn=1,nnod
864 IF(ixs16(l,n) == nod(nn))THEN
865 isecbuf(2,j) = isecbuf(2,j) + power2(l+8)
866 GOTO 100
867 ENDIF
868 ENDDO
869 100 CONTINUE
870 ENDDO
871 END IF
872 END IF
873 END IF
874 ENDDO
875c
876 IF (noprint == 1) RETURN
877c
878 DO j=1,nseg
879 n = isecbuf(1,j)
880 IF(n <= numels8)THEN
881 WRITE (iout,'(9I10)')ixs(nixs,isecbuf(1,j)),
882 . (mod(isecbuf(2,j)/power2(k),2),k=1,8)
883 ELSE
884 n=isecbuf(1,j)-numels8
885 IF(n <= numels10)THEN
886 WRITE (iout,'(5I10,/,10X,6I10)')
887 . ixs(nixs,isecbuf(1,j)),
888 . mod(isecbuf(2,j)/power2(1),2),
889 . mod(isecbuf(2,j)/power2(3),2),
890 . mod(isecbuf(2,j)/power2(6),2),
891 . mod(isecbuf(2,j)/power2(5),2),
892 . (mod(isecbuf(2,j)/power2(k),2),k=9,14)
893 ELSE
894 n=isecbuf(1,j)-numels8-numels10
895 IF(n <= numels20)THEN
896 WRITE (iout,'(9i10,/,10x,12i10)')
897 . IXS(NIXS,ISECBUF(1,J)),
898 . (MOD(ISECBUF(2,J)/POWER2(K),2),K=1,20)
899 ELSE
900 WRITE (IOUT,'(9i10,/,10x,8i10)')
901 . IXS(NIXS,ISECBUF(1,J)),
902 . (MOD(ISECBUF(2,J)/POWER2(K),2),K=1,16)
903 END IF
904 END IF
905 END IF
906 ENDDO
907C
908 RETURN