OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_ebcs_pres.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_pres ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_pres.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_pres( 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(submodel_data) LSUBMODEL(NSUBMOD)
66 TYPE(t_ebcs_pres), INTENT(INOUT) :: EBCS
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER ISU,SURF,NGR2USR,IPRES,IRHO,J,NSEG,IENER,IVX,IVY,IVZ
71 my_real c,pres,rho,lcar,r1,r2,ener,vx,vy,vz
72 EXTERNAL ngr2usr
73 INTEGER, DIMENSION(:), POINTER :: INGR2USR
74 LOGICAL IS_ENCRYPTED, IS_AVAILABLE
75C-----------------------------------------------
76C S o u r c e L i n e s
77C-----------------------------------------------
78
79 ipres=0
80 ivx=0
81 ivy=0
82 ivz=0
83 irho=0
84 iener=0
85 c=zero
86 pres=zero
87 rho=zero
88 lcar=zero
89 r1=zero
90 r2=zero
91 ener=zero
92 vx=zero
93 vy=zero
94 vz=zero
95
96 ebcs%title = trim(titr)
97
98 CALL hm_option_is_encrypted(is_encrypted)
99 CALL hm_get_intv('entityid', surf ,is_available,lsubmodel)
100
101 isu=0
102 ingr2usr => igrsurf(1:nsurf)%ID
103 IF (surf/=0) isu=ngr2usr(surf,ingr2usr,nsurf)
104 nseg=0
105 IF (isu/=0) nseg=igrsurf(isu)%NSEG
106 IF(surf==0)THEN
107 ierr=ierr+1
108 WRITE(istdo,'(6X,A)')' ** A SURFACE SHOULD BE INPUT'
109 WRITE(iout, '(6X,A)')' ** A SURFACE SHOULD BE INPUT'
110 ELSEIF(isu==0)THEN
111 ierr=ierr+1
112 WRITE(istdo,*)' ** ERROR SURFACE NOT FOUND, ID=',surf
113 WRITE(iout,*) ' ** ERROR SURFACE NOT FOUND, ID=',surf
114 ELSEIF(nseg==0)THEN
115 ierr=ierr+1
116 WRITE(istdo,*)' ** ERROR EMPTY SURFACE',surf
117 WRITE(iout,*) ' ** ERROR EMPTY SURFACE',surf
118 ENDIF
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_pr', ipres ,is_available,lsubmodel)
125 CALL hm_get_floatv('rad_ebcs_fscale_pr', pres ,is_available,lsubmodel,unitab)
126
127 !--line-4
128 CALL hm_get_intv('rad_fct_rho', irho ,is_available,lsubmodel)
129 CALL hm_get_floatv('rad_ebcs_fscale_rho', rho ,is_available,lsubmodel,unitab)
130
131 !--line-5
132 CALL hm_get_intv('rad_fct_en', iener ,is_available,lsubmodel)
133 CALL hm_get_floatv('rad_ebcs_fscale_en', ener ,is_available,lsubmodel,unitab)
134
135 !--line-6
136 CALL hm_get_floatv('rad_ebcs_lc', lcar ,is_available,lsubmodel,unitab)
137 CALL hm_get_floatv('rad_ebcs_r1', r1 ,is_available,lsubmodel,unitab)
138 CALL hm_get_floatv('rad_ebcs_r2', r2 ,is_available,lsubmodel,unitab)
139
140
141 IF(surf/=0 .AND. isu/=0 .AND. nseg/=0)THEN
142 WRITE(iout,1001)id,trim(titr)
143 WRITE(iout,1101)surf,nseg,c,pres,ipres,rho,irho,ener,iener,lcar,r1,r2
144 ENDIF
145 DO j=1,nfunct
146 IF(ipres/=0 .AND. ipres==npc(j)) THEN
147 ipres=j
148 EXIT
149 ENDIF
150 ENDDO
151 DO j=1,nfunct
152 IF(irho/=0 .AND. irho==npc(j)) THEN
153 irho=j
154 EXIT
155 ENDIF
156 ENDDO
157 DO j=1,nfunct
158 IF(iener/=0 .AND. iener==npc(j)) THEN
159 iener=j
160 EXIT
161 ENDIF
162 ENDDO
163 DO j=1,nfunct
164 IF(ivx/=0 .AND. ivx==npc(j)) THEN
165 ivx=j
166 EXIT
167 ENDIF
168 ENDDO
169 DO j=1,nfunct
170 IF(ivy/=0 .AND. ivy==npc(j)) THEN
171 ivy=j
172 EXIT
173 ENDIF
174 ENDDO
175 DO j=1,nfunct
176 IF(ivz/=0 .AND. ivz==npc(j)) THEN
177 ivz=j
178 EXIT
179 ENDIF
180 ENDDO
181 !initializes the list of surface node
182! K1=2*NSEG+1
183! CALL EBCNODE(IEBCS(K1),NSEG,IGRSURF(ISU)%NODES,NOD)
184! K2=K1+NOD
185! CALL EBCRECT(IEBCS(K1),NSEG,IGRSURF(ISU)%NODES,NOD,IEBCS(K2))
186 ebcs%title = titr
187 ebcs%ipres = ipres
188 ebcs%irho = irho
189 ebcs%iener = iener
190 ebcs%ivx = ivx
191 ebcs%ivy = ivy
192 ebcs%ivz = ivz
193 ebcs%c = c
194 ebcs%pres = pres
195 ebcs%rho = rho
196 ebcs%lcar = lcar
197 ebcs%r1 = r1
198 ebcs%r2 = r2
199 ebcs%ener = ener
200 ebcs%vx = vx
201 ebcs%vy = vy
202 ebcs%vz = vz
203
204 IF (multi_fvm%IS_USED) THEN
205 CALL ancmsg(msgid = 1602, msgtype = msgerror, anmode = aninfo,
206 . i1 = id, c1 = trim(titr), c2 = "NOT COMPATIBLE WITH LAW 151")
207 ENDIF
208
209C-----------
210 RETURN
211C-----------
212
213 1001 FORMAT( //'IMPOSED PRESSURE EBCS NUMBER . . . . . . :',i8,1x,a)
214 1101 FORMAT(
215 . ' ON SURFACE . . . . . . . . . . . . . . . ',i8,/,
216 . ' NUMBER OF SEGMENTS FOUND. . . . . . . . . ',i8,/,
217 . ' SPEED OF SOUND . . . . . . . . . . . . . ',e16.6,/,
218 . ' IMPOSED PRESSURE . . . . . . . . . . . . ',e16.6,/,
219 . ' PRESSURE SCALING FUNCTION . . . . . . . . ',i8,/,
220 . ' IMPOSED DENSITY . . . . . . . . . . . . . ',e16.6,/,
221 . ' DENSITY SCALING FUNCTION . . . . . . . . ',i8,/,
222 . ' IMPOSED ENERGY . . . . . . . . . . . . . ',e16.6,/,
223 . ' ENERGY SCALING FUNCTION . . . . . . . . . ',i8,/,
224 . ' CHARACTERISTIC LENGTH . . . . . . . . . . ',e16.6,/,
225 . ' LINEAR RESISTANCE . . . . . . . . . . . . ',e16.6,/,
226 . ' QUADRATIC RESISTANCE . . . . . . . . . . ',e16.6,/)
227
228 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:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
hm_read_ebcs_pres
subroutine hm_read_ebcs_pres(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
Definition hm_read_ebcs_pres.F:38
groupdef_mod
Definition groupdef_mod.F:668
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
submodel_mod
Definition submodel_mod.F:717
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
submodel_mod::submodel_data
Definition submodel_mod.F:728