مهندسی آلودگی هوا

کد فرترن انتقال حرارت سه بعدی

این کدی که نوشتم انتقال حرارت در یک مکعب رو نشون میده. کافیه این کد رو تو فرترن کپی کرده و اجرا کنید. خروجی ها رو میتونید تو تک پلات بصورت انیمیشن نشون بدید. این کدها همگی ترم دیفیوز هستند و ترم کانوکشن رو در پستهای بعدی میزارم.

 

 

MODULE C
IMPLICIT NONE
REAL, ALLOCATABLE::X(:),Y(:),Z(:),TEMP(:,:,:,:)
REAL::L,H,TOTAL,DX,DY,DT,ALPHA,TOLEZ,DZ
CHARACTER(4)::KK
INTEGER::I,J,K,P,M,N,NSTEP,NZ
END MODULE

PROGRAM TEMPER
USE C
IMPLICIT NONE
WRITE(*,*) 'PLESE ENTER L,N,H,M,TOTAL,NSTEP,ALPHA,TOLEZ,NZ'
READ(*,*) L,N,H,M,TOTAL,NSTEP,ALPHA,TOLEZ,NZ
ALLOCATE(X(N),Y(M),Z(NZ),TEMP(N,M,NZ,NSTEP))
CALL MESH
CALL INI
CALL BOUND
CALL TEM
CALL PLOT
END PROGRAM

SUBROUTINE MESH ()
USE C
IMPLICIT NONE
DX=L/(N-1)
DY=H/(M-1)
DZ=TOLEZ/(NZ-1)
DT=TOTAL/NSTEP
IF (ALPHA*DT/(DX*DY*DZ)>0.5) WRITE(*,*) 'INSTABILITY ERROR'
DO I=1,N
X(I)=(I-1)*DX
END DO
DO J=1,M
Y(J)=(J-1)*DY
END DO
DO K=1,NZ
Z(K)=(K-1)*DZ
END DO
END SUBROUTINE

SUBROUTINE BOUND()
USE C
IMPLICIT NONE
DO P=1,NSTEP
DO K=1,NZ
DO J=1,M
TEMP(1,J,K,P)=100
TEMP(N,J,K,P)=100
END DO
END DO
END DO
DO P=1,NSTEP
DO K=1,NZ
DO I=1,N
TEMP(I,1,K,P)=100
TEMP(I,M,K,P)=100
END DO
END DO
END DO
DO P=1,NSTEP
DO I=1,N
DO J=1,M
TEMP(I,J,1,P)=100
TEMP(I,J,NZ,P)=100
END DO
END DO
END DO
END SUBROUTINE

SUBROUTINE INI()
USE C
IMPLICIT NONE
DO K=2,NZ-1
DO J=2,M-1
DO I=2,N-1
TEMP(I,J,K,1)=0
END DO
END DO
END DO
END SUBROUTINE

SUBROUTINE TEM()
USE C
IMPLICIT NONE
DO P=1,NSTEP-1
DO J=2,M-1
DO I=2,N-1
DO K=2,NZ-1
TEMP(I,J,K,P+1)=(ALPHA*DT/(DX**2))*(TEMP(I+1,J,K,P)+TEMP(I-1,J,K,P))+(ALPHA*DT/(DY**2))*(TEMP(I,J+1,K,P)+TEMP(I,J-1,K,P))+(ALPHA*DT/(DZ**2))*(TEMP(I,J,K+1,P)+TEMP(I,J,K-1,P))+(1-(2*ALPHA*DT*((1/DX**2)+(1/DZ**2)+(1/DY**2))))*TEMP(I,J,K,P)
END DO
END DO
END DO
END DO
END SUBROUTINE

SUBROUTINE PLOT()
USE C
IMPLICIT NONE
DO P=1,NSTEP-1
WRITE(KK,1) 1000+K
1 FORMAT (I4)
OPEN(2,FILE="TEMP" //TRIM(KK)//".PLT")
WRITE(2,*) "VARIABLES= X,Y,Z,TEMP ZONE I=" , N ,"J=" , M, "K=" , NZ
DO K=1,NZ
DO J=1,M
DO I=1,N
WRITE(2,*) X(I),Y(J),Z(K),TEMP(I,J,K,P)
END DO
END DO
END DO
END DO
END SUBROUTINE

   + مصطفی کلهر ; ۱۱:٤۸ ‎ب.ظ ; یکشنبه ٢٠ اسفند ۱۳٩۱
comment نظرات ()