戻る

C ******************************************************************** C
C C
PROGRAM MAIN
C C
C --- Graphics for F 2 D - M A C --- C
C C
C ( 10 X 10 20 X 20 40 X 40 ) C
C C
C ( Graphics for Two-Dimensional Viscous Fluid Analysis C
C C
C Software by Finite Difference Method ) C
C C
C ******************************************************************** C
C
IMPLICIT REAL*8(A-H,O-Z)
C
INTEGER*2 NDE
C
C ----- Attention : Max. Dimension Size : 40 X 40 ----------------------
C =========
DIMENSION RMX( 2000), UT( 44,44), VT( 44,44), PHI( 44,44),
1 PHV( 1681), X ( 1681), Y ( 1681), NDE( 1600,4)
C
C ----------------------------------------------------------------------
C
COMMON /CST/ RE, DT, LOP
COMMON /SZC/ NEX, NEY, NNP, NEL
COMMON /SZE/ IM, JM, II, JJ, IP1, JP1, IM1, JM1
C
C ----- DATA ( 1) --------------------
C
OPEN ( 8, FILE='GH100.DAT')
** OPEN ( 8, FILE='GH400.DAT')
** OPEN ( 8, FILE='GH1000.DAT')
C
C ----- DATA ( 2)-----------------------------
C
** OPEN ( 3, FILE='R1000_40_UVVAL.DATA' ) ! DT = 0.021
** OPEN ( 7, FILE='R1000_40_F2D_MAC.DATA')
C
** OPEN ( 3, FILE='R400_40_UVVAL.DATA' ) ! DT = 0.035
** OPEN ( 7, FILE='R400_40_F2D_MAC.DATA')
C
** OPEN ( 3, FILE='R400_20_UVVAL.DATA' ) ! DT = 0.05
** OPEN ( 7, FILE='R400_20_F2D_MAC.DATA')
C
** OPEN ( 3, FILE='R100_40_UVVAL.DATA' ) ! DT = 0.015
** OPEN ( 7, FILE='R100_40_F2D_MAC.DATA')
C
OPEN ( 3, FILE='R100_10_UVVAL.DATA' ) ! DT = 0,1
OPEN ( 7, FILE='R100_10_F2D_MAC.DATA')
C
C ---------------------------------------------
C
KCR = 0
NPL = 0
C
999 READ(7,1000,END=888) IM, JM, RE, DT, LOP
1000 FORMAT(2I3,F7.1,F7.4,I5)
C
IF ( KCR.EQ.0) CALL SZSB ( IKY )
C
CALL PREP ( RMX, UT, VT, PHI, PHV, X, Y, NDE, IKY, KCR )
C
CALL VGA@
C
IF ( IKY.EQ.1) GO TO 900
C
IF ( KCR.EQ.0) CALL PMSH
C
CALL PTUV ( UT, VT, KCR )
C
CALL VRPT ( RMX, KCR, NPL )
C
CALL PCNT ( X, Y, NDE, PHV, KCR )
C
KCR = KCR + 1
GO TO 999
900 CONTINUE
C
CALL CMPR ( UT, VT, X, Y, NPL )
C
888 CONTINUE
C
CLOSE ( 8)
CLOSE ( 3)
CLOSE ( 7)
C
STOP
END
C **********************************************************************
C
SUBROUTINE CMPR ( UT, VT, X, Y, NPL )
C
IMPLICIT REAL*8(A-H,O-Z)
C
INTEGER*2 ICR, IX1, IY1, IX2, IY2
C
DIMENSION UT( IM,JM), VT( IM,JM), X( NNP), Y( NNP)
C
COMMON /CST/ RE, DT, LOP
COMMON /SZC/ NEX, NEY, NNP, NEL
COMMON /SZE/ IM, JM, II, JJ, IP1, JP1, IM1, JM1
C
IX1 = 0
IY1 = 0
IX2 = 639
IY2 = 479
C
ICR = 7
CALL CLEAR_SCREEN_AREA@( IX1, IY1, IX2, IY2, ICR )
C
KEY = 0
C
930 READ(3,1000,END=888) IX, IY, RE, DT, LOP
1000 FORMAT(2I3,F7.1,F7.4,I4)
C
READ(3,1100) (( UT( I,J), J = 1,JM), I = 1,IM )
READ(3,1100) (( VT( I,J), J = 1,JM), I = 1,IM )
1100 FORMAT(10D11.4)
C
C --------------------------------------------
C
CALL RCMP ( X, Y, UT, VT, KEY, NPL )
C
C ---------------------------------------------
KEY = KEY + 1
GO TO 930
C
888 CONTINUE
RETURN
END
C **********************************************************************
C
SUBROUTINE PCNT ( X, Y, NDE, TEP, KCR )
C
C ----- To Plot Contour Lines for Rectangular Meshes ---
C
C ( Linear Interpolation )
C
IMPLICIT REAL*8(A-H,O-Z)
C
INTEGER*2 ICR, NDE, X0, Y0, IWD, PX, PY, XIT, YIT
C
COMMON /ABC/ XIT, YIT, IWD
COMMON /SZC/ NEX, NEY, NNP, NEL
C
DIMENSION X ( NNP), Y ( NNP), NDE( NEL,4), TEP( NNP),
1 PX( 4), PY( 4), HVN( 21)
C
ICR = 15
IWD = 160
C
X0 = 100
Y0 = 70
CALL RECTANGLE@( X0, Y0, X0+IWD, Y0+IWD, ICR )
C
SLX = 160.D0
SLY = 160.D0
C
NM = 21
C ----------------------------
C
TMIN = 100.D0
TMAX = -100.D0
C ----------------------------------------------------------
DO 100 I = 1, NNP
C
IF ( TEP( I).GE.TMAX ) TMAX = TEP( I)
IF ( TEP( I).LE.TMIN ) TMIN = TEP( I)
C
100 CONTINUE
C ----------------------------------------------------------
** WRITE(6,2000) TMAX, TMIN
** 2000 FORMAT(' * Tmax.=',F7.3,' * Tmin.=',F7.3)
C
C ----------------------------------------------------------
DO 200 I = 1, NM
C
HVN( I) = TMIN + ( TMAX - TMIN )* DFLOAT( I)/DFLOAT( NM)
200 CONTINUE
C ----------------------------------------------------------
C
C ----- To Plot Contour Lines ---
C
PXV = 0.D0
PYV = 0.D0
C
C ----------------------------------------------------------
DO 300 L = 1, NEL
C
C ------------------------------------------------
DO 400 IH = 1, NM
C
HV = HVN( IH)
IL = 0
C
C --------------------------------------
DO 500 J = 1, 4
C
I1 = NDE( L,J)
IF ( J.NE.4) THEN
I2 = NDE( L,J+1 )
ELSE
I2 = NDE( L,1 )
END IF
C
IF ( DABS( TEP( I1)-TEP( I2)).LE.0.0001D0 ) THEN
IF ( DABS( TEP( I1)-HV ).LE.0.0001D0 ) THEN
C
IL = IL + 1
PX( IL) = IDNINT( X( I1)* SLX )
PY( IL) = IDNINT( Y( I1)* SLY )
C
END IF
C
ELSE IF ((( TEP( I1) .LE. HV) .AND. ( HV .LT. TEP( I2)))
1 .OR.(( TEP( I1) .GE. HV) .AND. ( HV .GT. TEP( I2))))
2 THEN
C
IL = IL + 1
RT = ( HV - TEP( I1))/( TEP( I2) - TEP( I1))
C
PX( IL) = IDNINT(( X( I1) + ( X( I2)-X( I1))* RT )* SLX )
PY( IL) = IDNINT(( Y( I1) + ( Y( I2)-Y( I1))* RT )* SLY )
C
END IF
C
500 CONTINUE
C --------------------------------------
IF ( IL.GE.2 ) THEN
C
C --------------------------------------
DO 600 J = 1, IL
C
JM = J
C ----- Attention : D2 = ( PXV-PX( J))**2 + ( PYV-PY( J))**2 ---
C
D2 = ( PXV - DFLOAT( PX( J)))** 2 + ( PYV - DFLOAT( PY( J)))** 2
C
C ----------------------------
DO 700 JJ = J + 1, IL
C
C --- Attention --- D2V = ( PXV-PX( JJ))**2 + ( PYV-PY( JJ))**2 ---
C
D2V = ( PXV - DFLOAT( PX( JJ)))**2 + ( PYV - DFLOAT( PY( JJ)))** 2
C
IF ( D2V.LT.D2 ) THEN
JM = JJ
D2 = D2V
END IF
C
700 CONTINUE
C ----------------------------
C
PXV = DFLOAT( PX( JM))
PYV = DFLOAT( PY( JM))
C
PX( JM)= PX( J)
PY( JM)= PY( J)
C
PX( J) = IDNINT( PXV )
PY( J) = IDNINT( PYV )
C
600 CONTINUE
C --------------------------------------
C
PXV = DFLOAT( PX( IL))
PYV = DFLOAT( PY( IL))
C
END IF
C
IF ( IL.GT.0 ) THEN
C
C --------------------------------------
DO 800 J = 2, IL
C
IF ( KCR.EQ.0)
1 CALL DRAW_LINE@( X0+PY( J-1), Y0+PX( J-1),
2 X0+PY( J), Y0+PX( J), 11 )
C
IF ( KCR.EQ.1)
1 CALL DRAW_LINE@( X0+PY( J-1), Y0+PX( J-1),
2 X0+PY( J), Y0+PX( J), 13 )
C
IF ( KCR.EQ.2)
1 CALL DRAW_LINE@( X0+PY( J-1), Y0+PX( J-1),
2 X0+PY( J ), Y0+PX( J), 14 )
C
800 CONTINUE
C --------------------------------------
C
END IF
C
400 CONTINUE
C ------------------------------------------------
C
300 CONTINUE
C ----------------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PMSH
C
IMPLICIT REAL*8(A-H,O-Z)
C
INTEGER*2 ICR, XIT, YIT, IWD, IWE, IW1, IW2, IW3
C
COMMON /ABC/ XIT, YIT, IWD
COMMON /SZC/ NEX, NEY, NNP, NEL
C
ICR = 15
IWD = 160
XIT = 280
YIT = 70
IW1 = XIT + IWD
IW2 = YIT + IWD
CALL RECTANGLE@( XIT, YIT, IW1, IW2, ICR )
C
IWE = IWD/ NEX
C ------------------------------------------------------
DO 100 I = 1, NEX-1
C
IW3 = YIT + IDNINT( DFLOAT( IWE)* DFLOAT( I))
CALL DRAW_LINE@( XIT, IW3, IW1, IW3, ICR )
C
100 CONTINUE
C ------------------------------------------------------
DO 200 J = 1, NEY-1
C
IW3 = XIT + IDNINT( DFLOAT( IWE)* DFLOAT( J))
CALL DRAW_LINE@( IW3, YIT, IW3, IW2, ICR )
C
200 CONTINUE
C ------------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PREP ( RMX, UT, VT, PHI, PHV, X, Y, NDE,
1 IKY, KCR )
C
IMPLICIT REAL*8(A-H,O-Z)
C
INTEGER*2 NDE
C
COMMON /CST/ RE, DT, LOP
COMMON /SZC/ NEX, NEY, NNP, NEL
COMMON /SZE/ IM, JM, II, JJ, IP1, JP1, IM1, JM1
C
DIMENSION RMX( 2000), UT( IM,JM), VT( IM,JM), PHI( IM,JM),
1 PHV( NNP), X ( NNP), Y ( NNP), NDE( NEL,4)
C
READ(7,1000) ( RMX( I), I = 2, LOP )
1000 FORMAT(10D11.4)
READ(7,1100) (( UT ( I,J ), J = 1,JM ), I = 1,IM )
READ(7,1100) (( VT ( I,J ), J = 1,JM ), I = 1,IM )
READ(7,1100) (( PHI( I,J ), J = 1,JM ), I = 1,IM )
READ(7,1100) ( X( I), I = 1, NNP )
READ(7,1100) ( Y( I), I = 1, NNP )
1100 FORMAT(10D11.4)
READ(7,1200) (( NDE( I,J), J = 1, 4 ), I = 1, NEL )
1200 FORMAT(30I4)
C
C ----------------------------------------------------------
IA = 0
DO 100 I = II, 2, -1
DO 100 J = JJ, 2, -1
C
IA = IA + 1
PHV( IA) = ( PHI( I,J ) + PHI( I+1,J )
1 + PHI( I,J+1) + PHI( I+1,J+1))* 0.25D0
C
100 CONTINUE
C ----------------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PTUV ( UT, VT, KCR )
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMMON /ABC/ XIT, YIT, IWD
COMMON /SZC/ NEX, NEY, NNP, NEL
COMMON /SZE/ IM, JM, II, JJ, IP1, JP1, IM1, JM1
C
INTEGER*2 XIT, YIT, X0, Y0, X1, Y1, IWD, ICR, IW1
C
DIMENSION UT( IM,JM), VT( IM,JM)
C
SCL = 20.D0
C
IW1 = XIT + IWD + 20
ICR = 15
CALL RECTANGLE@( IW1, YIT, IW1+IWD, YIT+IWD, ICR )
C
XXL = IWD/ NEX
YYL = IWD/ NEY
C
IF ( KCR.EQ.0) ICR = 11
IF ( KCR.EQ.1) ICR = 13
IF ( KCR.EQ.2) ICR = 14
C
C ----------------------------------------------------------
DO 100 I = 1, NEX
DO 100 J = 1, NEY
C ----------------------------------------------------------
C
C ----- Change of Velocity direction : X-Y no Henkan ---
C
X0 = IDNINT( YYL* ( DFLOAT( I) - 0.5D0 ) + DFLOAT( IW1))
Y0 = IDNINT( XXL* ( DFLOAT( J) - 0.5D0 ) + DFLOAT( YIT))
C
X1 = X0 - IDNINT(( VT( JP1-I, J+2)* SCL))
Y1 = Y0 + IDNINT(( UT( IP1-I, J+2)* SCL))
C
C ----- To omit 'PLOT' in case of 'UV'.LT.0.01 ---
C
CALL DRAW_LINE@( X0, Y0, X1, Y1, ICR )
C
100 CONTINUE
C ----------------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE RCMP ( X, Y, U, V, KEY, NPL )
C
IMPLICIT REAL*8(A-H,O-Z)
C
DIMENSION X ( NNP), Y ( NNP), U ( IM,JM), V ( IM,JM),
1 GU( 17), GV( 17), GUY( 17), GVX( 17)
C
COMMON /CST/ RE, DT, LOP
COMMON /SZC/ NEX, NEY, NNP, NEL
COMMON /SZE/ IM, JM, II, JJ, IP1, JP1, IM1, JM1
C
INTEGER*2 IX1, IY1, IX2, IY2, ICR, IICR
C
CHARACTER*80 STR0
DATA STR0 /'** Results for F2D-MAC ** ( Velocity Distribution com
1pared with Ghia''s Data )'/
C
IF ( KEY.EQ.0) ICR = 11
IF ( KEY.EQ.1) ICR = 13
IF ( KEY.EQ.2) ICR = 14
C
IICR = 16
C
CALL SET_TEXT_ATTRIBUTE@( 3, 1., 0., 0. )
C
CALL DRAW_TEXT@( STR0, 10, 5, IICR )
C
C ----------------------------------------------------------
C
CALL SET_TEXT_ATTRIBUTE@( 3, 1.5, 0., 0. )
C
IF ( DABS( RE-1000.D0).LE.0.001D0)
1 CALL DRAW_TEXT@( ' Re = 1000', 80, 400, IICR )
C
IF ( DABS( RE-400.D0).LE.0.001D0)
1 CALL DRAW_TEXT@( ' Re = 400', 80, 400, IICR )
C
IF ( DABS( RE-100.D0).LE.0.001D0)
1 CALL DRAW_TEXT@( ' Re = 100', 80, 400, IICR )
C
C ----------------------------------------------------------
C
C ----- Ghia's Data --- ( Re = 100 etc. )---
C
C ----------------------------------------------------------
DO 100 I = 1, 17
C
READ(8,1000) GU( I), GUY( I), GV( I), GVX( I)
1000 FORMAT( 4F10.5)
C
100 CONTINUE
C ----------------------------------------------------------
REWIND ( 8)
C
C ----- Attention ---
C
C ----- For Velocity direction change ---
C
IF ( DABS( RE- 100.D0).LE.0.001D0) THEN
C ----------------------------------------------------------
DO 200 I = 1, 17
C
GU ( I) = - GU( I) ! Re = 100
GVX( I) = 1.D0 - GVX( I) ! Re = 100
C
200 CONTINUE
C ----------------------------------------------------------
END IF
C
C ---------------------------------------------------
C
IF ( DABS( RE- 400.D0).LE.0.001D0) THEN
C ----------------------------------------------------------
DO 300 I = 1, 17
C
GVX( I) = 1.D0 - GVX( I) ! Re = 400
GV ( I) = - GV( I) ! Re = 400
C
300 CONTINUE
C ----------------------------------------------------------
END IF
C
IF ( DABS( RE- 1000.D0).LE.0.001D0) THEN
C ----------------------------------------------------------
DO 400 I = 1, 17
C
GV ( I) = - GV( I) ! Re = 1000
GVX( I) = 1.D0 - GVX( I) ! Re = 1000
C
400 CONTINUE
C ----------------------------------------------------------
END IF
C
C ---------------------------------------
X1 = 345
Y1 = 50
X0 = 20
Y0 = 50
C
SCL = 260.D0
X2 = SCL* 0.5D0
Y2 = SCL* 0.5D0
C
C ----- U by Ghia ---
C
IX1 = X0
IY1 = Y0
IX2 = X0 + SCL
IY2 = Y0 + SCL
CALL RECTANGLE@( IX1, IY1, IX2, IY2, IICR )
C
IX1 = X0 + X2
IY1 = Y0 + SCL
IX2 = X0 + X2
IY2 = Y0
CALL RECTANGLE@( IX1, IY1, IX2, IY2, IICR )
C
C ----------------------------------------------------
DO 500 I = 1, 16
C
IC = I + 1
IX1 = X0 + X2 + GU ( I) * X2
IY1 = Y0 + SCL - GUY( I) * SCL
IX2 = X0 + X2 + GU ( IC)* X2
IY2 = Y0 + SCL - GUY( IC)* SCL
CALL DRAW_LINE@( IX1, IY1, IX2, IY2, IICR )
C
500 CONTINUE
C ----------------------------------------------------
C
IX1 = 50
IY1 = 80 + NPL* 20
IX2 = 100
IY2 = IY1
CALL DRAW_LINE@( IX1, IY1, IX2, IY2, ICR )
C
NPL = NPL + 1
C
C ---- Computed U ---
C
C -----------------------------------------------------
DO 600 J = 3, II
C
N = IM* 0.5
UP = - ( V( N,J) + V( N+1,J))/ 2.D0
C
I = J - 3
N1 = IM1* I + II* 0.5
N2 = IM1* ( I+1) + II* 0.5
YP = 1.D0 - (( Y( N1) + Y( N2))/2.D0 )
C
IX1 = X0 + X2 + UP* X2
IY1 = Y0 + SCL - YP* SCL
IX2 = 2
IY2 = 2
CALL ELLIPSE@( IX1, IY1, IX2, IY2, ICR )
C
600 CONTINUE
C -----------------------------------------------------
C
C ----- V by Ghia ---
C
IX1 = 345
IY1 = 50
IX2 = X1 + SCL
IY2 = Y1 + SCL
CALL RECTANGLE@( IX1, IY1, IX2, IY2, IICR )
C
IX1 = X1
IY1 = Y1 + Y2
IX2 = X1 + SCL
IY2 = Y1 + Y2
CALL RECTANGLE@( IX1, IY1, IX2, IY2, IICR )
C
C -----------------------------------------------------
DO 700 I = 1, 16
C
IC = I + 1
C
IX1 = X1 + ( 1.D0 - GVX( I))* SCL
IY1 = Y1 + Y2 + GV ( I) * Y2
IX2 = X1 + ( 1.D0 - GVX( IC))* SCL
IY2 = Y1 + Y2 + GV ( IC) * Y2
CALL DRAW_LINE@( IX1, IY1, IX2, IY2, IICR )
C
700 CONTINUE
C -----------------------------------------------------
C
C ----- Computed V ---
C
C -----------------------------------------------------
DO 800 I = 3, II
C
N = JM* 0.5D0
VP = ( U( I,N) + U( I,N+1))* 0.5D0
J = ( II* 0.5 - 1)* IM1 + ( I-2)
XP = ( X( J) + X( J+1))* 0.5D0
C
IX1 = X1 + XP* SCL
IY1 = Y1 + Y2 + VP* Y2
IX2 = 2
IY2 = 2
C
CALL ELLIPSE@( IX1, IY1, IX2, IY2, ICR )
C
800 CONTINUE
C -----------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE SZSB ( IKY )
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMMON /CST/ RE, DT, LOP
COMMON /SZC/ NEX, NEY, NNP, NEL
COMMON /SZE/ IM, JM, II, JJ, IP1, JP1, IM1, JM1
C
NEX = IM - 4
NEY = JM - 4
NNP = ( NEX+1)* ( NEY+1)
NEL = NEX* NEY
C
IM = NEX + 4
JM = NEY + 4
II = NEX + 2
JJ = NEY + 2
C
IP1 = II + 1
JP1 = JJ + 1
IM1 = II - 1
JM1 = JJ - 1
C
C ------------------
C
CALL TTLE
C
C ------------------
WRITE(6,2000) IM, JM, RE, DT, LOP
2000 FORMAT(/,' *** IM x JM ** ',I3,' *',I3,//,' ** Re =',F8.1,
1 ' * DT =',F7.4,' * Last Loop =',I5)
C
WRITE(6,*) ' '
WRITE(6,*) ' * IKY = 0 ( Normal Output ) * = 1 ( Velocity Distribu
1tion )'
WRITE(6,*) ' '
WRITE(6,*) ' IKY = ? '
READ (5,*) IKY
C
RETURN
END
C **********************************************************************
C
SUBROUTINE TTLE
C
WRITE(6,*) ' '
WRITE(6,101)'****************************************************'
WRITE(6,101)' '
WRITE(6,101)' ##### ### ### ## ## ## #### '
WRITE(6,101)' ## # # ## ## ### ### #### ## ## '
WRITE(6,101)' #### # # # ### ## # ## ## ## ## '
WRITE(6,101)' ## # # ## ## ## ###### ## ## '
WRITE(6,101)' ## #### ### ## ## ## ## #### '
WRITE(6,101)' '
WRITE(6,101)' Two Dimensional Viscous Fluid Flow Analysis '
WRITE(6,101)' '
WRITE(6,101)' Software by Finite Difference Method '
WRITE(6,101)' '
WRITE(6,101)' ( V.4.2 ) '
WRITE(6,101)' '
WRITE(6,101)' Copyright 2011 : Yasuhiro MATSUDA '
WRITE(6,101)' '
WRITE(6,101)'****************************************************'
101 FORMAT(A55)
C
RETURN
END
C **********************************************************************
C
SUBROUTINE VRPT ( RMX, KCR, NPL )
C
IMPLICIT REAL*8(A-H,O-Z)
C
INTEGER*2 ICR, IX0, IY0
C
C ----- Attention N.LE.500 ---
C
DIMENSION RMX( 2000)
C
INTEGER*2 IVAR( 2000), IXX( 2000)
C
COMMON /CST/ RE, DT, LOP
C
CHARACTER*70 STR0
CHARACTER*6 STR1( 3)
DATA STR0 /'*** Results for F2D-MAC *** ( Max. rel. var. of a Vel
1ocity (%))'/
DATA STR1/'0 ','LOP/2',' LOP'/
C
ICR = 15
C
CALL SET_TEXT_ATTRIBUTE@( 3, 1., 0., 0. )
C
CALL DRAW_TEXT@( STR0, 70, 20, ICR )
C
ICR = 15
C
CALL DRAW_TEXT@( STR1( 1), 45, 450, ICR )
CALL DRAW_TEXT@( STR1( 2), 315, 450, ICR )
CALL DRAW_TEXT@( STR1( 3), 585, 450, ICR )
C
IX0 = 50
IY0 = 40
C
CALL RECTANGLE@( IX0, IY0, IX0+580, IY0+400, ICR )
C
CALL DRAW_TEXT@( '1000', 15, 35, ICR )
CALL DRAW_TEXT@( ' 100', 15, 135, ICR )
CALL DRAW_TEXT@( ' 10', 15, 235, ICR )
CALL DRAW_TEXT@( ' 1', 15, 335, ICR )
CALL DRAW_TEXT@( ' 0.1', 15, 435, ICR )
C
CALL DRAW_TEXT@( '(%)', 15, 250, ICR )
C
C ----------------------------------------------------------
C
CALL SET_TEXT_ATTRIBUTE@( 3, 1.5, 0., 0. )
C
IF ( DABS( RE-1000.D0).LE.0.001D0)
1 CALL DRAW_TEXT@( ' Re = 1000', 100, 400, ICR )
C
IF ( DABS( RE-400.D0).LE.0.001D0)
1 CALL DRAW_TEXT@( ' Re = 400', 100, 400, ICR )
C
IF ( DABS( RE-100.D0).LE.0.001D0)
1 CALL DRAW_TEXT@( ' Re = 100', 100, 400, ICR )
C
C ----------------------------------------------------------
C
CALL SET_TEXT_ATTRIBUTE@( 3, 1., 0., 0. )
C
RIWD = 580.D0/ DFLOAT( LOP)
** WRITE(6,*) ' '
** WRITE(6,*) ' * RMX( LOP)= ', RMX( LOP)
C
C ------------------------------------------------
DO 100 I = 1, LOP
C
IF ( RMX( I).LE.0.D0 ) GO TO 100
RMX( I) = DLOG10( RMX( I))
C
100 CONTINUE
C ------------------------------------------------
C
SCL = 100.D0
C ------------------------------------------------
DO 200 I = 1, LOP
C
IXX ( I) = IX0 + IDNINT( DFLOAT( I)* RIWD )
IVAR( I) = 340 - IDNINT( RMX( I)* SCL )
C
200 CONTINUE
C -------------------------------------------------
** WRITE(6,*) ' * IVAR( LOP)=', IVAR( LOP)
C
IF ( KCR.EQ.0) ICR = 11
IF ( KCR.EQ.1) ICR = 13
IF ( KCR.EQ.2) ICR = 14
IX1 = 500
IY1 = 300 + NPL* 20
IX2 = IX1 + 50
IY2 = IY1
C
NPL = NPL + 1
C ---------------------------------------------
C
CALL POLYLINE@( IXX, IVAR, LOP, ICR )
C
C ---------------------------------------------
C
RETURN
END
C **********************************************************************