戻る

C
PROGRAM MAIN
C ******************************************************************** C
C C
C Error Analysis Software C
C C
C for 1D - Convectin & Diffusion Equation C
C ＝＝ C
C ( for FDM_Implicit Method ) C
C C
C ( V.3.5 ) C
C C
C Copyright : Yasuhiro MATSUDA C
C C
C ******************************************************************** C
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMMON /CST/ PAI
COMMON /NUM/ NRX, NBX, NKX
COMMON /ABC/ RVX( 10), BVX( 10), KMX( 14)
C
C -------------------
C
CALL RDWT
C
C ------------------------------------------------
DO 100 IR = 1, NRX
C
RX = RVX( IR)
C
SGA = 0.D0
SGC = 0.D0
RMX = 0.D0
C
C --------------------------------------
DO 200 IBX = 1, NBX
C
BX = BVX( IBX)
C
C ------------------------------
DO 300 IKX = NKX, 1, -1
C
KX = KMX( IKX)
VAX = 2.D0* PAI / DFLOAT( KX)
C
C ----- FDM: Implicit Method ----------------------------------
C
CALL FD_FI ( P1, P2, P3, P4, RX, BX, VAX)
C
C -------------------一----------------------------------------
C
CALL CMPS ( P1, P2, P3, P4, RX, BX, VAX, SGA, SGC, RMX)
C
C -------------------------------------------------------------
C
300 CONTINUE
C ------------------------------
C
200 CONTINUE
C --------------------------------------
SGA = DSQRT( SGA/( DFLOAT( NBX)* DFLOAT( NKX)))
SGC = DSQRT( SGC/( DFLOAT( NBX)* DFLOAT( NKX)))
TVR = DSQRT( SGA* SGA + SGC* SGC )
C
WRITE(6,2000) RX, RMX, TVR
2000 FORMAT(' R =',F5.2,3X,' Gzai =',F9.6,3X,' Error =',F9.6)
C
100 CONTINUE
C ------------------------------------------------
C
STOP
END
C **********************************************************************
C
BLOCK DATA
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMMON /NUM/ NRX, NBX, NKX
COMMON /ABC/ RVX( 10), BVX( 10), KMX( 14)
C
C ----- Kx, Ky, Kz ---
C
DATA NKX / 14/
DATA KMX / -3, -4, -6, -8, - 10, - 20, -40, 3, 4, 6, 8, 10, 20,40/
C
C ----- rx, ry, rz ---
C
DATA NRX / 4/
DATA RVX / 0.D0, 0.1D0, 0.3D0, 1.D0, 0., 0., 0., 0., 0., 0./
C
C ----- bx, by, bz ---
C
DATA NBX / 7/
DATA BVX / 0.1D0, 0.2D0, 0.3D0, 0.4D0, 0.5D0, 0.6D0, 0.7D0, 0.,
1 0., 0.D0/
C
END
C ***********************************************************************
C
SUBROUTINE FD_FI ( P1, P2, P3, P4, RX, BX, VAX)
C
IMPLICIT REAL*8(A-H,O-Z)
C
RXF = - 0.5D0* BX* BX/ 3.D0
RYF = - 0.5D0* BX* BX/ 3.D0
RZF = - 0.5D0* BX* BX/ 3.D0
C
G = 1.D00
C
IF ( RX.GE.0.001) THEN
F = 1.D0 - 0.5D0* BX* BX/ RX
RXF = RX* F
G = 1.D00
END IF
C
S5 = 2.D0* RXF* ( 1.D0 - DCOS( VAX))
S6 = G* BX* DSIN( VAX)
C
P1 = 1.D0
P2 = 0.D0
P3 = 1.D0 + S5
P4 = S6
C
RETURN
END
C **********************************************************************
C
SUBROUTINE TTLE
C
WRITE(6,*) ' '
WRITE(6,*) 'C ************************************************* C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C Error Analysis Software for C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C 1-Dimensional Convection- Diffusion Equation C'
WRITE(6,*) 'C == C'
WRITE(6,*) 'C for FDM : Implicit Method C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C ( V.3.5 ) C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C Copyright 2011 : Yasuhiro MATSUDA C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C ************************************************* C'
C
RETURN
END
C **********************************************************************
C
SUBROUTINE CMPS ( P1, P2, P3, P4, RX, BX, VAX, SGA, SGC, RMX)
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMMON /CST/ PAI
C
AE = ( P1* P3 + P2* P4)/ ( P3* P3 + P4* P4)
BE = ( P2* P3 - P1* P4)/ ( P3* P3 + P4* P4)
C
AA = DSQRT( AE* AE + BE* BE)
C
IF ( DABS( BE).LT.0.00001D0 .AND. AE.GE.0.D0) TA = 0.D0
TA = DATAN2( BE, AE)
C
CC = ( TA + VAX* BX)
IF ( DABS( CC).GT.PAI) CC = 2.D0* PAI - DABS( CC)
CC = CC + 1.D0
C
VAL = VAX* BX
C ------------------
C
AP = DEXP( - VAX* VAX* RX)
AE = AP* DCOS( VAX* BX) - AE
BE = - AP* DSIN( VAX* BX) - BE
C
IF ( AA.GE.RMX) RMX = AA
SGA = SGA + ( AA - AP) * ( AA - AP)
SGC = SGC + ( CC - 1.D0)* ( CC - 1.D0)
C
RETURN
END
C **********************************************************************
C
SUBROUTINE RDWT
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMMON /CST/ PAI
COMMON /NUM/ NRX, NBX, NKX
COMMON /ABC/ RVX( 10), BVX( 10), KMX( 14)
C
C --------------------------------
C
CALL TTLE
C
C ----------------------------------
C
PAI = 3.14159 26535 89793 D0
C
C ----------------------------------
C
WRITE(6,2000) NRX, NBX, NKX
2000 FORMAT(/,2X,' * No.of Rx =',I2,3X,' No.of Bx =',I2,3X,
1 ' No.of Kx =',I3 )
WRITE(6,2100) ( RVX( I),I = 1, NRX)
2100 FORMAT(/3X,' RX = ',15( F6.3,2X))
WRITE(6,2200) ( BVX( I),I = 1, NBX)
2200 FORMAT(/3X,' BX = ',15( F6.3,2X))
WRITE(6,2300) ( KMX( I),I = 1, NKX)
2300 FORMAT(/2X,' Kx = ',16( I3,2X),/,16X,10( I3,2X))
WRITE(6,*) ' '
WRITE(6,*) ' *** FDM_Fully Implicit Method *** '
WRITE(6,*) ' '
C
RETURN
END
C ********************************************************************