C.... File name .... GXVIRMS.HTM ... 040713
FUNCTION VIRMSCO(I)
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.... Coefficient which appears in the virtual mass forces of the phase
c momentum equations when ONEPHS=F:
IF(IGRND==-1) THEN
VIRMSCO=PRPRTY
ELSEIF(IGRND==1) THEN
C.... Selects Cvm= Const*Rc, where Rc is the volume fraction of the
C continuous phase:
VIRMSCO= CVMAG*F(L0R+I)
ELSEIF(IGRND==2) THEN
C.... Selects Cvm= Const*[1-2.78*min(0.2,Rd)], where Rd is the volume
C fraction of the dispersed phase:
VIRMSCO= CVMAG*(1.0 - 2.78*AMIN1(0.2,F(L0RD+I)))
ENDIF
END
c-----------------------------------------------------------------------
SUBROUTINE SLBVRM(IPILOPT,dbgloc)
INCLUDE 'farray'
INCLUDE 'grdloc'
INCLUDE 'satgrd'
INCLUDE 'satear'
INCLUDE 'grdear'
INCLUDE 'prpcmn'
COMMON /VMSCMN/FL1CON /FLPCMN/IFILP(30)
COMMON /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
COMMON/NAMFN/NAMFUN,NAMSUB
LOGICAL dbgloc,SLD,FL1CON
CHARACTER*6 NAMFUN,NAMSUB
C
NAMSUB= 'SLBVRM'
if(flag.or.dbgloc) call banner(1,'namsub',040713)
IGR= 10; ISC= IPROP-20
C.... Call GROUND for the user set property:
IF(IGRND==0) THEN
IF(USEGRD) THEN
CALL GROUND
ENDIF
GO TO 800
ENDIF
IF(IGRND==-1) GO TO 700
C.... Set constants and other auxiliary variables:
c
C-----------------------------------------------------------------------
C.... Coefficient which appears in the virtual mass forces of the phase
C momentum equations when ONEPHS=F. The default is that phase 1 is
C the continuous phase (FL1CON=T), unless the user sets CVM to a
C negative value, in which case phase 2 is taken as the continuous
C phase.
cccc CONST(1)= CVMA
IF(FL1CON) THEN
L0R = L0F(R1); L0RD= L0F(R2)
ELSE
L0R = L0F(R2); L0RD= L0F(R1)
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)= VIRMSCO(I)
ELSE
C.... exclude solids
DO 70 I= 1,NXNYST
IF(SLD(I)) THEN
F(KPROP+I) = TINY
ELSE
F(KPROP+I) = VIRMSCO(I)
ENDIF
70 CONTINUE
ENDIF
C----------------------------------------------------------------------
C.... Corrections, debug print-out, and other property adjustments:
C.... Call GREX to correct a property set above:
800 IF(USEGRX) THEN
CALL GREX3
ENDIF
C.... Call ALTPRP for an alternative property setting
IF(USEALT) THEN
CALL ALTPRP
ENDIF
C.... Call GROUND for the user to correct a property set above
IF(USEGRD) THEN
IF(IGRND>0) THEN
CALL GROUND
ENDIF
ENDIF
NAMSUB= 'slbvms'
if(flag.or.dbgloc) call banner(2,namsub,0)
END
c