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.AND..AND. IF(SURF/=0 ISU/=0 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.AND. IF(IPRES/=0 IPRES==NPC(J)) THEN
147 IPRES=J
148 EXIT
149 ENDIF
150 ENDDO
151 DO J=1,NFUNCT
152.AND. IF(IRHO/=0 IRHO==NPC(J)) THEN
153 IRHO=J
154 EXIT
155 ENDIF
156 ENDDO
157 DO J=1,NFUNCT
158.AND. IF(IENER/=0 IENER==NPC(J)) THEN
159 IENER=J
160 EXIT
161 ENDIF
162 ENDDO
163 DO J=1,NFUNCT
164.AND. IF(IVX/=0 IVX==NPC(J)) THEN
165 IVX=J
166 EXIT
167 ENDIF
168 ENDDO
169 DO J=1,NFUNCT
170.AND. IF(IVY/=0 IVY==NPC(J)) THEN
171 IVY=J
172 EXIT
173 ENDIF
174 ENDDO
175 DO J=1,NFUNCT
176.AND. IF(IVZ/=0 IVZ==NPC(J)) THEN
177 IVZ=J
178 EXIT
179 ENDIF
180 ENDDO
181 !initialise la liste des noeuds de la surface
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_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_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: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
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723