.... File name .... GXIMAS.HTM ........ 050918
REAL FUNCTION INTMAS(I)
C.... Interphase mass-transfer rate:
INCLUDE 'farray'
INCLUDE 'grdloc'
INCLUDE 'satgrd'
INCLUDE 'satear'
INCLUDE 'grdear'
INCLUDE 'prpcmn'
COMMON/GENI/IGF1(2),NXNYST,NDIR,KDUMM,IGF2(4),NFM,IGF3(39),
1 ITEM1,ITEM2,ISPH1,ISPH2,ICON1,ICON2,IPRPS,IGF4(4)
1 /CELPAR/IPHASE,IPROP,IGRND,IFILEP,KPROP
c
IF(IGRND==-1) THEN
IF(EQUVEL) THEN
C.... mdot = CMDOT * cell volume * volume-fraction product
INTMAS=CMDOT*F(L0R1+I)*F(L0R2+I)*CELVOL(I)
ELSE
C.... mdot = CMDOT
INTMAS=CMDOT
ENDIF
c
ELSEIF(IGRND==1) THEN
C.... The mass-transfer rate per cell proportional A*(R2-B)
INTMAS= CMDTA*(F(L0R+I)-CMDTB)
c
ELSEIF(IGRND==2) THEN
C.... The mass-transfer rate per cell proportional A*(R2-B)**C:
INTMAS= CMDTA*(F(L0R+I)-CMDTB)**CMDTC
c
ELSEIF(IGRND==3) THEN
C.... The mass-transfer rate per cell proportional A*(R2-B)*(C-MixF).
C This option is useful when the mass-transfer rate is limited by
C the "saturation" of the first phase, C being the saturation value
C of the mixture-fraction, MIXF, conveyed via CMDTC .
IF(L0MIXF/=0) THEN
FRAC=F(L0MIXF+I)
ELSE
c IF(L0CATM/=0) THEN
c FRACC=F(L0CATM+I)
c ELSE
c FRACC=0.0
c ENDIF
c IF(L0HATM/=0) THEN
c FRACH=F(L0HATM+I)
c ELSE
c FRACH=0.0
c ENDIF
c frac=fracc+frach
ENDIF
INTMAS= CMDTA * ( F(L0R+I)-CMDTB )*( CMDTC-FRAC )
c
ELSEIF(IGRND==4) THEN
C.... The mass-transfer rate per cell proportional to:
C (R1 - B)/(R1*R2)**C
INTMAS= CMDTA*(F(L0R+I)-CMDTB)/
1 ((F(L0R1+I)+TINY)*(F(L0R+I)+TINY))**CMDTC
c
ELSEIF(IGRND==5) THEN
C.... The mass-transfer rate linearly dependent on abs(dU/dX) (NOTE,
C L0MAS stores mass of 2nd phase):
DUDXI = CLDUDX(I,XCYCZ)
INTMAS= CMDTA*(F(L0R+I)-CMDTB)*CELMAS(I,2)*
1 (1.+ CMDTC*ABS(DUDXI))
c
ELSEIF(IGRND==6) THEN
C.... The mass-transfer rate linearly dependent on
C sqrt(abs(dP/dX*(1./Rho1 - 1./Rho2))):
DPDX = CLDSDX(L0P,I,XCYCZ)
TERM = DPDX*(1./F(L0DEN+I) - 1./F(L0DEND+I))
INTMAS= CMDTA*(F(L0R+I)-CMDTB)*CELMAS(I,2)*
1 (1.+ CMDTC*SQRT(ABS(TERM)))
ENDIF
C.... Interphase mass-transfer rate, is multiplied by the friction
C factor for EQUVEL=F (index passed through L0SCAL):
IF(.NOT.EQUVEL) INTMAS= INTMAS*F(L0SCAL+I)
END
c------------------------------------------------------------------
C
SUBROUTINE SLBIMS(IPILOPT,dbgloc)
INCLUDE 'farray'
INCLUDE 'grdloc'
INCLUDE 'satgrd'
INCLUDE 'satear'
INCLUDE 'grdear'
INCLUDE 'prpcmn'
COMMON/VMSCMN/FL1CON
1 /LRNTM1/L0WDIS,L0FMU,L0FONE,L0FTWO,L0REYN,L0REYT,L0UD1,
1 L0UD2,L0UD3,L0UD4
1 /LRNTM2/LBWDIS,LBFMU,LBFONE,LBFTWO,LBREYN,LBREYT,LBEPKE
C 1 /TSKEM/ GKTDKP,LBKP,LBKT,LBET,LBVOSQ,LBOMEG
COMMON/TSKEMI/ LBKP,LBKT,LBET,LBVOSQ,LBOMEG
1 /TSKEMR/ GKTDKP
1 /VELCMN/L0UVW(6),L0UVW2(6) /FLPCMN/IFILP(30)
1 /CELPAR/IPHASE,IPROP,IGRND,IFILEP,KPROP
COMMON/GENI/IGF1(2),NXNYST,NDIR,KDUMM,IGF2(4),NFM,IGF3(21),IPRL,
1 IBTAU,IGF4(16),ITEM1,ITEM2,ISPH1,ISPH2,ICON1,ICON2,
1 IPRPS,IRADX,IRADY,IRADZ,IVFOL
1 /F0/ IF01(29),L0XYDX,L0XYDY,IF02(3),L0XYRV,L0XYXG,IF03,
1 L0XYYG,IF04,L0XYDXG,L0XYDYG,IF05(68),KZXCY,IF05A(37),
1 L0AHZ,IF06(17),L0XYDZ,L0XYDZG,IF07(137)
COMMON/NAMFN/NAMFUN,NAMSUB
REAL INTMAS
LOGICAL DBGLOC,SLD,FL1CON,NEZ
CHARACTER*6 NAMFUN,NAMSUB
C
NAMSUB= 'SLBIMS'
if(flag.or.dbgloc) call banner(1,namsub,050918)
IGR= 10; ISC= 2
C.... Call GROUND for the user set property:
IF(IGRND==0) THEN
IF(USEGRD) THEN
if(dbgloc) then
call writ40('GROUND is called to set a property... ')
call writ2i('Group= ',igr,'Section=',isc)
endif
CALL GROUND
ENDIF
GO TO 800
ENDIF
C.... Set constants and other auxiliary variables:
IF(.NOT.EQUVEL) THEN
L0SCAL= L0F(LS12)
ELSE
IF(IGRND==-1) THEN
L0R1=L0F(R1); L0R2=L0F(R2)
ENDIF
ENDIF
C.... For a constant property go to the slab loop
IF(IGRND==-1) GO TO 700
L0R1=L0F(R1); L0R2=L0F(R2)
C-----------------------------------------------------------------------
L0R= L0R2
IF(IGRND==3) THEN
L0MIXF= L0F(LBMIXF)
ELSEIF(IGRND==6) THEN
L0DEN = L0F(DEN1); L0DEND= L0F(DEN2)
IF(SOLVE(1)) L0P=L0F(1)
ENDIF
IF(IGRND==5.OR.IGRND==6)THEN
IF(XCYCLE) XCYCZ=NEZ(F(KZXCY+IZ))
ENDIF
C-----------------------------------------------------------------------
C.... Loop over slab to get and set cell properties:
700 IGRND=IPILOPT
IF(IPRPS==0) THEN
C.... One material only
DO 60 I= 1,NXNYST
60 F(KPROP+I)= INTMAS(I)
ELSE
C.... exclude solids
DO 70 I= 1,NXNYST
IF(SLD(I)) THEN
F(KPROP+I)= TINY
ELSE
F(KPROP+I)= INTMAS(I)
ENDIF
70 CONTINUE
ENDIF
C----------------------------------------------------------------------
C.... Call GREX to correct a property set above
800 IF(USEGRX) CALL GREX3
C.... Call ALTPRP for an alternative property setting
IF(USEALT) CALL ALTPRP
C.... Call GROUND for the user to correct a property set above
IF(USEGRD) THEN
IF(IGRND>0) CALL GROUND
ENDIF
if(flag.or.dbgloc) call banner(2,'SLB2PH',0)
NAMSUB= 'SLB2PH'
END
c