戻る

C
PROGRAM MAIN
C
C ********************************************************************* C
C C
C Graphics for W A V E - F E M 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
C ----- Loop < = 1000 ---
C
DIMENSION UR( 1000), RER( 1000), U(20), EXU(20), X(39), Y(39)
C
CALL TTLE
C
OPEN ( 10, FILE='WAVE_FEM_PLDAT' ) ! DT = 1.15 Loop= 100
OPEN ( 11, FILE='WFEM_VAR' )
C
IJ = 0
900 CONTINUE
C
IJ = IJ + 1
C
READ(10,*,END=999) LOP, SEC, UR( IJ), RER( IJ)
IF ( MOD( LOP,10).EQ.0) THEN
WRITE(6,2000) LOP, SEC, UR( IJ), RER( IJ)
2000 FORMAT(' * LOP=', I4,' T=',F7.3,' * U(26)=',F8.3,
1 ' Rel_Er =',F9.3,'(%)')
END IF
GO TO 900
C
999 CONTINUE
READ(11,*) N, NNP
READ(11,*) ( U ( I), I = 1, N )
READ(11,*) ( EXU( I), I = 1, N )
READ(11,*) ( X( I), I = 1, NNP )
READ(11,*) ( Y( I), I = 1, NNP )
C
LOP = IJ - 1
WRITE(6,*) ' '
WRITE(6,2100) LOP
2100 FORMAT(' * No. of Plottings =',I4)
C
CALL VGA@
C
CALL PLTVR ( UR, LOP, 1 )
C
CALL PLTVR ( RER, LOP, 3 )
C
CALL PLTVR ( U, N, 4 )
C
CALL PLTVR ( EXU, N, 5 )
C
CALL MESHP ( X, Y )
C
CLOSE ( 10 )
C
STOP
END
C **********************************************************************
C
SUBROUTINE MESHP ( X, Y )
C
IMPLICIT REAL*8(A-H,O-Z)
C
INTEGER*2 ICR, XIT, YIT, IWD, IWE, IWK, IWK2, IWK3
C
DIMENSION X( 39), Y( 39)
C
ICR = 15
C
IWD = 30
XIT = 100
YIT = 300
C
C ----- Attention ---
C
IWK = YIT + 30
IWK2 = XIT + IWD* 12
IWK3 = YIT + 30
C
CALL DRAW_LINE@( XIT, IWK, IWK2, IWK3, ICR )
C
SCL = 4.D0
C
DO 200 J = 1, 12
C
IWE = IDNINT( X( J+1)* SCL )
IWK = XIT + IWE
IWK2 = YIT + 60
C
CALL DRAW_LINE@( IWK, YIT, IWK, IWK2, ICR )
C
200 CONTINUE
C
IWK3 = XIT + 360
C
CALL RECTANGLE@( XIT, YIT, IWK3, IWK2, ICR )
C
ICR = 11
C
DO 300 I =1, 3
C
CALL FILL_ELLIPSE@( XIT, YIT+(I-1)* 30, 2, 2, ICR )
C
300 CONTINUE
C
RETURN
END
C **********************************************************************
C
SUBROUTINE TTLE
C
IMPLICIT REAL*8 (A-H,O-Z)
C
WRITE(6,*) ' '
WRITE(6,*) 'C ************************************************* C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C WAVE - FEM C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C ( V.3.5 ) C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C Wave Analysis by Finite Element Method C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C Copyright 2011 : Yasuhiro MATSUDA C'
WRITE(6,*) 'C C'
WRITE(6,*) 'C ************************************************* C'
WRITE(6,*) ' '
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PLTVR ( RMX, LOP, KEY )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
INTEGER*2 ICR, IX0, IY0
C
C ----- Attention N.LE.500 ---
C
DIMENSION RMX( LOP)
C
INTEGER*2 IVR( 1000), IXX( 1000)
C
CHARACTER*120 STR0
CHARACTER*4 STR1( 3)
CHARACTER*5 STR2( 5)
C
DATA STR0 /' *** Wave Analysis by FEM *** ( Velocity & Rel. Err
1or (%) ) '/
DATA STR1 /' 0',' 5',' 10'/
C
DATA STR2 /' 1 ',' 5 ',' 0 ','-0.5 ',' -1 '/
C
IF ( KEY.NE.1) GO TO 111
C
ICR = 15
C
CALL SET_TEXT_ATTRIBUTE@( 3, 1., 0., 0. )
C
CALL DRAW_TEXT@( STR0, 70, 20, ICR )
C
CALL DRAW_TEXT@( ' 0', 0, 450, ICR )
CALL DRAW_TEXT@( ' XL/2', 285, 450, ICR )
CALL DRAW_TEXT@( ' XL ', 575, 450, ICR )
C
CALL DRAW_TEXT@( 'LOP/2', 290, 462, ICR )
CALL DRAW_TEXT@( ' LOP ', 580, 462, ICR )
C
CALL DRAW_TEXT@( STR1( 1), 600, 245, ICR )
CALL DRAW_TEXT@( STR1( 2), 600, 145, ICR )
CALL DRAW_TEXT@( STR1( 3), 600, 45, ICR )
C
CALL DRAW_TEXT@( STR2( 1), 0, 40, ICR )
CALL DRAW_TEXT@( STR2( 2), 0, 140, ICR )
CALL DRAW_TEXT@( STR2( 3), 0, 240, ICR )
CALL DRAW_TEXT@( STR2( 4), 0, 340, ICR )
CALL DRAW_TEXT@( STR2( 5), 0, 440, ICR )
C
IX0 = 35
IY0 = 50
C
CALL RECTANGLE@( IX0, IY0, IX0+580, IY0+400, ICR )
C
111 CONTINUE
IF ( KEY.EQ.1) ICR = 15
IF ( KEY.EQ.2) ICR = 14
IF ( KEY.EQ.3) ICR = 13
IF ( KEY.EQ.4) ICR = 11
IF ( KEY.EQ.5) ICR = 14
C
RIWD = 580.D0/ DFLOAT( LOP-1)
C
IF ( KEY.LE.2) RETURN
C
C --------------------------------------------------------------------
DO 100 I = 1, LOP
C
IXX( I) = IX0 + IDNINT( DFLOAT( I-1)* RIWD )
C
IF ( KEY.EQ.1) IVR( I) = IY0 + 200 - IDNINT( RMX( I-1)* 200.D0 )
IF ( KEY.EQ.2.OR.KEY.EQ.3 )
1 IVR( I) = IY0 + 200 - IDNINT( RMX( I)* 20.D0 )
IF ( KEY.GE.4) IVR( I) = IY0 + 200 - IDNINT( RMX( I)* 200.D0)
C
100 CONTINUE
C --------------------------------------------------------------------
C
CALL POLYLINE@( IXX, IVR, LOP, ICR )
C
RETURN
END
C **********************************************************************