CcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccCcccThiscomputerprogramwascopiedfromthegraduatestudentcourseprogramCcccoftheUniversityofMinnesota.Partofitwasre-formulatedtomeettheCcccpersonalcomputerenvironment.SomeinappropriateexpressionswerealsoCccccorrected.Theprogramisusedonlyforteachingpurpose.NopartofitCcccmaybepublished.Youmayuseitasaframetore-developyourowncodeCcccforresearchpurpose.XJTUInstructor,1995.11*****************************************************************************----------------------------MAINPROGRAM-----------------------------------****************************************************************************LOGICALLSTOPCOMMON/CNTL/LSTOP****************************************************************************OPEN(08,FILE='teresul'CALLSETUP0CALLGRIDCALLSETUP1CALLSTART10CALLDENSECALLBOUNDCALLOUTPUTIF(.NOT.LSTOPGOTO15CLOSE(08STOP15CALLSETUP2GOTO10END*---------------------------------------------------------------------------SUBROUTINEDIFLOW****************************************************************************COMMON/COEF/FLOW,DIFF,ACOF****************************************************************************ACOF=DIFFIF(FLOW.EQ.0.0RETURNTEMP=DIFF-ABS(FLOW*0.1ACOF=0.IF(TEMP.LE.0.RETURNTEMP=TEMP/DIFFACOF=DIFF*TEMP**5RETURNEND*--------------------------------------------------------------------------SUBROUTINESOLVE****************************************************************************DOUBLEPRECISIONTITLELOGICALLSOLVE,LPRINT,LBLK,LSTOPCOMMONF(22,22,10,P(22,22,RHO(22,22,GAM(22,22,CON(22,22,&AIP(22,22,AIM(22,22,AJP(22,22,AJM(22,22,AP(22,22,&X(22,XU(22,XDIF(22,XCV(22,XCVS(22,&Y(22,YV(22,YDIF(22,YCV(22,YCVS(22,&YCVR(22,YCVRS(22,ARX(22,ARXJ(22,ARXJP(22,&R(22,RMN(22,SX(22,SXMN(22,XCVI(22,XCVIP(22COMMONDU(22,22,DV(22,22,FV(22,FVP(22,&FX(22,FXM(22,FY(22,FYM(22,PT(22,QT(22COMMON/INDX/NF,NFMAX,NP,NRHO,NGAM,L1,L2,L3,M1,M2,M3,&IST,JST,ITER,LAST,TITLE(13,RELAX(13,TIME,DT,XL,YL,&IPREF,JPREF,LSOLVE(10,LPRINT(13,LBLK(10,MODE,NTIMES(10,RHOCON****************************************************************************ISTF=IST-1JSTF=JST-1IT1=L2+ISTIT2=L3+ISTJT1=M2+JSTJT2=M3+JST****************************************************************************DO999NT=1,NTIMES(NFDO999N=NF,NF*---------------------------------------------------------------------------IF(.NOT.LBLK(NFGOTO10PT(ISTF=0.QT(ISTF=0.DO11I=IST,L2BL=0.BLP=0.BLM=0.BLC=0.DO12J=JST,M2BL=BL+AP(I,JIF(J.NE.M2BL=BL-AJP(I,JIF(J.NE.JSTBL=BL-AJM(I,JBLP=BLP+AIP(I,JBLM=BLM+AIM(I,JBLC=BLC+CON(I,J+AIP(I,J*F(I+1,J,N+AIM(I,J*F(I-1,J,N&+AJP(I,J*F(I,J+1,N+AJM(I,J*F(I,J-1,N-AP(I,J*F(I,J,N12CONTINUEDENOM=BL-PT(I-1*BLMDENO=1.E15IF(ABS(DENOM/BL.LT.1.E-10DENOM=1.E20*DENOQT(I=(BLC+BLM*QT(I-1/DENOM11CONTINUEBL=0.DO13II=IST,L2I=IT1-IIBL=BL*PT(I+QT(IDO13J=JST,M213F(I,J,N=F(I,J,N+BL*---------------------------------------------------------------------------PT(JSTF=0.QT(JSTF=0.DO21J=JST,M2BL=0.BLP=0.BLM=0.BLC=0.DO22I=IST,L2BL=BL+AP(I,JIF(I.NE.L2BL=BL-AIP(I,JIF(I.NE.ISTBL=BL-AIM(I,JBLP=BLP+AJP(I,JBLM=BLM+AJM(I,JBLC=BLC+CON(I,J+AIP(I,J*F(I+1,J,N+AIM(I,J*F(I-1,J,N&+AJP(I,J*F(I,J+1,N+AJM(I,J*F(I,J-1,N-AP(I,J*F(I,J,N22CONTINUEDENOM=BL-PT(J-1*BLMIF(ABS(DENOM/BL.LT.1E-10DENOM=1.E20*DENOPT(J=BLP/DENOMQT(J=(BLC+BLM*QT(J-1/DENOM21CONTINUEBL=0.DO23JJ=JST,M2J=JT1-JJBL=BL*PT(J+QT(JDO23I=IST,L223F(I,J,N=F(I,...
