OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_impvel_lagmul.F File Reference
#include "implicit_f.inc"
#include "sphcom.inc"
#include "lagmult.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_lagmul (nlagmul, inum, iopt, fbfvel, ibfvel, itab, itabm1, igrnod, nom_opt, x0, ixr, ipart, ipartr, iskn, ikine, unitab, lsubmodel)

Function/Subroutine Documentation

◆ read_impvel_lagmul()

subroutine read_impvel_lagmul ( integer, intent(in) nlagmul,
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,
integer, dimension(liskn,*), intent(in) iskn,
integer, dimension(*) ikine,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 44 of file read_impvel_lagmul.F.

49C============================================================================
50C M o d u l e s
51C-----------------------------------------------
52 USE message_mod
53 USE groupdef_mod
54 USE submodel_mod
55 USE hm_option_read_mod
56 USE unitab_mod
57 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
58 use element_mod , only : nixr
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "sphcom.inc"
67#include "lagmult.inc"
68#include "com04_c.inc"
69#include "scr17_c.inc"
70#include "param_c.inc"
71#include "units_c.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 INTEGER ,INTENT(IN ) :: NLAGMUL
76 INTEGER ,INTENT(INOUT) :: INUM,IOPT
77 INTEGER ,DIMENSION(*) :: ITAB,ITABM1,IPARTR,IKINE
78 INTEGER ,DIMENSION(LIPART1,*) :: IPART
79 INTEGER ,DIMENSION(NIXR,*) :: IXR
80 INTEGER ,DIMENSION(NIFV,NFXVEL) :: IBFVEL
81 INTEGER ,DIMENSION(LISKN,*),INTENT(IN) :: ISKN
82 INTEGER ,DIMENSION(LNOPT1,*) ,INTENT(OUT) :: NOM_OPT
83 my_real ,DIMENSION(LFXVELR,NFXVEL) :: fbfvel
84 my_real ,DIMENSION(3,NUMNOD) ,INTENT(IN):: x0
85 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB
86 TYPE (GROUP_) ,DIMENSION(NGRNOD) ,INTENT(IN) :: IGRNOD
87 TYPE(SUBMODEL_DATA),DIMENSION(*) ,INTENT(IN) :: LSUBMODEL
88C-----------------------------------------------
89C L o c a l V a r i a b l e s
90C-----------------------------------------------
91 INTEGER J,NOD,NUM0,ILAGMUL,IUN,NNOD,NOFRAME,INOD,NOSKEW,
92 . SENS_ID,OPTID,UID,FCT1_ID,ILAGM,GRNOD_ID,IGS,LEN,
93 . IDIS,ICOOR,SKEW_ID
94 INTEGER ,DIMENSION(NUMNOD) :: NWORK
95 INTEGER ,DIMENSION(3*NUMNOD) :: IKINE1
96 my_real :: xscale,yscale,fscal_t,fscal_v,
97 . tstart,tstop
98 CHARACTER(LEN=NCHARKEY) :: KEY
99 CHARACTER(LEN=NCHARFIELD) :: XYZ
100 CHARACTER(LEN=NCHARTITLE) :: TITR,MESS
101 CHARACTER(LEN=2) :: X,Y,Z,XX,YY,ZZ
102 LOGICAL IS_AVAILABLE
103C-----------------------------------------------
104C E x t e r n a l F u n c t i o n s
105C-----------------------------------------------
106 INTEGER NODGRNR5,USR2SYS
107 EXTERNAL nodgrnr5,usr2sys
108C-----------------------------------------------
109C D a t a
110C-----------------------------------------------
111 DATA x /'X'/
112 DATA y /'Y'/
113 DATA z /'Z'/
114 DATA xx /'XX'/
115 DATA yy /'YY'/
116 DATA zz /'ZZ'/
117
118 DATA iun/1/
119 DATA mess/'IMPOSED VELOCITY DEFINITION '/
120C======================================================================|
121 is_available = .false.
122
123 num0 = inum+1
124c
125 ikine1(:) = 0
126c--------------------------------------------------
127c
128 CALL hm_option_start('/IMPVEL/LAGMUL')
129c
130c--------------------------------------------------
131 DO ilagmul = 1,nlagmul
132c--------------------------------------------------
133 CALL hm_option_read_key(lsubmodel,
134 . option_id = optid,
135 . unit_id = uid,
136 . option_titr = titr,
137 . keyword2 = key)
138c
139 iopt = iopt + 1
140 nom_opt(1,iopt) = optid
141 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,iopt),ltitr)
142c
143c--------------------------------------------------
144 icoor = 0
145 idis = 1
146 ilagm = 1
147 noframe = 0
148 sens_id = 0
149 len = 1
150 tstart = zero
151 tstop = infinity
152c--------------------------------------------------
153c READ STRING VALUES from /IMPVEL/LAGMUL
154c--------------------------------------------------
155 CALL hm_get_intv ('curveid' ,fct1_id,is_available,lsubmodel)
156 CALL hm_get_string('rad_dir' ,xyz ,ncharfield,is_available)
157 CALL hm_get_intv ('inputsystem' ,skew_id,is_available,lsubmodel)
158 CALL hm_get_intv ('entityid' ,grnod_id ,is_available,lsubmodel)
159c
160 CALL hm_get_floatv('xscale' ,xscale ,is_available,lsubmodel,unitab)
161 CALL hm_get_floatv('magnitude' ,yscale ,is_available,lsubmodel,unitab)
162c--------------------------------------------------
163c
164c--------------------------------------------------
165 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
166 IF (skew_id == iskn(4,j+1)) THEN
167 noskew = j+1
168 EXIT
169 ENDIF
170 ENDDO
171 IF (skew_id > 0 .and. noskew == 0)
172 . CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
173 . i1= optid,
174 . i2= skew_id,
175 . c1='IMPOSED VELOCITY',
176 . c2='IMPOSED VELOCITY',
177 . c3= titr)
178
179
180c--------------------------------------------------
181 IF (xscale == zero) THEN
182 CALL hm_get_floatv_dim('xscale' ,fscal_t ,is_available,lsubmodel,unitab)
183 xscale = fscal_t
184 ENDIF
185 IF (yscale == zero) THEN
186 CALL hm_get_floatv_dim('magnitude' ,fscal_v ,is_available,lsubmodel,unitab)
187 yscale = fscal_v
188 ENDIF
189c
190 IF (xyz(1:2) == xx .OR. xyz(1:2) == yy .OR. xyz(1:2) == zz) THEN
191 len = 2
192 ENDIF
193 WRITE (iout,1000)
194c Read NODE numbers from the group
195 nnod = nodgrnr5(grnod_id ,igs ,nwork,igrnod ,itabm1 ,mess )
196
197
198 nfvlag = nfvlag+nnod
199 lag_ncf = lag_ncf + nnod
200 lag_nhf = lag_nhf + nnod
201 IF(noskew == 0) THEN
202 lag_nkf = lag_nkf + nnod
203 ELSE
204 lag_nkf = lag_nkf + nnod*3
205 ENDIF
206c--------------------------------------------------
207c Treatment of explicitly defined nodes
208c--------------------------------------------------
209 DO j=1,nnod
210 inum = inum + 1
211 inod = iabs(nwork(j))
212 nod = itab(inod)
213c
214 ibfvel(1 ,inum) = nwork(j)
215 ibfvel(2 ,inum) = 0
216 ibfvel(3 ,inum) = fct1_id
217 ibfvel(4 ,inum) = sens_id
218 ibfvel(5 ,inum) = 0
219 ibfvel(6 ,inum) = 0
220 ibfvel(7 ,inum) = idis
221 ibfvel(8 ,inum) = ilagm
222 ibfvel(9 ,inum) = noframe
223 ibfvel(10,inum) = icoor
224 ibfvel(11,inum) = 0
225 ibfvel(12,inum) = iopt
226 ibfvel(13,inum) = 0
227 ibfvel(14,inum) = 0
228c
229
230c
231 fbfvel(1,inum) = yscale
232 fbfvel(2,inum) = tstart
233 fbfvel(3,inum) = tstop
234 fbfvel(4,inum) = zero
235 fbfvel(5,inum) = one/xscale
236 fbfvel(6,inum) = zero
237
238 IF(xyz(1:2) == xx)THEN
239 ibfvel(2,inum) = 4 + noskew*10
240 CALL kinset(16,nod,ikine(inod),4,noskew,ikine1(inod))
241 ELSEIF(xyz(1:2) == yy)THEN
242 ibfvel(2,inum) = 5 + noskew*10
243 CALL kinset(16,nod,ikine(inod),5,noskew,ikine1(inod))
244 ELSEIF(xyz(1:2) == zz)THEN
245 ibfvel(2,inum) = 6 + noskew*10
246 CALL kinset(16,nod,ikine(inod),6,noskew,ikine1(inod))
247 ELSEIF (xyz(1:1) == x)THEN
248 ibfvel(2,inum)=1 + noskew*10
249 CALL kinset(16,nod,ikine(inod),1,noskew,ikine1(inod))
250 ELSEIF(xyz(1:1) == y)THEN
251 ibfvel(2,inum) = 2 + noskew*10
252 CALL kinset(16,nod,ikine(inod),2,noskew,ikine1(inod))
253 ELSEIF(xyz(1:1) == z)THEN
254 ibfvel(2,inum) = 3 + noskew*10
255 CALL kinset(16,nod,ikine(inod),3,noskew,ikine1(inod))
256 ELSE
257 CALL ancmsg(msgid=164, msgtype=msgerror, anmode=aninfo,
258 . i1=optid,
259 . c1=titr,
260 . c2=xyz)
261 ENDIF
262c
263
264 WRITE (iout,4000) nod,iskn(4,noskew),0,xyz(1:len),fct1_id,sens_id,
265 . yscale,xscale,tstart,tstop,0
266 END DO
267c-----------
268 END DO !
269c----------------------------------------------------------------------
270 1000 FORMAT(//
271 .' IMPOSED VELOCITIES BY LAGRANGE MULTIPLIERS'/
272 .' ------------------------------------------'/
273 .' NODE SKEW FRAME DIRECTION LOAD_CURVE',
274 .' SENSOR FSCALE ASCALE')
275
276 4000 FORMAT(3x,i10,3x,i10,3x,i10,9x,a2,3x,i10,3x,i10,
277 . 2x,1pg20.13,2x,1pg20.13,2x,g20.13,2x,g20.13,16x,i10)
278c----------------------------------------------------------------------
279 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_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:161
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:78
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
kinset
subroutine kinset(ik, node, ikine, idir, isk, ikine1)
Definition kinset.F:57
min
#define min(a, b)
Definition macros.h:20
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
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
unitab_mod
Definition unitab_mod.F:517
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
nodgrnr5
integer function nodgrnr5(igu, igs, ibuf, igrnod, itabm1, mess)
Definition freform.F:298
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:615
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146