OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_impvel_fgeo.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!|| read_impvel_fgeo ../starter/source/constraints/general/impvel/read_impvel_fgeo.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_impvel ../starter/source/constraints/general/impvel/hm_read_impvel.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl ../starter/source/starter/freform.f
30!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
31!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
32!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
33!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
34!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
35!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
36!|| usr2sys ../starter/source/system/sysfus.F
37!||--- uses -----------------------------------------------------
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 read_impvel_fgeo(
43 . NFGEO ,INUM ,IOPT ,FBFVEL ,IBFVEL ,
44 . ITAB ,ITABM1 ,IGRNOD ,NOM_OPT ,X0 ,
45 . IXR ,IPART ,IPARTR ,UNITAB ,LSUBMODEL)
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
295 END
my_real
#define my_real
Definition cppsort.cpp:32
freform
subroutine freform(irunn, irfl, irfe, h3d_data, flag_cst_ams, dynain_data, sensors, dt, output, glob_therm)
Definition freform.F:88
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
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
read_impvel_fgeo
subroutine read_impvel_fgeo(nfgeo, inum, iopt, fbfvel, ibfvel, itab, itabm1, igrnod, nom_opt, x0, ixr, ipart, ipartr, unitab, lsubmodel)
Definition read_impvel_fgeo.F:46
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
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723