OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inivel.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/.
23C
24!||====================================================================
25!|| hm_read_inivel ../starter/source/initial_conditions/general/inivel/hm_read_inivel.F
26!||--- called by ------------------------------------------------------
27!|| lectur ../starter/source/starter/lectur.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../starter/source/output/message/message.F
30!|| freerr ../starter/source/starter/freform.F
31!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
32!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
33!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
34!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
35!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
36!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.F
37!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
38!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
39!|| subrotvect ../starter/source/model/submodel/subrot.F
40!|| udouble ../starter/source/system/sysfus.F
41!|| usr2sys ../starter/source/system/sysfus.F
42!||--- uses -----------------------------------------------------
43!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
44!|| message_mod ../starter/share/message_module/message_mod.f
45!|| submodel_mod ../starter/share/modules1/submodel_mod.F
46!||====================================================================
47 SUBROUTINE hm_read_inivel(V , W , ITAB , ITABM1 , VR ,
48 . IGRNOD , IGRBRIC, ISKN , SKEW , INIVIDS ,
49 . X , UNITAB , LSUBMODEL, RTRANS , XFRAME ,
50 . IFRAME , VFLOW , WFLOW , KXSP , MULTI_FVM ,
51 . FVM_INIVEL, IGRQUAD, IGRSH3N , RBY_MSN, RBY_INIAXIS,
52 . SENSORS ,NINIVELT,INIVEL_T )
53C-----------------------------------------------
54C D e s c r i p t i o n
55C-----------------------------------------------
56C INITIAL VELOCITY READER (OPTIONS : /INIVEL/...)
57C
58C /INIVEL/TRA ITYPE=0
59C /INIVEL/ROT ITYPE=1
60C /INIVEL/T+G ITYPE=2
61C /INIVEL/GRID ITYPE=3
62C /INIVEL/AXIS ITYPE=4
63C /INIVEL/FVM ITYPE=5
64C /INIVEL/NODE ITYPE=6
65C-----------------------------------------------
66C M o d u l e s
67C-----------------------------------------------
68 USE unitab_mod
69 USE submodel_mod
70 USE message_mod
71 USE multi_fvm_mod
72 USE groupdef_mod
73 USE hm_option_read_mod
74 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
75 USE sensor_mod
76 USE inivel_mod
77C----------------------------------------------------------------
78C I m p l i c i t T y p e s
79C-----------------------------------------------
80#include "implicit_f.inc"
81C-----------------------------------------------
82C C o m m o n B l o c k s
83C-----------------------------------------------
84#include "com01_c.inc"
85#include "com04_c.inc"
86#include "units_c.inc"
87#include "scr03_c.inc"
88#include "param_c.inc"
89#include "sphcom.inc"
90C-----------------------------------------------
91C D u m m y A r g u m e n t s
92C-----------------------------------------------
93 INTEGER ,INTENT(IN) :: NINIVELT
94 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
95 INTEGER :: ITAB(*), ITABM1(*),ISKN(LISKN,*),INIVIDS(*),IFRAME(LISKN,*),KXSP(NISP,*),RBY_MSN(2,*)
96 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
97 my_real :: V(3,*),W(3,*),VR(3,*),SKEW(LSKEW,*),X(3,*),RTRANS(NTRANSF,*),XFRAME(NXFRAME,*),VFLOW(3,*) ,WFLOW(3,*)
98 my_real :: rby_iniaxis(7,*)
99 TYPE(multi_fvm_struct) :: MULTI_FVM
100 TYPE(fvm_inivel_struct), INTENT(INOUT) :: FVM_INIVEL(*)
101 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
102 TYPE(inivel_), DIMENSION(NINIVELT), INTENT(INOUT) :: INIVEL_T
103C-----------------------------------------------
104 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
105 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
106 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
107 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
108C-----------------------------------------------
109C L o c a l V a r i a b l e s
110C-----------------------------------------------
111 INTEGER :: I,J,K,N,NRB,KPRI,KROT,NNOD,NOSYS,ITYPE,ID,ISK,IGR,IGRS,NBVEL
112 INTEGER :: USER_UNIT_ID,SUB_INDEX,IDIR,SENS_ID,NINIT,SENSID
113 INTEGER :: IDGRBRICK, IDGRQUAD, IDGRTRIA, IDGRBRICK_LOC, IDGRQUAD_LOC, IDGRTRIA_LOC
114 INTEGER :: NOD_COUNT,NODINIVEL,CPT,SUB_ID
115 INTEGER :: IFRA,IFM,IUN,K1,K2,K3,INOD,NB_NODES, ID_NODE,IOK
116 INTEGER :: NINIVEL_FVM,NINIVEL_TOTAL
117 INTEGER :: FVM_GRBRIC_USER_ID(NINVEL), FVM_GRQUAD_USER_ID(NINVEL), FVM_GRTRIA_USER_ID(NINVEL) ! printout only
118 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGNO_RBY
119 my_real :: v1, v2, v3, v4, v5, v6, vl1, vl2, vl3,vra, ox, oy, oz, nixj(6),vr1,vr2,vr3,bid
120 CHARACTER MESS*40
121 CHARACTER(LEN=NCHARTITLE) :: TITR
122 CHARACTER(LEN=NCHARKEY) :: KEY
123 CHARACTER(LEN=NCHARFIELD) ::XYZ
124 CHARACTER*16 :: LABEL
125 LOGICAL IS_AVAILABLE, IS_FOUND_UNIT_ID, IS_FOUND
126 my_real :: tstart
127C-----------------------------------------------
128C E x t e r n a l F u n c t i o n s
129C-----------------------------------------------
130 INTEGER,EXTERNAL :: USR2SYS
131 DATA mess/'INITIAL VELOCITIES DEFINITION '/
132 DATA iun/1/
133C-----------------------------------------------
134C S o u r c e L i n e s
135C-----------------------------------------------
136 is_available = .false.
137 nbvel = 0
138 isk = 0
139 ifra = 0
140 ifm = 0
141 k1 = 0
142 k2 = 0
143 k3 = 0
144 idir = 0
145 krot = 0
146 nod_count = 0
147 idgrbrick_loc = 0
148 idgrquad_loc = 0
149 idgrtria_loc = 0
150
151 CALL hm_option_count('/INIVEL' , ninivel_total)
152 CALL hm_option_count('/INIVEL/FVM', ninivel_fvm)
153C--------------------------------------------------
154C LOOP OVER /INIVEL/... OPTIONS IN INPUT FILE
155C--------------------------------------------------
156 CALL hm_option_start('/INIVEL')
157 i = 0
158 ninit = 0 ! number of /INIVEL w/ tstart
159
160 DO cpt=1,hm_ninvel
161 i = i + 1
162 !---SET CURSOR ON NEXT INIVEL OPTION
163 CALL hm_option_read_key(lsubmodel,option_id = id,unit_id = user_unit_id,submodel_index = sub_index,
164 . submodel_id = sub_id,option_titr = titr,keyword2 = key)
165
166 !---CHECK EXISTING UNIT ID IF PROVIDED
167 is_found_unit_id = .false.
168 DO j=1,unitab%NUNITS
169 IF (unitab%UNIT_ID(j) == user_unit_id) THEN
170 is_found_unit_id = .true.
171 EXIT
172 ENDIF
173 ENDDO
174 IF (user_unit_id /= 0 .AND. .NOT.is_found_unit_id) THEN
175 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
176 . i2=user_unit_id,i1=id,c1='INITIAL VELOCITY',c2='INITIAL VELOCITY',c3=titr)
177 ENDIF
178
179 !---SET ITYPE DEPENDING ON USER KEYWORD
180 fvm_inivel(i)%FLAG = .false.
181 tstart = zero
182 sens_id = 0
183 label='/INIVEL'
184 IF(key(1:3)=='TRA')THEN
185 itype=0
186 label='/INIVEL/TRA'
187 ELSEIF(key(1:3)=='ROT')THEN
188 itype=1
189 label='/INIVEL/ROT'
190 ELSEIF(key(1:3)=='T+G')THEN
191 itype=2
192 label='/INIVEL/T+G'
193 ELSEIF(key(1:3)=='GRI')THEN
194 itype=3
195 label='/INIVEL/GRID'
196 ELSEIF(key(1:4)=='AXIS')THEN
197 IF(invers < 120) THEN
198 CALL ancmsg(msgid=2046,anmode=aninfo,msgtype=msgerror,c1='/INIVEL/AXIS',i1=invers)
199 ENDIF
200 itype=4
201 label='/INIVEL/AXIS'
202 ELSEIF(key(1:3) == 'FVM') THEN
203 itype=5
204! FVM_INIVEL(I)%FLAG = .TRUE.
205 label='/INIVEL/FVM'
206 ELSEIF(key(1:4)=='NODE')THEN
207 itype=6
208 label='/INIVEL/NODE'
209 ELSE
210 CALL freerr(1)
211 RETURN
212 ENDIF
213
214 nbvel = nbvel+1
215 inivids(nbvel)=id
216
217! read t_start,sens_id for Itype<6
218 IF(itype < 6) THEN
219 CALL hm_get_floatv('tstart',tstart,is_available,lsubmodel,unitab)
220 CALL hm_get_intv('sensor_id',sensid,is_available,lsubmodel)
221 IF (sensid > 0) THEN
222 DO j=1,sensors%NSENSOR
223 IF(sensors%SENSOR_TAB(j)%SENS_ID == sensid) sens_id=j
224 ENDDO
225 IF(sens_id == 0)THEN
226 CALL ancmsg(msgid=1252,anmode=aninfo,msgtype=msgerror,c1=label, i1=id, c2=label, c3=titr, i2=sensid)
227 ENDIF
228 END IF
229 END IF
230!
231 IF(itype > 6) THEN
232 !invalid type
233 cycle
234
235 !---READER /INIVEL/TRA,ROT,T+G,GRID (0,1,2,3)
236 ELSEIF (itype <= 3) THEN
237 isk = 0
238 ifra = 0
239 CALL hm_get_intv('entityid',igr,is_available,lsubmodel)
240 CALL hm_get_intv('inputsystem',isk,is_available,lsubmodel)
241 IF(isk == 0 .AND. sub_index /= 0 ) isk = lsubmodel(sub_index)%SKEW
242 CALL hm_get_floatv('vector_X',vl1,is_available,lsubmodel,unitab)
243 CALL hm_get_floatv('vector_Y',vl2,is_available,lsubmodel,unitab)
244 CALL hm_get_floatv('vector_Z',vl3,is_available,lsubmodel,unitab)
245 IF(n2d /= 0 .AND. isk == 0)THEN
246 IF(vl1 /= 0)THEN
247 !2D plane strain warning about X-velocity
248 CALL ancmsg(msgid=1256, anmode=aninfo, msgtype=msgwarning, c1=label, i1=id, c2=label, c3=titr)
249 vl1 = zero
250 ENDIF
251 ENDIF
252 IF (tstart>zero .OR. sens_id>0) THEN
253 ninit = ninit + 1
254 inivel_t(ninit)%ID = id
255 inivel_t(ninit)%ITYPE = itype
256 inivel_t(ninit)%GENERAL%TYPE = itype
257 inivel_t(ninit)%GENERAL%SKEW_ID = isk
258 inivel_t(ninit)%GENERAL%GRND_ID = igr
259 inivel_t(ninit)%GENERAL%VX = vl1
260 inivel_t(ninit)%GENERAL%VY = vl2
261 inivel_t(ninit)%GENERAL%VZ = vl3
262 inivel_t(ninit)%GENERAL%SENSOR_ID = sensid
263 inivel_t(ninit)%GENERAL%TSTART = tstart
264 END IF
265
266 !---READER /INIVEL/AXIS (4)
267 ELSEIF (itype == 4) THEN
268 CALL hm_get_string('rad_dir',xyz,ncharfield,is_available)
269 CALL hm_get_intv('inputsystem',ifra,is_available,lsubmodel)
270 CALL hm_get_intv('entityid',igr,is_available,lsubmodel)
271
272 CALL hm_get_floatv('vector_X',vl1,is_available,lsubmodel,unitab)
273 CALL hm_get_floatv('vector_Y',vl2,is_available,lsubmodel,unitab)
274 CALL hm_get_floatv('vector_Z',vl3,is_available,lsubmodel,unitab)
275 CALL hm_get_floatv('rad_rotational_velocity',vra,is_available,lsubmodel,unitab)
276 IF(n2d /= 0 .AND. ifra == 0)THEN
277 IF(vl2 /=0 .OR. vl3 /= 0)THEN
278 !2D plane strain warning about Y or Z rotation (resulting into X-velocity)
279 CALL ancmsg(msgid=1256, anmode=aninfo, msgtype=msgwarning, c1=label, i1=id, c2=label, c3=titr)
280 vl2 = zero
281 vl3 = zero
282 ENDIF
283 ENDIF
284 IF(ifra == 0 .AND. sub_index /= 0) CALL subrotvect(vl1,vl2,vl3,rtrans,sub_id,lsubmodel)
285 IF(xyz(1:1)=='X') THEN
286 idir=1
287 ELSEIF(xyz(1:1)=='Y') THEN
288 idir=2
289 ELSEIF(xyz(1:1)=='Z') THEN
290 idir=3
291 ELSE
292 CALL ancmsg(msgid=933,msgtype=msgerror,anmode=aninfo,i1=id,c1=titr)
293 ENDIF
294 isk = 0
295 IF (tstart>zero .OR. sens_id>0) THEN
296 ninit = ninit + 1
297 inivel_t(ninit)%ID = id
298 inivel_t(ninit)%ITYPE = itype
299 inivel_t(ninit)%AXIS%DIR = idir
300 inivel_t(ninit)%AXIS%FRAME_ID = ifra
301 inivel_t(ninit)%AXIS%GRND_ID = igr
302 inivel_t(ninit)%AXIS%VX = vl1
303 inivel_t(ninit)%AXIS%VY = vl2
304 inivel_t(ninit)%AXIS%VZ = vl3
305 inivel_t(ninit)%AXIS%VR = vra
306 inivel_t(ninit)%AXIS%SENSOR_ID = sensid
307 inivel_t(ninit)%AXIS%TSTART = tstart
308 END IF
309
310 !---READER /INIVEL/FVM (5)
311 ELSEIF (itype == 5) THEN
312 CALL hm_get_floatv('Vx', vl1, is_available, lsubmodel, unitab)
313 CALL hm_get_floatv('Vy', vl2, is_available, lsubmodel, unitab)
314 CALL hm_get_floatv('Vz', vl3, is_available, lsubmodel, unitab)
315 CALL hm_get_intv('grbric_ID', idgrbrick, is_available, lsubmodel)
316 CALL hm_get_intv('grqd_ID', idgrquad, is_available, lsubmodel)
317 CALL hm_get_intv('grtria_ID', idgrtria, is_available, lsubmodel)
318 CALL hm_get_intv('skew_ID', isk, is_available, lsubmodel)
319 IF(n2d /= 0 .AND. isk == 0)THEN
320 IF(vl1 /= 0)THEN
321 !2D plane strain warning about X-velocity
322 CALL ancmsg(msgid=1256, anmode=aninfo, msgtype=msgwarning, c1=label, i1=id, c2=label, c3=titr)
323 vl1 = zero
324 ENDIF
325 ENDIF
326 IF (tstart>zero .OR. sens_id>0) THEN
327 ninit = ninit + 1
328 inivel_t(ninit)%ID = id
329 inivel_t(ninit)%ITYPE = itype
330 inivel_t(ninit)%FVM%SKEW_ID = isk
331 inivel_t(ninit)%FVM%GRBRIC_ID = idgrbrick
332 inivel_t(ninit)%FVM%GRQD_ID = idgrquad
333 inivel_t(ninit)%FVM%GRTRIA_ID = idgrtria
334 inivel_t(ninit)%FVM%VX = vl1
335 inivel_t(ninit)%FVM%VY = vl2
336 inivel_t(ninit)%FVM%VZ = vl3
337 inivel_t(ninit)%FVM%SENSOR_ID = sensid
338 inivel_t(ninit)%FVM%TSTART = tstart
339 END IF
340
341 !---READER /INIVEL/NODE (6)
342 ELSEIF (itype == 6) THEN
343 CALL hm_get_intv('NB_NODES', nb_nodes, is_available, lsubmodel)
344 DO n=1,nb_nodes
345 CALL hm_get_int_array_index('NODE', id_node, n, is_available, lsubmodel)
346 CALL hm_get_int_array_index('SKEWA', isk, n, is_available, lsubmodel)
347 CALL hm_get_float_array_index('VXTA', vl1, n, is_available, lsubmodel, unitab)
348 CALL hm_get_float_array_index('VYTA', vl2, n, is_available, lsubmodel, unitab)
349 CALL hm_get_float_array_index('VZTA', vl3, n, is_available, lsubmodel, unitab)
350 CALL hm_get_float_array_index('VXRA', vr1, n, is_available, lsubmodel, unitab)
351 CALL hm_get_float_array_index('VYRA', vr2, n, is_available, lsubmodel, unitab)
352 CALL hm_get_float_array_index('VZRA', vr3, n, is_available, lsubmodel, unitab)
353 IF(n2d /= 0 .AND. isk == 0)THEN
354 IF(vl1 /=0 .OR. vr2 /= 0 .OR. vr3 /= 0)THEN
355 !plane strain warning about X-direction
356 CALL ancmsg(msgid=1256, anmode=aninfo, msgtype=msgwarning, c1=label, i1=id, c2=label, c3=titr)
357 vl1 = zero
358 vr2 = zero
359 vr3 = zero
360 ENDIF
361 ENDIF
362 iok = 0
363 krot = 1
364 IF (id_node > 0) THEN
365 IF (isk > 0) THEN
366 v1 = -huge(v1)
367 v2 = -huge(v2)
368 v3 = -huge(v3)
369 v4 = -huge(v4)
370 v5 = -huge(v5)
371 v6 = -huge(v6)
372 DO j=0,numskw+min(iun,nspcond)*numsph+nsubmod
373 IF (isk == iskn(4,j+1)) THEN
374 isk=j+1
375 v1 = skew(1,isk)*vl1+skew(4,isk)*vl2+skew(7,isk)*vl3
376 v2 = skew(2,isk)*vl1+skew(5,isk)*vl2+skew(8,isk)*vl3
377 v3 = skew(3,isk)*vl1+skew(6,isk)*vl2+skew(9,isk)*vl3
378 v4 = skew(1,isk)*vr1+skew(4,isk)*vr2+skew(7,isk)*vr3
379 v5 = skew(2,isk)*vr1+skew(5,isk)*vr2+skew(8,isk)*vr3
380 v6 = skew(3,isk)*vr1+skew(6,isk)*vr2+skew(9,isk)*vr3
381 iok = 1
382 ENDIF
383 ENDDO
384 IF (iok == 0)CALL ancmsg(msgid=184,msgtype=msgerror,anmode=aninfo,
385 . i1=id,i2=isk,c1='INITIAL VELOCITY',c2='INITIAL VELOCITY',c3=titr)
386 nosys = usr2sys(id_node,itabm1,mess,id)
387 v(1,nosys) = v1
388 v(2,nosys) = v2
389 v(3,nosys) = v3
390 vr(1,nosys) = v4
391 vr(2,nosys) = v5
392 vr(3,nosys) = v6
393 ELSEIF (isk == 0 .AND. ifra == 0) THEN
394 nosys = usr2sys(id_node,itabm1,mess,id)
395 v(1,nosys) = vl1
396 v(2,nosys) = vl2
397 v(3,nosys) = vl3
398 vr(1,nosys) = vr1
399 vr(2,nosys) = vr2
400 vr(3,nosys) = vr3
401 ENDIF
402 ENDIF
403 ENDDO !N=1,NB_NODES
404 isk = 0
405
406 ENDIF !ITYPE TEST
407C
408 IF (itype /= 6) THEN
409 IF (isk > 0) THEN
410 is_found = .false.
411 DO j=0,numskw+min(iun,nspcond)*numsph+nsubmod
412 IF (isk == iskn(4,j+1)) THEN
413 isk=j+1
414 v1 = skew(1,isk)*vl1+skew(4,isk)*vl2+skew(7,isk)*vl3
415 v2 = skew(2,isk)*vl1+skew(5,isk)*vl2+skew(8,isk)*vl3
416 v3 = skew(3,isk)*vl1+skew(6,isk)*vl2+skew(9,isk)*vl3
417 is_found = .true.
418 EXIT
419 ENDIF
420 ENDDO
421 IF(.NOT. is_found)THEN
422 CALL ancmsg(msgid=184,msgtype=msgerror,anmode=aninfo,i1=id,i2=isk,
423 . c1='INITIAL VELOCITY', c2='INITIAL VELOCITY', c3=titr)
424 ENDIF
425
426 ELSEIF (ifra > 0) THEN
427 is_found = .false.
428 DO k=1,numfram
429 j=k+1
430 IF(ifra==iframe(4,j)) THEN
431 v1 = xframe(1,j)*vl1+xframe(4,j)*vl2+xframe(7,j)*vl3
432 v2 = xframe(2,j)*vl1+xframe(5,j)*vl2+xframe(8,j)*vl3
433 v3 = xframe(3,j)*vl1+xframe(6,j)*vl2+xframe(9,j)*vl3
434 is_found = .true.
435 EXIT
436 ENDIF
437 ENDDO
438 IF(.NOT. is_found)THEN
439 CALL ancmsg(msgid=490,msgtype=msgerror,anmode=aninfo,i1=id,i2=ifra,
440 . c1='INITIAL VELOCITY',c2='INITIAL VELOCITY',c3=titr)
441 ENDIF
442 ifm = j
443 ELSEIF (isk == 0 .AND. ifra == 0) THEN
444 v1 = vl1
445 v2 = vl2
446 v3 = vl3
447 ENDIF
448 ENDIF
449 idgrbrick_loc = -1
450 idgrquad_loc = -1
451 idgrtria_loc = -1
452
453 IF (itype == 5) THEN
454 IF (.NOT. multi_fvm%IS_USED) THEN
455 CALL ancmsg(msgid=1554,msgtype=msgerror,anmode=aninfo,c1='IN /INIVEL OPTION')
456 ELSE
457 idgrbrick_loc = -1
458 idgrquad_loc = -1
459 idgrtria_loc = -1
460 IF (idgrbrick + idgrquad + idgrtria == 0) THEN
461 CALL ancmsg(msgid=1553, msgtype=msgwarning, anmode=aninfo,c1='IN /INIVEL OPTION')
462 ELSE
463 IF (idgrbrick /= 0) THEN
464 DO j = 1,ngrbric
465 IF (idgrbrick == igrbric(j)%ID) idgrbrick_loc = j
466 ENDDO
467 IF (idgrbrick_loc == -1) THEN
468 CALL ancmsg(msgid=1554, msgtype=msgerror,anmode=aninfo,c1='IN /INIVEL OPTION',i1=idgrbrick)
469 ENDIF
470 ENDIF
471 IF (idgrquad /= 0) THEN
472 DO j = 1,ngrquad
473 IF (idgrquad == igrquad(j)%ID) idgrquad_loc = j
474 ENDDO
475 IF (idgrquad_loc == -1) THEN
476 CALL ancmsg(msgid=1554,msgtype=msgerror,anmode=aninfo,c1='IN /INIVEL OPTION',i1=idgrquad)
477 ENDIF
478 ENDIF
479 IF (idgrtria /= 0) THEN
480 DO j = 1,ngrsh3n
481 IF (idgrtria == igrsh3n(j)%ID) idgrtria_loc = j
482 ENDDO
483 IF (idgrtria_loc == -1) THEN
484 CALL ancmsg(msgid=1554,msgtype=msgerror,anmode=aninfo,c1='IN /INIVEL OPTION',i1=idgrtria)
485 ENDIF
486 ENDIF
487 ENDIF
488 ! Going on
489 ! Brick groups
490 IF (tstart==zero .AND. sens_id==0) THEN
491 fvm_inivel(i)%FLAG = .true.
492 fvm_inivel(i)%GRBRICID = idgrbrick_loc
493 fvm_inivel(i)%GRQUADID = idgrquad_loc
494 fvm_inivel(i)%GRSH3NID = idgrtria_loc
495 fvm_inivel(i)%VX = v1
496 fvm_inivel(i)%VY = v2
497 fvm_inivel(i)%VZ = v3
498 fvm_grbric_user_id(i) = idgrbrick
499 fvm_grquad_user_id(i) = idgrquad
500 fvm_grtria_user_id(i) = idgrtria
501 END IF !(TSTART==ZERO .AND. SENS_ID==0) THEN
502 ENDIF
503 ENDIF
504C
505 IF (itype /= 5 .AND. itype /= 6) THEN
506 igrs=0
507 IF (igr == 0) THEN
508 CALL ancmsg(msgid=668,msgtype=msgerror,anmode=aninfo,c1='/INIVEL',c2='/INIVEL',c3=titr,i1=id)
509 ENDIF
510 DO j=1,ngrnod
511 IF(igr == igrnod(j)%ID) igrs=j
512 ENDDO
513 IF(igrs /= 0 )THEN
514 IF(tstart==zero .AND. sens_id==0)THEN
515 DO j=1,igrnod(igrs)%NENTITY
516 nosys=igrnod(igrs)%ENTITY(j)
517 IF(itype == 0) THEN
518 v(1,nosys)=v1
519 v(2,nosys)=v2
520 v(3,nosys)=v3
521 IF(ialelag > 0) THEN
522 vflow(1,nosys) = v1
523 vflow(2,nosys) = v2
524 vflow(3,nosys) = v3
525 wflow(1,nosys) = v1
526 wflow(2,nosys) = v2
527 wflow(3,nosys) = v3
528 ENDIF
529 ELSEIF(itype == 1) THEN
530 krot = 1
531 IF (iroddl>0) THEN
532 vr(1,nosys)=v1
533 vr(2,nosys)=v2
534 vr(3,nosys)=v3
535 ENDIF
536 ELSEIF(itype == 2) THEN
537 v(1,nosys)=v1
538 v(2,nosys)=v2
539 v(3,nosys)=v3
540 IF (iale == 1) THEN
541 w(1,nosys)=v1
542 w(2,nosys)=v2
543 w(3,nosys)=v3
544 ENDIF
545 IF(ialelag > 0) THEN
546 vflow(1,nosys) = v1
547 vflow(2,nosys) = v2
548 vflow(3,nosys) = v3
549 wflow(1,nosys) = v1
550 wflow(2,nosys) = v2
551 wflow(3,nosys) = v3
552 ENDIF
553 ELSEIF(itype == 3) THEN
554 w(1,nosys)=v1
555 w(2,nosys)=v2
556 w(3,nosys)=v3
557 IF(ialelag > 0) THEN
558 vflow(1,nosys) = v1
559 vflow(2,nosys) = v2
560 vflow(3,nosys) = v3
561 wflow(1,nosys) = v1
562 wflow(2,nosys) = v2
563 wflow(3,nosys) = v3
564 ENDIF
565 ELSEIF(itype == 4) THEN
566C-- /INIVEL/AXIS -> tag of main nodes of rbody
567 IF ((.NOT.ALLOCATED(tagno_rby)).AND.(nrbody > 0)) THEN
568 ALLOCATE(tagno_rby(numnod))
569 tagno_rby(1:numnod) = 0
570 DO nrb=1,nrbody
571 tagno_rby(rby_msn(2,nrb)) = nrb
572 ENDDO
573 ENDIF
574 nixj = zero
575 IF (ifra > 0) THEN
576 k1=3*idir-2
577 k2=3*idir-1
578 k3=3*idir
579 ox = xframe(10,ifm)
580 oy = xframe(11,ifm)
581 oz = xframe(12,ifm)
582 nixj(1)=xframe(k1,ifm)*(x(2,nosys)-oy)
583 nixj(2)=xframe(k2,ifm)*(x(1,nosys)-ox)
584 nixj(3)=xframe(k2,ifm)*(x(3,nosys)-oz)
585 nixj(4)=xframe(k3,ifm)*(x(2,nosys)-oy)
586 nixj(5)=xframe(k3,ifm)*(x(1,nosys)-ox)
587 nixj(6)=xframe(k1,ifm)*(x(3,nosys)-oz)
588 IF (iroddl>0) THEN
589 vr(1,nosys)= vra*xframe(k1,ifm)
590 vr(2,nosys)= vra*xframe(k2,ifm)
591 vr(3,nosys)= vra*xframe(k3,ifm)
592 END IF
593 ELSE
594 IF(idir==1) THEN
595 nixj(1)=x(2,nosys)
596 nixj(6)=x(3,nosys)
597 ELSEIF(idir==2) THEN
598 nixj(2)=x(1,nosys)
599 nixj(3)=x(3,nosys)
600 ELSEIF(idir==3) THEN
601 nixj(4)=x(2,nosys)
602 nixj(5)=x(1,nosys)
603 ENDIF
604 IF (iroddl>0) THEN
605 vr(1,nosys)= zero !VRA*XFRAME(K1,IFM)
606 vr(2,nosys)= zero !VRA*XFRAME(K2,IFM)
607 vr(3,nosys)= zero !VRA*XFRAME(K3,IFM)
608 IF (idir==1) vr(1,nosys)= vra
609 IF (idir==2) vr(2,nosys)= vra
610 IF (idir==3) vr(3,nosys)= vra
611 END IF
612 ENDIF
613 v(1,nosys)= v1+vra*(nixj(3)-nixj(4))
614 v(2,nosys)= v2+vra*(nixj(5)-nixj(6))
615 v(3,nosys)= v3+vra*(nixj(1)-nixj(2))
616 IF(ialelag > 0) THEN
617 vflow(1,nosys) = v(1,nosys)
618 vflow(2,nosys) = v(2,nosys)
619 vflow(3,nosys) = v(3,nosys)
620 wflow(1,nosys) = v(1,nosys)
621 wflow(2,nosys) = v(2,nosys)
622 wflow(3,nosys) = v(3,nosys)
623 ENDIF
624
625C-- /INIVEL/AXIS -> data must be stored to update initial velocity when RBODY main node is moved (inirby.F)
626 IF (nrbody > 0) THEN
627 IF (tagno_rby(nosys) > 0) THEN
628 rby_iniaxis(1,tagno_rby(nosys)) = one
629 rby_iniaxis(2,tagno_rby(nosys)) = v(1,nosys)
630 rby_iniaxis(3,tagno_rby(nosys)) = v(2,nosys)
631 rby_iniaxis(4,tagno_rby(nosys)) = v(3,nosys)
632 IF (iroddl>0) THEN
633 rby_iniaxis(5,tagno_rby(nosys)) = vr(1,nosys)
634 rby_iniaxis(6,tagno_rby(nosys)) = vr(2,nosys)
635 rby_iniaxis(7,tagno_rby(nosys)) = vr(3,nosys)
636 ENDIF
637 ENDIF
638 ENDIF
639 ENDIF
640 ENDDO
641 nnod=igrnod(igrs)%NENTITY
642 END IF ! (TSTART==ZERO .AND. SENSOR_ID==0)THEN
643 ELSE
644 CALL ancmsg(msgid=53,msgtype=msgerror,anmode=aninfo,c1='IN /INIVEL OPTION',i1=igr)
645 ENDIF
646 ENDIF ! IF (ITYPE /= 5 .AND. ITYPE /= 6)
647 ENDDO
648
649 IF (ALLOCATED(tagno_rby)) DEALLOCATE(tagno_rby)
650
651 CALL udouble(inivids,1,nbvel,mess,0,bid)
652
653 !--- Reset velocities for the dormant SPH particles in the reservoir
654 IF (nsphres>0) THEN
655 DO n=1,nsphres
656 inod = kxsp(3,first_sphres+n-1)
657 v(1,inod) = zero
658 v(2,inod) = zero
659 v(3,inod) = zero
660 IF (iroddl>0) THEN
661 vr(1,inod) = zero
662 vr(2,inod) = zero
663 vr(3,inod) = zero
664 ENDIF
665 END DO
666 ENDIF
667
668
669 !--------------------------------------------------
670 ! STARTER LISTING FILE (INITIAL VELOCITY PRINTED IF IPRI >= 2)
671 ! IPRI : SEE /IOFLAG OPTION
672 !--------------------------------------------------
673 IF (hm_ninvel > 0) THEN
674 j=0
675 nodinivel=0
676
677 ! INITIAL VELOCIIES FOR STAGGERED SCHEME
678 IF(ipri >= 2 .AND. ninivel_total-ninivel_fvm > 0 )THEN
679
680 !---TITLE OUTPUT
681 ! STAGGERED SCHEME (VELOCITIES AT NODES)
682 IF(iale /= 0) THEN
683 WRITE(iout,2100)
684 ELSEIF(krot == 0) THEN
685 WRITE(iout,2000)
686 ELSE
687 WRITE(iout,2200)
688 ENDIF
689
690 !---DETAILS OUTPUT--------------------------
691 ! STAGGERED SCHEME (VELOCITIES AT NODES)
692 kpri=0
693 DO n=1,numnod,50
694 j=j+50
695 j=min(j,numnod)
696 IF(iale == 0)THEN
697 DO i=n,j
698 IF(kpri >= 50) THEN
699 IF(krot == 0) THEN
700 WRITE(iout,2000)
701 ELSE
702 WRITE(iout,2200)
703 ENDIF
704 kpri=0
705 ENDIF
706 IF(iroddl /= 0) THEN
707 IF (v(1,i)/=zero.OR.v(2,i)/=zero.OR.v(3,i)/=zero.OR.vr(1,i)/=zero.OR.vr(2,i)/=zero.OR.vr(3,i)/=zero)THEN
708 nodinivel=nodinivel+1
709 IF (vr(1,i) /= zero .OR. vr(2,i) /= zero .OR. vr(3,i) /= zero) THEN
710 WRITE(iout,'(3X,I10,8X,1P6G20.13)') itab(i),v(1,i),v(2,i),v(3,i),vr(1,i),vr(2,i),vr(3,i)
711 ELSE
712 WRITE(iout,'(3X,I10,8X,1P6G20.13)')itab(i),v(1,i),v(2,i),v(3,i)
713 ENDIF
714 kpri=kpri+1
715 ENDIF
716 ELSEIF(v(1,i) /= zero .OR. v(2,i) /= zero .OR. v(3,i) /= zero) THEN
717 nodinivel=nodinivel+1
718 WRITE(iout,'(3X,I10,8X,1P6G20.13)')itab(i),v(1,i),v(2,i),v(3,i)
719 kpri=kpri+1
720 ENDIF
721 enddo!next I
722
723 ELSEIF(iale /= 0)THEN
724 DO i=n,j
725 IF(kpri==50) THEN
726 WRITE(iout,2100)
727 kpri=0
728 ENDIF
729 IF(v(1,i)/=zero.OR.v(2,i)/=zero.OR.v(3,i)/=zero.OR.w(1,i)/=zero.OR.w(2,i)/=zero.OR.w(3,i)/=zero) THEN
730 nodinivel=nodinivel+1
731 WRITE(iout,'(5X,I10,8X,1P6G20.13)') itab(i),v(1,i),v(2,i),v(3,i),w(1,i),w(2,i),w(3,i)
732 kpri=kpri+1
733 ENDIF
734 enddo! NEXT I
735 ENDIF
736
737 enddo!NEXT N
738 WRITE(iout,'(/,A,I10,//)') ' NUMBER OF NODES WITH INITIAL VELOCITY:',nodinivel
739
740 ENDIF
741
742 ! INITIAL VELOCIIES FOR COLLOCATED SCHEME
743 IF(ipri >= 2 .AND. ninivel_fvm > 0 )THEN
744 WRITE(iout,3000)
745 !---DETAILS OUTPUT-----------------------------------
746 ! COLOCATED SCHEME (VELOCITIES AT CELL CENTROIDS)
747 DO i=1,hm_ninvel ! bug cpt
748 IF(.NOT. fvm_inivel(i)%FLAG)cycle
749 v1=fvm_inivel(i)%VX
750 v2=fvm_inivel(i)%VY
751 v3=fvm_inivel(i)%VZ
752 IF(idgrbrick_loc >0)THEN
753 WRITE(iout,3001)
754 WRITE(iout,'(5X,I10,8X,1P6G20.13)') fvm_grbric_user_id(i),v1,v2,v3
755 ENDIF
756 IF(idgrquad_loc >0)THEN
757 WRITE(iout,3002)
758 WRITE(iout,'(5X,I10,8X,1P6G20.13)') fvm_grquad_user_id(i),v1,v2,v3
759 ENDIF
760 IF(idgrtria_loc >0)THEN
761 WRITE(iout,3003)
762 WRITE(iout,'(5X,I10,8X,1P6G20.13)') fvm_grtria_user_id(i),v1,v2,v3
763 ENDIF
764 enddo!next CPT
765 WRITE(iout,'(//)')
766 endif!IF(IPRI >= 2)
767 IF (ninit > 0 ) WRITE(iout,4000) ninit
768
769 endif!(HM_NINVEL > 0)
770!-----------
771 RETURN
772!-----------
7732000 FORMAT(//
774 .' INITIAL VELOCITIES '/
775 .' ------------------- '/
776 + 9x,'NODE',22x,'VX ',15x,'VY ',15x,'VZ '/)
7772100 FORMAT(//
778 .' INITIAL VELOCITIES '/
779 .' ------------------- '/
780 + 9x,'NODE',22x,'VX ',15x,'VY ',15x,'VZ ',
781 + 14x,'WX ',15x,'WY ',15x,'WZ '/)
7822200 FORMAT(//
783 .' INITIAL VELOCITIES '/
784 .' ------------------- '/
785 + 9x,'NODE',22x,'VX ',15x,'VY ',15x,'VZ ',
786 + 14x,'VRX ',15x,'VRY ',15x,'VRZ'/)
7873000 FORMAT(//
788 .' INITIAL VELOCITIES (FVM) '/
789 .' ------------------------ ')
7903001 FORMAT(
791 + 9x,'GRBRIC',22x,'VX ',15x,'VY ',15x,'VZ ')
7923002 FORMAT(
793 + 9x,'GRQUAD',22x,'VX ',15x,'vy ',15X,'vz ')
7943003 FORMAT(
795 + 9X,'grtria',22X,'vx ',15X,'vy ',15X,'vz ')
796!-----------
7974000 FORMAT(//
798 .' initial velocities '/
799 .' ------------------- '/
800 + I8,3X,'initial velocities will be applied in engine by t_start or sensor'/)
801
802!-----------
803 END SUBROUTINE HM_READ_INIVEL
804
805
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
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_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:78
hm_option_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_read_inivel
subroutine hm_read_inivel(v, w, itab, itabm1, vr, igrnod, igrbric, iskn, skew, inivids, x, unitab, lsubmodel, rtrans, xframe, iframe, vflow, wflow, kxsp, multi_fvm, fvm_inivel, igrquad, igrsh3n, rby_msn, rby_iniaxis, sensors, ninivelt, inivel_t)
Definition hm_read_inivel.F:53
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
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
freerr
subroutine freerr(it)
Definition freform.F:501
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:573
starter
program starter
Definition starter.F:39
subrotvect
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:54