OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inject2.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "tablen_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_inject2 (geo, igeo, prop_tag, igtyp, prop_id, idtitl, unitab, lsubmodel, ipm, pm, npc, pld)

Function/Subroutine Documentation

◆ hm_read_inject2()

subroutine hm_read_inject2 ( dimension(*), intent(inout) geo,
integer, dimension(*) igeo,
type(prop_tag_), dimension(0:maxprop) prop_tag,
integer, intent(in) igtyp,
integer, intent(in) prop_id,
character(len=nchartitle) idtitl,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, dimension(npropmi,nummat), intent(in) ipm,
dimension(npropm,nummat), intent(in) pm,
integer, dimension(*), intent(in) npc,
dimension(*), intent(in) pld )

Definition at line 41 of file hm_read_inject2.F.

44C============================================================================
45C M o d u l e s
46C-----------------------------------------------
47 USE unitab_mod
48 USE elbuftag_mod
49 USE message_mod
50 USE submodel_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "units_c.inc"
61#include "param_c.inc"
62#include "com04_c.inc"
63#include "tablen_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
68 INTEGER IGEO(*)
69 INTEGER ,INTENT(IN) :: IGTYP,PROP_ID,IPM(NPROPMI,NUMMAT),NPC(*)
70 my_real, INTENT(IN) :: pld(*),pm(npropm,nummat)
71 my_real, INTENT(INOUT) :: geo(*)
72 CHARACTER(LEN=NCHARTITLE)::IDTITL
73 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
74 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER IG,I,J,NGASES,IFLOW,
79 . ICURPT
80 INTEGER MAT_ID(2,100),F_IDMASS(2,100),F_IDTEMP(2,100),
81 . F_IDMF(2,100),MW_MIXTURE,MW_MIXTURE_OK,
82 . NB_POINTS,NB_POINTS_1,
83 . IFUN_REF,IFUN_TMP,IFUN_TMP_USR
85 . fsmass(100),fstemp(100),astime,
86 . molfr(100),
87 . cpai_mix,cpbi_mix,cpci_mix,cpdi_mix,cpei_mix,cpfi_mix,
88 . mf_tot,mol_tot,mass_tot,mass_ini,mol_ini,mwi_mixture,
89 . stp_gama_mix,stp_temp,init_mass,cpi_mix,
90 . r_igc1, fac_m, fac_t
91 CHARACTER MESS*40
92 DATA mess/'INJECTOR PROPERTY SET '/
93 DATA stp_temp/293.15/
94 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
95C-----------------------------------------------
96C E x t e r n a l F u n c t i o n s
97C-----------------------------------------------
98 INTEGER NINTRI
99C=======================================================================
100C
101 is_encrypted = .false.
102 is_available = .false.
103C----------------------
104C FROM LECGEO - GENERAL
105C----------------------
106 igeo( 1)=prop_id
107 igeo(11)=igtyp
108 geo(12) =igtyp+0.1
109C----------------------
110
111 ig=igeo(1)
112 igeo(22)=2 !I_INJECT : Injectors (1:'INJECT1' or 2:'INJECT2')
113
114C Initialisation
115 mat_id=0
116 f_idmass=0
117 f_idtemp=0
118 f_idmf=0
119 molfr=0
120 fsmass=zero
121 fstemp=zero
122 astime=zero
123 cpai_mix=0
124 cpbi_mix=0
125 cpci_mix=0
126 cpdi_mix=0
127 cpei_mix=0
128 cpfi_mix=0
129 fac_t=one
130 fac_m=one
131C Reading Card 1
132 CALL hm_get_intv('NIP',ngases,is_available,lsubmodel)
133 CALL hm_get_intv('IFLOW',iflow,is_available,lsubmodel)
134C Verification
135 IF (ngases<1.OR.100<ngases) THEN
136 CALL ancmsg(msgid=696,
137 . msgtype=msgerror,
138 . anmode=aninfo,
139 . i1=prop_id,
140 . c1=idtitl,
141 . i2=ngases,
142 . i3=100)
143 END IF
144 IF (iflow/=0.AND.iflow/=1) THEN
145 CALL ancmsg(msgid=697,
146 . msgtype=msgerror,
147 . anmode=aninfo,
148 . i1=prop_id,
149 . c1=idtitl)
150 END IF
151C Reading Card 2
152 CALL hm_get_intv('FUN_A1',f_idmass(1,1),is_available,lsubmodel)
153 CALL hm_get_intv('FUN_B1',f_idtemp(1,1),is_available,lsubmodel)
154 CALL hm_get_floatv('F_SCALE_Y',fsmass(1),is_available,lsubmodel,unitab)
155 CALL hm_get_floatv('F_SHIFT_Y',fstemp(1),is_available,lsubmodel,unitab)
156 CALL hm_get_floatv('A_SCALE_X',astime,is_available,lsubmodel,unitab)
157 CALL hm_get_floatv_dim('F_SCALE_Y',fac_m,is_available,lsubmodel,unitab)
158 CALL hm_get_floatv_dim('A_SCALE_X',fac_t,is_available,lsubmodel,unitab)
159
160
161 IF(fsmass(1) == zero)fsmass(1)=one*fac_m
162 IF(fstemp(1) == zero)fstemp(1)=one*fac_t
163 IF(f_idmass(1,1) == 0) THEN
164 CALL ancmsg(msgid=1115,
165 . msgtype=msgerror,
166 . anmode=aninfo_blind_1,
167 . i1=prop_id,
168 . c1=idtitl )
169 ELSE
170 DO j=1,nfunct
171 IF(npc(nfunct+1+j) == f_idmass(1,1)) f_idmass(2,1)=j
172 IF(npc(nfunct+1+j) == f_idtemp(1,1)) f_idtemp(2,1)=j
173 ENDDO
174 IF(f_idmass(2,1) == 0)THEN
175 CALL ancmsg(msgid=708,
176 . msgtype=msgerror,
177 . anmode=aninfo_blind_1,
178 . i1=prop_id,
179 . c1=idtitl,
180 . i2=f_idmass(1,1))
181 ENDIF
182 IF(f_idtemp(1,1)/=0.AND.f_idtemp(2,1) == 0)THEN
183 CALL ancmsg(msgid=708,
184 . msgtype=msgerror,
185 . anmode=aninfo_blind_1,
186 . i1=prop_id,
187 . c1=idtitl,
188 . i2=f_idtemp(1,1))
189 ENDIF
190 DO i=1,ngases
191
192 CALL hm_get_int_array_index('materialIds',mat_id(1,i),i,is_available,lsubmodel)
193 CALL hm_get_float_array_index('CM1',molfr(i),i,is_available,lsubmodel,unitab)
194 CALL hm_get_int_array_index('ABG_Imass',f_idmf(1,i),i,is_available,lsubmodel)
195
196 IF (molfr(i) < zero) THEN
197 CALL ancmsg(msgid=729,
198 . msgtype=msgerror,
199 . anmode=aninfo_blind_1,
200 . i1=prop_id,
201 . c1=idtitl)
202 END IF
203 IF (f_idmf(1,i)/=0) molfr(i)=one
204C Material existence verification and functions
205C ---
206C --- Materiaux
207 mat_id(2,i) = nintri(mat_id(1,i),ipm,npropmi,nummat,1)
208 IF(mat_id(2,i) == 0) THEN
209 CALL ancmsg(msgid=698,
210 . msgtype=msgerror,
211 . anmode=aninfo,
212 . i1=prop_id,
213 . c1=idtitl,
214 . i2=mat_id(1,i))
215 ELSEIF(ipm(2,mat_id(2,i))/=999) THEN
216 CALL ancmsg(msgid=857,
217 . msgtype=msgerror,
218 . anmode=aninfo_blind_1,
219 . i1=prop_id,
220 . c1=idtitl,
221 . i2=mat_id(1,i))
222 END IF
223C --- Fonctions
224 DO j=1,nfunct
225 IF(npc(nfunct+1+j) == f_idmf(1,i)) f_idmf(2,i)=j
226 ENDDO
227 IF(f_idmf(1,i)/=0.AND.f_idmf(2,i) == 0)THEN
228 CALL ancmsg(msgid=708,
229 . msgtype=msgerror,
230 . anmode=aninfo_blind_1,
231 . i1=prop_id,
232 . c1=idtitl,
233 . i2=f_idmf(1,i))
234 ENDIF
235 ENDDO ! I=1,NGASES
236 ENDIF
237
238C Units conversion --------------------
239 IF(astime == zero)astime=one*fac_t
240 r_igc1=pm(27,mat_id(2,1))
241C Verification of the growth of mass function
242 DO i=1,ngases
243 ifun_tmp=0
244 ifun_tmp_usr=0
245 IF (igeo(22) == 1) THEN
246 IF (f_idmass(2,i)/=0) THEN
247 ifun_tmp=f_idmass(2,i)
248 ifun_tmp_usr=f_idmass(1,i)
249 END IF
250 ELSE IF (igeo(22) == 2) THEN
251 IF (f_idmf(2,i)/=0) THEN
252 ifun_tmp=f_idmf(2,i)
253 ifun_tmp_usr=f_idmf(1,i)
254 END IF
255 END IF
256 IF (ifun_tmp/=0) THEN
257 IF ((npc(ifun_tmp+1)-npc(ifun_tmp)) >= 4) THEN
258 IF (iflow == 0) THEN
259 DO j = npc(ifun_tmp),npc(ifun_tmp+1)-3,2
260 IF (pld(j+1) > pld(j+3)) THEN
261 CALL ancmsg(msgid=720,
262 . msgtype=msgwarning,
263 . anmode=aninfo_blind_1,
264 . i1=prop_id,
265 . c1=idtitl,
266 . i2=ifun_tmp_usr,i3=i)
267 END IF
268 END DO
269 ELSE IF (iflow == 1) THEN
270 DO j = npc(ifun_tmp),npc(ifun_tmp+1)-1,2
271 IF (pld(j+1) < zero) THEN
272 CALL ancmsg(msgid=721,
273 . msgtype=msgwarning,
274 . anmode=aninfo_blind_1,
275 . i1=prop_id,
276 . c1=idtitl,
277 . i2=ifun_tmp_usr,i3=i)
278 END IF
279 END DO
280 END IF
281 END IF
282 END IF
283 END DO
284
285 mw_mixture=zero
286 mw_mixture_ok=0
287C Verification of the number of points of molar fraction functions
288 nb_points_1=-1
289 DO i=1,ngases
290 IF (f_idmf(2,i)/=0) THEN
291 IF (nb_points_1==-1)
292 . nb_points_1=npc(f_idmf(2,i))-npc(f_idmf(2,i)+1)
293 nb_points=npc(f_idmf(2,i))-npc(f_idmf(2,i)+1)
294 IF (nb_points/=nb_points_1) THEN
295 CALL ancmsg(msgid=713,
296 . msgtype=msgerror,
297 . anmode=aninfo,
298 . i1=prop_id,
299 . c1=idtitl)
300 END IF
301 END IF
302 END DO
303C Verification of the abscissas of molar fraction functions
304 ifun_ref=-1
305 DO i=1,ngases
306 IF (f_idmf(2,i)/=0) THEN
307 IF (ifun_ref==-1)
308 . ifun_ref=f_idmf(2,i)
309 DO j=npc(f_idmf(2,i)),npc(f_idmf(2,i)+1)-1,2
310 icurpt=j-npc(f_idmf(2,i))
311 IF (pld(j)/=pld(npc(ifun_ref)+icurpt)) THEN
312 CALL ancmsg(msgid=715,
313 . msgtype=msgerror,
314 . anmode=aninfo,
315 . i1=prop_id,
316 . c1=idtitl)
317 END IF
318 END DO
319 END IF
320 END DO
321C Verification somme des fractions molaires egale a 1
322 IF (ifun_ref/=-1) THEN
323C In the case where there is at least one function
324 DO j=npc(ifun_ref),npc(ifun_ref+1)-1,2
325 icurpt=j-npc(ifun_ref)
326 mf_tot=zero
327 DO i=1,ngases
328 IF (f_idmf(2,i)==0) THEN
329 mf_tot=mf_tot+molfr(i)
330 IF (molfr(i)<zero) THEN
331 CALL ancmsg(msgid=728,
332 . msgtype=msgerror,
333 . anmode=aninfo_blind_1,
334 . i1=prop_id,
335 . c1=idtitl,
336 . i2=icurpt/2+1,i3=i)
337 END IF
338 ELSE
339 IF (pld(npc(f_idmf(2,i))+icurpt+1)<zero) THEN
340 CALL ancmsg(msgid=728,
341 . msgtype=msgerror,
342 . anmode=aninfo_blind_1,
343 . i1=prop_id,
344 . c1=idtitl,
345 . i2=icurpt/2+1,i3=i)
346 END IF
347 mf_tot=mf_tot+pld(npc(f_idmf(2,i))+icurpt+1)
348 . *molfr(i)
349 END IF
350 END DO
351 IF (abs(mf_tot-one)>em03) THEN
352 CALL ancmsg(msgid=716,
353 . msgtype=msgerror,
354 . anmode=aninfo_blind_1,
355 . i1=prop_id,
356 . c1=idtitl,
357 . i2=icurpt/2+1)
358 END IF
359 END DO
360 ELSE
361 !In the case where there are only molar fractions
362 mf_tot=zero
363 DO i=1,ngases
364 mf_tot=mf_tot+molfr(i)
365 END DO
366 !If the sum is zero, nothing can be done, MF_TOT is positive
367 IF (mf_tot<em03) THEN
368 CALL ancmsg(msgid=717,
369 . msgtype=msgerror,
370 . anmode=aninfo,
371 . i1=prop_id,
372 . c1=idtitl)
373 ELSE IF (abs(mf_tot-one)>em03) THEN
374 !Otherwise, we normalize with respect to the sum
375 DO i=1,ngases
376 molfr(i)=molfr(i)/mf_tot
377 END DO
378 CALL ancmsg(msgid=741,
379 . msgtype=msgwarning,
380 . anmode=aninfo_blind_1,
381 . i1=prop_id,
382 . c1=idtitl)
383 END IF
384 END IF
385
386C Calculation of initial characteristics of the mixture
387 mwi_mixture=zero
388 cpai_mix=zero
389 cpbi_mix=zero
390 cpci_mix=zero
391 cpdi_mix=zero
392 cpei_mix=zero
393 cpfi_mix=zero
394 mass_ini=zero
395 mol_ini=zero
396 mass_tot=zero
397 mol_tot=zero
398 init_mass=zero
399
400 DO i=1,ngases
401 IF (f_idmf(2,i) == 0) THEN
402 mol_ini=molfr(i)
403 ELSE
404 mol_ini=molfr(i)*pld(npc(f_idmf(2,i))+3)
405 END IF
406 mol_tot=mol_tot+mol_ini
407 END DO
408 DO i=1,ngases
409 IF (mol_tot == zero) THEN
410 init_mass = em09 / unitab%FAC_M_WORK
411 ELSE
412 IF (f_idmf(2,i) == 0) THEN
413 mol_ini=molfr(i)
414 ELSE
415 mol_ini=molfr(i)*pld(npc(f_idmf(2,i))+3)
416 END IF
417 init_mass = mol_ini*pm(20,mat_id(2,i))
418 END IF
419 mass_tot = mass_tot + init_mass
420 cpai_mix = cpai_mix + init_mass*pm(21,mat_id(2,i))
421 cpbi_mix = cpbi_mix + init_mass*pm(22,mat_id(2,i))
422 cpci_mix = cpci_mix + init_mass*pm(23,mat_id(2,i))
423 cpdi_mix = cpdi_mix + init_mass*pm(24,mat_id(2,i))
424 cpei_mix = cpei_mix + init_mass*pm(25,mat_id(2,i))
425 cpfi_mix = cpfi_mix + init_mass*pm(26,mat_id(2,i))
426 END DO
427 mwi_mixture=mass_tot/mol_tot
428 cpai_mix = cpai_mix / mass_tot
429 cpbi_mix = cpbi_mix / mass_tot
430 cpci_mix = cpci_mix / mass_tot
431 cpdi_mix = cpdi_mix / mass_tot
432 cpei_mix = cpei_mix / mass_tot
433 cpfi_mix = cpfi_mix / mass_tot
434
435C ------------------------------------------
436 igeo(23)=ngases
437 igeo(24)=iflow
438 igeo(25)=f_idmass(2,1)
439 igeo(26)=f_idtemp(2,1)
440 DO i=1,ngases
441 igeo(100+(i-1)*2+1)=mat_id(2,i)
442 igeo(100+(i-1)*2+2)=f_idmf(2,i)
443 END DO
444C ------------------------------------------
445 geo(201)=astime
446 geo(202)=mwi_mixture
447 geo(203)=cpai_mix
448 geo(204)=cpbi_mix
449 geo(205)=cpci_mix
450 geo(206)=cpdi_mix
451 geo(207)=cpei_mix
452 geo(208)=cpfi_mix
453 cpi_mix =cpai_mix
454 . +cpbi_mix*stp_temp
455 . +cpci_mix*stp_temp*stp_temp
456 . +cpdi_mix*stp_temp*stp_temp*stp_temp
457 . +cpei_mix/(stp_temp*stp_temp)
458 . +cpfi_mix*stp_temp*stp_temp*stp_temp*stp_temp
459 stp_gama_mix=cpi_mix/(cpi_mix-r_igc1/mwi_mixture)
460
461 geo(209)=fsmass(1)
462 geo(210)=fstemp(1)
463 geo(211)=mw_mixture
464 DO i=1,ngases
465 geo(211+(i-1)+1)=molfr(i)
466 END DO
467C ------------------------------------------
468 IF(is_encrypted)THEN
469 WRITE(iout,1000)prop_id
470 ELSE
471 WRITE(iout,1130)ig,iflow,f_idmass(1,1),f_idtemp(1,1),
472 . fsmass(1),fstemp(1),astime
473 WRITE(iout,1110)ngases
474 WRITE(iout,1115)mwi_mixture,stp_gama_mix,
475 . cpai_mix,cpbi_mix,cpci_mix,
476 . cpdi_mix,cpei_mix,cpfi_mix
477 DO i=1,ngases
478 WRITE(iout,1140)mat_id(1,i),molfr(i),f_idmf(1,i)
479 END DO
480 WRITE(iout,'(//)')
481 ENDIF
482C
483C----------------------
484C FROM LECGEO - GENERAL
485C----------------------
486 IF(geo(39)/=zero.AND.igeo( 9)== 0) igeo( 9)=nint(geo(39))
487 IF(geo(171)/=zero.AND.igeo(10)== 0) igeo(10)=nint(geo(171))
488C----------------------
489
490 RETURN
491 1000 FORMAT(
492 & 5x,'INJECTOR PROPERTY SET (/PROP/INJECT2)'/,
493 & 5x,'--------------------------------------',/,
494 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10,/,
495 & 5x,'CONFIDENTIAL DATA'//)
496c1100 FORMAT(
497c & 5X,'INJECTOR PROPERTY SET (/PROP/INJECT2)'/,
498c & 5X,'PROPERTY SET NUMBER . . . . . . . . . .=',I10,/,
499c & 5X,'INCOMING MASS FLAG FOR FUNCTIONS. . . .=',I10,/,
500c & 5X,'(0:MASS/TIME, 1:MASS FLOW/TIME)',/,
501c & 5X,'ABSCISSA SCALE FACTOR',/,
502c & 5X,' FOR TIME BASED FUNCTIONS . . . . .=',1PG20.13,/)
503 1110 FORMAT(
504 & 5x,'MIXTURE DEFINTION'/,
505 & 5x,'NUMBER OF GASES . . . . . . . . . . . .=',i10,/)
506 1115 FORMAT(
507 & 5x,'INITIAL CHARACTERISTICS OF MIXTURE',/,
508 & 5x,'----------------------------------',/,
509 & 5x,'MOLECULAR WEIGHT. . . . . . . . . . . .=',1pg20.13,/,
510 & 5x,'STP GAMMA . . . . . . . . . . . . . . .=',1pg20.13,/,
511 & 5x,'COEFFICIENT CPA . . . . . . . . . . . .=',1pg20.13,/,
512 & 5x,'COEFFICIENT CPB . . . . . . . . . . . .=',1pg20.13,/,
513 & 5x,'COEFFICIENT CPC . . . . . . . . . . . .=',1pg20.13,/,
514 & 5x,'COEFFICIENT CPD . . . . . . . . . . . .=',1pg20.13,/,
515 & 5x,'COEFFICIENT CPE . . . . . . . . . . . .=',1pg20.13,/,
516 & 5x,'COEFFICIENT CPF . . . . . . . . . . . .=',1pg20.13,/)
517 1130 FORMAT(
518 & 5x,'INJECTOR PROPERTY SET'/,
519 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10,/,
520 & 5x,'INCOMING MASS FLAG FOR FUNCTIONS. . . .=',i10,/,
521 & 5x,'(0:MASS/TIME, 1:MASS FLOW/TIME)',/,
522 & 5x,'TIME FUNCTION FOR INCOMING MASS . . . .=',i10,/,
523 & 5x,'TIME FUNCTION FOR INCOMING GAS TEMP . .=',i10,/,
524 & 5x,'SCALE FACTOR FOR INCOMING MASS. . . . .=',1pg20.13,/,
525 & 5x,'SCALE FACTOR FOR INCOMING GAS TEMP. . .=',1pg20.13,/,
526 & 5x,'ABSCISSA SCALE FACTOR',/,
527 & 5x,' for time based functions . . . . .=',1PG20.13,/)
528 1140 FORMAT(
529 & 10X,'gas number. . . . . . . . . . . . . . .=',I10,/,
530 & 10X,'molar fraction. . . . . . . . . . . . .=',1PG20.13,/,
531 & 10X,'time FUNCTION for molar fraction. . . .=',I10,/)
532 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
for(i8=*sizetab-1;i8 >=0;i8--)
integer, parameter nchartitle
integer function nintri(iext, antn, m, n, m1)
Definition nintrr.F:45
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