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, itab, isec, noprint)
subroutine sec_tri (nseg, isecbuf, ix, nix, nne, nod, nnod, itab, numel, isec, txt)
subroutine lecsec0 (lsubmodel)
subroutine sec_nodes (igu1, istyp, ngrele, igrele, x0, a, b, c, d, e, f, itab, ix, nix, kk, nnod, nstrf, nbinter, n1, k1, nbnodes, j, nodtag, tagelems, x1, y1, z1, x2, y2, z2, r)
subroutine sec_nodes_sol (igu1, istyp, ngr, igrbric, x0, a, b, c, d, e, f, itab, ixs, ixs10, ixs16, ixs20, nix, kk, nnod, nstrf, nbinter, n1, 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 999 of file hm_read_sect.F.

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

◆ 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
79C-----------------------------------------------
80C I m p l i c i t T y p e s
81C-----------------------------------------------
82#include "implicit_f.inc"
83C-----------------------------------------------
84C A n a l y s e M o d u l e
85C-----------------------------------------------
86#include "analyse_name.inc"
87C-----------------------------------------------
88C C o m m o n B l o c k s
89C-----------------------------------------------
90#include "units_c.inc"
91#include "com04_c.inc"
92#include "scr17_c.inc"
93#include "param_c.inc"
94#include "sphcom.inc"
95#include "r2r_c.inc"
96C-----------------------------------------------
97C D u m m y A r g u m e n t s
98C-----------------------------------------------
99 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
100 INTEGER IXC(NIXC,NUMELC), IXTG(NIXTG,NUMELTG), ITAB(NUMNOD),
101 . ITABM1(*),IXS(NIXS,NUMELS), IXQ(NIXQ,NUMELQ), IXT(NIXT,NUMELT),
102 . IXP(NIXP,NUMELP), IXR(NIXR,NUMELR), IPARI(NPARI,NINTER),
103 . IXS10(6,*),IXS20(12,*),IXS16(8,*),ISKN(LISKN,*),
104 . ISOLNOD(*),NOM_SECT(*)
105 INTEGER NOM_OPT(LNOPT1,*)
106 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
107 my_real x0(3,*),secbuf(*),xframe(nxframe,numfram+1), rtrans(ntransf,nrtrans)
108 INTEGER,INTENT(IN):: NB_SEATBELT_SHELLS
109 INTEGER,INTENT(IN)::SEATBELT_SHELL_TO_SPRING(NUMELC,2)
110C-----------------------------------------------
111 TYPE (GROUP_) ,DIMENSION(NGRNOD) :: IGRNOD
112 TYPE (GROUP_) ,DIMENSION(NGRBRIC) :: IGRBRIC
113 TYPE (GROUP_) ,DIMENSION(NGRQUAD) :: IGRQUAD
114 TYPE (GROUP_) ,DIMENSION(NGRSHEL) :: IGRSH4N
115 TYPE (GROUP_) ,DIMENSION(NGRTRUS) :: IGRTRUSS
116 TYPE (GROUP_) ,DIMENSION(NGRBEAM) :: IGRBEAM
117 TYPE (GROUP_) ,DIMENSION(NGRSPRI) :: IGRSPRING
118 TYPE (GROUP_) ,DIMENSION(NGRSH3N) :: IGRSH3N
119C-----------------------------------------------
120C L o c a l V a r i a b l e s
121C-----------------------------------------------
122 INTEGER ,DIMENSION(NSECT) :: SECTIDS
123 INTEGER K1, I, J, L, KK, K2, K,LREC,
124 . NNOD, NBINTER,K0,K3,K4,K5,K6,K7,K8,K9,KR0,
125 . NSEGQ,NSEGS,NSEGC,NSEGT,NSEGP,NSEGR,NSEGTG,I0,ID,
126 . IGU,IGS,IGUS,IGUQ,IGUC,IGUT,IGUP,IGUR,IGUTG,IFRAM,
127 . NNSK1,NNSK2,NNSK3,UID,IFLAGUNIT,IE,IADV,
128 . ISU,NFRAM,JJ,IUN,
129 . TAGELEM1,TAGELEM2,TAGELEM3,
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,pos,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 :: NUMSECT,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,ngrbric,igrbric,x0,a,
442 2 b,c,d,e,f,itab,ixs,ixs10,ixs16,ixs20,
443 3 nixs,kk,nnod,nstrf,nbinter,n1 ,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,itab,ixq,nixq,kk,nnod,nstrf,
452 3 nbinter,n1,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,itab,ixc,nixc,kk,nnod,nstrf,
460 3 nbinter,n1,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,itab,ixt,nixt,kk,nnod,nstrf,
469 3 nbinter,n1,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,itab,ixp,nixp,kk,nnod,nstrf,
479 3 nbinter,n1,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,itab,ixr,nixr,kk,nnod,nstrf,
488 3 nbinter,n1,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,itab,ixtg,nixtg,kk,nnod,nstrf,
497 3 nbinter,n1,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,itab,i,noprint)
634C-------------------------------------------------------------
635C QUADS
636C--------------------------------------------------------------
637 WRITE (iout,3400) nsegq
638 CALL sec_tri(nsegq,nstrf(k4),ixq,nixq,4,nstrf(k2),
639 . nnod,itab,numelq,i,' QUADS')
640C-------------------------------------------------------------
641C COQUES
642C--------------------------------------------------------------
643 WRITE (iout,3100) nsegc
644 CALL sec_tri(nsegc,nstrf(k5),ixc,nixc,4,nstrf(k2),
645 . nnod,itab,numelc,i,' SHELLS')
646C-------------------------------------------------------------
647C BARRES
648C--------------------------------------------------------------
649 WRITE (iout,3500) nsegt
650 CALL sec_tri(nsegt,nstrf(k6),ixt,nixt,2,nstrf(k2),
651 . nnod,itab,numelt,i,' TRUSSES')
652C-------------------------------------------------------------
653C POUTRES
654C--------------------------------------------------------------
655 WRITE (iout,3600) nsegp
656 CALL sec_tri(nsegp,nstrf(k7),ixp,nixp,2,nstrf(k2),
657 . nnod,itab,numelp,i,' BEAMS')
658C-------------------------------------------------------------
659C RESSORTS
660C--------------------------------------------------------------
661 WRITE (iout,3700) nsegr
662 CALL sec_tri(nsegr,nstrf(k8),ixr,nixr,2,nstrf(k2),
663 . nnod,itab,numelr,i,' SPRINGS')
664C-------------------------------------------------------------
665C COQUES 3N
666C--------------------------------------------------------------
667 WRITE (iout,3200) nsegtg
668 CALL sec_tri(nsegtg,nstrf(k9),ixtg,nixtg,3,nstrf(k2),
669 . nnod,itab,numeltg,i,' 3 NODES SHELLS')
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 2901 FORMAT(/' SECTION',i10,' ID',i10/
751 + ' ---------------'/
752 + ' TYPE . . . . . . . . . . . . . . .',i8/
753 + ' FRAME TYPE . . . . . . . . . . . .',i8/)
754 3000 FORMAT(/
755 + ' NUMBER OF NODES. . . . . . . . . .',i10/
756 + ' NODES:')
757 3100 FORMAT(/
758 + ' NUMBER OF SHELL ELEMENTS . . . . .',i10/
759 + ' SHELL N1 N2 N3 N4')
760 3200 FORMAT(/
761 + ' NUMBER OF 3 NODES SHELL ELEMENTS .',i10/
762 + ' SHELL N1 N2 N3')
763 3300 FORMAT(/
764 + ' NUMBER OF BRICK ELEMENTS . . . . .',i10/
765 + ' BRICK N1 N2 N3 N4',
766 + ' N5 N6 N7 N8')
767 3400 FORMAT(/
768 + ' NUMBER OF QUAD ELEMENTS . . . . .',i10/
769 + ' QUAD N1 N2 N3 N4')
770 3500 FORMAT(/
771 + ' NUMBER OF TRUSS ELEMENTS . . . . .',i10/
772 + ' TRUSS N1 N2')
773 3600 FORMAT(/
774 + ' NUMBER OF BEAM ELEMENTS . . . . .',i10/
775 + ' BEAM N1 N2')
776 3700 FORMAT(/
777 + ' NUMBER OF SPRING ELEMENTS . . . . .',i8/
778 + ' SPRING N1 N2')
779C
780 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:415
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:76
sec_nodes
subroutine sec_nodes(igu1, istyp, ngrele, igrele, x0, a, b, c, d, e, f, itab, ix, nix, kk, nnod, nstrf, nbinter, n1, k1, nbnodes, j, nodtag, tagelems, x1, y1, z1, x2, y2, z2, r)
Definition hm_read_sect.F:1054
secstri
subroutine secstri(nseg, isecbuf, ixs, ixs10, ixs16, ixs20, nod, nnod, itab, isec, noprint)
Definition hm_read_sect.F:791
sec_tri
subroutine sec_tri(nseg, isecbuf, ix, nix, nne, nod, nnod, itab, numel, isec, txt)
Definition hm_read_sect.F:920
sec_nodes_sol
subroutine sec_nodes_sol(igu1, istyp, ngr, igrbric, x0, a, b, c, d, e, f, itab, ixs, ixs10, ixs16, ixs20, nix, kk, nnod, nstrf, nbinter, n1, k1, j, nodtag, isolnod, tagelems, x1, y1, z1, x2, y2, z2, r)
Definition hm_read_sect.F:1214
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
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:720
unitab_mod
Definition unitab_mod.F:513
grsize_ele
integer function grsize_ele(igu, igrelem, ngrelem)
Definition nintrr.F:538
grsize_ele_trans
integer function grsize_ele_trans(igu, igrelem, ngrelem, seatbelt_shell_to_spring)
Definition nintrr.F:578
hm_sz_r2r
subroutine hm_sz_r2r(tag, val, lsubmodel)
Definition routines_r2r.F:300
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:889
nodgrnr5
integer function nodgrnr5(igu, igs, ibuf, igrnod, itabm1, mess)
Definition freform.F:303
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:589
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(numnod) itab,
integer, dimension(nix,*) ix,
integer nix,
integer kk,
integer nnod,
integer, dimension(*) nstrf,
integer nbinter,
integer n1,
integer k1,
integer nbnodes,
integer j,
integer, dimension(numnod) nodtag,
integer, dimension(*) tagelems,
x1,
y1,
z1,
x2,
y2,
z2,
r )

