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