C=========================================================================
C INTEGRATE ADVECTION EQUATION BY EXPLICIT-FTCS METHOD
C dc/dt + u*dc/dx = 0
C INITIAL-CONDITION : c(x,0) = 0.
C BOUNDARY-CONDITION : c(0,t) = 1.
C=========================================================================
C------------------ MAIN PROGRAM -----------------------------------------
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
PARAMETER (MXNX=1000,MXNT=1000)
DOUBLE PRECISION C(0:MXNX,0:MXNT)
CHARACTER CHARTRIAL*2
CALL INPUT(XX,DX,NX,TT,DT,NT,U,SIGMA,CHARTRIAL)
CALL SOLVER(MXNX,MXNT,NX,NT,SIGMA,C)
CALL OUTPUT(MXNX,MXNT,XX,DX,NX,TT,DT,NT,U,SIGMA,C,CHARTRIAL)
STOP 'NORMAL TERMINATION'
END
C-------------------------------------------------------------------------
C------------------ SUB ROUTINE ------------------------------------------
SUBROUTINE INPUT(XX,DX,NX,TT,DT,NT,U,SIGMA,CHARTRIAL)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
CHARACTER CHARTRIAL*2
10 WRITE(*,*) 'Input simulation length XX and simulation time TT -->'
WRITE(*,*) 'Input simulation length XX'
READ(*,*) XX
WRITE(*,*) 'Input simulation time TT'
READ(*,*) TT
WRITE(*,*) ' '
WRITE(*,*) 'Input length increment DX and time increment DT -->'
WRITE(*,*) 'length increment DX'
READ(*,*) DX
WRITE(*,*) 'time increment DT'
READ(*,*) DT
WRITE(*,*) ' '
WRITE(*,*) 'Input advection velocity U -->'
WRITE(*,*) 'advection velocity U'
READ(*,*) U
WRITE(*,*) ' '
WRITE(*,*) 'Input 2 characters to append to filename -->'
WRITE(*,*) 'appendix to filename CHARACTER'
READ(*,'(A2)') CHARTRIAL
NX = INT(XX/DX)
NT = INT(TT/DT)
SIGMA = U*DT/DX
WRITE(*,*) ' '
WRITE(*,*) '========== INPUT PARAMETER ====================='
WRITE(*,'(A15,F10.4)') 'XX = ',XX
WRITE(*,'(A15,F10.4)') 'DX = ',DX
WRITE(*,'(A15,I10)') 'NX = ',NX
WRITE(*,'(A15,F10.4)') 'TT = ',TT
WRITE(*,'(A15,F10.4)') 'DT = ',DT
WRITE(*,'(A15,I10)') 'NT = ',NT
WRITE(*,'(A15,F10.4)') 'U = ',U
WRITE(*,'(A15,F10.4)') 'SIGMA = ',SIGMA
WRITE(*,'(A15,A2)') 'CHARACTER = ',CHARTRIAL
WRITE(*,*) '=================================================='
WRITE(*,*) ' '
WRITE(*,*) 'Is these parameters OK ? ----->'
WRITE(*,*) 'Yes --- enter 1, No --- enter 0'
READ(*,*) ID
IF(ID.EQ.0) GO TO 10
RETURN
END
SUBROUTINE SOLVER(MXNX,MXNT,NX,NT,SIGMA,C)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DOUBLE PRECISION C(0:MXNX,0:MXNT)
IF(NX.GT.MXNX) STOP 'NX > MXNX'
IF(NT.GT.MXNT) STOP 'NT > MXNT'
C---- RESET
DO N = 0,NT
DO J = 0,NX
C(N,J) = 0.
END DO
END DO
C---- ENTRY OF INITIAL-CONDITION AND BOUDARY-CONDITION
DO J = 0,NX
C(J,0) = 0.
END DO
DO N = 1,NT
C(0,N) = 1.
END DO
C---- COMPUTATION OF NUMERICAL SOLUTION BY EXPLICIT-FTCS METHOD
DO N = 0,NT-1
DO J = 1,NX-1
C(J,N+1) = C(J,N) - SIGMA*(C(J+1,N)-C(J-1,N))/2.
END DO
C(NX,N+1) = C(NX,N) - SIGMA*(C(NX,N)-C(NX-1,N))
END DO
RETURN
END
SUBROUTINE OUTPUT(MXNX,MXNT,XX,DX,NX,TT,DT,NT,U,SIGMA,C,CHARTRIAL)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DOUBLE PRECISION C(0:MXNX,0:MXNT)
CHARACTER CHARTRIAL*2,INPDATA*13,OUTDATA*14
INPDATA = './input'//CHARTRIAL//'.dat'
OUTDATA = './output'//CHARTRIAL//'.dat'
C---- OUTPUT OF INPUT-PARAMETER
OPEN(1,FILE=INPDATA,STATUS='REPLACE')
WRITE(1,'(A30,F10.4)') 'SIMULATION LENGTH = ',XX
WRITE(1,'(A30,F10.4)') 'LENGTH INCREMENT = ',DX
WRITE(1,'(A30,I10)') 'TOTAL STEPS FOR LENGTH = ',NX
WRITE(1,'(A30,F10.4)') 'SIMULATION TIME = ',TT
WRITE(1,'(A30,F10.4)') 'TIME INCREMENT = ',DT
WRITE(1,'(A30,I10)') 'TOTAL STEPS FOR TIME = ',NT
WRITE(1,'(A30,F10.4)') 'ADVECTION VELOCITY = ',U
WRITE(1,'(A30,F10.4)') 'NON-DIMENSIONAL PARAMETER = ',SIGMA
CLOSE(1)
C---- OUTPUT OF NUMERICAL SOLUTION
OPEN(2,FILE=OUTDATA,STATUS='REPLACE')
DO J = 0,NX
WRITE(2,'(2F20.8)') J*DX, C(J,NT)
END DO
CLOSE(2)
RETURN
END