c
.... 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