OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_ebcs_vel.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!|| hm_read_ebcs_vel ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_vel.F
25!||--- called by ------------------------------------------------------
26!|| read_ebcs ../starter/source/boundary_conditions/ebcs/read_ebcs.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
32!|| ngr2usr ../starter/source/system/nintrr.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_ebcs_vel(IGRSURF, NPC, MULTI_FVM, UNITAB, ID, TITR, LSUBMODEL, EBCS)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE unitab_mod
42 USE message_mod
43 USE multi_fvm_mod
44 USE groupdef_mod
45 USE submodel_mod
46 USE ebcs_mod
47 USE names_and_titles_mod , ONLY : nchartitle
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "units_c.inc"
56#include "com04_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
61 INTEGER :: NPC(*),ID
62 TYPE (MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
63 TYPE (SURF_) ,TARGET, DIMENSION(NSURF) :: IGRSURF
64 CHARACTER(LEN=NCHARTITLE), INTENT(IN) :: TITR
65 TYPE(t_ebcs_vel), INTENT(INOUT) :: EBCS
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER ISU,SURF,NGR2USR,IRHO,J,NSEG,IENER,IVX,IVY,IVZ
70 my_real c,rho,lcar,r1,r2,ener,vx,vy,vz
71 EXTERNAL ngr2usr
72 INTEGER, DIMENSION(:), POINTER :: INGR2USR
73 TYPE(submodel_data) LSUBMODEL(NSUBMOD)
74 LOGICAL IS_ENCRYPTED, IS_AVAILABLE
75C-----------------------------------------------
76C S o u r c e L i n e s
77C-----------------------------------------------
78
79 ivx=0
80 ivy=0
81 ivz=0
82 irho=0
83 iener=0
84 c=zero
85 rho=zero
86 lcar=zero
87 r1=zero
88 r2=zero
89 ener=zero
90 vx=zero
91 vy=zero
92 vz=zero
93
94 ebcs%title = trim(titr)
95
96 CALL hm_option_is_encrypted(is_encrypted)
97 CALL hm_get_intv('entityid', surf ,is_available,lsubmodel)
98
99 isu=0
100 ingr2usr => igrsurf(1:nsurf)%ID
101 IF (surf/=0) isu=ngr2usr(surf,ingr2usr,nsurf)
102 nseg=0
103 IF (isu/=0) nseg=igrsurf(isu)%NSEG
104 IF(surf==0)THEN
105 ierr=ierr+1
106 WRITE(istdo,'(6X,A)')' ** A SURFACE SHOULD BE INPUT'
107 WRITE(iout, '(6X,A)')' ** A SURFACE SHOULD BE INPUT'
108 ELSEIF(isu==0)THEN
109 ierr=ierr+1
110 WRITE(istdo,*)' ** ERROR SURFACE NOT FOUND, ID=',surf
111 WRITE(iout,*) ' ** ERROR SURFACE NOT FOUND, ID=',surf
112 ELSEIF(nseg==0)THEN
113 ierr=ierr+1
114 WRITE(istdo,*)' ** ERROR EMPTY SURFACE',surf
115 WRITE(iout,*) ' ** ERROR EMPTY SURFACE',surf
116 ENDIF
117
118
119
120 !--line-2
121 CALL hm_get_floatv('rad_ebcs_c', c ,is_available,lsubmodel,unitab)
122
123 !--line-3
124 CALL hm_get_intv('rad_fct_vx', ivx ,is_available,lsubmodel)
125 CALL hm_get_floatv('rad_ebcs_fscale_vx', vx ,is_available,lsubmodel,unitab)
126 !--line-4
127 CALL hm_get_intv('rad_fct_vy', ivy ,is_available,lsubmodel)
128 CALL hm_get_floatv('rad_ebcs_fscale_vy', vy ,is_available,lsubmodel,unitab)
129 !--line-5
130 CALL hm_get_intv('rad_fct_vz', ivz ,is_available,lsubmodel)
131 CALL hm_get_floatv('rad_ebcs_fscale_vz', vz ,is_available,lsubmodel,unitab)
132
133 !--line-6
134 CALL hm_get_intv('rad_fct_rho', irho ,is_available,lsubmodel)
135 CALL hm_get_floatv('rad_ebcs_fscale_rho', rho ,is_available,lsubmodel,unitab)
136
137 !--line-7
138 CALL hm_get_intv('rad_fct_en', iener ,is_available,lsubmodel)
139 CALL hm_get_floatv('rad_ebcs_fscale_en', ener ,is_available,lsubmodel,unitab)
140
141 !--line-8
142 CALL hm_get_floatv('rad_ebcs_lc', lcar ,is_available,lsubmodel,unitab)
143 CALL hm_get_floatv('rad_ebcs_r1', r1 ,is_available,lsubmodel,unitab)
144 CALL hm_get_floatv('rad_ebcs_r2', r2 ,is_available,lsubmodel,unitab)
145
146 IF(surf/=0 .AND. isu/=0 .AND. nseg/=0)THEN
147 WRITE(iout,1004)id,trim(titr)
148 WRITE(iout,1103)surf,nseg,c,vx,ivx,vy,ivy,vz,ivz,rho,irho,ener,iener,lcar
149 ENDIF
150 DO j=1,nfunct
151 IF(irho/=0 .AND. irho==npc(j)) THEN
152 irho=j
153 EXIT
154 ENDIF
155 ENDDO
156 DO j=1,nfunct
157 IF(iener/=0 .AND. iener==npc(j)) THEN
158 iener=j
159 EXIT
160 ENDIF
161 ENDDO
162 DO j=1,nfunct
163 IF(ivx/=0 .AND. ivx==npc(j)) THEN
164 ivx=j
165 EXIT
166 ENDIF
167 ENDDO
168 DO j=1,nfunct
169 IF(ivy/=0 .AND. ivy==npc(j)) THEN
170 ivy=j
171 EXIT
172 ENDIF
173 ENDDO
174 DO j=1,nfunct
175 IF(ivz/=0 .AND. ivz==npc(j)) THEN
176 ivz=j
177 EXIT
178 ENDIF
179 ENDDO
180
181 ebcs%title = titr
182 ebcs%irho = irho
183 ebcs%iener = iener
184 ebcs%c = c
185 ebcs%rho = rho
186 ebcs%lcar = lcar
187 ebcs%r1 = r1
188 ebcs%r2 = r2
189 ebcs%ener = ener
190 ebcs%ivx = ivx
191 ebcs%ivy = ivy
192 ebcs%ivz = ivz
193 ebcs%vx = vx
194 ebcs%vy = vy
195 ebcs%vz = vz
196
197 IF (multi_fvm%IS_USED) THEN
198 CALL ancmsg(msgid = 1602, msgtype = msgerror, anmode = aninfo,
199 . i1 = id, c1 = trim(titr), c2 = "NOT COMPATIBLE WITH LAW 151")
200 ENDIF
201C-----------
202 RETURN
203C-----------
204
205 1004 FORMAT( //'IMPOSED VELOCITY . . . . . . . . . . . . :',i8,1x,a)
206 1103 FORMAT(
207 . ' ON SURFACE . . . . . . . . . . . . . . . ',i8,/,
208 . ' NUMBER OF SEGMENTS FOUND. . . . . . . . . ',i8,/,
209 . ' SPEED OF SOUND . . . . . . . . . . . . . ',e16.6,/,
210 . ' IMPOSED VELOCITY VX . . . . . . . . . . . ',e16.6,/,
211 . ' VX SCALING FUNCTION . . . . . . . . . . . ',i8,/,
212 . ' IMPOSED VELOCITY VY . . . . . . . . . . . ',e16.6,/,
213 . ' VY SCALING FUNCTION . . . . . . . . . . . ',i8,/,
214 . ' IMPOSED VELOCITY VZ . . . . . . . . . . . ',e16.6,/,
215 . ' VZ SCALING FUNCTION . . . . . . . . . . . ',i8,/,
216 . ' IMPOSED DENSITY . . . . . . . . . . . . . ',e16.6,/,
217 . ' DENSITY SCALING FUNCTION . . . . . . . . ',i8,/,
218 . ' IMPOSED ENERGY . . . . . . . . . . . . . ',e16.6,/,
219 . ' ENERGY SCALING FUNCTION . . . . . . . . . ',i8,/,
220 . ' CHARACTERISTIC LENGTH . . . . . . . . . . ',e16.6,/)
221
222 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:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_read_ebcs_vel
subroutine hm_read_ebcs_vel(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
Definition hm_read_ebcs_vel.F:38
groupdef_mod
Definition groupdef_mod.F:662
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
submodel_mod
Definition submodel_mod.F:712
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
submodel_mod::submodel_data
Definition submodel_mod.F:723