c *****************************************************************
SUBROUTINE BALANS
c *****************************************************************
IMPLICIT REAL*8 (A-H,O-Z),INTEGER*4 (I-N)
COMMON/CELL/ ROCELL(2001,2001),UCELL(2001,2001),VCELL(2001,2001),
& ETCELL(2001,2001),EICELL(2001,2001)
COMMON/GX/UX(2001,2001),VX(2001,2001),ROX(2001,2001),PX(2001,2001)
COMMON/GY/UY(2001,2001),VY(2001,2001),ROY(2001,2001),PY(2001,2001)
COMMON/XY/X(2001),Y(2001)
COMMON/D1X/PN(2001),UN(2001),RON(2001),VN(2001)
COMMON/FLUXES/FLUX1_X(2001,2001),FLUX1_Y(2001,2001)
& ,FLUX2_X(2001,2001),FLUX2_Y(2001,2001)
& ,FLUX3_X(2001,2001),FLUX3_Y(2001,2001)
& ,FLUX4_X(2001,2001),FLUX4_Y(2001,2001)
COMMON/BAL/NX,NY,CFL,EPS,GAM,DT
c *****************************************************************
DO 1 I=1,NX
DO 1 J=1,NY-1
c -------------------------------------------
UR=UX(I,J)
VR=VX(I,J)
PR=PX(I,J)
ROR=ROX(I,J)
EIR=PR/(ROR*(GAM-1))
ETROR=(EIR+0.5*UR*UR+0.5*VR*VR)*ROR
c -------------------------------------------------
FLUX1_X(I,J)=UR*ROR
FLUX2_X(I,J)=PR+ROR*UR*UR
FLUX3_X(I,J)=ROR*VR*UR
FLUX4_X(I,J)=PR*UR+ETROR*UR
c -----------------------------------------------------------------
1 CONTINUE
DO 2 I=1,NX-1
DO 2 J=1,NY
c ------------------------------------------------
UT=UY(I,J)
VT=VY(I,J)
PT=PY(I,J)
ROT=ROY(I,J)
EIT=PT/(ROT*(GAM-1))
ETROT=(EIT+0.5*UT*UT+0.5*VT*VT)*ROT
! -------------------------------------------------
FLUX1_Y(I,J)=VT*ROT
FLUX2_Y(I,J)=ROT*UT*VT
FLUX3_Y(I,J)=PT+ROT*VT*VT
FLUX4_Y(I,J)=PT*VT+ETROT*VT
! -----------------------------------------------------------------
2 CONTINUE
mbc = 2
DO 3 I=1+mbc,NX-mbc
DO 3 J=1+mbc,NY-mbc
ROC=ROCELL(I,J)
UC=UCELL(I,J)
VC=VCELL(I,J)
ETC=ETCELL(I,J)
EIC=EICELL(I,J)
! -------------------------------------------------
HX=X(I+1)-X(I)
HY=Y(J+1)-Y(J)
! -------------------------------------------------
AX=(FLUX1_X(I+1,J)-FLUX1_X(I,J))/HX
AY=(FLUX1_Y(I,J+1)-FLUX1_Y(I,J))/HY
ROCW=ROC-0.5*DT*(AX+AY)
ROCELL(I,J)=ROCW
AX=(FLUX2_X(I+1,J)-FLUX2_X(I,J))/HX
AY=(FLUX2_Y(I,J+1)-FLUX2_Y(I,J))/HY
UROW=UC*ROC-0.5*DT*(AX+AY)
UCELL(I,J)=UROW/ROCW
AX=(FLUX3_X(I+1,J)-FLUX3_X(I,J))/HX
AY=(FLUX3_Y(I,J+1)-FLUX3_Y(I,J))/HY
VROW=VC*ROC-0.5*DT*(AX+AY)
VCELL(I,J)=VROW/ROCW
AX=(FLUX4_X(I+1,J)-FLUX4_X(I,J))/HX
AY=(FLUX4_Y(I,J+1)-FLUX4_Y(I,J))/HY
ETCRO=ETC*ROC-0.5*DT*(AX+AY)
ETCELL(I,J)=ETCRO/ROCW
EN=ETCELL(I,J)-0.5*UCELL(I,J)**2-0.5*VCELL(I,J)**2
EICELL(I,J)=EN
IF(EN.LT.EPS) EICELL(I,J)=EPS
IF(ROCW.LT.EPS) ROCELL(I,J)=EPS
SMU=DSQRT(GAM*(GAM-1)*EN) +DABS(UCELL(I,J))
SMV=DSQRT(GAM*(GAM-1)*EN) +DABS(VCELL(I,J))
CFLLOCAL=MAX(SMU*DT/HX,SMV*DT/HY)
CFL=MAX(CFL,CFLLOCAL)
! -----------------------------------------------------------------
3 CONTINUE
RETURN
END