戻る

C ********************************************************************* C
C C
C Graphics Software for F2D - FDM ( UVP ) C
C C
C ( V. 4.0 ) C
c C
C Copyright : Yasuhiro MATSUDA C
C C
C ********************************************************************* C
C
PROGRAM MAIN
C
IMPLICIT REAL*8 (A-H,O-Z)
C
C ----- Attention ( In case of 20 x 20 & 40 x 40 )
C
C No. of Plot = < 10000 -----
C
C ----- DATA ( 1 ) -----------------------------------------------------
C
PARAMETER ( IX = 21, IY = 21,
C
* PARAMETER ( IX = 41, IY = 41,
C
1 IX1= IX-1, IY1= IY-1, IXY= IX*IY, IXY1= IX1*IY1 )
C
C ----------------------------------------------------------------------
C
COMMON /LOPN/ RAX( 10000),TMX( 10000), PMX( 10000)
C
DIMENSION U ( IX,IY), V( IX,IY), HX( IX1), HY ( IY1),
1 PRS( IXY), X( IXY), Y ( IXY), NDE( IXY1,4)
C
C ----- DATA ( 2 ) ------------------------------------------------------
C
* OPEN (11, FILE='EM20_F2D_FDM_R100.DAT' ) ! Re = 100 DT = 0.04
OPEN (11, FILE='UE20_F2D_FDM_R100.DAT' ) ! Re = 100 DT = 0.014
C
OPEN ( 8, FILE='GH100.DAT')
C
C ----------------------------
C
* OPEN (11, FILE='UE40_F2D_FDM_R400_008.DAT' ) ! Re=400 DT= 0.008
* OPEN (11, FILE='UE40_F2D_FDM_R400_009.DAT' ) ! Re=400 DT= 0.009
C
* OPEN ( 8, FILE='GH400.DAT')
C
C ----------------------------
C
*** OPEN (11, FILE='UE40_F2D_FDM_R1000.DAT' ) ! DT = 0.013
*** OPEN (11, FILE='UE50_F2D_FDM_R1000.DAT' ) ! DT = 0.008
*** OPEN ( 8, FILE='GH1000.DAT')
C
C ----------------------------------------------------------------------
C
CALL TTLE
C
C ----------------------------------------------------------------------
C
CALL PRPS ( PRS, U, V, HX, HY, X, Y, NDE, NPL,
1 MSH, REN, IX, IY, IXY, IXY1, KPL )
C
C ----------------------------------------------------------------------
C
CALL VGA@
C
IF ( KPL.NE.1) GO TO 333
C
C ----------------------------------------------------------
C
CALL PLVR ( RAX, NPL, 1 )
C
C ----------------------------------------------------------
C
*** CALL PLVR ( PMX, NPL, 3 )
C
C ---------------------------------------------------------------
C
CALL PLUV ( U, V, HX, HY, X, Y, IX, IY, IXY )
C
C ---------------------------------------------------------------
C
CALL PLCT ( X, Y, NDE, PRS, 3, IXY, IXY1 )
C
C ---------------------------------------------------------------
C
IF ( MSH.EQ.1) CALL MSFG ( IX, IY )
C
C ----------------------------------------------------------
C
IF ( MSH.NE.1) CALL MSPT ( X, Y, IX, IY, IXY )
C
C ----------------------------------------------------------
GO TO 999
C ---------------------------------------------------------------
C
333 CALL CMPLT ( U, V, X, Y, NPL, IX, IY, IXY, REN )
C
C ---------------------------------------------------------------
999 CONTINUE
C
STOP
END
C **********************************************************************
C
SUBROUTINE CMPLT ( UT, VT, X, Y, NPL, IM, JM, NNP, REN )
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
IX1 = 0
IY1 = 0
IX2 = 639
IY2 = 479
ICR = 7
C
CALL CLEAR_SCREEN_AREA@( IX1, IY1, IX2, IY2, ICR )
C
KEY = 0
C
C ---------------------------------------------------------------
C
CALL RFCMP ( X, Y, UT, VT, KEY, NPL, IM, JM, NNP, REN )
C
C ---------------------------------------------------------------
KEY = KEY + 1
C
RETURN
END
C **********************************************************************
C
SUBROUTINE RFCMP ( X, Y, U, V, KEY, NPL, IM, JM, NNP, REN )
C
IMPLICIT REAL*8(A-H,O-Z)
C
DIMENSION X( NNP), Y( NNP), U( IM,JM), V( IM,JM)
C
COMMON /CNST/ X0, Y0, X1, X2, Y1, Y2, SCAL
COMMON /GDAT/ GU ( 17), GUY( 17), GV ( 17), GVX( 17)
COMMON /CDAT/ UAR( 100), UVR( 3000), YPV( 100), XPV( 100)
C ==== Attention ================================
C
INTEGER*2 ICR, IC2
C
CHARACTER*80 STR0
C
DATA STR0 /'** Results for F2D-FDM (uvp) ** ( Velocity Distr. 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
IC2 = 16
C
CALL SET_TEXT_ATTRIBUTE@( 3, 1., 0., 0. )
C
CALL DRAW_TEXT@( STR0, 10, 5, IC2 )
C
C ----- Ghia's Data --- ( Re = 100, 400, 1000 )---
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 : Velocity direction change : Wall Moving direction ---
C
IF ( DABS( REN-1000.D0).LE.0.01D0 ) THEN
C ------------------------------------------------
DO 200 I = 1, 17
C
GV ( I) = - GV( I) ! for Re= 1000
GVX( I) = 1.D0 - GVX( I)
C
200 CONTINUE
C ------------------------------------------------
END IF
C
IF ( DABS( REN-400.D0).LE.0.01D0 ) THEN
C ------------------------------------------------
DO 300 I = 1, 17
C
GV ( I) = - GV( I) ! Re = 400
GVX( I) = 1.D0 - GVX( I)
C
300 CONTINUE
C ------------------------------------------------
END IF
C
IF ( DABS( REN-100.D0).LE.0.01D0 ) THEN
C ------------------------------------------------
DO 400 I = 1, 17
C
GU ( I) = - GU( I) ! Re = 100
GVX( I) = 1.D0 - GVX( I)
C
400 CONTINUE
C ------------------------------------------------
END IF
C
C --------------------------------------------------
C
CALL PLGD ( IC2 )
C
C --------------------------------------------------
C
CALL PLCV ( X, Y, U, V, IM, JM, NNP, ICR )
C
C --------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PLCV ( X, Y, U, V, IM, JM, NNP, ICR )
C
IMPLICIT REAL*8(A-H,O-Z)
C
DIMENSION X( NNP), Y( NNP), U( IM,JM), V( IM,JM)
C
COMMON /CNST/ X0, Y0, X1, X2, Y1, Y2, SCAL
COMMON /CDAT/ UAR( 100), UVR( 3000), YPV( 100), XPV( 100)
C
INTEGER*2 IX1, IY1, IX2, IY2, ICR
C
C ----- Computed "U" -------------------
C
DO 100 J = 1, JM
DO 100 I = 1, IM
C
NN = IM* ( J-1) + I
UVR( NN) = U( I,J)
C
100 CONTINUE
C --------------------------------------
** UVR( 1) = 1.D0
KIN = 0
C
DO 200 I = 1, NNP
C
IF ( DABS( X( I)-0.5D0).LE.0.0001 ) THEN
KIN = KIN + 1 ! KIN .LE. 100
UAR( KIN) = UVR( I)
YPV( KIN) = Y ( I)
END IF
C
200 CONTINUE
C --------------------------------------
WRITE(6,*) ' * KIN=', KIN
C
UAR( KIN) = 1.D0
C ===== Attention =====
C
C --------------------------------------
DO 300 I = 1, KIN
C
IX1 = X0 + X2 + UAR( I)* X2
IY1 = Y0 + SCAL - YPV( I)* SCAL
IX2 = 2
IY2 = 2
CALL ELLIPSE@( IX1, IY1, IX2, IY2, ICR )
C
300 CONTINUE
C --------------------------------------
C
C ----- Computed "V" -------------------
C
DO 400 J = 1, JM
DO 400 I = 1, IM
C
NN = IM* ( J-1) + I
UVR( NN) = V( I,J)
C
400 CONTINUE
C --------------------------------------
C
** WRITE(6,*) ' * UVR =', ( UVR( I), I= 1, NN )
** WRITE(6,*) ' NN( V) =', NN
C
C --------------------------------------
KIN = 0
DO 500 I = 1, NNP
C
IF ( DABS( Y(I)-0.5D0).LE.0.0001) THEN
KIN = KIN + 1 ! KIN .LE. 100
UAR( KIN) = UVR( I)
XPV( KIN) = X ( I)
END IF
C
500 CONTINUE
C --------------------------------------
DO 600 I = 1, KIN
C
IX1 = X1 + XPV( I)* SCAL
IY1 = Y1 + Y2 - UAR( I)* Y2
IX2 = 2
IY2 = 2
CALL ELLIPSE@( IX1, IY1, IX2, IY2, ICR )
C
600 CONTINUE
C --------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PLGD ( IC2 )
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMMON /GDAT/ GU( 17), GUY( 17), GV( 17), GVX( 17)
C
COMMON /CNST/ X0, Y0, X1, X2, Y1, Y2, SCAL
C
INTEGER*2 IX1, IY1, IX2, IY2, IC2
C
C ----- To plot U - Distribution -------
C
X1 = 345
Y1 = 50
X0 = 20
Y0 = 50
C
SCAL = 260.D0
X2 = SCAL* 0.5D0
Y2 = SCAL* 0.5D0
C
IX1 = X0
IY1 = Y0
IX2 = X0 + SCAL
IY2 = Y0 + SCAL
C
CALL RECTANGLE@( IX1, IY1, IX2, IY2, IC2 )
C
IX1 = X0 + X2
IY1 = Y0 + SCAL
IX2 = X0 + X2
IY2 = Y0
C
CALL RECTANGLE@( IX1, IY1, IX2, IY2, IC2 )
C
C ----- U by Ghia ----------
C
DO 100 I = 1, 16
C
IC = I + 1
IX1 = X0 + X2 + GU ( I)* X2
IY1 = Y0 + SCAL - GUY( I)* SCAL
IX2 = X0 + X2 + GU ( IC)* X2
IY2 = Y0 + SCAL - GUY( IC)* SCAL
CALL DRAW_LINE@( IX1, IY1, IX2, IY2, IC2 )
C
100 CONTINUE
C --------------------------
C
IX1 = 45
IY1 = 80
C
IX2 = 90
IY2 = IY1
C
CALL DRAW_LINE@( IX1, IY1, IX2, IY2, IC2 )
C
CALL DRAW_TEXT@( 'Ref.', 100, 72, IC2 )
C
C ----- To plot V - Distribution -------------------------
C
IX1 = 345
IY1 = 50
IX2 = X1 + SCAL
IY2 = Y1 + SCAL
C
CALL RECTANGLE@( IX1, IY1, IX2, IY2, IC2 )
C
IX1 = X1
IY1 = Y1 + Y2
IX2 = X1 + SCAL
IY2 = Y1 + Y2
C
CALL RECTANGLE@( IX1, IY1, IX2, IY2, IC2 )
C
C ----- V by Ghia ------------
C
DO 200 I = 1, 16
C
IC = I + 1
IX1 = X1 + ( 1 - GVX( I)) * SCAL
IY1 = Y1 + Y2 + GV ( I) * Y2
IX2 = X1 + ( 1 - GVX( IC))* SCAL
IY2 = Y1 + Y2 + GV ( IC) * Y2
CALL DRAW_LINE@( IX1, IY1, IX2, IY2, IC2 )
C
200 CONTINUE
C ----------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PLUV ( U, V, HX, HY, X, Y, IX, IY, IXY )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
INTEGER*2 ICR, XIT, YIT, X0, Y0, X1, Y1, IWD
C
DIMENSION U( IX,IY), V( IX,IY), HX( IX-1), HY( IY-1),
1 X( IXY), Y( IXY)
C
ICR = 11
C
IWD = 160
X0 = 80
Y0 = 70
XIT = 80
YIT = 70
SCL = 10.D0
C
CALL RECTANGLE@( XIT, YIT, XIT+IWD, YIT+IWD, 15 )
C
IP = IX
JP = IY
C
C ------- Unequal length -------------------------
C
DO 100 I = 1, IX-1
C
HX( I) = HX( I)* DFLOAT( IWD)
100 CONTINUE
C ------------------------------------------------
DO 200 J = 1, IY-1
C
HY( J) = HY( J)* DFLOAT( IWD)
200 CONTINUE
C ------------------------------------------------
C
*** WRITE(6,*) ' *** HY=', ( HY( I), I=1, IY-1 )
C
C ----- HYT: Total length of Y-Direction Size ---
C
HYT = 0.D0
DO 300 I = 1, JP-1
C
HYT = HYT + HY( I)
C
300 CONTINUE
C ------------------------------------------------
WRITE(6,*) ' * HYT =', HYT
C
C ------------------------------------------------
DO 400 I = 2, IP
C
XXL = 0.D0
C --------------------------------------
DO 450 K = 1, I-1
C
XXL = XXL + HX( K)
450 CONTINUE
C --------------------------------------
HYD = 0.D0
C ------------------------------------------------
DO 400 J = 2, JP
C
X0 = IDNINT( XXL) + XIT
HYD = HYD + HY( J-1)
Y0 = IDNINT( HYT - HYD ) + YIT
C
C ----- Y - Plot Direction : Downward ---
C
** X1 = X0 + NINT ( U( I,J)* SCL )
** Y1 = Y0 - NINT ( V( I,J)* SCL )
C
X1 = X0 + IDNINT( U( I,J)* SCL )
Y1 = Y0 - IDNINT( V( I,J)* SCL )
C
CALL DRAW_LINE@( X0, Y0, X1, Y1, ICR )
C
400 CONTINUE
C ------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PRPS ( PRS, U, V, HX, HY, X, Y, NDE,
1 NPL, MSH, REN, IX, IY, IXY, IXY1, KPL )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
DIMENSION PRS( IXY), U( IX,IY), V( IX,IY), HX( IX-1),
1 HY ( IY-1), X( IXY), Y( IXY), NDE( IXY1,4)
C
COMMON /LOPN/ RAX( 10000), TMX( 10000), PMX( 10000)
C
C ----- Attention --- Plotting Data ---
C
READ(11,1000) REN, DT, LOPE, MSH, NPL
1000 FORMAT(F8.2, F7.5, I5, I2, I5)
C
IF ( NPL.GT.10000) WRITE(6,*) ' * No. Plottings .GT.10000 : STOP'
IF ( NPL.GT.10000) STOP
C
WRITE(6,2000) IX, IY
2000 FORMAT(/,' ** IX * IY =',I3,' X ',I3 )
WRITE(6,2100) REN, DT, LOPE, MSH
2100 FORMAT(/,' ** ( IX1*IY1 ) ** Re =',F8.2,' DELT =',F8.5,' * LOP
1E =', I5,' * MSH =',I2)
C
C ----- At NPL --- Attention - NPL < = 10000 ---
C
WRITE(6,2200) NPL
2200 FORMAT(18X,' No. of Plottings =', I6,/)
C
READ(11,1200) ( PRS( I), I = 1, IXY )

READ(11,1200) ( RAX( I), I = 1, NPL )
READ(11,1200) ( PMX( I), I = 1, NPL )
READ(11,1200) ( X( I) , I = 1, IXY )
READ(11,1200) ( Y( I) , I = 1, IXY )
C
READ(11,1200) (( U( I,J), J = 1, IY ), I = 1, IX )
READ(11,1200) (( V( I,J), J = 1, IY ), I = 1, IX )
READ(11,1200) ( HX( I), I = 1, IX-1 )
READ(11,1200) ( HY( I), I = 1, IY-1 )
1200 FORMAT(10F8.3)
C
READ(11,1300) (( NDE( I,J), J = 1, 4), I = 1, IXY1)
1300 FORMAT(20I4)
C
WRITE(6,*) '* KPL = 1 ( Meshes/Vel. Distr./Pressure Distr.) or 2
1( Comparison with Ref.)'
C
READ(5,*) KPL
WRITE(6,*) ' *** KPL =', KPL
C
RETURN
END
C **********************************************************************
C
SUBROUTINE TTLE
C
WRITE(6,*) '*****************************************************'
WRITE(6,*) '* *'
WRITE(6,*) '* F I G - F 2 D - F D M *'
WRITE(6,*) '* *'
WRITE(6,*) '* 2D Fluid Flow Analysis *'
WRITE(6,*) '* *'
WRITE(6,*) '* by Fourth-ordered F.D.M. *'
WRITE(6,*) '* *'
WRITE(6,*) '* ( uvp ) *'
WRITE(6,*) '* *'
WRITE(6,*) '* ( V.4.0 ) *'
WRITE(6,*) '* *'
WRITE(6,*) '* Copyright 2011 : Yasuhiro MATSUDA *'
WRITE(6,*) '* *'
WRITE(6,*) '*****************************************************'
C
RETURN
END
C **********************************************************************
C
SUBROUTINE MSFG ( IX, IY )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
INTEGER*2 ICR, XIT, YIT, IWD, IWK1, IWK2
C
COMMON /ABC/ XIT, YIT, IWD
C
ICR = 15
IWD = 160
XIT = 440
YIT = 70
C
CALL RECTANGLE@( XIT, YIT, XIT+IWD, YIT+IWD, ICR )
C
C ---------------------------------------------------------------
C
RIWE = DFLOAT( IWD)/ DFLOAT( IX-1)
WRITE(6,*) ' * RIWE=', RIWE
IWK2 = XIT + IWD
C
DO 100 I = 1, IX-2
C
IWK1 = IDNINT( DFLOAT( YIT) + RIWE * DFLOAT( I)) ! Better
CALL DRAW_LINE@( XIT, IWK1, IWK2, IWK1, ICR )
C
100 CONTINUE
C ---------------------------------------------------------------
IWK2 = YIT + IWD
C
DO 200 J = 1, IY-2
C
IWK1 = IDNINT( DFLOAT( XIT) + RIWE* DFLOAT( J)) ! Better
CALL DRAW_LINE@( IWK1, YIT, IWK1, IWK2, ICR )
C
200 CONTINUE
C ---------------------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE MSPT ( X, Y, IX, IY, IXY )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
INTEGER*2 ICR, XIT, YIT, IWD, IWE, JWE
C
COMMON /ABC/ XIT, YIT, IWD
C
DIMENSION X( IXY), Y( IXY)
C
ICR = 15
IWD = 160
XIT = 440
YIT = 70
CALL RECTANGLE@( XIT, YIT, XIT+IWD, YIT+IWD, ICR )
C
C ----------------------------------------------------------
DO 100 I = 1, IX+1
C
JWE = IDNINT( Y( 1+IY*(I-1))* DFLOAT( IWD))
C
CALL DRAW_LINE@( XIT, YIT+JWE, XIT+IWD, YIT+JWE, ICR )
C
100 CONTINUE
C ----------------------------------------------------------
DO 200 J = 1, IY+1
C
IWE = IDNINT( X( J+1)*DFLOAT( IWD))
C
CALL DRAW_LINE@( XIT+IWE, YIT, XIT+IWE, YIT+IWD, ICR )
C
200 CONTINUE
C ----------------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PLCT ( X, Y, NDE, CTV, KKK, IXY, IXY1 )
C
C ----- To plot contour lines for rectangular Meshes ---
C ( Linear interpolation )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
INTEGER*2 ICR, X0, Y0, XIT, IWD, PX, PY
C
DIMENSION CTV( IXY), X ( IXY), Y ( IXY), NDE( IXY1,4),
1 PX ( 4), PY( 4), HVA( 101)
C ===========
RMI = 100.D0
RMX = 0.D0
C
C ------------------------------------------------
DO 100 I = 1, IXY
C
IF ( CTV( I).LE.RMI ) RMI = CTV( I)
IF ( CTV( I).GE.RMX ) RMX = CTV( I)
C
100 CONTINUE
C ------------------------------------------------
WRITE(6,2000) KKK, RMI, RMX
2000 FORMAT(' ** KKK =',I2,' Rmin.=',F8.3,5X,' Rmax.=',F8.3 )
C
NM = 41
C ============
C
DRM = ( RMX - RMI)/ DFLOAT( NM-1)
WRITE(6,*) ' * DRM =', DRM
C ------------------------------------------------
DO 200 I = 1, NM
C
HVA( I) = RMI + DRM* DFLOAT( I-1)
200 CONTINUE
C ------------------------------------------------
C
ICR = 15
C
IWD = 160
XIT = 190
X0 = 80
Y0 = 70
YIT = 70
C --------------------------
IF ( KKK.EQ.1 ) THEN
CALL RECTANGLE@( X0, Y0, X0+IWD, Y0+IWD, ICR )
ICR = 12
GO TO 900
END IF
C --------------------------
XIT = XIT + IWD + 20
X0 = X0 + 180
CALL RECTANGLE@( X0, Y0, X0+IWD, Y0+IWD, ICR )
ICR = 11
C
900 CONTINUE
C
SCX = 160.D0
SCY = 160.D0
C
C ----- To plot contour lines ---
C
PXV = 0.D0
PYV = 0.D0
C
C ----------------------------------------------------------
DO 300 L = 1, IXY1
C
C ------------------------------------------------
DO 400 IH = 1, NM
C ========================
C
HV = HVA( IH)
C
ICL = 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( CTV( I1) - CTV( I2)).LE.0.000001) THEN
C
IF ( DABS( CTV( I1) - HV ) .LE.0.000001) THEN
ICL = ICL + 1
PX( ICL) = NINT( X( I1)* SCX )
PY( ICL) = NINT( Y( I1)* SCY )
END IF
C
ELSE IF ((( CTV(I1).LE.HV ) .AND. ( HV.LT.CTV(I2)))
1 .OR. (( CTV(I1).GE.HV ) .AND. ( HV.GT.CTV(I2)))) THEN
C
ICL = ICL + 1
RT = ( HV - CTV(I1))/( CTV(I2) - CTV(I1))
PX(ICL) = ( X(I1) + ( X(I2) - X(I1))* RT )* SCX
PY(ICL) = ( Y(I1) + ( Y(I2) - Y(I1))* RT )* SCY
END IF
C
500 CONTINUE
C --------------------------------------
C
IF ( ICL.GE.2) THEN
C --------------------------------------
DO 600 J = 1, ICL
C
JM = J
D2 = ( PXV - PX( J))** 2 + ( PYV - PY( J))** 2
C
C ----------------------------
DO 700 JJ = J+1, ICL
C
D2V = ( PXV - PX(JJ))** 2 + ( PYV - PY(JJ))** 2
IF ( D2V.LT.D2 ) THEN
JM = JJ
D2 = D2V
END IF
C
700 CONTINUE
C ----------------------------
PXV = PX( JM)
PYV = PY( JM)
PX( JM) = PX( J)
PY( JM) = PY( J)
PX( J) = PXV
PY( J) = PYV
C
600 CONTINUE
C --------------------------------------
PXV = PX( ICL)
PYV = PY( ICL)
END IF
C
IF ( ICL.GT.0 ) THEN
C --------------------------------------
DO 800 J = 2, ICL
C
CALL DRAW_LINE@
C
1 ( X0+PX( 1), Y0+PY( 1), X0+PX( J), Y0+PY( J), ICR )
C
800 CONTINUE
C --------------------------------------
END IF
C
400 CONTINUE
C ------------------------------------------------
C
300 CONTINUE
C ----------------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PLVR ( RWK, NPL, KKK )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
INTEGER*2 ICR, IX0, IY0
C
C ----- Attention NPL .LE.10000 -----------
C
DIMENSION RWK ( 10000)
C
INTEGER*2 IVAR( 10000), IXX( 10000)
C
CHARACTER*90 STR3
CHARACTER*6 STR1( 3)
C
DATA STR3 /'* F2D-FDM (uvp) ( Max. rel_var_of Velocities (%))'/
DATA STR1 /'0 ','NPL/2',' NPL'/
C
C ----- Attention --- Max. Value ---
C
IF ( KKK.NE.1) GO TO 1234
C
ICR = 15
C
CALL SET_TEXT_ATTRIBUTE@( 3, 1., 0., 0. )
C
CALL DRAW_TEXT@( STR3, 70, 20, ICR )
C
ICR = 15
C
CALL DRAW_TEXT@( STR1( 1), 47, 450, ICR )
CALL DRAW_TEXT@( STR1( 2), 305, 450, ICR )
CALL DRAW_TEXT@( STR1( 3), 585, 450, ICR )
C
IX0 = 50
IY0 = 40
C
CALL RECTANGLE@( IX0, IY0, IX0+580, IY0+400, 15 )
C
1234 CONTINUE
C
IF ( KKK.NE.1) GO TO 133
C
CALL DRAW_TEXT@( '1000', 15, 35, ICR )
CALL DRAW_TEXT@( ' 100', 15, 115, ICR )
CALL DRAW_TEXT@( ' 10', 15, 195, ICR )
CALL DRAW_TEXT@( ' 1', 15, 275, ICR )
CALL DRAW_TEXT@( ' 0.1', 15, 355, ICR )
CALL DRAW_TEXT@( '0.01', 15, 435, ICR )
CALL DRAW_TEXT@( '(%)', 15, 245, ICR )
C
133 CONTINUE
C
RIWD = 580.D0/ DFLOAT( NPL)
C
C ------------------------------------------------
DO 100 I = 1, NPL
C
IF ( RWK( I).LE.0.D0 ) GO TO 100
C
RWK( I) = DLOG10( RWK( I))
C
100 CONTINUE
C ------------------------------------------------
C
SCL = 80.D0
C
IF ( KKK.EQ.1) ICR =15
IF ( KKK.EQ.2) ICR =12
IF ( KKK.EQ.3) ICR =11
IF ( KKK.EQ.4) ICR =14
C
C ----------------------------------------------------------
DO 200 I = 1, NPL
C
IXX ( I) = IX0 + IDNINT( DFLOAT( I)* RIWD )
IVAR( I) = 280 - IDNINT( RWK( I)* SCL )
C
200 CONTINUE
C ----------------------------------------------------------
WRITE(6,*) ' * IVAR( NPL)=', IVAR( NPL)
C
CALL POLYLINE@( IXX, IVAR, NPL, ICR )
C
C ----------------------------------------------------------
C
RETURN
END
C **********************************************************************