| 查看: 1090 | 回复: 4 | ||
[求助]
有人能把这个程序运行下吗？或者给我解释下 已有1人参与
|
|
!############################################################# MODULE PARAM !############################################################# INTEGER,PARAMETER :: REAL_P = SELECTED_REAL_KIND(P=8,R=25) INTEGER,PARAMETER :: NMAX=42 INTEGER,PARAMETER :: TMAX=200 INTEGER,PARAMETER :: RMAX=5 INTEGER,PARAMETER :: MMAX=5 END MODULE PARAM !############################################################# MODULE VAR !############################################################# USE PARAM IMPLICIT NONE REAL(REAL_P), DIMENSION(NMAX) :: X,XC,R REAL(REAL_P), DIMENSION(NMAX) :: DEN REAL(REAL_P), DIMENSION(NMAX) :: CON REAL(REAL_P), DIMENSION(NMAX) :: CP REAL(REAL_P), DIMENSION(NMAX) :: T,TO,TOO,Z,ZO,ZOO REAL(REAL_P), DIMENSION(RMAX) :: KK REAL(REAL_P), DIMENSION(NMAX) :: AP,SU,AE,AW REAL(REAL_P), DIMENSION(NMAX) :: BPR,V REAL(REAL_P) :: Q1,QN REAL(REAL_P) :: TIN,DT,DTR,TIME,ERR,SOR INTEGER :: NTMAX,NI,NIM,NR,LMAX,NM INTEGER :: IK(MMAX) REAL(REAL_P) :: Y(MMAX,RMAX) END MODULE VAR !############################################################# SUBROUTINE GRID !############################################################# USE VAR IMPLICIT NONE INTEGER :: I,N REAL(REAL_P) :: EXP,DX,XMIN,XMAX OPEN(1,FILE='1dinv.inp') PRINT *,' ENTER: XMIN, XMAX, EXP. FACTOR, NUMBER OF NODES: ' READ(1,*) XMIN,XMAX,EXP,N NIM = N+1 NI = N+2 IF(EXP.EQ.1.) THEN DX=(XMAX-XMIN)/REAL(N) ELSE DX=(XMAX-XMIN)*(1.-EXP)/(1.-EXP**N) ENDIF ! X(1)=XMIN DO I=2,NIM X(I)=X(I-1)+DX DX=DX*EXP END DO X(NI)=XMAX XC(1)=XMIN DO I=2,NIM XC(I)=0.5*(X(I-1)+X(I)) END DO XC(NI)=XMAX ! R = X R = 1. END SUBROUTINE GRID !############################################################# SUBROUTINE CALCPRO !############################################################# USE PARAM USE VAR IMPLICIT NONE CP = 1. CON = 1 DEN = 1. END SUBROUTINE CALCPRO !############################################################# SUBROUTINE COEF1 !############################################################# USE PARAM USE VAR IMPLICIT NONE INTEGER I REAL(REAL_P) :: FAC,COND,APT,VOL,URF AP =0. ! !.....CALCULATE FLUXES THROUGH INNER CV-FACES:EAST ! DO I=2,NIM-1 FAC = (X(I)-XC(I))/(XC(I+1)-XC(I)) COND = FAC*CON(I+1)+(1.-FAC)*CON(I) AE(I) = -COND*R(I)/(XC(I+1)-XC(I)) AW(I+1) = AE(I) END DO ! !.....TIME DISCRETIZATION -> EULER IMPLICIT ! DO I=2,NIM VOL=0.5*(R(I)+R(I-1))*(X(I)-X(I-1)) APT=DEN(I)*CP(I)*VOL*DTR AP(I)=AP(I)+APT END DO ! !.....FINAL COEFFICIENT AND SOURCE MATRIX FOR FI-EQUATION ! DO I=1,NIM AP(I)=AP(I)-AE(I)-AW(I) END DO ! END SUBROUTINE COEF1 !############################################################# SUBROUTINE COEF2(FIO) !############################################################# USE PARAM USE VAR IMPLICIT NONE INTEGER I REAL(REAL_P) :: APT,VOL REAL(REAL_P),DIMENSION(NMAX):: FIO SU =0. ! !.....TIME DISCRETIZATION -> EULER IMPLICIT ! DO I=2,NIM VOL=0.5*(R(I)+R(I-1))*(X(I)-X(I-1)) APT=DEN(I)*CP(I)*VOL*DTR SU(I)=SU(I)+APT*FIO(I) END DO END SUBROUTINE COEF2 ! !############################################################# SUBROUTINE BC(FI1,FIN) !############################################################# USE PARAM USE VAR IMPLICIT NONE INTEGER I REAL(REAL_P) FI1,FIN ! !.....BOUNDARY CONDITION FOR TEMP ! I = 2 SU(I) = SU(I) + FI1*R(I-1) I = NIM SU(I) = SU(I) + FIN*R(I) ! END SUBROUTINE BC ! !############################################################# SUBROUTINE BCPOST(FI,FI1,FIN) !############################################################# USE PARAM USE VAR IMPLICIT NONE INTEGER I,IB REAL(REAL_P) DN,FI1,FIN REAL(REAL_P),DIMENSION(NMAX)::FI I =2 IB=I-1 DN=XC(I)-XC(IB) FI(IB)=FI(I)+FI1*DN/CON(IB) I =NIM IB=I+1 DN=XC(IB)-XC(I) FI(IB)=FI(I)+FIN*DN/CON(IB) END SUBROUTINE BCPOST !######################################################## PROGRAM ONEDINV !######################################################## ! This program solves the unsteady one-dimensional ! convection-diffusion equation with Dirichlet boundary ! conditions on both ends. Initial solution is zero ! field, boundary conditions are time-independent; the ! transition from initial to steady solution is ! simulated using different time integration schemes. ! ! 1995 M. Peric, Institut fuer Schiffbau !######################################################## ! USE PARAM USE VAR IMPLICIT NONE CHARACTER PNAME*20,FILIN*20,FILOUT*20 INTEGER :: IT,I,LS REAL(REAL_P) :: S1,S2,DQ ! !.....READ FILE NAMES AND OPEN FILES ! PRINT *,' ENTER PROBLEM NAME' READ(*,'(A5)') PNAME WRITE(FILIN, '(A5,4H.inp)') PNAME WRITE(FILOUT,'(A5,4H.dat)') PNAME OPEN (UNIT=1,FILE=FILIN) OPEN (UNIT=2,FILE=FILOUT) REWIND 1 REWIND 2 ! !.....READ GRID DATA, CALCULATE NODE COORDINATES ! CALL GRID ! !.....READ INIT TEMPERATURE AND MEASURED LOCATION ! PRINT *,' ENTER : TIME INTERVAL,TIME STEPS,NO. OF FUTURES,NO. OF INERS,NO. OF MEASURED LCOATION' READ(1,*) DT,NTMAX,NR,LMAX,NM PRINT *,' READ : MEASURED LCOATIONS' READ(1,*) (IK(I),I=1,NM) PRINT *,' READ : INIT TEMPERATURE' ! READ(1,*) (Y(1,I),I=1,NR) TIN = Y(1,1) ! CALL INIT ! !.....START TIME LOOP (BETA = 0. FOR THE FIRST STEP & 3 LEVEL SCHEME) ! TIME=0. DTR=1./DT ! CALL TOUT(IT) DO IT=1,NTMAX TIME=TIME+DT ! DO I=1,NR-1 Y(1,I) = Y(1,I+1) END DO IF(IT<NTMAX) READ(1,*) Y(1,NR) ! !.....SHIFT SOLUTIONS TO OLDER LEVELS ! TO = T ZO = 0. Q1 = 0. ! !.....PHYP ! CALL CALCPRO CALL COEF1 CALL TDMA1 IF((NTMAX-IT+1)<NR) THEN NR =NTMAX-IT+1 END IF DO LS=1,LMAX IF(LS==1) THEN S2 = 0. Z =ZO END IF S1 = 0. T =TO ! DO I=1,NR ! TOO = T CALL COEF2(TOO) CALL BC(Q1,QN) CALL TDMA2(T) CALL BCPOST(T,Q1,QN) ! IF(LS==1) THEN ZOO = Z CALL COEF2(ZOO) CALL BC(1._REAL_P,0._REAL_P) CALL TDMA2(Z) CALL BCPOST(Z,1._REAL_P,0._REAL_P) KK(I) = Z(IK(1)) S2 = S2 + KK(I)*KK(I) END IF ! S1 = S1 + (Y(1,I)-T(IK(1)))*KK(I) END DO DQ = S1/S2 Q1 = Q1 + DQ ERR=ABS(DQ/Q1) WRITE(*,'(I10,I10,E10.3)') IT,LS,ERR IF(ERR<1.e-10) THEN CALL COEF2(TO) CALL BC(Q1,QN) CALL TDMA2(T) CALL BCPOST(T,Q1,QN) CALL TOUT(IT) EXIT END IF END DO END DO CLOSE(1) CLOSE(2) END PROGRAM ONEDINV SUBROUTINE INIT USE PARAM USE VAR IMPLICIT NONE ! !.....INITIALIZE SOLUTION, SET BOUNDARY VALUES ! T = TIN Z = 0. QN =0. ! END SUBROUTINE INIT ! SUBROUTINE TOUT(IT) USE PARAM USE VAR IMPLICIT NONE INTEGER IT ! !.....INITIALIZE SOLUTION, SET BOUNDARY VALUES ! WRITE(2,'(6E15.3)') TIME,T(1),Q1,T(NI),Y(1,1),Z(IK(1)) ! END SUBROUTINE TOUT !############################################################# SUBROUTINE TDMA1 !############################################################# ! INITIAL VALUES OF VARIABLES BPR(I) AND V(I) ASSUMED ZERO! ! USE PARAM USE VAR IMPLICIT NONE INTEGER I ! !.....CALCULATE 1./U_P (BPR) ! BPR(1) = 0. DO I=2,NIM BPR(I)=1./(AP(I)-AW(I)*AE(I-1)*BPR(I-1)) END DO ! END SUBROUTINE TDMA1 !############################################################# SUBROUTINE TDMA2(FI) !############################################################# USE PARAM USE VAR IMPLICIT NONE REAL(REAL_P),DIMENSION(NMAX)::FI INTEGER ::I ! !.....CALCULATE MODIFIED SOURCE TERM (V) ! V(1) = 0. DO I=2,NIM V(I)=SU(I)-AW(I)*V(I-1)*BPR(I-1) END DO ! !.....CALCULATE VARIABLE VALUES - BACKWARD SUBSTITUTION ! DO I=NIM,2,-1 FI(I)=(V(I)-AE(I)*FI(I+1))*BPR(I) END DO RETURN END SUBROUTINE TDMA2 |
回复此楼» 猜你喜欢
材料考研调剂
已经有3人回复
-
材料调剂
已经有12人回复
-
英一数一408，总分284，二战真诚求调剂
已经有14人回复
-
085410 一志愿211 22408分数359求调剂
已经有4人回复
-
271求调剂
已经有19人回复
-
385分 生物学（071000）求调剂
已经有3人回复
-
一志愿安徽大学计算机科学与技术学硕，331分求调剂
已经有3人回复
-
318求调剂，计算材料方向
已经有8人回复
-
291求调剂
已经有25人回复
-
一志愿北京科技大学085601材料工程英一数二初试总分335求调剂
已经有6人回复
» 本主题相关价值贴推荐，对您同样有帮助:
- 正大天晴达沙替尼、伊马替尼火箭神速”之我见 转载
已经有43人回复
- 假如女人是一种编程语言
已经有7人回复
- 【转帖】让人难以相信的中国药品说明书---药审的秘密
已经有18人回复
- 【整理】《提问的智慧》——献给那些不会提问的人
已经有78人回复
- 【转载】10个保持注意力的技巧(转)（中文版）
已经有7人回复
wxws.2008
木虫 (正式写手)
- 应助: 5 (幼儿园)
- 金币: 5015.5
- 散金: 256
- 红花: 9
- 帖子: 354
- 在线: 147.9小时
- 虫号: 639701
- 注册: 2008-10-29
- 性别: GG
- 专业: 荒漠化与水土保持
2楼2015-12-14 14:04:53
3楼2015-12-14 14:42:38
seanbsd
木虫 (小有名气)
- 应助: 8 (幼儿园)
- 金币: 3652.1
- 红花: 1
- 帖子: 207
- 在线: 45.6小时
- 虫号: 3744514
- 注册: 2015-03-17
- 专业: 电气科学与工程
4楼2015-12-14 15:40:42
5楼2015-12-14 20:20:40
