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 42 of file hm_read_inject2.F.

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