OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_ebcs_gradp0.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_gradp0 ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_gradp0.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_gradp0(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 "com01_c.inc"
57#include "com04_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
62 INTEGER NPC(*),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_gradp0), INTENT(INOUT) :: EBCS
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER J,ISU,SURF,NGR2USR,IPRES,IRHO,NSEG,IENER
72 my_real c,pres,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 ipres=0
81 irho=0
82 iener=0
83 c=zero
84 pres=zero
85 rho=zero
86 lcar=zero
87 r1=zero
88 r2=zero
89 ener=zero
90
91 ebcs%title = trim(titr)
92 ebcs%HAS_IELEM = .true.
93
94
95 CALL hm_option_is_encrypted(is_encrypted)
96 CALL hm_get_intv('entityid', surf ,is_available,lsubmodel)
97
98 isu=0
99 ingr2usr => igrsurf(1:nsurf)%ID
100 IF (surf/=0) isu=ngr2usr(surf,ingr2usr,nsurf)
101 nseg=0
102 IF (isu/=0) nseg=igrsurf(isu)%NSEG
103 IF(surf==0)THEN
104 ierr=ierr+1
105 WRITE(istdo,'(6X,A)')' ** A SURFACE SHOULD BE INPUT'
106 WRITE(iout, '(6x,a)')' ** a surface should be input'
107 ELSEIF(ISU==0)THEN
108 IERR=IERR+1
109 WRITE(ISTDO,*)' ** error surface not found, id=',SURF
110 WRITE(IOUT,*) ' ** error surface not found, id=',SURF
111 ELSEIF(NSEG==0)THEN
112 IERR=IERR+1
113 WRITE(ISTDO,*)' ** error empty surface',SURF
114 WRITE(IOUT,*) ' ** error empty surface',SURF
115 ENDIF
116
117 !--line-2
118 CALL HM_GET_FLOATV('rad_ebcs_c', C ,IS_AVAILABLE,LSUBMODEL,UNITAB)
119 !--line-3
120 CALL HM_GET_INTV('rad_fct_pr', IPRES ,IS_AVAILABLE,LSUBMODEL)
121 CALL HM_GET_FLOATV('rad_ebcs_fscale_pr', PRES ,IS_AVAILABLE,LSUBMODEL,UNITAB)
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 !--line-5
126 CALL HM_GET_INTV('rad_fct_en', IENER ,IS_AVAILABLE,LSUBMODEL)
127 CALL HM_GET_FLOATV('rad_ebcs_fscale_en', ENER ,IS_AVAILABLE,LSUBMODEL,UNITAB)
128 !--line-6
129 CALL HM_GET_FLOATV('rad_ebcs_lc', LCAR ,IS_AVAILABLE,LSUBMODEL,UNITAB)
130 CALL HM_GET_FLOATV('rad_ebcs_r1', R1 ,IS_AVAILABLE,LSUBMODEL,UNITAB)
131 CALL HM_GET_FLOATV('rad_ebcs_r2', R2 ,IS_AVAILABLE,LSUBMODEL,UNITAB)
132
133.AND..AND. IF(SURF /= 0 ISU /= 0 NSEG /= 0)THEN
134 WRITE(IOUT,1000)ID,TRIM(TITR)
135 WRITE(IOUT,1101)SURF,NSEG,C,PRES,IPRES,RHO,IRHO,ENER,IENER,LCAR,R1,R2
136 ENDIF
137 DO J=1,NFUNCT
138.AND. IF(IPRES/=0 IPRES==NPC(J)) THEN
139 IPRES=J
140 EXIT
141 ENDIF
142 ENDDO
143 DO J=1,NFUNCT
144.AND. IF(IRHO/=0 IRHO==NPC(J)) THEN
145 IRHO=J
146 EXIT
147 ENDIF
148 ENDDO
149 DO J=1,NFUNCT
150.AND. IF(IENER/=0 IENER==NPC(J)) THEN
151 IENER=J
152 EXIT
153 ENDIF
154 ENDDO
155
156 EBCS%title = TITR
157 EBCS%ipres = IPRES
158 EBCS%irho = IRHO
159 EBCS%iener = IENER
160 EBCS%c = C
161 EBCS%pres = PRES
162 EBCS%rho = RHO
163 EBCS%lcar = LCAR
164 EBCS%r1 = R1
165 EBCS%r2 = R2
166 EBCS%ener = ENER
167
168 IF (MULTI_FVM%IS_USED) THEN
169 CALL ANCMSG(MSGID = 1602, MSGTYPE = MSGERROR, ANMODE = ANINFO,
170 . I1 = ID, C1 = TRIM(TITR), C2 = "NOT COMPATIBLE WITH LAW 151")
171 ENDIF
172
173 IF(NSPMD > 1) THEN
174 CALL ANCMSG(MSGID = 755, MSGTYPE = MSGERROR, ANMODE = ANINFO,C1 = 'elementary boundary conditions')
175 ENDIF
176
177C-----------
178 RETURN
179C-----------
180
181 1000 FORMAT( //'zero pressure gradient ebcs number . . . :',I8,1X,A)
182 1101 FORMAT(
183 . ' on surface . . . . . . . . . . . . . . . ',I8,/,
184 . ' number of segments found. . . . . . . . . ',I8,/,
185 . ' speed of sound . . . . . . . . . . . . . ',E16.6,/,
186 . ' imposed pressure . . . . . . . . . . . . ',E16.6,/,
187 . ' pressure scaling FUNCTION . . . . . . . . ',I8,/,
188 . ' imposed density . . . . . . . . . . . . . ',E16.6,/,
189 . ' density scaling function . . . . . . . . ',I8,/,
190 . ' imposed energy . . . . . . . . . . . . . ',E16.6,/,
191 . ' energy scaling function . . . . . . . . . ',I8,/,
192 . ' characteristic length . . . . . . . . . . ',E16.6,/,
193 . ' linear resistance . . . . . . . . . . . . ',E16.6,/,
194 . ' quadratic resistance . . . . . . . . . . ',E16.6,/)
195
196
197 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_gradp0
subroutine hm_read_ebcs_gradp0(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
Definition hm_read_ebcs_gradp0.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
submodel_mod::submodel_data
Definition submodel_mod.F:723