cgximas.htm c c
.... File name .... GXIMAS.HTM ........ 040713
C#### JCL 04.07.13 move needed settings out of PRPADR into here      
C#### SCM 04.02.09 Split commons for REALs and INTEGERs
C#### JCL 22.03.06 add KD13 as IF0(304)
      REAL FUNCTION INTMAS(I)
C.... Interphase mass-transfer rate:
      INCLUDE '/phoenics/d_includ/farray'
      INCLUDE '/phoenics/d_includ/grdloc'
      INCLUDE '/phoenics/d_includ/satgrd'
      INCLUDE '/phoenics/d_includ/satear'
      INCLUDE '/phoenics/d_includ/grdear'
      INCLUDE '/phoenics/d_includ/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 '/phoenics/d_includ/farray'
      INCLUDE '/phoenics/d_includ/grdloc'
      INCLUDE '/phoenics/d_includ/satgrd'
      INCLUDE '/phoenics/d_includ/satear'
      INCLUDE '/phoenics/d_includ/grdear'
      INCLUDE '/phoenics/d_includ/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#### SCM 04.02.09 Split commons for REALs and INTEGERs
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
C#### JCL 05.07.13 add KZXCY
     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
      CHARACTER*6 NAMFUN,NAMSUB
C
      NAMSUB= 'SLBIMS'
      if(flag.or.dbgloc) call banner(1,namsub,040713)
      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)
C#### JCL 05.07.13 logic in INTMAS indicates that L0R1/2 are needed for EQUVEL=T
C####              not F. L0SCAL is only needed for EQUVEL=F        
      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
C#### JCL 04.07.13 move needed settings out of PRPADR into here      
C####      CALL PRPADR
      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