戻る

C
PROGRAM MAIN
C ******************************************************************** C
C C
C Error Analysis Software C
C C
C for 3D - Diffusion Equation C
C C
C ( For FEMs ) 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/ MT( 50), TV( 14)
COMMON /NUM/ MTS, NT, NRX, NRY, NRZ, NKX, NKY, NKZ
COMMON /ABC/ RVX( 10), RVY( 10), RVZ( 10), KMX( 14), KMY( 14),
1 KMZ( 14)
COMMON /NAMEM/ NMT( 2)
CHARACTER*6 NMT
C
DIMENSION OPTE( 20, 50), OPTT( 20, 50), OPTR( 20, 50),
1 OPTG( 20, 50), OPET( 50), OPT ( 50),
2 OPR ( 50), OPGZ( 50)
C
C --------------------------------------------
C
OPEN ( 7, FILE='DIF3D_FEM_EA.RESULT' )
C
C --------------------------------------------
C
CALL DINPT
C
C -------------------------------------------------------------------
DO 100 I = 1, MTS
C
WRITE(6,2000) NMT( I)
WRITE(7,2000) NMT( I)
2000 FORMAT(/,1X,' *** ',A6,' ***',/ )
C
KT = 0
NTT = NT
IF ( MT(I).EQ.2) NTT = 1
C
C ---------------------------------------------------------
DO 200 J = 1, NTT
C
T = TV( J)
KT = KT + 1
IF ( MT(I).EQ.2) GO TO 10
WRITE(7,2100) T
2100 FORMAT(/,3X,'** Time Scheme Par. = ',F6.3,' **'/)
C
10 CONTINUE
KR = 0
NKXYZ = NKX* NKY* NKZ
C
CALL CLEAR ( TSGA, TSGC, DAB3, DUMY)
C
C ------------------------------------------------
DO 300 IR = 1, NRX
C
RX = RVX( IR)
RY = RVY( IR)
RZ = RVZ( IR)
C
CALL CLEAR ( SGA, SGC, DAB2, RMX )
C
CALL INIT ( OPET, OPGZ)
C
CALL CLEAR ( BSA, BSC, DAB1, RMXB )
C
C ----------------------------
DO 500 IKX = NKX, 1, -1
C
KX = KMX( IKX)
VAX = 2.D0* PAI/ DFLOAT( KX)
C
C ----------------------------
DO 500 IKY = NKY, 1, -1
C
KY = KMY( IKY)
VAY = 2.D0* PAI/ DFLOAT( KY)
C
C ----------------------------
DO 500 IKZ = NKZ, 1, -1
C
KZ = KMZ( IKZ)
VAZ = 2.D0* PAI/ DFLOAT( KZ)
C
C ------ Schemes ---
C
CALL SMTHD ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY, VAZ, I, T )
C
C -------------------
C
CALL CMP1 ( P1, P2, P3, P4, RX, RY, RZ, VAX, VAY,
1 VAZ, A, C, DAB0, BA, BC, TS, DAB1, BSA,
2 BSC, RMXB, SGA, SGC, RMX )
C
500 CONTINUE
C -----------------------------
C
CALL CMP2 ( NKXYZ, DAB1, DAB2, BSA, BSC, TBS )
C
CALL CMP3 ( NKXYZ, DAB2, DAB3, SGA, SGC, TSGA, TSGC, TVR )
C
C ----------------------------
C
IF ( MT(I).EQ.1) CALL COPT1 ( KT, KR, T, RX, RMX, TVR,
1 OPTE, OPTT, OPTR, OPTG )
C
IF ( MT(I).EQ.2) CALL OUTP1 ( RX, RY, RZ, RMX, SGA, SGC,
1 TVR, DAB2 )
C
300 CONTINUE
C -----------------------------------------------
C
CALL CALC4 ( NRX, NKXYZ, DAB3, TSGA, TSGC, SUMT )
C
200 CONTINUE
C ----------------------------------------------------------
C
IF ( MT(I).EQ.1 ) THEN
C
CALL COPT2 ( KT, KR, OPTE, OPTT, OPTR, OPTG, OPET,
1 OPR, OPT, OPGZ)
C
CALL OUTP2 ( KR, OPET, OPR, OPT, OPGZ) ! Opt. THEtA
C
END IF
C -------------
C
100 CONTINUE
C --------------------------------------------------------------------
WRITE(6,2200)
WRITE(7,2200)
2200 FORMAT(/,5X,'** END **')
C
CLOSE( 7)
C
STOP
END
C ********************************************************************