OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_impacc.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "sphcom.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_impacc (fac, ibfv, nfxvel0, itab, itabm1, ikine, igrnod, iskn, unitab, lsubmodel, num, nimpacc)

Function/Subroutine Documentation

◆ hm_read_impacc()

subroutine hm_read_impacc ( intent(inout) fac,
integer, dimension(nifv,nfxvel0) ibfv,
integer, intent(in) nfxvel0,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
integer, dimension(*) ikine,
type (group_), dimension(ngrnod), intent(in) igrnod,
integer, dimension(liskn,*) iskn,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(inout) num,
integer, intent(inout) nimpacc )

Definition at line 44 of file hm_read_impacc.F.

48C============================================================================
49C M o d u l e s
50C-----------------------------------------------
51 USE unitab_mod
52 USE message_mod
53 USE groupdef_mod
54 USE submodel_mod
55 USE hm_option_read_mod
56 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com04_c.inc"
65#include "param_c.inc"
66#include "sphcom.inc"
67#include "units_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
72 INTEGER ,INTENT(INOUT) :: NIMPACC,NUM
73 INTEGER ,INTENT(IN) :: NFXVEL0
74 INTEGER ,DIMENSION(NIFV,NFXVEL0) :: IBFV
75 INTEGER ,DIMENSION(LISKN,*) :: ISKN
76 INTEGER ,DIMENSION(*) :: ITAB,ITABM1,IKINE
77 my_real,DIMENSION(LFXVELR,*) ,INTENT(INOUT) :: fac
78
79 TYPE (GROUP_) ,DIMENSION(NGRNOD) ,INTENT(IN) :: IGRNOD
80 TYPE(SUBMODEL_DATA),DIMENSION(*) ,INTENT(IN) :: LSUBMODEL
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER J,ID,UID,IACC,FCT_ID,INP_ID,SENS_ID,GRN,NACC,
85 . NOSKEW,NOFRAME,NUM0,NN,I_VDA,INOD,NODID,IGS,
86 . L_XYZ,SUBID,NOSUB,NODENUM(NFXVEL0)
87 INTEGER ,DIMENSION(3*NUMNOD) :: IKINE1
88 LOGICAL IS_AVAILABLE
89 CHARACTER(LEN=NCHARFIELD) :: XYZ
90 CHARACTER(LEN=NCHARTITLE) :: TITR,MESS
91 INTEGER ,DIMENSION(:),ALLOCATABLE :: IACCIDS
92 CHARACTER(LEN=2) :: X,Y,Z,XX,YY,ZZ
93 my_real :: fac1,fac2,fac3,facx,fscal_t,fscal_a,bid
94C-----------------------------------------------
95C D a t a
96C-----------------------------------------------
97 DATA x /'X'/
98 DATA y /'Y'/
99 DATA z /'Z'/
100 DATA xx /'XX'/
101 DATA yy /'YY'/
102 DATA zz /'ZZ'/
103 DATA mess/'IMPOSED ACCELERATION DEFINITION '/
104C-----------------------------------------------
105C E x t e r n a l F u n c t i o n s
106C-----------------------------------------------
107 INTEGER NODGRNR5
108 EXTERNAL nodgrnr5
109C======================================================================|
110!---
111 WRITE (iout,1000)
112!---
113!---
114 i_vda = num ! (VDA ---> velocities + desplacements + accelerations)
115!---
116 ikine1(1:3*numnod) = 0
117 nodenum(1:nfxvel0) = 0
118 bid = zero
119 nacc = 0
120c--------------------------------------------------
121c COUNT /IMPACC Options
122c--------------------------------------------------
123 CALL hm_option_count('/IMPACC',nimpacc)
124!
125 ALLOCATE(iaccids(nimpacc))
126 iaccids(1:nimpacc) = 0
127!
128 is_available = .false.
129C--------------------------------------------------
130C START BROWSING MODEL /IMPACC
131C--------------------------------------------------
132 CALL hm_option_start('/IMPACC')
133C--------------------------------------------------
134C BROWSING MODEL IMPACC 1-> NIMPACC
135C--------------------------------------------------
136 DO iacc=1,nimpacc
137 titr = ''
138C--------------------------------------------------
139C EXTRACT DATAS OF /IMPACC/... LINE
140C--------------------------------------------------
141 CALL HM_OPTION_READ_KEY(LSUBMODEL,
142 . OPTION_ID = ID,
143 . UNIT_ID = UID,
144 . SUBMODEL_ID = SUBID,
145 . SUBMODEL_INDEX = NOSUB,
146 . OPTION_TITR = TITR)
147!
148 IACCIDS(IACC) = ID
149!
150C--------------------------------------------------
151C EXTRACT DATA (STRING VALUES)
152C--------------------------------------------------
153 CALL HM_GET_INTV('curveid' ,FCT_ID ,IS_AVAILABLE,LSUBMODEL)
154 CALL HM_GET_STRING('rad_dir' ,XYZ ,ncharfield,IS_AVAILABLE)
155 CALL HM_GET_INTV('inputsystem' ,INP_ID ,IS_AVAILABLE,LSUBMODEL)
156 CALL HM_GET_INTV('rad_sensor_id' ,SENS_ID ,IS_AVAILABLE,LSUBMODEL)
157 CALL HM_GET_INTV('entityid' ,GRN ,IS_AVAILABLE,LSUBMODEL)
158!
159 CALL HM_GET_FLOATV('xscale' ,FACX,IS_AVAILABLE,LSUBMODEL,UNITAB)
160 CALL HM_GET_FLOATV('magnitude' ,FAC1,IS_AVAILABLE,LSUBMODEL,UNITAB)
161 CALL HM_GET_FLOATV('rad_tstart' ,FAC2,IS_AVAILABLE,LSUBMODEL,UNITAB)
162 CALL HM_GET_FLOATV('rad_tstop' ,FAC3,IS_AVAILABLE,LSUBMODEL,UNITAB)
163c--------------------------------------------------
164c Check skew and frame IDs
165c--------------------------------------------------
166.AND. IF ((INP_ID == 0)(SUBID /= 0)) THEN
167 INP_ID = LSUBMODEL(NOSUB)%SKEW
168 ENDIF
169c----
170 NOSKEW = 0
171 NOFRAME = 0
172c----
173 DO J=0,NUMSKW+MIN(1,NSPCOND)*NUMSPH+NSUBMOD
174 IF (INP_ID == ISKN(4,J+1)) THEN
175 NOSKEW = J+1
176 EXIT
177 ENDIF
178 ENDDO
179.and. IF (INP_ID > 0 NOSKEW == 0)
180 . CALL ANCMSG(MSGID=137,ANMODE=ANINFO,MSGTYPE=MSGERROR,
181 . I1= ID,
182 . I2= NOSKEW,
183 . C1='imposed acceleration',
184 . C2='imposed acceleration',
185 . C3= TITR)
186c----
187c--------------------------------------------------
188c Default scale factors
189c--------------------------------------------------
190 CALL HM_GET_FLOATV_DIM('xscale' ,FSCAL_T ,IS_AVAILABLE,LSUBMODEL,UNITAB)
191 CALL HM_GET_FLOATV_DIM('magnitude',FSCAL_A ,IS_AVAILABLE,LSUBMODEL,UNITAB)
192 IF (FACX == ZERO) FACX = ONE * FSCAL_T
193 FACX = ONE / FACX
194 IF (FAC1 == ZERO) FAC1 = ONE * FSCAL_A
195 IF (FAC3 == ZERO) FAC3 = EP20
196c--------------------------------------------------
197.OR..OR. IF (XYZ(1:2) == XX XYZ(1:2) == YY XYZ(1:2) == ZZ) THEN
198 FAC1 = FAC1 / (FSCAL_A * FSCAL_T * FSCAL_T)
199 ENDIF
200!---
201 NUM0 = NUM
202 NN = NODGRNR5(GRN,IGS,NODENUM,IGRNOD,ITABM1,MESS)
203 NUM = NUM + NN
204 NACC = NACC + NN
205!
206 DO J=1,NN
207 I_VDA = I_VDA + 1
208 IBFV(1,I_VDA) = NODENUM(J)
209 IBFV(2,I_VDA) = 0
210 IBFV(3,I_VDA) = FCT_ID
211 IBFV(4,I_VDA) = SENS_ID
212 IBFV(5,I_VDA) = 0
213 IBFV(6,I_VDA) = 0 ! initialization in lecrby (if rotation velocity on main)
214 IBFV(7,I_VDA) = 0
215 IBFV(8,I_VDA) = 0
216 IBFV(9,I_VDA) = NOFRAME
217 IBFV(10,I_VDA) = 0
218 IBFV(11,I_VDA) = 0
219 IBFV(12,I_VDA) = IACC
220 IBFV(13,I_VDA) = 0
221 IBFV(14,I_VDA) = 0
222!
223 FAC(1,I_VDA)= FAC1
224 FAC(2,I_VDA)= FAC2
225 FAC(3,I_VDA)= FAC3
226 FAC(4,I_VDA)= ZERO
227 FAC(5,I_VDA)= FACX
228 FAC(6,I_VDA)= ZERO
229!
230 INOD = IABS(NODENUM(J))
231 NODID = ITAB(INOD)
232!---
233! PRINT OUT
234!---
235 L_XYZ = 0
236.OR..OR. IF (XYZ(1:2) == XX XYZ(1:2) == YY XYZ(1:2) == ZZ) THEN
237 L_XYZ = 2
238.OR..OR. ELSEIF (XYZ(1:1) == X XYZ(1:1) == Y XYZ(1:1) == Z) THEN
239 L_XYZ = 1
240 ENDIF
241!
242 WRITE (IOUT,'(3x,i10,3x,i10,3x,i10,9x,a2,3x,i10,3x,i10,2x,
243 . 1pg20.13,2x,1pg20.13,2x,g20.13,2x,g20.13,16x,i10)')
244 . NODID,ISKN(4,NOSKEW),0,XYZ(1:L_XYZ),IBFV(3,I_VDA),SENS_ID,
245 . FAC(1,I_VDA),ONE/FACX,FAC(2,I_VDA),FAC(3,I_VDA),IBFV(10,I_VDA)
246!
247 IF (XYZ(1:2) == XX) THEN
248 IBFV(2,I_VDA) = 4 + NOSKEW*10
249 CALL KINSET(16,NODID,IKINE(INOD),4,NOSKEW,IKINE1(INOD))
250 ELSEIF (XYZ(1:2) == YY) THEN
251 IBFV(2,I_VDA) = 5 + NOSKEW*10
252 CALL KINSET(16,NODID,IKINE(INOD),5,NOSKEW,IKINE1(INOD))
253 ELSEIF (XYZ(1:2) == 'zz') THEN
254 IBFV(2,I_VDA) = 6 + NOSKEW*10
255 CALL KINSET(16,NODID,IKINE(INOD),6,NOSKEW,IKINE1(INOD))
256 ELSEIF (XYZ(1:1) == X) THEN
257 IBFV(2,I_VDA)= 1 + NOSKEW*10
258 CALL KINSET(16,NODID,IKINE(INOD),1,NOSKEW,IKINE1(INOD))
259 ELSEIF (XYZ(1:1) == Y) THEN
260 IBFV(2,I_VDA) = 2 + NOSKEW*10
261 CALL KINSET(16,NODID,IKINE(INOD),2,NOSKEW,IKINE1(INOD))
262 ELSEIF (XYZ(1:1) == 'z') THEN
263 IBFV(2,I_VDA) = 3 + NOSKEW*10
264 CALL KINSET(16,NODID,IKINE(INOD),3,NOSKEW,IKINE1(INOD))
265 ELSE
266 CALL ANCMSG(MSGID=164,
267 . MSGTYPE=MSGERROR,
268 . ANMODE=ANINFO,I1=ID,
269 . C1=TITR,
270 . C2=XYZ)
271 ENDIF ! IF (XYZ(1:1) == X)
272 ENDDO ! DO J=1,NN
273!---------------------------
274 ENDDO ! DO IACC=1,NIMPACC
275c-----------
276c TEST DOUBLE IDs
277c-----------
278!
279 CALL UDOUBLE(IACCIDS,1,NIMPACC,MESS,0,BID)
280c
281 NIMPACC = NACC
282!
283C-----
284 DEALLOCATE(IACCIDS)
285C-----
286 1000 FORMAT(//
287 .' imposed accelerations '/
288 .' --------------------- '/
289 .' node skew frame direction load_curve',
290 .' sensor fscale ascale',
291 .' start_time stop_time')
292C-----
293 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
hm_option_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
groupdef_mod
Definition groupdef_mod.F:668
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
nodgrnr5
integer function nodgrnr5(igu, igs, ibuf, igrnod, itabm1, mess)
Definition freform.F:298