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