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