OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_gauge.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_gauge ../starter/source/output/gauge/hm_read_gauge.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl ../starter/source/starter/freform.F
30!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.F
33!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
34!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
35!|| sz_r2r ../starter/source/coupling/rad2rad/routines_r2r.F
36!|| usr2sys ../starter/source/system/sysfus.F
37!|| vdouble ../starter/source/system/sysfus.F
38!||--- uses -----------------------------------------------------
39!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
40!|| message_mod ../starter/share/message_module/message_mod.F
41!|| r2r_mod ../starter/share/modules1/r2r_mod.F
42!|| submodel_mod ../starter/share/modules1/submodel_mod.F
43!||====================================================================
44 SUBROUTINE hm_read_gauge(LGAUGE,GAUGE,ITABM1,UNITAB,IXC,NOM_OPT,LSUBMODEL)
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE unitab_mod
49 USE message_mod
50 USE r2r_mod
51 USE hm_option_read_mod
52 USE submodel_mod
53 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
54 use element_mod , only : nixc
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "scr17_c.inc"
63#include "units_c.inc"
64#include "com04_c.inc"
65#include "param_c.inc"
66#include "r2r_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
71 INTEGER,INTENT(IN) :: IXC(NIXC,*),ITABM1(*)
72 INTEGER,INTENT(INOUT) :: LGAUGE(3,*)
73 INTEGER NOM_OPT(LNOPT1,*)
74 my_real gauge(llgauge,*)
75 TYPE(submodel_data) LSUBMODEL(*)
76C-----------------------------------------------
77 LOGICAL IS_AVAILABLE
78C-----------------------------------------------
79C E x t e r n a l F u n c t i o n s
80C-----------------------------------------------
81 INTEGER USR2SYS
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER I, J, NGAU, NOD, NBGAUGE_SPH, NBGAUGE_POINT
86 INTEGER NS, NG
87 my_real ff,bid,dist,xgauge,ygauge,zgauge
88 CHARACTER MESS*40
89 CHARACTER(LEN=NCHARTITLE) :: TITR
90 CHARACTER(LEN=NCHARKEY) :: KEY
91 DATA mess/'GAUGE DEFINITION '/
92C=======================================================================
93 is_available = .false.
94C-----------------------------------------------
95C---------------------------------------------
96C READING DES PARAMETRES DE GAUGES
97C-----------------------------------------------
98c LGAUGE(3,*)
99c 1: -Isolid -(NUMELS_G+1) if SPH gauge
100c 2: GaugeId
101c 3: +Node or -Shell
102c
103c => GAUGE(LLGAUGE,*), LLGAUGE = 37
104c 1: Dist (distance from Shell) Dist (distance from Shell)
105c 2: XG XG
106c 3: YG YG
107c 4: ZG ZG
108c 5: Alpha (Solid penetration ratio) not yet used
109c 6: XSAV (SPH sorting)
110c 7: YSAV (SPH sorting)
111c 8: ZSAV (SPH sorting)
112c 9: FF (sph only)
113c 10: Intantaneous Pressure
114c 11: intantaneous PA
115c 12: intantaneous Rho
116c 13: intantaneous E
117c 14: ! Butterworth !
118c 15: ! Butterworth !
119c 16: ! Butterworth !
120c 17: ! Butterworth !
121c 18: ! Butterworth !
122c 19: ! Butterworth !
123c 20: ! Butterworth !
124c 21: ! Butterworth !
125c 22: ! Butterworth !
126c 23: ! Butterworth !
127c 24: ! Butterworth !
128c 25: ! Butterworth !
129c 26: ! Butterworth !
130c 27: ! Butterworth !
131c 28: ! Butterworth !
132c 29: ! Butterworth !
133c 30: Pressure filtered Pressure
134c 31: PA filtered PA
135c 32: Rho filtered Rho
136c 33: E filtered E
137c 34: ! Xpoint !
138c 35: ! Ypoint !
139c 36: ! Zpoint !
140c 37: ! Butterworth !
141C=======================================================================
142 ng = 0
143 ff = 0
144 CALL hm_option_count('/GAUGE/SPH', nbgauge_sph)
145C-----------------------------------------------------------------
146 IF ( nbgauge_sph > 0)THEN
147C-----------------------------------------------------------------
148 CALL hm_option_start('/GAUGE/SPH')
149 DO i=1,nbgauge_sph
150 ng=ng+1
151 !--- Multidomatic-> We do not know the non-tagged sections ----
152 IF(nsubdom > 0) THEN
153 IF(taggau(ng) == 0) CALL sz_r2r(taggau,ng)
154 ENDIF
155 !----------------------------------------------------------
156 key=''
157 CALL hm_option_read_key(lsubmodel,option_id=ngau,keyword2=key,option_titr=titr)
158 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)
159
160
161 nom_opt(1,i)=ngau
162
163 lgauge(1,i)=-(numels+1)
164 dist = zero
165 CALL hm_get_intv ('NODE1' ,nod ,is_available,lsubmodel)
166 CALL hm_get_intv ('shell_ID' ,ns ,is_available,lsubmodel)
167 CALL hm_get_floatv ('DIST' ,dist ,is_available, lsubmodel, unitab)
168 CALL hm_get_floatv ('Fcut' ,ff ,is_available, lsubmodel, unitab)
169
170 gauge(1,i) =dist
171 gauge(9,i) =ff
172 lgauge(2,i)=ngau
173
174 WRITE (iout,'(///,a)')' sph gauge'
175 WRITE (IOUT,'(a/)') ' ---------'
176 WRITE (IOUT,'(a,i10)')' sph gauge number . . . . . . . . . . .',NGAU
177
178 IF(NOD /= 0)THEN
179 LGAUGE(3,I)=USR2SYS(NOD,ITABM1,MESS,NGAU)
180 WRITE (IOUT,'(a,i10)')' node number. . . . . . . . . . . . . .',NOD
181 ELSEIF(NS /= 0)THEN
182 DO J=1,NUMELC
183 IF(IXC(NIXC,J)==NS)THEN
184 LGAUGE(3,I)=-J
185 EXIT
186 ENDIF
187 ENDDO
188 WRITE (IOUT,'(a,i10)') ' shell number . . . . . . . . . . . . .',NS
189 WRITE (IOUT,'(a,1pg20.13)')' distance . . . . . . . . . . . . . . .',DIST
190 ENDIF
191 WRITE (IOUT,'(a,1pg20.13)') ' 4-pole butterworth corner frequency. .',FF
192C-------------------------------------
193
194 ENDDO ! NBGAUGE_SPH
195
196 ENDIF
197
198C-----------------------------------------------
199c--------/GAUGE/POINT
200C-----------------------------------------------
201 CALL HM_OPTION_COUNT('/gauge/point', NBGAUGE_POINT)
202C-----------------------------------------------------------------
203 IF ( NBGAUGE_POINT > 0)THEN
204 CALL HM_OPTION_START('/gauge/point')
205 DO I=1,NBGAUGE_POINT
206 KEY=''
207 CALL HM_OPTION_READ_KEY(LSUBMODEL,OPTION_ID=NGAU,KEYWORD2=KEY,OPTION_TITR=TITR)
208 NOM_OPT(1,I)=NGAU
209 CALL FRETITL(TITR,NOM_OPT(LNOPT1-LTITR+1,I),LTITR)
210 NG=NG+1
211 !Multidomatic-> We do not know the non-tagged sections ----
212 IF(NSUBDOM > 0) THEN
213 IF(TAGGAU(NG) == 0) CALL SZ_R2R(TAGGAU,NG)
214 ENDIF
215 !-----------------------------------------------------------------
216 LGAUGE(1,NG)=0
217 CALL HM_GET_FLOATV ('xi' ,Xgauge ,IS_AVAILABLE, LSUBMODEL, UNITAB)
218 CALL HM_GET_FLOATV ('yi' ,Ygauge ,IS_AVAILABLE, LSUBMODEL, UNITAB)
219 CALL HM_GET_FLOATV ('zi' ,Zgauge ,IS_AVAILABLE, LSUBMODEL, UNITAB)
220 LGAUGE(2,NG)=NGAU
221 LGAUGE(3,NG)=0 ! ID shell or node only
222 GAUGE(1,NG)=ZERO ! DIST
223 GAUGE(9,NG)=ZERO ! FF
224 GAUGE(34,NG)=Xgauge
225 GAUGE(35,NG)=Ygauge
226 GAUGE(36,NG)=Zgauge
227 WRITE (IOUT,'(///,a)')' gauge'
228 WRITE (IOUT,'(a/)') ' -----'
229 WRITE (IOUT,'(a,i10)')' gauge number . . . . . . . . . . . . .',NGAU
230 WRITE (IOUT,'(a,i10)')' gauge point coordinate:'
231 WRITE (IOUT,'(a,/1p3g20.13/)')' xg yg zg',Xgauge, Ygauge, Zgauge
232 WRITE (IOUT,'(a,1pg20.13)')' 4-pole butterworth corner frequency. .',FF
233 ENDDO ! DO I=1,NBGAUGE_POINT
234 ENDIF ! IF ( NBGAUGE_POINT > 0)
235C-----------------------------------------------
236c--------/GAUGE
237C-----------------------------------------------
238 CALL HM_OPTION_START('/gauge')
239C-----------------------------------------------
240 DO I=1,NBGAUGE
241 KEY=''
242 CALL HM_OPTION_READ_KEY(LSUBMODEL,OPTION_ID=NGAU,KEYWORD2=KEY,OPTION_TITR=TITR)
243 NOM_OPT(1,I)=NGAU
244 CALL FRETITL(TITR,NOM_OPT(LNOPT1-LTITR+1,I),LTITR)
245
246 IF (KEY == 'sph.OR.' KEY == 'point') CYCLE
247 NG=NG+1
248 !Multidomatic-> We do not know the non-tagged sections ----
249 IF(NSUBDOM > 0) THEN
250 IF(TAGGAU(NG) == 0) CALL SZ_R2R(TAGGAU,NG)
251 ENDIF
252 !-----------------------------------------------------------------
253 LGAUGE(1,NG)=0
254
255 DIST = ZERO
256 CALL HM_GET_INTV ('node1' ,NOD ,IS_AVAILABLE,LSUBMODEL)
257 CALL HM_GET_INTV ('shell_id' ,NS ,IS_AVAILABLE,LSUBMODEL)
258 CALL HM_GET_FLOATV ('dist' ,DIST ,IS_AVAILABLE, LSUBMODEL, UNITAB)
259
260 GAUGE(1,NG)=DIST
261 GAUGE(9,NG)=ZERO
262 LGAUGE(2,NG)=NGAU
263
264 WRITE (IOUT,'(///,a)')' gauge'
265 WRITE (IOUT,'(a/)') ' -----'
266 WRITE (IOUT,'(a,i10)')' gauge number . . . . . . . . . . . . .',NGAU
267 IF(NOD /= 0)THEN
268 LGAUGE(3,NG)=USR2SYS(NOD,ITABM1,MESS,NGAU)
269 WRITE (IOUT,'(a,i10)')' node number. . . . . . . . . . . . . .',NOD
270 ELSEIF(NS /= 0)THEN
271 DO J=1,NUMELC
272 IF(IXC(NIXC,J)==NS)THEN
273 LGAUGE(3,NG)=-J
274 EXIT
275 ENDIF
276 ENDDO
277 IF (LGAUGE(3,NG) == 0)CALL ANCMSG(MSGID=3013,MSGTYPE=MSGERROR,ANMODE=ANINFO,I1=NGAU,C1=TITR,I2=NS)
278 WRITE (IOUT,'(/,a,i10)')' shell number . . . . . . . . . . . . .',NS
279 WRITE (IOUT,'(a,1pg20.13)')' distance . . . . . . . . . . . . . . .',DIST
280 ENDIF
281 WRITE (IOUT,'(a,1pg20.13)')' 4-pole butterworth corner frequency. .',FF
282C-------------------------------------
283 ENDDO ! NBGAUGE
284
285C-------------------------------------
286C Recherche des ID doubles
287C-------------------------------------
288 CALL VDOUBLE(NOM_OPT,LNOPT1,NBGAUGE,MESS,0,BID)
289C----
290 RETURN
291 END
butterworth
subroutine butterworth(dt, freq, x2, x1, x, fx2, fx1, fx)
Definition butterworth.F:31
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_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_read_gauge
subroutine hm_read_gauge(lgauge, gauge, itabm1, unitab, ixc, nom_opt, lsubmodel)
Definition hm_read_gauge.F:45
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
hm_option_read_mod
Definition hm_option_read_mod.F:412
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
r2r_mod
Definition r2r_mod.F:125
r2r_mod::taggau
integer, dimension(:), allocatable taggau
Definition r2r_mod.F:142
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
sz_r2r
subroutine sz_r2r(tag, val)
Definition routines_r2r.F:241
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:615
submodel_mod::submodel_data
Definition submodel_mod.F:728