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

Go to the source code of this file.

Functions/Subroutines

subroutine read_impvel_fgeo (nfgeo, inum, iopt, fbfvel, ibfvel, itab, itabm1, igrnod, nom_opt, x0, ixr, ipart, ipartr, unitab, lsubmodel)

Function/Subroutine Documentation

◆ read_impvel_fgeo()

subroutine read_impvel_fgeo ( integer, intent(in) nfgeo,
integer, intent(inout) inum,
integer, intent(inout) iopt,
dimension(lfxvelr,nfxvel) fbfvel,
integer, dimension(nifv,nfxvel) ibfvel,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
type (group_), dimension(ngrnod), intent(in) igrnod,
integer, dimension(lnopt1,*), intent(out) nom_opt,
intent(in) x0,
integer, dimension(nixr,*) ixr,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartr,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 42 of file read_impvel_fgeo.F.

46C============================================================================
47C M o d u l e s
48C-----------------------------------------------
49 USE message_mod
50 USE groupdef_mod
51 USE submodel_mod
52 USE hm_option_read_mod
53 USE unitab_mod
54 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com04_c.inc"
63#include "scr17_c.inc"
64#include "param_c.inc"
65#include "units_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER ,INTENT(IN ) :: NFGEO
70 INTEGER ,INTENT(INOUT) :: INUM,IOPT
71 INTEGER ,DIMENSION(*) :: ITAB,ITABM1,IPARTR
72 INTEGER ,DIMENSION(LIPART1,*) :: IPART
73 INTEGER ,DIMENSION(NIXR,*) :: IXR
74 INTEGER ,DIMENSION(NIFV,NFXVEL) :: IBFVEL
75 INTEGER ,DIMENSION(LNOPT1,*) ,INTENT(OUT) :: NOM_OPT
76 my_real ,DIMENSION(LFXVELR,NFXVEL) :: fbfvel
77 my_real ,DIMENSION(3,NUMNOD) ,INTENT(IN):: x0
78 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB
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 I,J,K,N,N1,N2,NUM0,IFGEO,JPART,NNOD,NOFRAME,
85 . SENS_ID,PART_ID,OPTID,UID,FCT1_ID,FCT2_ID,ILAGM,
86 . FGEO,IDIS,ICOOR,DISTRIBUTION
87 INTEGER ,DIMENSION(NUMNOD) :: NOD1,NOD2
88 my_real :: tstart,xscale,yscale,fscal_t,fscal_v,t0,dmin,dist,
89 . xi,yi,zi,xf,yf,zf
90 CHARACTER(LEN=NCHARKEY) :: KEY
91 CHARACTER(LEN=NCHARTITLE) :: TITR,MESS
92 LOGICAL IS_AVAILABLE
93C-----------------------------------------------
94C E x t e r n a l F u n c t i o n s
95C-----------------------------------------------
96 INTEGER USR2SYS
97 EXTERNAL usr2sys
98C-----------------------------------------------
99C D a t a
100C-----------------------------------------------
101 DATA mess/'IMPOSED VELOCITY DEFINITION '/
102C======================================================================|
103 is_available = .false.
104
105 num0 = inum+1
106c--------------------------------------------------
107c
108 CALL hm_option_start('/IMPVEL/FGEO')
109c
110c--------------------------------------------------
111 DO ifgeo = 1,nfgeo
112c--------------------------------------------------
113 CALL hm_option_read_key(lsubmodel,
114 . option_id = optid,
115 . unit_id = uid,
116 . option_titr = titr,
117 . keyword2 = key)
118c
119 iopt = iopt + 1
120 nom_opt(1,iopt) = optid
121 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,iopt),ltitr)
122c
123c--------------------------------------------------
124 icoor = 0
125 fgeo = 2
126 idis = 0
127 ilagm = 0
128 noframe = 0
129c--------------------------------------------------
130c READ STRING VALUES from /IMPVEL
131c--------------------------------------------------
132c CALL HM_GET_INTV ('distribution' ,DISTRIBUTION ,IS_AVAILABLE,LSUBMODEL)
133c
134 CALL hm_get_intv ('curveid' ,fct1_id ,is_available,lsubmodel)
135 CALL hm_get_intv ('rad_spring_part',part_id ,is_available,lsubmodel)
136 CALL hm_get_intv ('rad_fct_l_id' ,fct2_id ,is_available,lsubmodel)
137 CALL hm_get_intv ('rad_sensor_id' ,sens_id ,is_available,lsubmodel)
138c
139 CALL hm_get_floatv('xscale' ,xscale ,is_available,lsubmodel,unitab)
140 CALL hm_get_floatv('rad_t0' ,t0 ,is_available,lsubmodel,unitab)
141 CALL hm_get_floatv('rad_tstart' ,TSTART ,IS_AVAILABLE,LSUBMODEL,UNITAB)
142 CALL HM_GET_FLOATV('magnitude' ,YSCALE ,IS_AVAILABLE,LSUBMODEL,UNITAB)
143 CALL HM_GET_FLOATV('rad_dmin' ,DMIN ,IS_AVAILABLE,LSUBMODEL,UNITAB)
144c
145 CALL HM_GET_INTV('distribution_table_count' ,NNOD ,IS_AVAILABLE,LSUBMODEL)
146 DO I = 1,NNOD
147 CALL HM_GET_INT_ARRAY_INDEX('location_unit_node' ,NOD1(I) ,I ,IS_AVAILABLE, LSUBMODEL)
148 CALL HM_GET_INT_ARRAY_INDEX('rad_node_id' ,NOD2(I) ,I ,IS_AVAILABLE, LSUBMODEL)
149 ENDDO
150c
151c--------------------------------------------------
152c Default scale factors
153c--------------------------------------------------
154 IF (T0 <= ZERO) THEN
155 CALL ANCMSG(MSGID=1074, MSGTYPE=MSGERROR, ANMODE=ANINFO,
156 . I1=OPTID, C1=TITR, R1=T0)
157 CALL HM_GET_FLOATV_DIM('rad_t0' ,FSCAL_T ,IS_AVAILABLE,LSUBMODEL,UNITAB)
158 T0 = ONE * FSCAL_T
159 ENDIF
160 IF (XSCALE == ZERO) THEN
161 CALL HM_GET_FLOATV_DIM('xscale' ,FSCAL_T ,IS_AVAILABLE,LSUBMODEL,UNITAB)
162 XSCALE = ONE * FSCAL_T
163 ENDIF
164 IF (YSCALE == ZERO) THEN
165 CALL HM_GET_FLOATV_DIM('magnitude' ,FSCAL_V ,IS_AVAILABLE,LSUBMODEL,UNITAB)
166 YSCALE = ONE * FSCAL_V
167 ENDIF
168c
169 WRITE (IOUT,1000)
170c--------------------------------------------------
171c Treatment of explicitly defined nodes
172c--------------------------------------------------
173 DO J=1,NNOD
174
175 N2 = USR2SYS(NOD2(J),ITABM1,MESS,OPTID)
176 XF = X0(1,N2)
177 YF = X0(2,N2)
178 ZF = X0(3,N2)
179c
180 IF (NOD1(J) > 0) THEN
181 INUM = INUM + 1
182 N1 = USR2SYS(NOD1(J),ITABM1,MESS,OPTID)
183 XI = X0(1,N1)
184 YI = X0(2,N1)
185 ZI = X0(3,N1)
186 DIST = SQRT((XF-XI)**2 + (YF-YI)**2 + (ZF-ZI)**2)
187c
188 IBFVEL(1 ,INUM) = N1
189 IBFVEL(2 ,INUM) = 0
190 IBFVEL(3 ,INUM) = FCT1_ID
191 IBFVEL(4 ,INUM) = SENS_ID
192 IBFVEL(5 ,INUM) = 0
193 IBFVEL(6 ,INUM) = 0
194 IBFVEL(7 ,INUM) = IDIS
195 IBFVEL(8 ,INUM) = ILAGM
196 IBFVEL(9 ,INUM) = NOFRAME
197 IBFVEL(10,INUM) = ICOOR
198 IBFVEL(11,INUM) = 0
199 IBFVEL(12,INUM) = IOPT
200 IBFVEL(13,INUM) = FGEO
201 IBFVEL(14,INUM) = N2
202 IBFVEL(15,INUM) = FCT2_ID
203c
204 FBFVEL(1,INUM) = DIST / T0
205 FBFVEL(2,INUM) = TSTART
206 FBFVEL(3,INUM) = INFINITY
207 FBFVEL(4,INUM) = ZERO
208 FBFVEL(5,INUM) = XSCALE
209 FBFVEL(6,INUM) = ZERO
210 FBFVEL(7,INUM) = DMIN
211 FBFVEL(8,INUM) = YSCALE
212c
213 WRITE (IOUT,2000) ITAB(N1),ITAB(N2),FCT1_ID,SENS_ID,FCT2_ID,
214 . DIST/T0,ONE/XSCALE,TSTART,DMIN,YSCALE
215 END IF
216 END DO
217c--------------------------------------------------
218c Treatment of nodes defined by spring part
219c--------------------------------------------------
220 IF (PART_ID > 0) THEN
221 JPART = 0
222 DO N=1,NPART
223 IF (IPART(4,N) == PART_ID) JPART = N
224 ENDDO
225c
226 DO N=1,NUMELR
227 IF (IPARTR(N) == JPART) THEN
228 INUM = INUM + 1
229 N1 = IXR(2,N)
230 N2 = IXR(3,N)
231 XI = X0(1,N1)
232 YI = X0(2,N1)
233 ZI = X0(3,N1)
234 XF = X0(1,N2)
235 YF = X0(2,N2)
236 ZF = X0(3,N2)
237 DIST= SQRT((XF-XI)**2 + (YF-YI)**2 + (ZF-ZI)**2)
238c
239 IBFVEL(1 ,INUM) = N1
240 IBFVEL(2 ,INUM) = 0
241 IBFVEL(3 ,INUM) = FCT1_ID
242 IBFVEL(4 ,INUM) = SENS_ID
243 IBFVEL(5 ,INUM) = 0
244 IBFVEL(6 ,INUM) = 0
245 IBFVEL(7 ,INUM) = IDIS
246 IBFVEL(8 ,INUM) = ILAGM
247 IBFVEL(9 ,INUM) = NOFRAME
248 IBFVEL(10,INUM) = ICOOR
249 IBFVEL(11,INUM) = 0
250 IBFVEL(12,INUM) = IOPT
251 IBFVEL(13,INUM) = FGEO
252 IBFVEL(14,INUM) = N2
253 IBFVEL(15,INUM) = FCT2_ID
254c
255 FBFVEL(1,INUM) = DIST / T0
256 FBFVEL(2,INUM) = TSTART
257 FBFVEL(3,INUM) = INFINITY
258 FBFVEL(4,INUM) = ZERO
259 FBFVEL(5,INUM) = XSCALE
260 FBFVEL(6,INUM) = ZERO
261 FBFVEL(7,INUM) = DMIN
262 FBFVEL(8,INUM) = YSCALE
263c
264 WRITE (IOUT,2000) ITAB(N1),ITAB(N2),FCT1_ID,SENS_ID,FCT2_ID,
265 . DIST/T0,ONE/XSCALE,TSTART,DMIN,YSCALE
266 END IF
267 END DO
268 END IF ! PART_ID > 0
269c----------------------------------------------------------------------
270c /IMPVEL/FGEO CALCULE LE NOMBRE D'OCCURENCES D'ONE NOEUD DE DESTINATION
271c--------------------------------------------------
272 DO N = 1,INUM
273 IF (IBFVEL(13,N) /= 2) CYCLE
274 N2 = IBFVEL(14,N)
275 K = 1
276 DO I = 1,INUM
277 IF (I == N) CYCLE
278 IF (IBFVEL(13,I) /= 2) CYCLE
279 IF (IBFVEL(14,I) == N2) K = K + 1
280 END DO
281 IBFVEL(16,N) = K
282 END DO
283c-----------
284 END DO ! IFGEO = 1,NFGEO
285c----------------------------------------------------------------------
286 1000 FORMAT(//
287 .' imposed velocities prescribed final geometry '/
288 .' ----------------------------------------------'/
289 .' node1 node2 vel_curve sensor load_curve ',
290 .' fscale ascale start_time ',
291 .' dmin load_scale')
292 2000 FORMAT(5(1X,I10),5(1X,1PG16.9))
293c----------------------------------------------------------------------
294 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:415
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
groupdef_mod
Definition groupdef_mod.F:662
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::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160