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 double stockage temporaire - supprimer GEO(12)=IGTYP apres 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.OR. IF (ISMSTR==2 ISMSTR==4) THEN
143 ISMSTR=0
144.OR. ELSEIF (ISMSTR==1 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.AND. IF ((L(2)==ZERO)(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.AND. ELSEIF ((ISECT >= 10)(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--- coord isoparametriques et surfaces relatives des pts d'integration
269.AND. IF (ISECT == 0IREF == 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.NOT. IF( IS_ENCRYPTED)THEN
305 WRITE(IOUT,1000)IG,ISS,IR1X,IR1Y,IR1Z,IR2X,IR2Y,IR2Z,DM,DR,ISECT,L(1)
306.OR. IF(ISECT==1ISECT==3) THEN
307 WRITE(IOUT,1002) L(2)
308.AND. ELSEIF ((ISECT >= 7)(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.AND. IF(GEO( 3)/=ZEROIGEO(5)== 0)IGEO(5)=NINT(GEO(3))
339.AND. IF(GEO(171)/=ZEROIGEO(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 ! cercle divise en 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 !POINTS RADIALS ALIGNES
697 IF (intr == 17) THEN
698 nip = 17
699 r1 = 0.5477225575*l(1)
700 r2 = 0.8062257748*l(1)
701 r3 = l(1)
702 d2 = a_lobatto(4,5)*l(1)
703 phi = zero
704 dphi= pi * fourth
705 ip = 1
706 geo(ipy+ip) = zero
707 geo(ipz+ip) = zero
708 geo(ipa+ip) = pi*r1*r1
709 ai = pi * (r2*r2 - r1*r1)/eight
710 DO ip = 2,nip-1,2
711 geo(ipy+ip) = d2*cos(phi)
712 geo(ipz+ip) = d2*sin(phi)
713 geo(ipa+ip) = ai
714 phi = phi + dphi
715 ENDDO
716 phi = zero
717 ai = pi * (r3*r3 - r2*r2)/eight
718 DO ip = 3,nip,2
719 geo(ipy+ip) = l(1)*cos(phi)
720 geo(ipz+ip) = l(1)*sin(phi)
721 geo(ipa+ip) = ai
722 phi = phi + dphi
723 ENDDO
724 ELSEIF (intr == 25) THEN
725 nip = 25
726 r1 = 0.46291005*l(1)
727 r2 = 0.69006559*l(1)
728 r3 = 0.859124693*l(1)
729 r4 = l(1)
730 d2 = a_lobatto(5,7)*l(1)
731 d3 = a_lobatto(6,7)*l(1)
732 d4 = a_lobatto(7,7)*l(1)
733 ip = 1
734 geo(ipy+ip) = zero
735 geo(ipz+ip) = zero
736 geo(ipa+ip) = pi*r1*r1
737 phi = zero
738 dphi= pi * fourth
739 ai = pi * (r2*r2 - r1*r1)/eight
740 DO ip = 2,nip-2,3
741 geo(ipy+ip) = d2*cos(phi)
742 geo(ipz+ip) = d2*sin(phi)
743 geo(ipa+ip) = ai
744 phi = phi + dphi
745 ENDDO
746 phi = zero
747 ai = pi * (r3*r3 - r2*r2)/eight
748 DO ip = 3,nip-1,3
749 geo(ipy+ip) = d3*cos(phi)
750 geo(ipz+ip) = d3*sin(phi)
751 geo(ipa+ip) = ai
752 phi = phi + dphi
753 ENDDO
754 phi = zero
755 ai = pi * (r4*r4 - r3*r3)/eight
756 DO ip = 4,nip,3
757 geo(ipy+ip) = d4*cos(phi)
758 geo(ipz+ip) = d4*sin(phi)
759 geo(ipa+ip) = ai
760 phi = phi + dphi
761 ENDDO
762
763
764 ENDIF
765c---------------
766c---------------
767 CASE (5) ! circular section with points on edge
768c---------------
769 area = pi*l(1)*l(1)
770 IF (intr /= 1.AND. intr /= 9 .AND. intr /= 17 ) THEN
771 CALL ancmsg(msgid=1877,
772 . msgtype=msgerror,
773 . anmode=aninfo_blind_1,
774 . i1=ig,
775 . c1=idtitl)
776
777 ELSEIF (intr == 1) THEN
778 nip = 1
779 geo(ipy+1) = zero
780 geo(ipz+1) = zero
781 geo(ipa+1) = area
782 ELSEIF (intr == 9) THEN
783 nip = intr
784 r2 = 0.57346235*l(1)
785 ip = 1
786 geo(ipy+ip) = zero
787 geo(ipz+ip) = zero
788 geo(ipa+ip) = pi*r2*r2
789 r1 = 0.7*l(1)
790 dphi = pi*half
791 phi = zero
792 ai = pi*(l(1)*l(1) - r2*r2)/eight
793 DO ip = 2,nip-1,2
794 geo(ipy+ip) = l(1)*sin(phi)
795 geo(ipz+ip) = l(1)*cos(phi)
796 geo(ipa+ip) = ai
797 phi = phi + dphi
798 ENDDO
799 phi = pi*fourth
800 DO ip = 3,nip,2
801 geo(ipy+ip) = r1*cos(phi)
802 geo(ipz+ip) = r1*sin(phi)
803 geo(ipa+ip) = ai
804 phi = phi + dphi
805 ENDDO
806 ELSEIF (intr == 17) THEN ! POINTS RADIALS NON ALIGNES
807 nip = intr
808 r1 = 0.4472136*l(1) ! rayon petit cercle
809 r2 = 0.774597 *l(1) !rayon cercle moyen
810 r3 = l(1) ! rayon de la section
811 d2 = half*l(1) !distance au point d'integ
812 ai = pi * (r3*r3 - r2*r2)/eight
813 phi = zero
814 dphi= pi * fourth
815 ip = 1
816 geo(ipy+ip) = zero
817 geo(ipz+ip) = zero
818 geo(ipa+ip) = pi*r1*r1
819 DO ip = 2,nip-1,2
820 geo(ipy+ip) = l(1)*cos(phi)
821 geo(ipz+ip) = l(1)*sin(phi)
822 geo(ipa+ip) = ai
823 phi = phi + dphi
824 ENDDO
825 phi = pi / eight
826 ai = pi * (r2*r2 - r1*r1)/eight
827 DO ip = 3,nip,2
828 geo(ipy+ip) = d2*cos(phi)
829 geo(ipz+ip) = d2*sin(phi)
830 geo(ipa+ip) = ai
831 phi = phi + dphi
832 ENDDO
833 ENDIF
834c---------------
835 CASE (6) ! circular section not in documentation
836c---------------
837 nc = 3+intr ! number of layers
838 ns = 4*nc ! number of sections
839 nip = nc*ns
840 area = pi*l(1)*l(1)
841 ai = area/nip
842 dphi = pi*two/ns
843 r1 = zero
844 r2 = l(1) / sqrt(em20+nc)
845 ip = 0
846 DO i = 1,nc
847 len(i) = (r2 + r1*(sqr3-one)) / sqr3
848 r1 = r2
849 r2 = l(1)*sqrt((i+one)/nc)
850 phi = zero
851 DO j = 1,ns
852 ip = ip+1
853 geo(ipy+ip) = len(i)*sin(phi)
854 geo(ipz+ip) = len(i)*cos(phi)
855 geo(ipa+ip) = ai
856 phi = phi+dphi
857 area = area + ai
858 ENDDO
859 ENDDO
860 CASE DEFAULT
861 END SELECT
862c---------------
863 RETURN
864 END SUBROUTINE defbeam_sect
my_real
#define my_real
Definition cppsort.cpp:32
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
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
elbuftag_mod
Definition elbuftag_mod.F:227
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
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
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
second
real function second()
SECOND Using ETIME
Definition second_EXT_ETIME.f:35
section
subroutine section(nnod, n1, n2, n3, nstrf, x, v, vr, fsav, fopta, secfcum, ms, in, ifram, xsec)
Definition section.F:34
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
starter
program starter
Definition starter.F:39
elbuftag_mod::prop_tag_
Definition elbuftag_mod.F:374
submodel_mod::submodel_data
Definition submodel_mod.F:723