45
46
47
54
55
56
57#include "implicit_f.inc"
58
59
60
61#include "units_c.inc"
62#include "param_c.inc"
63#include "com04_c.inc"
64#include "tablen_c.inc"
65
66
67
68 TYPE (UNIT_TYPE_),INTENT(IN) ::
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(*)
76
77
78
79 INTEGER IG,I,,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
96
97
98
99 INTEGER NINTRI,USR2SYS
100
101
102 is_encrypted = .false.
103 is_available = .false.
104
105
106
107 igeo( 1)=prop_id
108 igeo(11)=igtyp
109 geo(12) =igtyp+0.1
110
111
112 ig=igeo(1)
113 igeo(22)=2
114
115
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
132
133 CALL hm_get_intv(
'NIP',ngases,is_available,lsubmodel)
134 CALL hm_get_intv(
'IFLOW',iflow,is_available,lsubmodel)
135
136 IF (ngases<1.OR.100<ngases) THEN
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
147 . msgtype=msgerror,
148 . anmode=aninfo,
149 . i1=prop_id,
150 . c1=idtitl)
151 END IF
152
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)
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
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
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
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
196
197 IF (molfr(i) < zero) THEN
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
205
206
207
208 mat_id(2,i) =
nintri(mat_id(1,i),ipm,npropmi,nummat,1)
209 IF(mat_id(2,i) == 0) THEN
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
218 . msgtype=msgerror,
219 . anmode=aninfo_blind_1,
220 . i1=prop_id,
221 . c1=idtitl,
222 . i2=mat_id(1,i))
223 END IF
224
225 DO j=1,nfunct
226 IF(npc(nfunct+1+j) == f_idmf
227 ENDDO
228 IF(f_idmf(1,i)/=0.AND.f_idmf(2,i) == 0)THEN
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
237 ENDIF
238
239
240 IF(astime == zero)astime=one*fac_t
241 r_igc1=pm(27,mat_id(2,1))
242
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
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
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
288
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
297 . msgtype=msgerror,
298 . anmode=aninfo,
299 . i1=prop_id,
300 . c1=idtitl)
301 END IF
302 END IF
303 END DO
304
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
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
322
323 IF (ifun_ref/=-1) THEN
324
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
333 . msgtype=msgerror,
334 . anmode=aninfo_blind_1,
335 . i1=prop_id,
336 .
337
338 END IF
339 ELSE
340 IF (pld(npc(f_idmf(2,i))+icurpt+1)<zero) THEN
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
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
363 mf_tot=zero
364 DO i=1,ngases
365 mf_tot=mf_tot+molfr(i)
366 END DO
367
368 IF (mf_tot<em03) THEN
370 . msgtype=msgerror,
371 . anmode=aninfo,
372 . i1=prop_id,
373 . c1=idtitl)
374 ELSE IF (abs(mf_tot-one)>em03) THEN
375
376 DO i=1,ngases
377 molfr(i)=molfr(i)/mf_tot
378 END DO
380 . msgtype=msgwarning,
381 . anmode=aninfo_blind_1,
382 . i1=prop_id,
383 . c1=idtitl)
384 END IF
385 END IF
386
387
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
436
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
445
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
468
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
483
484
485
486
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))
489
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'//)
497
498
499
500
501
502
503
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
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)
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)