OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inject1.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_inject1 ../starter/source/properties/injector/hm_read_inject1.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_properties ../starter/source/properties/hm_read_properties.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
30!|| hm_get_float_array_index_dim ../starter/source/devtools/hm_reader/hm_get_float_array_index_dim.F
31!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
32!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
33!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
34!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
35!|| nintri ../starter/source/system/nintrr.F
36!|| usr2sys ../starter/source/system/sysfus.F
37!||--- uses -----------------------------------------------------
38!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
39!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
40!|| message_mod ../starter/share/message_module/message_mod.F
41!|| submodel_mod ../starter/share/modules1/submodel_mod.F
42!||====================================================================
43 SUBROUTINE hm_read_inject1(GEO ,IGEO ,PROP_TAG ,IGTYP ,PROP_ID ,
44 . IDTITL ,UNITAB ,LSUBMODEL,IPM ,PM ,
45 . NPC ,PLD)
46C============================================================================
47C M o d u l e s
48C-----------------------------------------------
49 USE unitab_mod
50 USE elbuftag_mod
51 USE message_mod
52 USE submodel_mod
53 USE hm_option_read_mod
54 USE names_and_titles_mod , ONLY : nchartitle
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 "units_c.inc"
63#include "param_c.inc"
64#include "com04_c.inc"
65#include "tablen_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
70 INTEGER IGEO(*)
71 INTEGER ,INTENT(IN) :: IGTYP,PROP_ID,IPM(NPROPMI,NUMMAT),NPC(*)
72 my_real, INTENT(IN) :: pld(*),pm(npropm,nummat)
73 my_real, INTENT(INOUT) :: geo(*)
74 CHARACTER(LEN=NCHARTITLE)::IDTITL
75 TYPE(prop_tag_) , DIMENSION(0:MAXPROP) :: PROP_TAG
76 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER IG,I,J,K,NGASES,IFLOW,IJET,NOD1,NOD2,NOD3,
81 . ICURPT
82 INTEGER MAT_ID(2,100),F_IDMASS(2,100),F_IDTEMP(2,100),
83 . F_IDMF(2,100),MW_MIXTURE,MW_MIXTURE_OK,
84 . nb_points,nb_points_1,nb_points_old,
85 . ifun_ref,ifun_tmp,ifun_tmp_usr
86 my_real
87 . fsmass(100),fstemp(100),astime,
88 . molfr(100),
89 . cpai_mix,cpbi_mix,cpci_mix,cpdi_mix,cpei_mix,cpfi_mix,
90 . mf_tot,mol_tot,mass_tot,mass_ini,mol_ini,mwi_mixture,
91 . stp_gama_mix,stp_temp,mass_mol,init_mass,cpi_mix,
92 . r_igc1, fac_time, fac_mass, fac_temp
93 CHARACTER MESS*40
94 DATA MESS/'INJECTOR PROPERTY SET '/
95 DATA stp_temp/293.15/
96 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
97C-----------------------------------------------
98C E x t e r n a l F u n c t i o n s
99C-----------------------------------------------
100 INTEGER NINTRI,USR2SYS
101C=======================================================================
102C
103 is_encrypted = .false.
104 is_available = .false.
105C----------------------
106C FROM LECGEO - GENERAL
107C----------------------
108 igeo( 1)=prop_id
109 igeo(11)=igtyp
110 geo(12) =igtyp+0.1
111C----------------------
112
113 ig=igeo(1)
114 igeo(22)=1 !I_INJECT : Injectors (1:'INJECT1' or 2:'INJECT2')
115
116C Initialisation
117 mat_id=0
118 f_idmass=0
119 f_idtemp=0
120 f_idmf=0
121 molfr=0
122 fsmass=zero
123 fstemp=zero
124 astime=zero
125 cpai_mix=0
126 cpbi_mix=0
127 cpci_mix=0
128 cpdi_mix=0
129 cpei_mix=0
130 cpfi_mix=0
131 fac_time=one
132C Lecture carte 1
133 CALL hm_get_intv('NIP',ngases,is_available,lsubmodel)
134 CALL hm_get_intv('IFLOW',iflow,is_available,lsubmodel)
135 CALL hm_get_floatv('A_SCALE_X',astime,is_available,lsubmodel,unitab)
136 CALL hm_get_floatv_dim('A_SCALE_X',fac_time,is_available,lsubmodel,unitab)
137
138C Verification
139 IF (ngases<1.OR.100<ngases) THEN
140 CALL ancmsg(msgid=696,
141 . msgtype=msgerror,
142 . anmode=aninfo,
143 . i1=prop_id,
144 . c1=idtitl,
145 . i2=ngases,
146 . i3=100)
147 END IF
148 IF (iflow/=0.AND.iflow/=1) THEN
149 CALL ancmsg(msgid=697,
150 . msgtype=msgerror,
151 . anmode=aninfo,
152 . i1=prop_id,
153 . c1=idtitl)
154 END IF
155C Lecture NGASES cartes
156 IF(ngases>0)THEN
157 CALL hm_get_float_array_index_dim('ABG_Smass',fac_mass,1,is_available,lsubmodel,unitab)
158 CALL hm_get_float_array_index_dim('ABG_Stemp',fac_temp,1,is_available,lsubmodel,unitab)
159 ENDIF
160
161 DO i=1,ngases
162 CALL hm_get_int_array_index('materialIds',mat_id(1,i),i,is_available,lsubmodel)
163 CALL hm_get_int_array_index('abg_imass',F_IDMASS(1,I),I,IS_AVAILABLE,LSUBMODEL)
164 CALL HM_GET_INT_ARRAY_INDEX('abg_itemp',F_IDTEMP(1,I),I,IS_AVAILABLE,LSUBMODEL)
165 CALL HM_GET_FLOAT_ARRAY_INDEX('abg_smass',FSMASS(I),I,IS_AVAILABLE,LSUBMODEL,UNITAB)
166 CALL HM_GET_FLOAT_ARRAY_INDEX('abg_stemp',FSTEMP(I),I,IS_AVAILABLE,LSUBMODEL,UNITAB)
167C Verification existence materiaux et functions
168C ---
169C --- Materiaux
170 IF(FSMASS(I) == ZERO)FSMASS(I)=ONE*FAC_MASS
171 IF(FSTEMP(I) == ZERO)FSTEMP(I)=ONE*FAC_TEMP
172 MAT_ID(2,I) = NINTRI(MAT_ID(1,I),IPM,NPROPMI,NUMMAT,1)
173 IF(MAT_ID(2,I) == 0) THEN
174 CALL ANCMSG(MSGID=698,
175 . MSGTYPE=MSGERROR,
176 . ANMODE=ANINFO_BLIND_1,
177 . I1=PROP_ID,
178 . C1=IDTITL,
179 . I2=MAT_ID(1,I))
180 ELSEIF(IPM(2,MAT_ID(2,I))/=999) THEN
181 CALL ANCMSG(MSGID=857,
182 . MSGTYPE=MSGERROR,
183 . ANMODE=ANINFO_BLIND_1,
184 . I1=PROP_ID,
185 . C1=IDTITL,
186 . I2=MAT_ID(1,I))
187 END IF
188C --- Fonctions
189 IF(F_IDMASS(1,I) > 0) THEN
190 DO J=1,NFUNCT
191 IF(NPC(NFUNCT+1+J) == F_IDMASS(1,I)) F_IDMASS(2,I)=J
192 ENDDO
193 ENDIF
194 IF(F_IDTEMP(1,I) > 0) THEN
195 DO J=1,NFUNCT
196 IF(NPC(NFUNCT+1+J) == F_IDTEMP(1,I)) F_IDTEMP(2,I)=J
197 ENDDO
198 ENDIF
199.AND. IF(F_IDMASS(1,I)/=0F_IDMASS(2,I) == 0)THEN
200 CALL ANCMSG(MSGID=708,
201 . MSGTYPE=MSGERROR,
202 . ANMODE=ANINFO_BLIND_1,
203 . I1=PROP_ID,
204 . C1=IDTITL,
205 . I2=F_IDMASS(1,I))
206 ENDIF
207.AND. IF(F_IDTEMP(1,I)/=0F_IDTEMP(2,I) == 0)THEN
208 CALL ANCMSG(MSGID=708,
209 . MSGTYPE=MSGERROR,
210 . ANMODE=ANINFO_BLIND_1,
211 . I1=PROP_ID,
212 . C1=IDTITL,
213 . I2=F_IDTEMP(1,I))
214 ENDIF
215 ENDDO ! I=1,NGASES
216
217C Conversion d unites ----------------------
218 IF(ASTIME == ZERO)ASTIME=ONE*FAC_TIME
219 R_IGC1=PM(27,MAT_ID(2,1))
220C Verification de la croissance des fonctions de masse
221 DO I=1,NGASES
222 IFUN_TMP=0
223 IFUN_TMP_USR=0
224 IF (IGEO(22) == 1) THEN
225 IF (F_IDMASS(2,I)/=0) THEN
226 IFUN_TMP=F_IDMASS(2,I)
227 IFUN_TMP_USR=F_IDMASS(1,I)
228 END IF
229 ELSE IF (IGEO(22) == 2) THEN
230 IF (F_IDMF(2,I)/=0) THEN
231 IFUN_TMP=F_IDMF(2,I)
232 IFUN_TMP_USR=F_IDMF(1,I)
233 END IF
234 END IF
235 IF (IFUN_TMP/=0) THEN
236 IF ((NPC(IFUN_TMP+1)-NPC(IFUN_TMP)) >= 4) THEN
237 IF (IFLOW == 0) THEN
238 DO J = NPC(IFUN_TMP),NPC(IFUN_TMP+1)-3,2
239 IF (PLD(J+1) > PLD(J+3)) THEN
240 CALL ANCMSG(MSGID=720,
241 . MSGTYPE=MSGWARNING,
242 . ANMODE=ANINFO_BLIND_1,
243 . I1=PROP_ID,
244 . C1=IDTITL,
245 . I2=IFUN_TMP_USR,I3=I)
246 END IF
247 END DO
248 ELSE IF (IFLOW == 1) THEN
249 DO J = NPC(IFUN_TMP),NPC(IFUN_TMP+1)-1,2
250 IF (PLD(J+1) < ZERO) THEN
251 CALL ANCMSG(MSGID=721,
252 . MSGTYPE=MSGWARNING,
253 . ANMODE=ANINFO_BLIND_1,
254 . I1=PROP_ID,
255 . C1=IDTITL,
256 . I2=IFUN_TMP_USR,I3=I)
257 END IF
258 END DO
259 END IF
260 END IF
261 END IF
262 END DO
263
264C Calcul des caracteristiques initiales du melange
265 MWI_MIXTURE=ZERO
266 CPAI_MIX=ZERO
267 CPBI_MIX=ZERO
268 CPCI_MIX=ZERO
269 CPDI_MIX=ZERO
270 CPEI_MIX=ZERO
271 CPFI_MIX=ZERO
272 MASS_INI=ZERO
273 MOL_INI=ZERO
274 MASS_TOT=ZERO
275 MOL_TOT=ZERO
276 INIT_MASS=ZERO
277
278C Calcul de la masse totale
279 DO I=1,NGASES
280 IF (F_IDMASS(2,I) > 0) THEN
281 MASS_TOT = MASS_TOT + PLD(NPC(F_IDMASS(2,I))+3)*FSMASS(I)
282 ENDIF
283 END DO
284 DO I=1,NGASES
285C Moyenne simple dans le cas d une masse nulle
286C on considere que chaque gaz arrive avec la meme masse
287C attention dans ce cas la moyenne faite pour mw est :
288C mw = somme (moles) / somme (masses)
289C mw = somme (1/masse_molaire) / somme (masses=1)=ngases
290.OR. IF (MASS_TOT == ZERO F_IDMASS(2,I) == 0) THEN
291 INIT_MASS=ONE
292 ELSE
293 INIT_MASS=PLD(NPC(F_IDMASS(2,I))+3)*FSMASS(I)
294 END IF
295 MOL_TOT=MOL_TOT + INIT_MASS/PM(20,MAT_ID(2,I))
296 CPAI_MIX = CPAI_MIX + INIT_MASS*PM(21,MAT_ID(2,I))
297 CPBI_MIX = CPBI_MIX + INIT_MASS*PM(22,MAT_ID(2,I))
298 CPCI_MIX = CPCI_MIX + INIT_MASS*PM(23,MAT_ID(2,I))
299 CPDI_MIX = CPDI_MIX + INIT_MASS*PM(24,MAT_ID(2,I))
300 CPEI_MIX = CPEI_MIX + INIT_MASS*PM(25,MAT_ID(2,I))
301 CPFI_MIX = CPFI_MIX + INIT_MASS*PM(26,MAT_ID(2,I))
302 END DO
303C on utilise mass tot pour detecter
304C comment calculer init_mass
305 IF (MASS_TOT == ZERO) THEN
306 MASS_TOT=NGASES
307 END IF
308 MWI_MIXTURE=MASS_TOT/MOL_TOT
309 CPAI_MIX = CPAI_MIX / MASS_TOT
310 CPBI_MIX = CPBI_MIX / MASS_TOT
311 CPCI_MIX = CPCI_MIX / MASS_TOT
312 CPDI_MIX = CPDI_MIX / MASS_TOT
313 CPEI_MIX = CPEI_MIX / MASS_TOT
314 CPFI_MIX = CPFI_MIX / MASS_TOT
315C ------------------------------------------
316 IGEO(23)=NGASES
317 IGEO(24)=IFLOW
318 DO I=1,NGASES
319 IGEO(100+(I-1)*3+1)=MAT_ID(2,I)
320 IGEO(100+(I-1)*3+2)=F_IDMASS(2,I)
321 IGEO(100+(I-1)*3+3)=F_IDTEMP(2,I)
322 END DO
323C ------------------------------------------
324 GEO(201)=ASTIME
325 GEO(202)=MWI_MIXTURE
326 GEO(203)=CPAI_MIX
327 GEO(204)=CPBI_MIX
328 GEO(205)=CPCI_MIX
329 GEO(206)=CPDI_MIX
330 GEO(207)=CPEI_MIX
331 GEO(208)=CPFI_MIX
332 CPI_MIX =CPAI_MIX
333 . +CPBI_MIX*STP_TEMP
334 . +CPCI_MIX*STP_TEMP*STP_TEMP
335 . +CPDI_MIX*STP_TEMP*STP_TEMP*STP_TEMP
336 . +CPEI_MIX/(STP_TEMP*STP_TEMP)
337 . +CPFI_MIX*STP_TEMP*STP_TEMP*STP_TEMP*STP_TEMP
338 STP_GAMA_MIX=CPI_MIX/(CPI_MIX-R_IGC1/MWI_MIXTURE)
339
340 DO I=1,NGASES
341 GEO(208+(I-1)*2+1)=FSMASS(I)
342 GEO(208+(I-1)*2+2)=FSTEMP(I)
343 END DO
344C ------------------------------------------
345 IF(IS_ENCRYPTED)THEN
346 WRITE(IOUT,1000)PROP_ID
347 ELSE
348 WRITE(IOUT,1100)IG,IFLOW,ASTIME
349 WRITE(IOUT,1110)NGASES
350 WRITE(IOUT,1115)MWI_MIXTURE,STP_GAMA_MIX,
351 . CPAI_MIX,CPBI_MIX,CPCI_MIX,
352 . CPDI_MIX,CPEI_MIX,CPFI_MIX
353 DO I=1,NGASES
354 WRITE(IOUT,1120)MAT_ID(1,I),F_IDMASS(1,I),F_IDTEMP(1,I), FSMASS(I),FSTEMP(I)
355 END DO
356 WRITE(IOUT,'(//)')
357 ENDIF
358C
359C----------------------
360C FROM LECGEO - GENERAL
361C----------------------
362.AND. IF(GEO(39)/=ZEROIGEO( 9)== 0) IGEO( 9)=NINT(GEO(39))
363.AND. IF(GEO(171)/=ZEROIGEO(10)== 0) IGEO(10)=NINT(GEO(171))
364C----------------------
365
366 RETURN
367 1000 FORMAT(
368 & 5X,'injector property set(/prop/inject1)'/,
369 & 5X,'--------------------------------------',/,
370 & 5X,'property set number . . . . . . . . . .=',I10,/,
371 & 5X,'confidential data'//)
372 1100 FORMAT(
373 & 5X,'injector property set(/prop/inject1)'/,
374 & 5X,'property set number . . . . . . . . . .=',I10,/,
375 & 5X,'incoming mass flag for functions. . . .=',I10,/,
376 & 5X,'(0:mass/time, 1:mass flow/time)',/,
377 & 5X,'abscissa scale factor',/,
378 & 5X,' for time based functions . . . . .=',1PG20.13,/)
379 1110 FORMAT(
380 & 5X,'mixture defintion'/,
381 & 5X,'number of gases . . . . . . . . . . . .=',I10,/)
382 1115 FORMAT(
383 & 5X,'initial characteristics of mixture',/,
384 & 5X,'----------------------------------',/,
385 & 5X,'molecular weight. . . . . . . . . . . .=',1PG20.13,/,
386 & 5X,'stp gamma . . . . . . . . . . . . . . .=',1PG20.13,/,
387 & 5X,'coefficient cpa . . . . . . . . . . . .=',1PG20.13,/,
388 & 5X,'coefficient cpb . . . . . . . . . . . .=',1PG20.13,/,
389 & 5X,'coefficient cpc . . . . . . . . . . . .=',1PG20.13,/,
390 & 5X,'coefficient cpd . . . . . . . . . . . .=',1PG20.13,/,
391 & 5X,'coefficient cpe . . . . . . . . . . . .=',1PG20.13,/,
392 & 5X,'coefficient cpf . . . . . . . . . . . .=',1PG20.13,/)
393 1120 FORMAT(
394 & 10X,'gas number. . . . . . . . . . . . . . .=',I10,/,
395 & 10X,'time FUNCTION for incoming mass . . . .=',I10,/,
396 & 10X,'time function for incoming gas temp . .=',I10,/,
397 & 10X,'scale factor for incoming mass. . . . .=',1PG20.13,/,
398 & 10X,'scale factor for incoming gas temp. . .=',1PG20.13,/)
399 999 CALL FREERR(3)
400 RETURN
401 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_float_array_index_dim
subroutine hm_get_float_array_index_dim(name, dim_fac, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index_dim.F:47
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_read_inject1
subroutine hm_read_inject1(geo, igeo, prop_tag, igtyp, prop_id, idtitl, unitab, lsubmodel, ipm, pm, npc, pld)
Definition hm_read_inject1.F:46
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
elbuftag_mod
Definition elbuftag_mod.F:227
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
elbuftag_mod::prop_tag_
Definition elbuftag_mod.F:374
submodel_mod::submodel_data
Definition submodel_mod.F:723