Definition at line 1050 of file hm_read_sect.F.

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

◆ sec_nodes_sol()

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

Definition at line 1209 of file hm_read_sect.F.

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

Definition at line 918 of file hm_read_sect.F.

920C-----------------------------------------------
921C I m p l i c i t T y p e s
922C-----------------------------------------------
923#include "implicit_f.inc"
924C-----------------------------------------------
925C C o m m o n B l o c k s
926C-----------------------------------------------
927#include "units_c.inc"
928C
929 INTEGER NIX,NSEG,ISECBUF(2,*),IX(NIX,*),NNE,NOD(*),NNOD,
930 . ITAB(*),NUMEL,ISEC
931 INTEGER I,J,JJ,K,N,NN,L,POWER2(10),UNPACK(0:1023,10),IFIRST
932 CHARACTER*(*) TXT
933C
934 DATA power2/1,2,4,8,16,32,64,128,256,512/
935 DATA ifirst/0/
936 SAVE ifirst,unpack
937C-----------------------------------------------
938C S o u r c e F i l e s
939C-----------------------------------------------
940 IF(ifirst == 0)THEN
941 ifirst=1
942 DO i=1,10
943 DO j=0,1023
944 unpack(j,i)=mod(j/power2(i),2)
945 ENDDO
946 ENDDO
947 ENDIF
948
949C-------------------------------------------------------------
950C TRI SUR LES NUMEROS INTERNES
951C--------------------------------------------------------------
952 DO j=1,nseg-1
953 n = isecbuf(1,j)
954 DO jj=j,nseg
955 nn = isecbuf(1,jj)
956 IF(nn < n)THEN
957 isecbuf(1,j) = nn
958 isecbuf(1,jj) = n
959 n = isecbuf(1,j)
960 ENDIF
961 ENDDO
962 ENDDO
963C-------------------------------------------------------------
964C RECHERCHE DES NOEUDS DES ELEMENTS DE LA SECTION
965C--------------------------------------------------------------
966 DO j=1,nseg
967 n = isecbuf(1,j)
968 isecbuf(2,j) = 0
969 DO l=1,nne
970 DO nn=1,nnod
971 IF(ix(l+1,n) == nod(nn))THEN
972 isecbuf(2,j) = isecbuf(2,j) + power2(l)
973 GOTO 70
974 ENDIF
975 ENDDO
976 70 CONTINUE
977 ENDDO
978 ENDDO
979 DO j=1,nseg
980 WRITE (iout,'(11I10)')ix(nix,isecbuf(1,j)),
981 . (unpack(isecbuf(2,j),k),k=1,nne)
982 ENDDO
983C
984 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, dimension(numnod) itab,
integer isec,
integer noprint )

Definition at line 789 of file hm_read_sect.F.

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