| 查看: 1152 | 回复: 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 |
回复此楼» 猜你喜欢
今年审到国自然15份，谈谈感受
已经有15人回复
-
国自然上会要求
已经有5人回复
-
面上本子正文33页，违规吗？会被低分嘛？
已经有7人回复
-
上海大学实验技术岗位非升即走
已经有8人回复
-
考博自荐
已经有6人回复
-
青C资助名额大幅增加！
已经有16人回复
-
重磅！青年科学基金项目（C类）资助增幅预计超过50%
已经有10人回复
-
我在等一个没有答案的答案
已经有3人回复
-
半夜喝咖啡
已经有5人回复
-
售SCI一区T0P文章，我:8.O.5.5.1.O.5.4,科目齐全,可+急
已经有4人回复
» 本主题相关价值贴推荐，对您同样有帮助:
- 正大天晴达沙替尼、伊马替尼火箭神速”之我见 转载
已经有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
30