OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_ebcs_normv.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_normv ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_normv.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_normv(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(*)
62 INTEGER ID
63 TYPE (MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
64 TYPE (SURF_) ,TARGET, DIMENSION(NSURF) :: IGRSURF
65 CHARACTER(LEN=NCHARTITLE), INTENT(IN) :: TITR
66 TYPE(submodel_data) LSUBMODEL(NSUBMOD)
67 TYPE(t_ebcs_normv), INTENT(INOUT) :: EBCS
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER ISU,SURF,NGR2USR,IVIMP,IRHO,J,NSEG,IENER
72 my_real c,vimp,rho,lcar,r1,r2,ener
73 EXTERNAL ngr2usr
74 INTEGER, DIMENSION(:), POINTER :: INGR2USR
75 LOGICAL IS_ENCRYPTED, IS_AVAILABLE
76C-----------------------------------------------
77C S o u r c e L i n e s
78C-----------------------------------------------
79
80 ivimp=0
81 irho=0
82 iener=0
83 c=zero
84 vimp=zero
85 rho=zero
86 lcar=zero
87 r1=zero
88 r2=zero
89 ener=zero
90
91 ebcs%title = trim(titr)
92
93 CALL hm_option_is_encrypted(is_encrypted)
94 CALL hm_get_intv('entityid', surf ,is_available,lsubmodel)
95
96 isu=0
97 ingr2usr => igrsurf(1:nsurf)%ID
98 IF (surf/=0) isu=ngr2usr(surf,ingr2usr,nsurf)
99 nseg=0
100 IF (isu/=0) nseg=igrsurf(isu)%NSEG
101 IF(surf==0)THEN
102 ierr=ierr+1
103 WRITE(istdo,'(6X,A)')' ** A SURFACE SHOULD BE INPUT'
104 WRITE(iout, '(6X,A)')' ** A SURFACE SHOULD BE INPUT'
105 ELSEIF(isu==0)THEN
106 ierr=ierr+1
107 WRITE(istdo,*)' ** ERROR SURFACE NOT FOUND, ID=',surf
108 WRITE(iout,*) ' ** ERROR SURFACE NOT FOUND, ID=',surf
109 ELSEIF(nseg==0)THEN
110 ierr=ierr+1
111 WRITE(istdo,*)' ** ERROR EMPTY SURFACE',surf
112 WRITE(iout,*) ' ** ERROR EMPTY SURFACE',surf
113 ENDIF
114
115 !--line-2
116 CALL hm_get_floatv('rad_ebcs_c', c ,is_available,lsubmodel,unitab)
117
118 !--line-3
119 CALL hm_get_intv('curveid', ivimp ,is_available,lsubmodel)
120 CALL hm_get_floatv('xscale', vimp ,is_available,lsubmodel,unitab)
121
122 !--line-4
123 CALL hm_get_intv('rad_fct_rho', irho ,is_available,lsubmodel)
124 CALL hm_get_floatv('rad_ebcs_fscale_rho', rho ,is_available,lsubmodel,unitab)
125
126 !--line-5
127 CALL hm_get_intv('rad_fct_en', iener ,is_available,lsubmodel)
128 CALL hm_get_floatv('rad_ebcs_fscale_en', ener ,is_available,lsubmodel,unitab)
129
130 !--line-6
131 CALL hm_get_floatv('rad_ebcs_lc', lcar ,is_available,lsubmodel,unitab)
132 CALL hm_get_floatv('rad_ebcs_r1', r1 ,is_available,lsubmodel,unitab)
133 CALL hm_get_floatv('rad_ebcs_r2', r2 ,is_available,lsubmodel,unitab)
134
135 IF(surf/=0 .AND. isu/=0 .AND. nseg/=0)THEN
136 WRITE(iout,1005)id,trim(titr)
137 WRITE(iout,1102)surf,nseg,c,vimp,ivimp,rho,irho,ener,iener,lcar
138 ENDIF
139 DO j=1,nfunct
140 IF(ivimp/=0 .AND. ivimp==npc(j)) THEN
141 ivimp=j
142 EXIT
143 ENDIF
144 ENDDO
145 DO j=1,nfunct
146 IF(irho/=0 .AND. irho==npc(j)) THEN
147 irho=j
148 EXIT
149 ENDIF
150 ENDDO
151 DO j=1,nfunct
152 IF(iener/=0 .AND. iener==npc(j)) THEN
153 iener=j
154 EXIT
155 ENDIF
156 ENDDO
157
158 ebcs%title = titr
159 ebcs%ivimp = ivimp
160 ebcs%irho = irho
161 ebcs%iener = iener
162 ebcs%c = c
163 ebcs%vimp = vimp
164 ebcs%rho = rho
165 ebcs%lcar = lcar
166 ebcs%r1 = r1
167 ebcs%r2 = r2
168 ebcs%ener = ener
169
170 IF (multi_fvm%IS_USED) THEN
171 CALL ancmsg(msgid = 1602, msgtype = msgerror, anmode = aninfo,
172 . i1 = id, c1 = trim(titr), c2 = "NOT COMPATIBLE WITH LAW 151")
173 ENDIF
174
175C-----------
176 RETURN
177C-----------
178
179 1005 FORMAT( //'IMPOSED NORMAL VELOCITY EBCS NUMBER . . :',i8,1x,a)
180 1102 FORMAT(
181 . ' ON SURFACE . . . . . . . . . . . . . . . ',i8,/,
182 . ' NUMBER OF SEGMENTS FOUND. . . . . . . . . ',i8,/,
183 . ' SPEED OF SOUND . . . . . . . . . . . . . ',e16.6,/,
184 . ' IMPOSED VELOCITY . . . . . . . . . . . . ',e16.6,/,
185 . ' VELOCITY SCALING FUNCTION . . . . . . . . ',i8,/,
186 . ' IMPOSED DENSITY . . . . . . . . . . . . . ',e16.6,/,
187 . ' DENSITY SCALING FUNCTION . . . . . . . . ',i8,/,
188 . ' IMPOSED ENERGY . . . . . . . . . . . . . ',e16.6,/,
189 . ' ENERGY SCALING FUNCTION . . . . . . . . . ',i8,/,
190 . ' CHARACTERISTIC LENGTH . . . . . . . . . . ',e16.6,/)
191
192 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_normv
subroutine hm_read_ebcs_normv(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
Definition hm_read_ebcs_normv.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