戻る


C PROGRAM MAIN
C ******************************************************************** C
C C
C Error Analysis Software C
C C
C for 3D - Diffusion Equation C
C C
C ( In case of Finite Difference Methods ) C
C C
C ( V.3.0 ) 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 /MTV/ NMT( 3)
CHARACTER*10 NMT
COMMON /NUM/ MTS, NRX, NRY, NRZ, NKX, NKY, NKZ, NKXYZ
COMMON /ABC/ RVX( 10), RVY( 10), RVZ( 10), KMX( 14), KMY( 14),
1 KMZ( 14)
C

C
CALL DATAW
C
C ----------------------------------------------------------
DO 100 I = 1, MTS
C
WRITE(6,2000) NMT( I)
2000 FORMAT(/' * Method =',1X,A10,1X/)
C
C ------------------------------------------------
DO 200 IR = 1, NRX
C
RX = RVX( IR)
RY = RVY( IR)
RZ = RVZ( IR)
C
SGA = 0.D0
SGC = 0.D0
RMX = 0.D0
C
C ---------------------------------
DO 300 IKX = NKX, 1, -1
C
KX = KMX( IKX)
VAX = 2.D0* PAI/ DFLOAT( KX)
C
C ---------------------------------
DO 300 IKY = NKY, 1, -1
C
KY = KMY( IKY)
VAY = 2.D0* PAI/ DFLOAT( KY)
C
C ---------------------------------
DO 300 IKZ = NKZ, 1, -1
C
KZ = KMZ( IKZ)
VAZ = 2.D0* PAI/ DFLOAT( KZ)
C
C ------------------
C
CALL SMTD ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY, VAZ, I )
C
C ------------------
C
CALL CPER ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY, VAZ,
1 A, C, BA, BC, TS, SGA, SGC, RMX )
C
300 CONTINUE
C ---------------------------------
C
CALL RSLT ( RX, RMX, SGA, SGC )
C
200 CONTINUE
C -----------------------------------------------
C
100 CONTINUE
C ----------------------------------------------------------
C
STOP
END
C **********************************************************************
C
BLOCK DATA
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMMON /CST/ PAI
COMMON /MTV/ NMT( 3)
CHARACTER*10 NMT
COMMON /NUM/ MTS, NRX, NRY, NRZ, NKX, NKY, NKZ, NKXYZ
COMMON /ABC/ RVX( 10), RVY( 10), RVZ( 10), KMX( 14), KMY( 14),
1 KMZ( 14)
C
DATA PAI / 3.14159 26535 89793 D0 /
C
C ----- Test for DIF3D-FDMs-EA --------------
C
DATA NMT/ 'FDM_Exp_C','FDM_Imp-C1','FDM_Imp-C2' /
C -------------------------------------------
C
DATA NKX, NKY, NKZ / 14, 14, 14/
DATA KMX / -3, -4, -6, -8, - 10, - 20, -40, 3, 4, 6, 8, 10,20,40/
DATA KMY / -3, -4, -6, -8, - 10, - 20, -40, 3, 4, 6, 8, 10,20,40/
DATA KMZ / -3, -4, -6, -8, - 10, - 20, -40, 3, 4, 6, 8, 10,20,40/
C
DATA MTS / 3 /
C
DATA NRX, NRY, NRZ / 6, 6, 6/
DATA RVX / 0.01, 0.02, 0.04, 0.1, 0.2, 0.3, 0., 0., 0., 0./
DATA RVY / 0.01, 0.02, 0.04, 0.1, 0.2, 0.3, 0., 0., 0., 0./
DATA RVZ / 0.01, 0.02, 0.04, 0.1, 0.2, 0.3, 0., 0., 0., 0./
C
END
C **********************************************************************
C
SUBROUTINE RSLT ( RX, RMX, SGA, SGC )
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMMON /NUM/ MTS, NRX, NRY, NRZ, NKX, NKY, NKZ, NKXYZ
C
SGA = DSQRT( SGA / DFLOAT( NKXYZ))
SGC = DSQRT( SGC / DFLOAT( NKXYZ))
C
ETV = DSQRT( SGA* SGA + SGC* SGC)
C
WRITE(6,2100) RX, RMX, ETV
2100 FORMAT(' R =',F5.2,3X,'GZAI =',F9.6,3X,' * Et =',F9.6 )
C
RETURN
END
C *********************************************************************
C
SUBROUTINE TTLE
C
WRITE(6,*) ' '
WRITE(6,*) '*****************************************************'
WRITE(6,*) 'C C'
WRITE(6,*) 'C Error Analysis Software for C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C 3-Dimensional Convection-Diffusion Equation C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C For Finite Difference Methods C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C ( V.3.0 ) C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C Copyright 2011 : Yasuhiro MATSUDA C'
WRITE(6,*) 'C C'
WRITE(6,*) '*****************************************************'
C
RETURN
END
C **********************************************************************
C
SUBROUTINE CPER ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY,
1 VAZ, AA, CC, BA, BC, TS, 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 )
IF ( DABS( CC).GT.PAI ) CC = 2.D0* PAI - DABS( CC)
CC = CC + 1.D0
C
VAL = 0.D0
C
AP = DEXP( - VAX* VAX* RX - VAY* VAY* RY - VAZ* VAZ* RZ )
C
AE = AP - AE
BE = - BE
C
BA = DSQRT( ( AA - AP)* ( AA - AP))
BC = DSQRT( ( CC - 1.D0)* ( CC - 1.D0))
C
TS = DSQRT( BA* BA + BC* BC)
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 IMPL2 ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY, VAZ )
C
C ----- With Correction --- CRNSN : RBWIS ---
C
IMPLICIT REAL*8(A-H,O-Z)
C
C ---------------------------------
F1( X ) = 1.D0 - DCOS( X )
F3( X ) = DSIN( X )
C ---------------------------------
C
S1 = 2.D0
S2 = - 2.D0* ( RX* F1( VAX ) + RY* F1( VAY ) + RZ* F1( VAZ ))
C
S7 = 2.D0
S8 = 2.D0* ( RX* F1( VAX ) + RY* F1( VAY ) + RZ* F1( VAZ ))
C
P1 = S1 + S2
P2 = 0.D0
P3 = S7 + S8
P4 = 0.D0
C
RETURN
END
C **********************************************************************
C
SUBROUTINE EXPL ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY, VAZ )
C
C ----- With Correction --- FTCS : LXWDF : SZE : EXFU : EXFU3 ---
C
IMPLICIT REAL*8(A-H,O-Z)
C
RXF = RX
RYF = RY
RZF = RZ
C
S1 = 1.D0
S2 = - 2.D0* ( RXF* ( 1.D0 - DCOS( VAX))
1 + RYF* ( 1.D0 - DCOS( VAY))
2 + RZF* ( 1.D0 - DCOS( VAZ)))
C
P1 = S1 + S2
P2 = 0.D0
P3 = 1.D0
P4 = 0.D0
C
RETURN
END
C **********************************************************************
C
SUBROUTINE IMPL1 ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY, VAZ )
C
C ----- With Correction --- FULLY : KOSLA : IMFU ---
C
IMPLICIT REAL*8(A-H,O-Z)
C
RXF = RX
RYF = RY
RZF = RZ
C
S4 = 1.D0
S5 = 2.D0* ( RXF* ( 1.D0 - DCOS( VAX))
1 + RYF* ( 1.D0 - DCOS( VAY))
2 + RZF* ( 1.D0 - DCOS( VAZ)))
C
P1 = 1.D0
P2 = 0.D0
P3 = S4 + S5
P4 = 0.D0
C
RETURN
END
C **********************************************************************
C
SUBROUTINE DATAW
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMMON /MTV/ NMT( 3)
CHARACTER*10 NMT
COMMON /NUM/ MTS, NRX, NRY, NRZ, NKX, NKY, NKZ, NKXYZ
COMMON /ABC/ RVX( 10), RVY( 10), RVZ( 10), KMX( 14), KMY( 14),
1 KMZ( 14)
C
CALL TTLE
C
NKXYZ = NKX* NKY* NKZ
C
WRITE(6,2000) MTS, ( NMT( I), I = 1, MTS)
2000 FORMAT(/,3X,' MTS =',I3,3X,'* Method = ',3(2X,A6,1X))
WRITE(6,2100) NRX, NRY, NRZ, NKX, NKY, NKZ
2100 FORMAT(/ 5X,' * No. of Rx = ',I3,' N_Ry=',I3,' N_Rz=',I3/
1 5X,' * No. of Kx = ',I3,' N_Ky=',I3,' N_Kz=',I3/ )
WRITE(6,2300) ( RVX( I),I = 1,NRX)
WRITE(6,2400) ( RVY( I),I = 1,NRY)
WRITE(6,2500) ( RVZ( I),I = 1,NRZ)
2300 FORMAT( 3X,' RX = ',15( F6.3,2X))
2400 FORMAT( 3X,' RY = ',15( F6.3,2X))
2500 FORMAT( 3X,' RZ = ',15( F6.3,2X))
C
WRITE(6,2600) ( KMX( I),I = 1,NKX)
WRITE(6,2700) ( KMY( I),I = 1,NKY )
WRITE(6,2800) ( KMZ( I),I = 1,NKZ)
2600 FORMAT(/2X,' KX = ',16( I3,2X),/,16X,10( I3,2X))
2700 FORMAT( 2X,' KY = ',16( I3,2X),/,16X,10( I3,2X))
2800 FORMAT( 2X,' KZ = ',16( I3,2X),/,16X,10( I3,2X)///)
C
RETURN
END
C **********************************************************************
C
SUBROUTINE SMTD ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY, VAZ,I )
C
IMPLICIT REAL*8(A-H,O-Z)
C
C FDM - Expl with Correction : LXWDF = SZE = EXFU = EXFU3 = EXPL
C
C FDM - Impl with Correction : IMPL1 = KOSLA = IMFU / IMPL2 = RBWIS
C
GO TO ( 1, 2, 3 ) , I
C
C ----- Explicit FDMs ---
C
1 CALL EXPL ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY, VAZ )
C
GO TO 99
C
C ----- Implicit FDMs ---
C
2 CALL IMPL1 ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY, VAZ )
C
GO TO 99
C
3 CALL IMPL2 ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY, VAZ )
C
99 RETURN
END
C ********************************************************************