OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop18.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_prop18 ../starter/source/properties/beam/hm_read_prop18.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_properties ../starter/source/properties/hm_read_properties.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| defbeam_sect ../starter/source/properties/beam/hm_read_prop18.F
30!|| defbeam_sect_new ../starter/source/properties/beam/defbeam_sect_new.F90
31!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
32!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.f
33!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
34!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
35!||--- uses -----------------------------------------------------
36!|| defbeam_sect_new_mod ../starter/source/properties/beam/defbeam_sect_new.F90
37!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
38!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
39!|| message_mod ../starter/share/message_module/message_mod.F
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE hm_read_prop18(GEO ,IGEO ,PROP_TAG ,IGTYP ,IG ,
43 . IDTITL ,UNITAB ,LSUBMODEL)
44C============================================================================
45C M o d u l e s
46C-----------------------------------------------
47 USE unitab_mod
48 USE elbuftag_mod
49 USE message_mod
50 USE submodel_mod
51 USE hm_option_read_mod
52 USE defbeam_sect_new_mod
53 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "units_c.inc"
62#include "tablen_c.inc"
63#include "param_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 TYPE (unit_type_),INTENT(IN) ::unitab
68 INTEGER IGEO(*)
69 INTEGER IGTYP,IG,NBADI
70 my_real
71 . geo(*)
72 CHARACTER(LEN=NCHARTITLE)::IDTITL
73 TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
74 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 CHARACTER(LEN=NCHARFIELD) :: STRING
79 CHARACTER CHROT*7
80 INTEGER I,J,IP,INTR,INTS,NIP,NIPMAX,NC,NS,IPY,IPZ,IPA,IREF,ISECT,
81 . irx,ir1x,ir1y,ir1z,ir2x,ir2y,ir2z,iss
82 INTEGER IHBE,ISMSTR,ISHEAR,NB_DIM,ID_FORMAT,INTR_MAX
83 my_real
84 . dm,dr,py,pz,ai,yi,zi,wi,area,y0,z0,l(6),pun
85 my_real
86 . area_i,tixx_i,tiyy_i,tizz_i, ari,ini,ryi,rzi
87 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
88 DATA pun/0.1/
89C=======================================================================
90C
91 is_encrypted = .false.
92 is_available = .false.
93C--------------------------------------------------
94C OLD HIDDEN FLAGS - SET TO ZERO
95C IHBE -> ISECT
96C ISH3N,ISROT,CVIS not used
97C--------------------------------------------------
98C
99C--------------------------------------------------
100C EXTRACT DATA (IS OPTION CRYPTED)
101C--------------------------------------------------
102 CALL hm_option_is_encrypted(is_encrypted)
103C--------------------------------------------------
104C EXTRACT DATAS (INTEGER VALUES)
105C--------------------------------------------------
106 CALL hm_get_intv('Ismstr',ismstr,is_available,lsubmodel)
107 CALL hm_get_intv('ISFLAG',isect,is_available,lsubmodel)
108 CALL hm_get_intv('NIP' ,nip,is_available,lsubmodel)
109 CALL hm_get_intv('Iref' ,iref,is_available,lsubmodel)
110 CALL hm_get_intv('NITRS' ,intr,is_available,lsubmodel)
111 CALL hm_get_intv('Translation_Wx1',ir1x,is_available,lsubmodel)
112 CALL hm_get_intv('Translation_Wy1',ir1y,is_available,lsubmodel)
113 CALL hm_get_intv('Translation_Wz1',ir1z,is_available,lsubmodel)
114 CALL hm_get_intv('Translation_Wx2',ir2x,is_available,lsubmodel)
115 CALL hm_get_intv('Translation_Wy2',ir2y,is_available,lsubmodel)
116 CALL hm_get_intv('Translation_Wz2',ir2z,is_available,lsubmodel)
117C--------------------------------------------------
118C EXTRACT DATAS (REAL VALUES)
119C--------------------------------------------------
120 CALL hm_get_floatv('Dm',dm,is_available,lsubmodel,unitab)
121 CALL hm_get_floatv('df',dr,is_available,lsubmodel,unitab)
122 CALL hm_get_floatv('Y0',y0,is_available,lsubmodel,unitab)
123 CALL hm_get_floatv('Z0',z0,is_available,lsubmodel,unitab)
124 CALL hm_get_floatv('L1',l(1),is_available,lsubmodel,unitab)
125 CALL hm_get_floatv('L2',l(2),is_available,lsubmodel,unitab)
126 CALL hm_get_floatv('L3',l(3),is_available,lsubmodel,unitab)
127 CALL hm_get_floatv('L4',l(4),is_available,lsubmodel,unitab)
128 CALL hm_get_floatv('L5',l(5),is_available,lsubmodel,unitab)
129 CALL hm_get_floatv('L6',l(6),is_available,lsubmodel,unitab)
130C--------------------------------------------------
131C
132 geo(3)=ismstr
133 IF (ismstr==3) geo(5)=ep06
134C Temporary double storage - Delete GEO (12) = Igtyp after tests
135 igeo( 1)=ig
136 igeo(10)=isect
137 igeo(11)=igtyp
138 geo(12) =igtyp+pun
139 geo(171)=isect
140
141C----------------------
142 IF (ismstr==2 .OR. ismstr==4) THEN
143 ismstr=0
144 ELSEIF (ismstr==1 .OR. ismstr==3) THEN
145 ismstr=1
146 ENDIF
147 geo(3) = ismstr
148
149C-------
150 nipmax = 100
151 ipy = 200
152 ipz = 300
153 ipa = 400
154 area = zero
155 isect = igeo(10)
156 iss = int(geo(3))
157 IF(iss == 0) iss = 4
158 IF (dr == zero) dr = em02
159C---
160 nip = min(nip,nipmax)
161c------------------------
162 IF (isect == 0) THEN
163C--------------------------------------------------
164C--- user-defined integration points
165C--------------------------------------------------
166 DO ip = 1,nip
167 CALL hm_get_float_array_index('Y_IP',py,ip,is_available,lsubmodel,unitab)
168 CALL hm_get_float_array_index('Z_IP',pz,ip,is_available,lsubmodel,unitab)
169 CALL hm_get_float_array_index('AREA_IP',ai,ip,is_available,lsubmodel,unitab)
170C
171 IF (ai<=zero) THEN
172 CALL ancmsg(msgid=314,
173 . msgtype=msgerror,
174 . anmode=aninfo_blind_1,
175 . i1=ig,
176 . c1=idtitl,
177 . r1=ai)
178 ENDIF
179 geo(ipy+ip) = py
180 geo(ipz+ip) = pz
181 geo(ipa+ip) = ai
182 area = area + ai
183 ENDDO
184
185 ELSEIF (isect <= 6) THEN
186C
187C--------------------------------------------------
188C--- predefined sections (old - Isect = 1 to 6)
189C--------------------------------------------------
190C
191 IF (intr == 0) intr = 2
192 IF ((l(2)==zero).AND.(l(1)> zero)) l(2) = l(1)
193C
194 CALL defbeam_sect(geo,isect,intr,nip,area,l,ig,idtitl)
195C
196C Check of missing dimensions in input
197 IF (l(1) == zero) THEN
198 CALL ancmsg(msgid=2092,
199 . msgtype=msgerror,
200 . anmode=aninfo_blind_1,
201 . i1=ig,
202 . c1=idtitl)
203 ENDIF
204C
205 ELSEIF ((isect >= 10).AND.(isect <= 31)) THEN
206C
207C--------------------------------------------------
208C--- predefined sections (new - Isect = 10 to 31)
209C--------------------------------------------------
210C
211 CALL defbeam_sect_new(geo,npropg,isect,intr,intr_max,nip,area,l,nb_dim)
212C
213C Check of max intr
214 IF (intr > intr_max) THEN
215 CALL ancmsg(msgid=3060,
216 . msgtype=msgerror,
217 . anmode=aninfo_blind_1,
218 . i1=ig,
219 . i2=intr,
220 . i3=isect,
221 . i4=intr_max,
222 . c1=idtitl)
223 ENDIF
224C
225C Check of missing dimensions in input
226 DO i=1,nb_dim
227 IF (l(i)==zero) THEN
228 CALL ancmsg(msgid=3059,
229 . msgtype=msgerror,
230 . anmode=aninfo_blind_1,
231 . i1=i,
232 . prmod=msg_cumu)
233 ENDIF
234 ENDDO
235 CALL ancmsg(msgid=3059,
236 . msgtype=msgerror,
237 . anmode=aninfo_blind_1,
238 . i1=ig,
239 . c1=idtitl,
240 . prmod=msg_print)
241C
242 ELSE
243C
244C--------------------------------------------------
245C--- Non supported values of Isect
246C--------------------------------------------------
247C
248 CALL ancmsg(msgid=3061,
249 . msgtype=msgerror,
250 . anmode=aninfo_blind_1,
251 . i1=ig,
252 . i2=isect,
253 . c1=idtitl)
254C
255 ENDIF
256c------------------------
257c------------------------
258c
259 IF (nip > 100) THEN
260 CALL ancmsg(msgid=977,
261 . msgtype=msgerror,
262 . anmode=aninfo_blind_1,
263 . i1=ig,
264 . c1=idtitl,
265 . i2=nip)
266 ENDIF
267
268C--- isoparametric coordinates and relative surfaces of integration points
269 IF (isect == 0.AND.iref == 0) THEN
270 y0 = zero
271 z0 = zero
272 DO ip = 1,nip
273 y0 = y0 + geo(ipy+ip)*geo(ipa+ip)
274 z0 = z0 + geo(ipz+ip)*geo(ipa+ip)
275 ENDDO
276 y0 = y0 / area
277 z0 = z0 / area
278 ENDIF
279 DO ip = 1,nip
280 geo(ipy+ip) = geo(ipy+ip) - y0
281 geo(ipz+ip) = geo(ipz+ip) - z0
282 ENDDO
283C--- rotation dof
284 irx = min(1,ir1x+ir2x)
285 geo(7) = 1.1-irx
286 geo(8) = 1.1-ir1y
287 geo(9) = 1.1-ir1z
288 geo(10)= 1.1-ir2y
289 geo(11)= 1.1-ir2z
290C---compute for print
291 area_i= zero
292 tiyy_i= zero
293 tizz_i= zero
294 DO ip=1,nip
295 ari = geo(ipa+ip)
296 ini = ari*ari*one_over_12
297 ryi = geo(ipy+ip)
298 rzi = geo(ipz+ip)
299 area_i = area_i + ari
300 tiyy_i = tiyy_i + ini + ari * ryi*ryi
301 tizz_i = tizz_i + ini + ari * rzi*rzi
302 ENDDO
303 tixx_i = tiyy_i + tizz_i
304 IF(.NOT. is_encrypted)THEN
305 WRITE(iout,1000)ig,iss,ir1x,ir1y,ir1z,ir2x,ir2y,ir2z,dm,dr,isect,l(1)
306 IF(isect==1.OR.isect==3) THEN
307 WRITE(iout,1002) l(2)
308 ELSEIF ((isect >= 7).AND.(nb_dim > 1)) THEN
309 IF (nb_dim > 1) WRITE(iout,1002) l(2)
310 IF (nb_dim > 2) WRITE(iout,1203) l(3)
311 IF (nb_dim > 3) WRITE(iout,1204) l(4)
312 IF (nb_dim > 4) WRITE(iout,1205) l(5)
313 IF (nb_dim > 5) WRITE(iout,1206) l(6)
314 ENDIF
315 WRITE(iout,1003)nip
316 DO ip=1,nip
317 WRITE(iout,1010) ip,y0+geo(ipy+ip),z0+geo(ipz+ip),
318 . geo(ipa+ip)
319 ENDDO
320 WRITE(iout,1100)area_i,tiyy_i,tizz_i,tixx_i
321 WRITE(iout,*)
322 ELSE
323 WRITE(iout,1020) ig
324 ENDIF
325C---
326 geo(1) = area
327 geo(16) = dm
328 geo(17) = dr
329 geo(21) = y0
330 geo(22) = z0
331 igeo(3) = nip
332C
333C----------------------
334C
335 geo(37)=0
336 ishear = geo(37)
337C
338 IF(geo( 3)/=zero.AND.igeo(5)== 0)igeo(5)=nint(geo(3))
339 IF(geo(171)/=zero.AND.igeo(10)== 0) igeo(10)=nint(geo(171))
340C
341C-----------------------------
342C PROPERTY BUFFER
343C-----------------------------
344C
345 prop_tag(igtyp)%G_FOR = 3
346 prop_tag(igtyp)%G_MOM = 3
347 prop_tag(igtyp)%G_EINT = 2
348 prop_tag(igtyp)%G_LENGTH = 1 ! total length
349 prop_tag(igtyp)%G_SKEW = 3 ! local skew (RLOC)
350 prop_tag(igtyp)%L_SIG = 3
351 prop_tag(igtyp)%L_STRA = 3
352C-----------------------------
353C
354 RETURN
355C---
356 1000 FORMAT(
357 & 5x,'INTEGRATED BEAM PROPERTY SET (TYPE 18)'/,
358 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
359 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
360 & 5x,'NODE 1 LOCAL ROTATION RELEASE X DIR.. .=',i10/,
361 & 5x,'NODE 1 LOCAL ROTATION RELEASE Y DIR.. .=',i10/,
362 & 5x,'NODE 1 LOCAL ROTATION RELEASE Z DIR.. .=',i10/,
363 & 5x,'NODE 2 LOCAL ROTATION RELEASE X DIR.. .=',i10/,
364 & 5x,'NODE 2 LOCAL ROTATION RELEASE Y DIR.. .=',i10/,
365 & 5x,'NODE 2 LOCAL ROTATION RELEASE Z DIR.. .=',i10/,
366 & 5x,'BEAM STRUCTURAL MEMBRANE DAMPING. . . .=',1pg20.13/,
367 & 5x,'BEAM STRUCTURAL FLEXURAL DAMPING. . . .=',1pg20.13/,
368 & 5x,'SECTION TYPE. . . . . . . . . . . . . .=',i10/,
369 & 5x,'FIRST SIZE OF SECTION L1. . . . . . . .=',1pg20.13)
370 1002 FORMAT(
371 & 5x,'SECOND SIZE OF SECTION L2 . . . . . . .=',1pg20.13)
372 1003 FORMAT(
373 & 5x,'NUMBER OF INTEGRATION POINTS. . . . . .=',i10//,
374 & 5x,'INTEGRATION POINTS:')
375 1010 FORMAT(
376 & 5x,'POINT NO: . . . . . . . . . . . . . =',i10/,
377 & 8x,'LOCAL Y POSITION. . . . . . . . . . =',1pg20.13/,
378 & 8x,'LOCAL Z POSITION. . . . . . . . . . =',1pg20.13/,
379 & 8x,'POINT AREA. . . . . . . . . . . . . =',1pg20.13)
380 1020 FORMAT(
381 & 5x,'INTEGRATED BEAM PROPERTY SET (TYPE 18)'/,
382 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10,
383 & 5x,'CONFIDENTIAL DATA'//)
384 1100 FORMAT(
385 & 5x,'BEAM AREA . . . . . . . . . . . . . . .=',1pg20.13/,
386 & 5x,'MOMENT OF INERTIA IYY . . . . . . . . .=',1pg20.13/,
387 & 5x,'MOMENT OF INERTIA IZZ . . . . . . . . .=',1pg20.13/,
388 & 5x,'MOMENT OF INERTIA IXX . . . . . . . . .=',1pg20.13/)
389C
390 1203 FORMAT(
391 & 5x,'THIRD SIZE OF SECTION L3. . . . . . . .=',1pg20.13)
392 1204 FORMAT(
393 & 5x,'FOURTH SIZE OF SECTION L4 . . . . . . .=',1pg20.13)
394 1205 FORMAT(
395 & 5x,'FIFTH SIZE OF SECTION L5. . . . . . . .=',1pg20.13)
396 1206 FORMAT(
397 & 5x,'SIXTH SIZE OF SECTION L6. . . . . . . .=',1pg20.13)
398C
399 END SUBROUTINE
400
401!||====================================================================
402!|| defbeam_sect ../starter/source/properties/beam/hm_read_prop18.F
403!||--- called by ------------------------------------------------------
404!|| hm_read_prop18 ../starter/source/properties/beam/hm_read_prop18.F
405!||--- calls -----------------------------------------------------
406!|| ancmsg ../starter/source/output/message/message.f
407!||--- uses -----------------------------------------------------
408!|| message_mod ../starter/share/message_module/message_mod.F
409!||====================================================================
410 SUBROUTINE defbeam_sect(GEO,ISECT,INTR,NIP,
411 . AREA,L,IG,IDTITL)
412C-----------------------------------------------
413 USE message_mod
414 USE names_and_titles_mod , ONLY : nchartitle
415C-----------------------------------------------
416C I m p l i c i t T y p e s
417C-----------------------------------------------
418#include "implicit_f.inc"
419C-----------------------------------------------
420C C o m m o n B l o c k s
421C-----------------------------------------------
422#include "param_c.inc"
423C-----------------------------------------------
424C D u m m y A r g u m e n t s
425C-----------------------------------------------
426 INTEGER ISECT,INTR,NIP,IG
427 my_real AREA,L(6)
428 my_real geo(npropg)
429 CHARACTER(LEN=NCHARTITLE)::IDTITL
430C-----------------------------------------------
431C L o c a l V a r i a b l e s
432C-----------------------------------------------
433 INTEGER I,J,IP,NC,NS,IPY,IPZ,IPA
434 my_real AI,YI,ZI,WI,PHI,DPHI,R1,R2,R3,R4,D2, D3, D4
435 my_real w_gauss(9,9),a_gauss(9,9),w_lobatto(9,9),a_lobatto(9,9),len(10)
436C-----------------------------------------------
437 DATA w_gauss /
438 1 2. ,0. ,0. ,
439 1 0. ,0. ,0. ,
440 1 0. ,0. ,0. ,
441 2 1. ,1. ,0. ,
442 2 0. ,0. ,0. ,
443 2 0. ,0. ,0. ,
444 3 0.555555555555556,0.888888888888889,0.555555555555556,
445 3 0. ,0. ,0. ,
446 3 0. ,0. ,0. ,
447 4 0.347854845137454,0.652145154862546,0.652145154862546,
448 4 0.347854845137454,0. ,0. ,
449 4 0. ,0. ,0. ,
450 5 0.236926885056189,0.478628670499366,0.568888888888889,
451 5 0.478628670499366,0.236926885056189,0. ,
452 5 0. ,0. ,0. ,
453 6 0.171324492379170,0.360761573048139,0.467913934572691,
454 6 0.467913934572691,0.360761573048139,0.171324492379170,
455 6 0. ,0. ,0. ,
456 7 0.129484966168870,0.279705391489277,0.381830050505119,
457 7 0.417959183673469,0.381830050505119,0.279705391489277,
458 7 0.129484966168870,0. ,0. ,
459 8 0.101228536290376,0.222381034453374,0.313706645877887,
460 8 0.362683783378362,0.362683783378362,0.313706645877887,
461 8 0.222381034453374,0.101228536290376,0. ,
462 9 0.081274388361574,0.180648160694857,0.260610696402935,
463 9 0.312347077040003,0.330239355001260,0.312347077040003,
464 9 0.260610696402935,0.180648160694857,0.081274388361574/
465 DATA a_gauss /
466 1 0. ,0. ,0. ,
467 1 0. ,0. ,0. ,
468 1 0. ,0. ,0. ,
469 2 -.577350269189626,0.577350269189626,0. ,
470 2 0. ,0. ,0. ,
471 2 0. ,0. ,0. ,
472 3 -.774596669241483,0. ,0.774596669241483,
473 3 0. ,0. ,0. ,
474 3 0. ,0. ,0. ,
475 4 -.861136311594053,-.339981043584856,0.339981043584856,
476 4 0.861136311594053,0. ,0. ,
477 4 0. ,0. ,0. ,
478 5 -.906179845938664,-.538469310105683,0. ,
479 5 0.538469310105683,0.906179845938664,0. ,
480 5 0. ,0. ,0. ,
481 6 -.932469514203152,-.661209386466265,-.238619186083197,
482 6 0.238619186083197,0.661209386466265,0.932469514203152,
483 6 0. ,0. ,0. ,
484 7 -.949107912342759,-.741531185599394,-.405845151377397,
485 7 0. ,0.405845151377397,0.741531185599394,
486 7 0.949107912342759,0. ,0. ,
487 8 -.960289856497536,-.796666477413627,-.525532409916329,
488 8 -.183434642495650,0.183434642495650,0.525532409916329,
489 8 0.796666477413627,0.960289856497536,0. ,
490 9 -.968160239507626,-.836031107326636,-.613371432700590,
491 9 -.324253423403809,0. ,0.324253423403809,
492 9 0.613371432700590,0.836031107326636,0.968160239507626/
493C-----------------------------------------------
494 DATA w_lobatto /
495 1 2. ,0. ,0. ,
496 1 0. ,0. ,0. ,
497 1 0. ,0. ,0. ,
498 2 1. ,1. ,0. ,
499 2 0. ,0. ,0. ,
500 2 0. ,0. ,0. ,
501 3 0.333333333333333,1.333333333333333,0.333333333333333,
502 3 0. ,0. ,0. ,
503 3 0. ,0. ,0. ,
504 4 0.166666666666667,0.833333333333333,0.833333333333333,
505 4 0.166666666666667,0. ,0. ,
506 4 0. ,0. ,0. ,
507 5 0.100000000000000,0.544444444444444,0.711111111111111,
508 5 0.544444444444444,0.100000000000000,0. ,
509 5 0. ,0. ,0. ,
510 6 0.066666666666667,0.378474956297847,0.554858377035486,
511 6 0.554858377035486,0.378474956297847,0.066666666666667,
512 6 0. ,0. ,0. ,
513 7 0.047619047619048,0.276826047361566,0.431745381209863,
514 7 0.487619047619048,0.431745381209863,0.276826047361566,
515 7 0.047619047619048,0. ,0. ,
516 8 0.035714285714286,0.210704227143506,0.341122692483504,
517 8 0.412458794658704,0.412458794658704,0.341122692483504,
518 8 0.210704227143506,0.035714285714286,0. ,
519 9 0.027777777777778,0.165495361560806,0.274538712500162,
520 9 0.346428510973046,0.371519274376417,0.346428510973046,
521 9 0.274538712500162,0.165495361560806,0.027777777777778/
522 DATA a_lobatto /
523 1 0. ,0. ,0. ,
524 1 0. ,0. ,0. ,
525 1 0. ,0. ,0. ,
526 2 -1.00000000000000,1.000000000000000,0. ,
527 2 0. ,0. ,0. ,
528 2 0. ,0. ,0. ,
529 3 -1.00000000000000,0. ,1.000000000000000,
530 3 0. ,0. ,0. ,
531 3 0. ,0. ,0. ,
532 4 -1.00000000000000,-.447213595499958,0.447213595499958,
533 4 1.000000000000000,0. ,0. ,
534 4 0. ,0. ,0. ,
535 5 -1.00000000000000,-.654653670707977,0. ,
536 5 0.654653670707977,1.000000000000000,0. ,
537 5 0. ,0. ,0. ,
538 6 -1.00000000000000,-.765055323929465,-.285231516480645,
539 6 0.285231516480645,0.765055323929465,1.000000000000000,
540 6 0. ,0. ,0. ,
541 7 -1.00000000000000,-.830223896278567,-.468848793470714,
542 7 0. ,0.468848793470714,0.830223896278567,
543 7 1.000000000000000,0. ,0. ,
544 8 -1.00000000000000,-.871740148509607,-.591700181433142,
545 8 -.209299217902479,0.209299217902479,0.591700181433142,
546 8 0.871740148509607,1.000000000000000,0. ,
547 9 -1.00000000000000,-.899757995411460,-.677186279510737,
548 9 -.363117463826178,0. ,0.363117463826178,
549 9 0.677186279510737,0.899757995411460,1.000000000000000/
550C======================================================================|
551C======================================================================|
552 ipy = 200
553 ipz = 300
554 ipa = 400
555c-----------------------
556 SELECT CASE (isect)
557c---------------
558 CASE (1) ! basic rectangular section with Gauss integration rule
559c---------------
560 area = l(1)*l(2)
561! INER = AREA*AREA*ONE_OVER_12
562 IF (intr < 1 .OR. intr > 9) THEN
563c write error message
564 ELSEIF (intr == 1) THEN
565 nip = intr
566 geo(ipy+1) = zero
567 geo(ipz+1) = zero
568 geo(ipa+1) = area
569 ELSE
570 nip = intr*intr
571 r1 = l(1)*half
572 r2 = l(2)*half
573 ai = area*fourth
574 ip = 0
575 DO i = 1,intr
576 DO j = 1,intr
577 ip = ip+1
578 geo(ipy+ip)=a_gauss(i,intr)*r1
579 geo(ipz+ip)=a_gauss(j,intr)*r2
580 geo(ipa+ip)=w_gauss(i,intr)*w_gauss(j,intr)*ai
581 ENDDO
582 ENDDO
583 ENDIF
584c---------------
585 CASE (2) ! basic circular section with Gauss integration rule
586c---------------
587 area = pi*l(1)*l(1)
588! INER = AREA*L(1)*L(1)*FOURTH
589 IF (intr < 1 .OR. intr > 9) THEN
590c write error message
591 ELSEIF (intr == 1) THEN
592 nip = 1
593 geo(ipy+1) = zero
594 geo(ipz+1) = zero
595 geo(ipa+1) = area
596 ELSEIF (intr == 2) THEN ! Circle divides into 4
597 nip = intr*intr
598 ai = area/nip
599 r1 = l(1)/sqr3
600 r1 = l(1)*sqr2*half
601 dphi = two*pi/nip
602 phi = dphi*half
603 DO ip = 1,nip
604 geo(ipy+ip) = r1*sin(phi)
605 geo(ipz+ip) = r1*cos(phi)
606 geo(ipa+ip) = ai
607 phi = phi + dphi
608 ENDDO
609 ELSEIF (intr == 3) THEN
610 nip = intr*intr
611 ai = area/twelve !
612 ip = 1
613 geo(ipy+ip) = zero
614 geo(ipz+ip) = zero
615 geo(ipa+ip) = ai*four
616 r1 = l(1)*sqr3*half
617 dphi = pi*fourth
618 phi = zero
619 DO ip = 2,nip
620 geo(ipy+ip) = r1*sin(phi)
621 geo(ipz+ip) = r1*cos(phi)
622 geo(ipa+ip) = ai
623 phi = phi + dphi
624 ENDDO
625 ELSEIF (intr == 4) THEN
626 nip = 7
627 r1 = l(1)*sqr2/sqr3
628 dphi = pi*third
629 ip = 1
630 geo(ipy+ip) = zero
631 geo(ipz+ip) = zero
632 geo(ipa+ip) = area*fourth
633 ai = area/eight
634 phi = zero
635 DO ip = 2,nip
636 geo(ipy+ip) = r1*sin(phi)
637 geo(ipz+ip) = r1*cos(phi)
638 geo(ipa+ip) = ai
639 phi = phi + dphi
640 ENDDO
641 ELSEIF (intr == 5) THEN
642 nip = 21
643 ip = 1
644 geo(ipy+ip) = zero
645 geo(ipz+ip) = zero
646 geo(ipa+ip) = area/nine
647 ai = area*(sixteen + sqr6)/360.
648 r1 = sqrt((six-sqr6)/ten)*l(1)
649 phi = pi/five
650 DO ip = 2,11
651 geo(ipy+ip) = r1*cos(phi*ip)
652 geo(ipz+ip) = r1*sin(phi*ip)
653 geo(ipa+ip) = ai
654 ENDDO
655 ai = area*(sixteen - sqr6)/360.
656 r1 = sqrt((six+sqr6)/ten)*l(1)
657 DO ip = 12,21
658 geo(ipy+ip) = r1*cos(phi*ip)
659 geo(ipz+ip) = r1*sin(phi*ip)
660 geo(ipa+ip) = ai
661 ENDDO
662 ENDIF
663c---------------
664 CASE (3) ! basic rectangular section with Lobatto integration rule
665c---------------
666 area = l(1)*l(2)
667! INER = AREA*AREA*ONE_OVER_12
668 IF (intr < 1 .OR. intr > 9) THEN
669 CALL ancmsg(msgid=1878,
670 . msgtype=msgerror,
671 . anmode=aninfo_blind_1,
672 . i1=ig,
673 . c1=idtitl)
674 ELSEIF (intr == 1) THEN
675 nip = intr
676 geo(ipy+1) = zero
677 geo(ipz+1) = zero
678 geo(ipa+1) = area
679 ELSE
680 nip = intr*intr
681 r1 = l(1)*half
682 r2 = l(2)*half
683 ai = area*fourth
684 ip = 0
685 DO i = 1,intr
686 DO j = 1,intr
687 ip = ip+1
688 geo(ipy+ip)=a_lobatto(i,intr)*r1
689 geo(ipz+ip)=a_lobatto(j,intr)*r2
690 geo(ipa+ip)=w_lobatto(i,intr)*w_lobatto(j,intr)*ai
691 ENDDO
692 ENDDO
693 ENDIF
694c---------------
695 CASE (4) ! circular section Lobatto 5 OR 7 in radius 8 in circonference
696 area = pi*l(1)*l(1)
697 !POINTS RADIALS ALIGNES
698 IF (intr == 17) THEN
699 nip = 17
700 r1 = 0.5477225575*l(1)
701 r2 = 0.8062257748*l(1)
702 r3 = l(1)
703 d2 = a_lobatto(4,5)*l(1)
704 phi = zero
705 dphi= pi * fourth
706 ip = 1
707 geo(ipy+ip) = zero
708 geo(ipz+ip) = zero
709 geo(ipa+ip) = pi*r1*r1
710 ai = pi * (r2*r2 - r1*r1)/eight
711 DO ip = 2,nip-1,2
712 geo(ipy+ip) = d2*cos(phi)
713 geo(ipz+ip) = d2*sin(phi)
714 geo(ipa+ip) = ai
715 phi = phi + dphi
716 ENDDO
717 phi = zero
718 ai = pi * (r3*r3 - r2*r2)/eight
719 DO ip = 3,nip,2
720 geo(ipy+ip) = l(1)*cos(phi)
721 geo(ipz+ip) = l(1)*sin(phi)
722 geo(ipa+ip) = ai
723 phi = phi + dphi
724 ENDDO
725 ELSEIF (intr == 25) THEN
726 nip = 25
727 r1 = 0.46291005*l(1)
728 r2 = 0.69006559*l(1)
729 r3 = 0.859124693*l(1)
730 r4 = l(1)
731 d2 = a_lobatto(5,7)*l(1)
732 d3 = a_lobatto(6,7)*l(1)
733 d4 = a_lobatto(7,7)*l(1)
734 ip = 1
735 geo(ipy+ip) = zero
736 geo(ipz+ip) = zero
737 geo(ipa+ip) = pi*r1*r1
738 phi = zero
739 dphi= pi * fourth
740 ai = pi * (r2*r2 - r1*r1)/eight
741 DO ip = 2,nip-2,3
742 geo(ipy+ip) = d2*cos(phi)
743 geo(ipz+ip) = d2*sin(phi)
744 geo(ipa+ip) = ai
745 phi = phi + dphi
746 ENDDO
747 phi = zero
748 ai = pi * (r3*r3 - r2*r2)/eight
749 DO ip = 3,nip-1,3
750 geo(ipy+ip) = d3*cos(phi)
751 geo(ipz+ip) = d3*sin(phi)
752 geo(ipa+ip) = ai
753 phi = phi + dphi
754 ENDDO
755 phi = zero
756 ai = pi * (r4*r4 - r3*r3)/eight
757 DO ip = 4,nip,3
758 geo(ipy+ip) = d4*cos(phi)
759 geo(ipz+ip) = d4*sin(phi)
760 geo(ipa+ip) = ai
761 phi = phi + dphi
762 ENDDO
763
764
765 ENDIF
766c---------------
767c---------------
768 CASE (5) ! circular section with points on edge
769c---------------
770 area = pi*l(1)*l(1)
771 IF (intr /= 1.AND. intr /= 9 .AND. intr /= 17 ) THEN
772 CALL ancmsg(msgid=1877,
773 . msgtype=msgerror,
774 . anmode=aninfo_blind_1,
775 . i1=ig,
776 . c1=idtitl)
777
778 ELSEIF (intr == 1) THEN
779 nip = 1
780 geo(ipy+1) = zero
781 geo(ipz+1) = zero
782 geo(ipa+1) = area
783 ELSEIF (intr == 9) THEN
784 nip = intr
785 r2 = 0.57346235*l(1)
786 ip = 1
787 geo(ipy+ip) = zero
788 geo(ipz+ip) = zero
789 geo(ipa+ip) = pi*r2*r2
790 r1 = 0.7*l(1)
791 dphi = pi*half
792 phi = zero
793 ai = pi*(l(1)*l(1) - r2*r2)/eight
794 DO ip = 2,nip-1,2
795 geo(ipy+ip) = l(1)*sin(phi)
796 geo(ipz+ip) = l(1)*cos(phi)
797 geo(ipa+ip) = ai
798 phi = phi + dphi
799 ENDDO
800 phi = pi*fourth
801 DO ip = 3,nip,2
802 geo(ipy+ip) = r1*cos(phi)
803 geo(ipz+ip) = r1*sin(phi)
804 geo(ipa+ip) = ai
805 phi = phi + dphi
806 ENDDO
807 ELSEIF (intr == 17) THEN ! POINTS RADIALS NON ALIGNES
808 nip = intr
809 r1 = 0.4472136*l(1) ! Small circle department
810 r2 = 0.774597 *l(1) !Middle circle department
811 r3 = l(1) ! radius of the section
812 d2 = half*l(1) !Distance to Integ point
813 ai = pi * (r3*r3 - r2*r2)/eight
814 phi = zero
815 dphi= pi * fourth
816 ip = 1
817 geo(ipy+ip) = zero
818 geo(ipz+ip) = zero
819 geo(ipa+ip) = pi*r1*r1
820 DO ip = 2,nip-1,2
821 geo(ipy+ip) = l(1)*cos(phi)
822 geo(ipz+ip) = l(1)*sin(phi)
823 geo(ipa+ip) = ai
824 phi = phi + dphi
825 ENDDO
826 phi = pi / eight
827 ai = pi * (r2*r2 - r1*r1)/eight
828 DO ip = 3,nip,2
829 geo(ipy+ip) = d2*cos(phi)
830 geo(ipz+ip) = d2*sin(phi)
831 geo(ipa+ip) = ai
832 phi = phi + dphi
833 ENDDO
834 ENDIF
835c---------------
836 CASE (6) ! circular section not in documentation
837c---------------
838 nc = 3+intr ! number of layers
839 ns = 4*nc ! number of sections
840 nip = nc*ns
841 area = pi*l(1)*l(1)
842 ai = area/nip
843 dphi = pi*two/ns
844 r1 = zero
845 r2 = l(1) / sqrt(em20+nc)
846 ip = 0
847 DO i = 1,nc
848 len(i) = (r2 + r1*(sqr3-one)) / sqr3
849 r1 = r2
850 r2 = l(1)*sqrt((i+one)/nc)
851 phi = zero
852 DO j = 1,ns
853 ip = ip+1
854 geo(ipy+ip) = len(i)*sin(phi)
855 geo(ipz+ip) = len(i)*cos(phi)
856 geo(ipa+ip) = ai
857 phi = phi+dphi
858 area = area + ai
859 ENDDO
860 ENDDO
861 CASE DEFAULT
862 END SELECT
863c---------------
864 RETURN
865 END SUBROUTINE defbeam_sect
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
defbeam_sect
subroutine defbeam_sect(geo, isect, intr, nip, area, l, ig, idtitl)
Definition hm_read_prop18.F:412
hm_read_prop18
subroutine hm_read_prop18(geo, igeo, prop_tag, igtyp, ig, idtitl, unitab, lsubmodel)
Definition hm_read_prop18.F:44
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
elbuftag_mod
Definition elbuftag_mod.F:230
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
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
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
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
starter
program starter
Definition starter.F:39
elbuftag_mod::prop_tag_
Definition elbuftag_mod.F:377
submodel_mod::submodel_data
Definition submodel_mod.F:728
unitab_mod::unit_type_
Definition unitab_mod.F:524