OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_preload.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "boltpr_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_preload (ixs, ixs10, ipreload, preload, iflag_bpreload, nstrf, sensors, unitab, x, isolnod, itab, lsubmodel, snpc, npc, ipreload_fun)

Function/Subroutine Documentation

◆ hm_read_preload()

subroutine hm_read_preload ( integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(3,*) ipreload,
preload,
integer, dimension(*) iflag_bpreload,
integer, dimension(*) nstrf,
type (sensors_), intent(in) sensors,
type (unit_type_), intent(in) unitab,
x,
integer, dimension(*) isolnod,
integer, dimension(*) itab,
type(submodel_data), dimension(*) lsubmodel,
integer, intent(in) snpc,
integer, dimension(snpc), intent(in) npc,
integer, dimension(2,npreload), intent(inout) ipreload_fun )

Definition at line 39 of file hm_read_preload.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE unitab_mod
47 USE message_mod
48 USE sensor_mod
49 USE hm_option_read_mod
50 USE submodel_mod
51 USE names_and_titles_mod , ONLY : nchartitle, ncharline
52 use element_mod , only : nixs
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "units_c.inc"
61#include "com04_c.inc"
62#include "boltpr_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
67 INTEGER IXS(NIXS,*), IXS10(6,*), IPRELOAD(3,*), IFLAG_BPRELOAD(*)
68 INTEGER NSTRF(*),ITAB(*),ISOLNOD(*)
69 INTEGER ,INTENT(IN) :: SNPC
70 INTEGER ,DIMENSION(SNPC), INTENT(IN) :: NPC
71 INTEGER ,DIMENSION(2,NPRELOAD), INTENT(INOUT) :: IPRELOAD_FUN
72 my_real preload(6,*),x(3,*)
73 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
74 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
75
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER ISEC, K, I1, I2, I, ISENS,NPR0,NN,ID,J,UID,IFLAGUNIT,JS,SENSNUM
80 INTEGER IUGRP(NPRELOAD),IDSENSOR(NPRELOAD)
81 INTEGER K0,K1,K2,K3,IS,IE,II,NS,NI,ITYPE,IN1,IN2,IN3,IFUN,FUN_ID
82 my_real lval(npreload),ts(npreload),te(npreload),nx(npreload),ny(npreload),nz(npreload)
83 my_real tdeb,tfin, loadval,x1,y1,z1,x2,y2,z2,x3,y3,z3,n3,area(npreload)
84 CHARACTER MESS*40
85 CHARACTER(LEN=NCHARTITLE) :: TITR
86 CHARACTER(LEN=NCHARLINE) ::KEY
87C-----------------------------------------------
88 LOGICAL IS_AVAILABLE
89C-----------------------------------------------
90C E x t e r n a l F u n c t i o n s
91C-----------------------------------------------
92 DATA mess/'BOLT PRELOADING DEFINITION '/
93C=======================================================================
94 is_available = .false.
95C-----------------------------------------------
96 CALL hm_option_start('/PRELOAD')
97C-----------------------------------------------
98 npr0=npreload
99 k=0
100 area(1:npreload)=zero
101
102 DO i=1,npr0
103 ! Read title, ID and Unit ID
104 titr = ''
105 CALL hm_option_read_key(lsubmodel,
106 . option_id = id,
107 . unit_id = uid,
108 . option_titr = titr,
109 . keyword2 = key)
110C
111 iugrp(i) = 0
112 IF (key(1:len_trim(key))=='AXIAL') cycle
113 ! Checking unit ID
114 iflagunit = 0
115C
116 DO j=1,unitab%NUNITS
117 IF (unitab%UNIT_ID(j) == uid) THEN
118 iflagunit = 1
119 EXIT
120 ENDIF
121 ENDDO
122 IF (uid/=0.AND.iflagunit==0) THEN
123 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
124 . i2=uid,i1=id,c1='BOLT PRELOAD',
125 . c2='BOLT PRELOAD',
126 . c3=titr)
127 ENDIF
128
129
130 !read card line
131 CALL hm_get_intv('sect_ID' ,isec ,is_available,lsubmodel)
132 CALL hm_get_intv('sens_ID' ,isens ,is_available,lsubmodel)
133 CALL hm_get_intv('Itype' ,itype ,is_available,lsubmodel)
134 CALL hm_get_intv('curveid' ,ifun ,is_available,lsubmodel)
135
136 CALL hm_get_floatv('preload',LOADVAL,IS_AVAILABLE, LSUBMODEL, UNITAB)
137 CALL HM_GET_FLOATV('tstart' ,TDEB ,IS_AVAILABLE, LSUBMODEL, UNITAB)
138 CALL HM_GET_FLOATV('tstop' ,TFIN ,IS_AVAILABLE, LSUBMODEL, UNITAB)
139
140
141 IF (ITYPE == 0) ITYPE = 1 ! Default to effort preloading
142
143
144.AND. IF(LOADVAL <= ZERO IFUN==0) THEN
145 CALL ANCMSG(MSGID=1255,MSGTYPE=MSGWARNING,
146 . ANMODE=ANINFO_BLIND_1,
147 . C1='bolt preload',
148 . I1=ID,
149 . C2=TITR)
150! LOADVAL = ZERO
151 ENDIF
152 IF (TFIN == ZERO) TFIN=EP30
153!
154 FUN_ID = 0
155 IF (IFUN>0) THEN
156 DO J=1,NFUNCT
157 IF(NPC(NFUNCT+J+1)==IFUN) FUN_ID=J
158 ENDDO
159 IF(FUN_ID==0)THEN
160 CALL ANCMSG(MSGID=154,ANMODE=ANINFO,MSGTYPE=MSGERROR,I2=IFUN,I1=ID,C1=TITR)
161 ENDIF
162 END IF !(IFUN>0) THEN
163 IF (FUN_ID>0) THEN ! Tstart,Tstop will be updated in Engin
164 TDEB = ZERO
165 TFIN = EP30
166 END IF !(IFUN>0) THEN
167c
168 SENSNUM = 0
169 IF (ISENS > 0) THEN
170 DO JS=1,SENSORS%NSENSOR
171 IF (ISENS == SENSORS%SENSOR_TAB(JS)%SENS_ID) THEN
172 SENSNUM = JS ! not used - not stored
173 EXIT
174 ENDIF
175 ENDDO
176 IF (SENSNUM == 0) THEN
177 ISENS = 0
178 CALL ANCMSG(MSGID=1252,ANMODE=ANINFO,MSGTYPE=MSGERROR,
179 . C1='bolt preload',
180 . C2='bolt preload',
181 . I2=ISENS,I1=ID,C3=TITR)
182 END IF
183 ENDIF !(ISENS > 0)
184c
185 NN = 0
186 IF (ISEC > 0) THEN !ISEC=sect_ID input is mandatory
187 K0=31
188 DO IS=1,NSECT
189 IF (ISEC==NSTRF(K0+23)) THEN
190 IUGRP(I) = ISEC
191 LVAL(I) = LOADVAL
192 IDSENSOR(I) = ISENS
193 TS(I) = TDEB
194 TE(I) = TFIN
195 IF (FUN_ID>0) THEN ! for printout
196 TS(I) = -IFUN
197 TE(I) = IFUN
198 END IF
199 NN = NSTRF(K0+6)
200 NS = NSTRF(K0+7)
201 NI = NSTRF(K0+14)
202 K1 = K0+30
203 K2 = K1+NI
204 K3 = K2+NN
205 IN1 = NSTRF(K0+3)
206 IN2 = NSTRF(K0+4)
207 IN3 = NSTRF(K0+5)
208 X1=X(1,IN2)-X(1,IN1)
209 Y1=X(2,IN2)-X(2,IN1)
210 Z1=X(3,IN2)-X(3,IN1)
211 X2=X(1,IN3)-X(1,IN1)
212 Y2=X(2,IN3)-X(2,IN1)
213 Z2=X(3,IN3)-X(3,IN1)
214 X3=Y1*Z2-Z1*Y2
215 Y3=Z1*X2-Z2*X1
216 Z3=X1*Y2-X2*Y1
217 N3=X3*X3+Y3*Y3+Z3*Z3
218c
219 IF(N3 < EM20) THEN
220 CALL ANCMSG(MSGID=1244,ANMODE=ANINFO,MSGTYPE=MSGERROR,
221 . C1='bolt preload',
222 . C2='bolt preload',
223 . I2=ISEC,I1=ID,C3=TITR)
224 ELSE
225 N3 = SQRT(N3)
226 X3 = X3/N3
227 Y3 = Y3/N3
228 Z3 = Z3/N3
229 NX(I) = X3
230 NY(I) = Y3
231 NZ(I) = Z3
232 ENDIF
233 IF(NS == 0) THEN
234 CALL ANCMSG(MSGID=1251,ANMODE=ANINFO,MSGTYPE=MSGERROR,
235 . C1='bolt preload',
236 . C2='bolt preload',
237 . i2=isec,i1=id,c3=titr)
238 ELSE
239 ! calculation of section area
240 CALL sectarea(ixs,ixs10,x,nstrf(k3),ns,isolnod,area(i),itab) !
241 IF (itype == 1) THEN
242 IF (area(i) > 1.e-30) loadval = loadval/area(i)
243 ENDIF
244 DO ie=1,ns
245 k=k+1
246 ii=(k3-1)+2*ie-1
247 ipreload(1,k) = nstrf(ii) ! Num. interne avant tri
248 ipreload(2,k) = isens ! Sensor
249 ipreload(3,k) = ixs(11,nstrf(ii)) ! User Id.
250 !IFLAG_BPRELOAD(NSTRF(II)) = 1 ! Flag sur element precontraint
251 iflag_bpreload(nstrf(ii)) = i ! flag on prestressed element
252
253
254 preload(1,k) = tdeb ! pretension start time
255 preload(2,k) = tfin ! pretension end time
256 preload(3,k) = loadval ! pretension stress
257 preload(4,k) = x3 ! Pretension Direction
258 preload(5,k) = y3
259 preload(6,k) = z3
260 ENDDO
261 ENDIF !IF(NS == 0)
262 GOTO 100
263 ENDIF !IF (ISEC==NSTRF(K0+23))
264 k0=nstrf(k0+24)
265 ENDDO
266 ENDIF
267 CALL ancmsg(msgid=1243,anmode=aninfo,msgtype=msgerror,
268 . c1='BOLT PRELOAD',
269 . c2='BOLT PRELOAD',
270 . i2=isec,i1=id,c3=titr)
271100 CONTINUE
272 ipreload_fun(1,i) = fun_id
273 ipreload_fun(2,i) = sensnum
274
275 ENDDO
276 i1=1
277 i2=min0(50,npreload)
278c-----------------------------output------------------------------------------
279 90 WRITE (iout,2000)
280 DO i=i1,i2
281 IF (iugrp(i)==0) cycle
282 IF (ts(i)<zero) THEN
283 ts(i) = zero
284 ifun = nint(te(i))
285 te(i)=ep30
286 WRITE (iout,'(I10,1X,I10,1X,1PE10.3,1X,I10,6(1X,1PE10.3),I10)') i,
287 . iugrp(i), area(i), idsensor(i), nx(i), ny(i), nz(i), lval(i), ts(i), te(i),ifun
288 ELSE
289 ifun = 0
290 WRITE (iout,'(I10,1X,I10,1X,1PE10.3,1X,I10,6(1X,1PE10.3),I10)') i,
291 . iugrp(i), area(i), idsensor(i), nx(i), ny(i), nz(i), lval(i), ts(i), te(i),ifun
292 END IF
293 ENDDO
294 IF(i2==npreload)GOTO 200
295 i1=i1+50
296 i2=min0(i2+50,npreload)
297 GOTO 90
298
299c-------------------------
300 200 RETURN
301c-------------------------
302 2000 FORMAT(//
303 .' BOLT PRELOADINGS '/
304 .' ---------------- '/
305 .' ID SECTION AREA SENSOR NX NY
306 . NZ PRELOAD START-T END-T IFUNC')
307C-----------
308 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
id
initmumps id
Definition multiplerhs_example.m:4
hm_option_read_mod
Definition hm_option_read_mod.F:412
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::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1006
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
sectarea
subroutine sectarea(ixs, ixs10, x, ibuf, nele, isolnod, area, itab)
Definition sectarea.F:32
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