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
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "sphcom.inc"
66#include "lagmult.inc"
67#include "com04_c.inc"
68#include "scr17_c.inc"
69#include "param_c.inc"
70#include "units_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER ,INTENT(IN ) :: NLAGMUL
75 INTEGER ,INTENT(INOUT) :: INUM,IOPT
76 INTEGER ,DIMENSION(*) :: ITAB,ITABM1,IPARTR,IKINE
77 INTEGER ,DIMENSION(LIPART1,*) :: IPART
78 INTEGER ,DIMENSION(NIXR,*) :: IXR
79 INTEGER ,DIMENSION(NIFV,NFXVEL) :: IBFVEL
80 INTEGER ,DIMENSION(LISKN,*),INTENT(IN) :: ISKN
81 INTEGER ,DIMENSION(LNOPT1,*) ,INTENT(OUT) :: NOM_OPT
82 my_real ,DIMENSION(LFXVELR,NFXVEL) :: fbfvel
83 my_real ,DIMENSION(3,NUMNOD) ,INTENT(IN):: x0
84 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB
85 TYPE (GROUP_) ,DIMENSION(NGRNOD) ,INTENT(IN) :: IGRNOD
86 TYPE(SUBMODEL_DATA),DIMENSION(*) ,INTENT(IN) :: LSUBMODEL
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER I,J,K,N,N1,N2,NOD,NUM0,ILAGMUL,IUN,JPART,NNOD,NOFRAME,INOD,NOSKEW,
91 . SENS_ID,PART_ID,OPTID,UID,FCT1_ID,FCT2_ID,ILAGM,GRNOD_ID,IGS,LEN,
92 . LAGMUL,IDIS,ICOOR,DISTRIBUTION,SKEW_ID
93 INTEGER ,DIMENSION(NUMNOD) :: NOD1,NOD2,NWORK
94 INTEGER ,DIMENSION(3*NUMNOD) :: IKINE1
95 my_real :: xscale,yscale,fscal_t,fscal_v,t0,dmin,dist,
96 . xi,yi,zi,xf,yf,zf,tstart,tstop
97 CHARACTER(LEN=NCHARKEY) :: KEY
98 CHARACTER(LEN=NCHARFIELD) :: XYZ
99 CHARACTER(LEN=NCHARTITLE) :: TITR,MESS
100 CHARACTER(LEN=2) :: X,Y,Z,XX,YY,ZZ
101 LOGICAL IS_AVAILABLE
102C-----------------------------------------------
103C E x t e r n a l F u n c t i o n s
104C-----------------------------------------------
105 INTEGER NODGRNR5,USR2SYS
106 EXTERNAL nodgrnr5,usr2sys
107C-----------------------------------------------
108C D a t a
109C-----------------------------------------------
110 DATA x /'X'/
111 DATA y /'Y'/
112 DATA z /'Z'/
113 DATA xx /'xx'/
114 DATA YY /'yy'/
115 DATA ZZ /'zz'/
116
117 DATA IUN/1/
118 DATA MESS/'imposed velocity definition '/
119C======================================================================|
120 IS_AVAILABLE = .FALSE.
121
122 NUM0 = INUM+1
123c
124 IKINE1(:) = 0
125c--------------------------------------------------
126c
127 CALL HM_OPTION_START('/impvel/lagmul')
128c
129c--------------------------------------------------
130 DO ILAGMUL = 1,NLAGMUL
131c--------------------------------------------------
132 CALL HM_OPTION_READ_KEY(LSUBMODEL,
133 . OPTION_ID = OPTID,
134 . UNIT_ID = UID,
135 . OPTION_TITR = TITR,
136 . KEYWORD2 = KEY)
137c
138 IOPT = IOPT + 1
139 NOM_OPT(1,IOPT) = OPTID
140 CALL FRETITL(TITR,NOM_OPT(LNOPT1-LTITR+1,IOPT),LTITR)
141c
142c--------------------------------------------------
143 ICOOR = 0
144 IDIS = 1
145 ILAGM = 1
146 NOFRAME = 0
147 SENS_ID = 0
148 LEN = 1
149 TSTART = ZERO
150 TSTOP = INFINITY
151c--------------------------------------------------
152c READ STRING VALUES from /IMPVEL/LAGMUL
153c--------------------------------------------------
154 CALL HM_GET_INTV ('curveid' ,FCT1_ID,IS_AVAILABLE,LSUBMODEL)
155 CALL HM_GET_STRING('rad_dir' ,XYZ ,ncharfield,IS_AVAILABLE)
156 CALL HM_GET_INTV ('inputsystem' ,SKEW_ID,IS_AVAILABLE,LSUBMODEL)
157 CALL HM_GET_INTV ('entityid' ,GRNOD_ID ,IS_AVAILABLE,LSUBMODEL)
158c
159 CALL HM_GET_FLOATV('xscale' ,XSCALE ,IS_AVAILABLE,LSUBMODEL,UNITAB)
160 CALL HM_GET_FLOATV('magnitude' ,YSCALE ,IS_AVAILABLE,LSUBMODEL,UNITAB)
161c--------------------------------------------------
162c
163c--------------------------------------------------
164 DO J=0,NUMSKW+MIN(1,NSPCOND)*NUMSPH+NSUBMOD
165 IF (SKEW_ID == ISKN(4,J+1)) THEN
166 NOSKEW = J+1
167 EXIT
168 ENDIF
169 ENDDO
170.and. IF (SKEW_ID > 0 NOSKEW == 0)
171 . CALL ANCMSG(MSGID=137,ANMODE=ANINFO,MSGTYPE=MSGERROR,
172 . I1= OPTID,
173 . I2= SKEW_ID,
174 . C1='imposed velocity',
175 . C2='imposed velocity',
176 . C3= TITR)
177
178
179c--------------------------------------------------
180 IF (XSCALE == ZERO) THEN
181 CALL HM_GET_FLOATV_DIM('xscale' ,FSCAL_T ,IS_AVAILABLE,LSUBMODEL,UNITAB)
182 XSCALE = FSCAL_T
183 ENDIF
184 IF (YSCALE == ZERO) THEN
185 CALL HM_GET_FLOATV_DIM('magnitude' ,FSCAL_V ,IS_AVAILABLE,LSUBMODEL,UNITAB)
186 YSCALE = FSCAL_V
187 ENDIF
188c
189.OR..OR. IF (XYZ(1:2) == XX XYZ(1:2) == YY XYZ(1:2) == ZZ) THEN
190 LEN = 2
191 ENDIF
192 WRITE (IOUT,1000)
193c Read NODE numbers from the group
194 NNOD = NODGRNR5(GRNOD_ID ,IGS ,NWORK,IGRNOD ,ITABM1 ,MESS )
195
196
197 NFVLAG = NFVLAG+NNOD
198 LAG_NCF = LAG_NCF + NNOD
199 LAG_NHF = LAG_NHF + NNOD
200 IF(NOSKEW == 0) THEN
201 LAG_NKF = LAG_NKF + NNOD
202 ELSE
203 LAG_NKF = LAG_NKF + NNOD*3
204 ENDIF
205c--------------------------------------------------
206c Treatment of explicitly defined nodes
207c--------------------------------------------------
208 DO J=1,NNOD
209 INUM = INUM + 1
210 INOD = IABS(NWORK(J))
211 NOD = ITAB(INOD)
212c
213 IBFVEL(1 ,INUM) = NWORK(J)
214 IBFVEL(2 ,INUM) = 0
215 IBFVEL(3 ,INUM) = FCT1_ID
216 IBFVEL(4 ,INUM) = SENS_ID
217 IBFVEL(5 ,INUM) = 0
218 IBFVEL(6 ,INUM) = 0
219 IBFVEL(7 ,INUM) = IDIS
220 IBFVEL(8 ,INUM) = ILAGM
221 IBFVEL(9 ,INUM) = NOFRAME
222 IBFVEL(10,INUM) = ICOOR
223 IBFVEL(11,INUM) = 0
224 IBFVEL(12,INUM) = IOPT
225 IBFVEL(13,INUM) = 0
226 IBFVEL(14,INUM) = 0
227c
228
229c
230 FBFVEL(1,INUM) = YSCALE
231 FBFVEL(2,INUM) = TSTART
232 FBFVEL(3,INUM) = TSTOP
233 FBFVEL(4,INUM) = ZERO
234 FBFVEL(5,INUM) = ONE/XSCALE
235 FBFVEL(6,INUM) = ZERO
236
237 IF(XYZ(1:2) == XX)THEN
238 IBFVEL(2,INUM) = 4 + NOSKEW*10
239 CALL KINSET(16,NOD,IKINE(INOD),4,NOSKEW,IKINE1(INOD))
240 ELSEIF(XYZ(1:2) == YY)THEN
241 IBFVEL(2,INUM) = 5 + NOSKEW*10
242 CALL KINSET(16,NOD,IKINE(INOD),5,NOSKEW,IKINE1(INOD))
243 ELSEIF(XYZ(1:2) == ZZ)THEN
244 IBFVEL(2,INUM) = 6 + NOSKEW*10
245 CALL KINSET(16,NOD,IKINE(INOD),6,NOSKEW,IKINE1(INOD))
246 ELSEIF (XYZ(1:1) == X)THEN
247 IBFVEL(2,INUM)=1 + NOSKEW*10
248 CALL KINSET(16,NOD,IKINE(INOD),1,NOSKEW,IKINE1(INOD))
249 ELSEIF(XYZ(1:1) == Y)THEN
250 IBFVEL(2,INUM) = 2 + NOSKEW*10
251 CALL KINSET(16,NOD,IKINE(INOD),2,NOSKEW,IKINE1(INOD))
252 ELSEIF(XYZ(1:1) == Z)THEN
253 IBFVEL(2,INUM) = 3 + NOSKEW*10
254 CALL KINSET(16,NOD,IKINE(INOD),3,NOSKEW,IKINE1(INOD))
255 ELSE
256 CALL ANCMSG(MSGID=164, MSGTYPE=MSGERROR, ANMODE=ANINFO,
257 . I1=OPTID,
258 . C1=TITR,
259 . C2=XYZ)
260 ENDIF
261c
262
263 WRITE (IOUT,4000) NOD,ISKN(4,NOSKEW),0,XYZ(1:LEN),FCT1_ID,SENS_ID,
264 . YSCALE,XSCALE,TSTART,TSTOP,0
265 END DO
266c-----------
267 END DO !
268c----------------------------------------------------------------------
269 1000 FORMAT(//
270 .' imposed velocities by lagrange multipliers'/
271 .' ------------------------------------------'/
272 .' node skew frame direction load_curve',
273 .' sensor fscale ascale')
274
275 4000 FORMAT(3X,I10,3X,I10,3X,I10,9X,A2,3X,I10,3X,I10,
276 . 2X,1PG20.13,2X,1PG20.13,2X,G20.13,2X,G20.13,16X,I10)
277c----------------------------------------------------------------------
278 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
nodgrnr5
integer function nodgrnr5(igu, igs, ibuf, igrnod, itabm1, mess)
Definition freform.F:303
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160