戻る

C ********************************************************************* C
C C
C FIG - F2D - FDM ( SV ) C
C C
C Copyright : Yasuhiro MATSUDA C
C C
C Graphics Software for F2D - FDM( SV ) 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 & 50 x 50 ) ---
C
C No. of Plot = < 50000 -----
C
PARAMETER ( IX = 21, IY = 21,
C *******************
C
*** PARAMETER ( IX = 51, IY = 51,
C *******************
C
1 IX1= IX-1, IY1= IY-1, IXY= IX*IY, IXY1= IX1*IY1 )
C --------------------------------------------------------------------
C
COMMON /LOPN/ RAX(50000),TMX(50000), PMX(50000)
C
DIMENSION U ( IX,IY), V( IX,IY), HX( IX1), HY ( IY1),
1 PSI( IXY), X( IXY), Y ( IXY), NODE( IXY1,4)
C
C ----- Attention --- Loop < = 50000 ---
C
C ----- DATA ( 1 ) --------------------------------
C
*** OPEN ( 7, FILE='F2D_FDM_FIG_R100_UM20.DAT' ) ! DT = 0.008
*** OPEN ( 8, FILE='GH100.DAT')
C
C ----- DATA ( 2 ) ---
C
*** OPEN ( 7, FILE='F2D_FDM_FIG_R1000.DAT' ) ! Equal length of meshes
C
*** OPEN ( 8, FILE='GH1000.DAT')
*** OPEN ( 7, FILE='F2D_FDM_R1000_UM50_FIG.DAT' ) ! Unequal length
C of meshes DT = 0.008
OPEN ( 8, FILE='GH400.DAT')
OPEN ( 7, FILE='F2D_FDM_R400_UM20_FIG.DAT' )
*** OPEN ( 7, FILE='F2D_FDM_R400_UM50_FIG.DAT' ) ! Unequal length
C of meshes
C
C -------------------------------------------------
C
CALL TTLE
C
CALL PREPS ( PSI, U, V, HX, HY, X, Y, NODE, NPL,
1 MSH, REN, IX, IY, IXY, IXY1, KPL )
C
CALL VGA@
C
IF ( KPL.NE.1 ) GO TO 333
C
CALL PLTVR ( RAX, NPL, 1 )
C
CALL PLTVR ( PMX, NPL, 3 )
C
CALL PLTUV ( U, V, HX, HY, X, Y, IX, IY, IXY )
C
C
CALL PLTCT ( X, Y, NODE, PSI, 3, IXY, IXY1 )
C
IF ( MSH.EQ.1) CALL MSHFG ( IX, IY )
C
IF ( MSH.NE.1) CALL MSPLT ( X, Y, IX, IY, IXY )
C
GO TO 999
C
333 CALL CMPLT ( U, V, X, Y, NPL, IX, IY, IXY, REN )
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 REFCMP ( X, Y, UT, VT, KEY, NPL, IM, JM, NNP, REN )
C
C ----------------------------------------------------------
C
KEY = KEY + 1
C
RETURN
END
C **********************************************************************
C
SUBROUTINE REFCMP ( 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 / GDAT / GU( 17), GUY( 17), GV( 17), GVX( 17)
C
COMMON / CNST / X0, Y0, X1, X2, Y1, Y2, SCAL
INTEGER*2 ICR, IICR
C
COMMON / CDATA / UAR( 100), UVR( 3000), YPV( 100), XPV( 100)
C *************** Attention *******************
C
CHARACTER*80 STR0
C
DATA STR0 /'** Results for F2D-FDM (SV) ** ( Velocity Distr. comp
1ared 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 ----- Ghia's Data --- ( Re = 100, 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 --- For Velocity direction change ---
C
C --- Wall Moving direction ---
C
IF ( DABS( REN-1000.D0).LE.0.01D0 ) THEN
C
DO 123 I = 1, 17
GV ( I) = - GV( I) ! for Re= 1000
GVX( I) = 1.D0 - GVX( I)
123 CONTINUE
C
END IF
C
IF ( DABS( REN-400.D0).LE.0.01D0 ) THEN
C
DO 124 I = 1, 17
GV( I) = - GV( I) ! for Re = 400
GVX( I) = 1.D0 - GVX( I)
124 CONTINUE
C
END IF
C
IF ( DABS( REN-100.D0).LE.0.01D0 ) THEN
C
DO 125 I = 1, 17
GU ( I) = - GU( I) ! Re = 100
GVX( I) = 1.D0 - GVX( I)
125 CONTINUE
C
END IF
C
C --------------------------------------------------
C
CALL PLTGD ( IICR )
C
C --------------------------------------------------
C
CALL PLTCV ( X, Y, U, V, IM, JM, NNP, ICR )
C
C --------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PLTCV ( 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 / CDATA / UAR( 100), UVR( 3000), YPV( 100), XPV( 100)
C ***********
C
COMMON / CNST / X0, Y0, X1, X2, Y1, Y2, SCAL
INTEGER*2 IX1, IY1, IX2, IY2, ICR
C
C ---- Computed "U" ------------------------------------
C
DO 1333 J = 1, JM
DO 1333 I = 1, IM
C
NN = IM* ( J-1) + I
C
UVR( NN) = U( I,J)
C
1333 CONTINUE
C
** UVR( 1) = 1.D0
C
KIN = 0
C
DO 1277 I = 1, NNP
C
IF ( DABS( X( I)-0.5D0).LE.0.0001 ) THEN
C
KIN = KIN + 1 ! KIN .LE. 100
UAR( KIN) = UVR( I)
YPV( KIN) = Y ( I)
END IF
C
1277 CONTINUE
C
WRITE(6,*) ' * KIN=', KIN
C
UAR( KIN) = 1.D0
C ****** Attention ******
C
DO 1235 I = 1, KIN
C
IX1 = X0 + X2 + UAR( I)* X2
C
IY1 = Y0 + SCAL - YPV( I)* SCAL
C
IX2 = 2
IY2 = 2
C
CALL ELLIPSE@ ( IX1, IY1, IX2, IY2, ICR )
C
1235 CONTINUE
C
C ----- Computed "V" -----------------------------------
C
DO 1335 J = 1, JM
DO 1335 I = 1, IM
C
NN = IM * ( J-1) + I
UVR( NN) = V( I,J)
1335 CONTINUE
C
** WRITE(6,*) ' * UVR =', ( UVR( I), I= 1, NN )
** WRITE(6,*) ' NN( V) =', NN
C
KIN = 0
C
DO 1280 I = 1, NNP
C
IF ( DABS( Y(I)-0.5D0).LE.0.0001 ) THEN
C
KIN = KIN + 1 ! KIN .LE. 100
UAR( KIN) = UVR( I)
XPV( KIN) = X ( I)
END IF
C
1280 CONTINUE
C
** XPV( 1) = 1.D0
C *******************
C
DO 1237 I = 1, KIN
C
IX1 = X1 + XPV( I)* SCAL
C
*** IY1 = Y1 + Y2 + UAR( I)* Y2 ! Re = 100
IY1 = Y1 + Y2 - UAR( I)* Y2 ! Re = 1000
C
IX2 = 2
IY2 = 2
C
CALL ELLIPSE@ ( IX1, IY1, IX2, IY2, ICR )
C
1237 CONTINUE
C ------------------------------------------------------
C
RETURN
END
C *********************************************************************
C
SUBROUTINE PLTGD ( IICR )
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
INTEGER*2 IX1, IY1, IX2, IY2, IICR
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, IICR )
C
IX1 = X0 + X2
IY1 = Y0 + SCAL
IX2 = X0 + X2
IY2 = Y0
C
CALL RECTANGLE@ ( IX1, IY1, IX2, IY2, IICR )
C
C ---- U by Ghia ----------
C
DO 200 I = 1, 16
C
IC = I + 1
C
IX1 = X0 + X2 + GU ( I)* X2
IY1 = Y0 + SCAL - GUY( I)* SCAL
C
IX2 = X0 + X2 + GU ( IC)* X2
IY2 = Y0 + SCAL - GUY( IC)* SCAL
C
CALL DRAW_LINE@ ( IX1, IY1, IX2, IY2, IICR )
C --------------------------------------------------
200 CONTINUE
C
C --------------------------
C
IX1 = 45
IY1 = 80
C
IX2 = 90
IY2 = IY1
C
CALL DRAW_LINE@ ( IX1, IY1, IX2, IY2, IICR )
C
CALL DRAW_TEXT@ ( 'Ref.', 100, 72, IICR )
C
C ----- To plot V - Distribution -------------------------
C
IX1 = 345
IY1 = 50
IX2 = X1 + SCAL
IY2 = Y1 + SCAL
C
CALL RECTANGLE@ ( IX1, IY1, IX2, IY2, IICR )
C
IX1 = X1
IY1 = Y1 + Y2
IX2 = X1 + SCAL
IY2 = Y1 + Y2
C
CALL RECTANGLE@ ( IX1, IY1, IX2, IY2, IICR )
C
C ----- V by Ghia ------------
C
DO 400 I = 1, 16
C
IC = I + 1
C
IX1 = X1 + ( 1 - GVX( I) )* SCAL
IY1 = Y1 + Y2 + GV( I)* Y2
C
IX2 = X1 + ( 1 - GVX( IC) )*SCAL
IY2 = Y1 + Y2 + GV( IC)* Y2
C
CALL DRAW_LINE@ ( IX1, IY1, IX2, IY2, IICR )
C -------------------------------------------------
400 CONTINUE
C
C ----------------------------
C
RETURN
END
C *********************************************************
C
SUBROUTINE PLTUV ( 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
*** WRITE(6,*) ' * HY=', ( HY(I), I=1, IY-1 )
C
ICR = 11
C
IWD = 160
X0 = 80
Y0 = 70
C
XIT = 80
YIT = 70
C
SCL = 10.D0
C
C ***************
C
CALL RECTANGLE@ ( XIT, YIT, XIT+IWD, YIT+IWD, 15 )
C
IP = IX
JP = IY
C
C ------- Unequal length ---
C
DO 1233 I = 1, IX-1
C
HX( I) = HX( I)* DFLOAT( IWD)
1233 CONTINUE
C
DO 1234 J = 1, IY-1
C
HY( J) = HY( J)* DFLOAT( IWD)
1234 CONTINUE
C
*** WRITE(6,*) ' *** HY=', ( HY( I), I=1, IY-1 )
C
C ----- HYT: Total length of Y-Direction Size ---
C
HYT = 0.D0
DO 123 I = 1, JP-1
C
HYT = HYT + HY( I)
123 CONTINUE
C
WRITE(6,*) ' * HYT =', HYT
C
C -----------------------------------------
DO 100 I = 2, IP
C
XXL = 0.D0
DO 50 K = 1, I-1
C
XXL = XXL + HX( K)
50 CONTINUE
C
HYD = 0.D0
C
C ------------------------------------
DO 100 J = 2, JP
C
X0 = IDNINT( XXL) + XIT
C
HYD = HYD + HY( J-1)
C
Y0 = IDNINT( HYT - HYD ) + YIT
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
C ----- Attention : Direction of 'j' : Downward ---
C
C --- To omit 'PLOT' in case of 'UV'.LT.0.01 ---
C
C INTEGER*2 ICR, XIT, YIT, X0, Y0, X1, Y1, IWD
C
C
*** WRITE(6,*) ' * X0 =', X0
C
CALL DRAW_LINE@ ( X0, Y0, X1, Y1, ICR )
C
100 CONTINUE
C ------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PREPS ( PSI, U, V, HX, HY, X, Y, NODE,
1 NPL, MSH, REN, IX, IY, IXY, IXY1, KPL )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
DIMENSION PSI( IXY), U( IX,IY), V( IX,IY), HX( IX-1),
1 HY ( IY-1), X( IXY), Y( IXY), NODE( IXY1,4)
C
COMMON /LOPN/ RAX(50000), TMX(50000), PMX(50000)
C
C ----- Attention --- Plotting Data ---
C
READ(7,2000) REN, DT, LOPE, MSH, NPL
2000 FORMAT( F8.2, F7.5, I5, I2, I3 )
C
IF ( NPL.GT.500 ) WRITE(6,*) ' ** No. Plotting .GT.50000 * STOP *'
IF ( NPL.GT.500 ) STOP
C
WRITE(6,*) ' '
WRITE(6,1234) IX, IY
1234 FORMAT(/,' *** IX * IY =',I3,' X ',I3 )
C
WRITE(6,*) ' '
WRITE(6,2050) REN, DT, LOPE, MSH
2050 FORMAT(' ** ( IX1*IY1 ) ** Re =',F8.2,' DELT =',F8.5,' * TLOP ='
1, I5,' * MSH =',I2 )
C
C ----- At the Last NPL --- Attention - NPL < = 50000 ---
C
WRITE(6,1233) NPL
1233 FORMAT(/,' * No. of Plotting =', I4,/)
C
READ(7,2200) ( PSI( I), I = 1, IXY )
READ(7,2200) ( RAX( I), I = 1, NPL )
READ(7,2200) ( PMX( I), I = 1, NPL )
C
READ(7,2200) ( X( I), I = 1, IXY )
C
*** WRITE(6,*) ' * X=', ( X ( I), I = 1, 100 ) ! ????
*** STOP
C
READ(7,2200) ( Y ( I), I = 1, IXY )
READ(7,2200) ( ( U( I,J), J = 1, IY ), I = 1, IX )
READ(7,2200) ( ( V( I,J), J = 1, IY ), I = 1, IX )
READ(7,2200) ( HX( I), I = 1, IX-1 )
READ(7,2200) ( HY( I), I = 1, IY-1 )
C
*** WRITE(6,*) ' * RAX =', ( RAX( I), I = 1, NPL )
C
2200 FORMAT(10F8.3)
C
READ(7,2400) ( ( NODE( I,J), J = 1, 4), I = 1, IXY1)
2400 FORMAT(20I4 )
C
WRITE(6,*) ' * KPL = 1 ( Meshes/ Str. F./ Vel. Distr.) or 2 ( Comp
1arison with Ref.)'
READ(5,*) KPL
WRITE(6,*) ' *** KPL =', KPL
C
RETURN
END
C **********************************************************************
C
SUBROUTINE TTLE
C
IMPLICIT REAL*8 (A-H,O-Z)
C
WRITE(6,2000)
WRITE(6,2100)'***************************************************'
WRITE(6,2100)' '
WRITE(6,2100)' *** FIG - F2D - FDM ( SV ) *** '
WRITE(6,2100)' '
WRITE(6,2100)' 2D Thermal-Fluid Analysis by the 4th order FDM '
WRITE(6,2100)' '
WRITE(6,2100)' Copyright 2011 : Yasuhiro MATSUDA '
WRITE(6,2100)' '
WRITE(6,2100)'***************************************************'
C
2000 FORMAT(/)
2100 FORMAT(A55)
C
RETURN
END
C **********************************************************************
C
SUBROUTINE MSHFG ( IX, IY )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
INTEGER*2 ICR, XIT, YIT, IWD, IWE, IWK1, IWK2
C
COMMON /ABC/ XIT, YIT, IWD
C
ICR = 15
IWD = 160
C
XIT = 440
YIT = 70
C
CALL RECTANGLE@ ( XIT, YIT, XIT+IWD, YIT+IWD, ICR )
C
RIWE = DFLOAT( IWD) / DFLOAT( IX-1)

WRITE(6,*) ' * RIWE=', RIWE
C
IWK2 = XIT + IWD
C
DO 100 I = 1, IX-2
C
IWK1 = IDNINT( DFLOAT( YIT) + RIWE * DFLOAT( I) ) ! Better
C
CALL DRAW_LINE@ ( XIT, IWK1, IWK2, IWK1, ICR )
C
100 CONTINUE
C
C --------------------------------
C
IWK2 = YIT + IWD
C
DO 200 J = 1, IY-2
C
IWK1 = IDNINT( DFLOAT( XIT) + RIWE* DFLOAT( J) ) ! Better
C
CALL DRAW_LINE@ ( IWK1, YIT, IWK1, IWK2, ICR )
C
200 CONTINUE
C
RETURN
END
C **********************************************************************
C
SUBROUTINE MSPLT ( 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
*** WRITE(6,*) ' * X=', ( X(I), I=1, IXY )
*** STOP
C
ICR = 15
IWD = 160
C
XIT = 440
YIT = 70
C
CALL RECTANGLE@ ( XIT, YIT, XIT+IWD, YIT+IWD, ICR )
C
DO 100 I = 1, IX+1
C
C ----- Attention ---
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
RETURN
END
C **********************************************************************
C
SUBROUTINE PLTCT ( X, Y, NODE, CTV, KKK, IXY, IXY1 )
C
C ----- To plot contour lines for rectangular MSHes ---
C
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), NODE( IXY1,4 )
C
DIMENSION PX( 4), PY( 4), HVA( 21)
C **********
RMI= 100.D0
RMX = 0.D0
C
DO 123 I = 1, IXY
C
IF ( CTV( I).LE.RMI ) RMI = CTV( I)
IF ( CTV( I).GE.RMX ) RMX = CTV( I)
123 CONTINUE
C
WRITE(6,1231) KKK, RMI, RMX
1231 FORMAT(' ** KKK =',I2,' Rmin.=',F8.3,5X,' Rmax.=',F8.3 )
C
NM = 11
C *********
C
DRM = ( RMX - RMI ) / DFLOAT( NM-1)
C
WRITE(6,*) ' * DRM=', DRM
C
DO 1222 I = 1, NM
C
HVA( I) = RMI + DRM* DFLOAT( I-1)
1222 CONTINUE
C
C *****************************
C
ICR = 15
C
IWD = 160
XIT = 190
X0 = 80
Y0 = 70
YIT = 70
C
C --------------------------
C
IF ( KKK.EQ.1 ) THEN
C
CALL RECTANGLE@ ( X0, Y0, X0+IWD, Y0+IWD, ICR )
C
ICR = 12
C
GO TO 3344
C
END IF
C
C --------------------------
C
XIT = XIT + IWD + 20
X0 = X0 + 180
C
CALL RECTANGLE@ ( X0, Y0, X0+IWD, Y0+IWD, ICR )
C
ICR = 11
C
3344 CONTINUE
C *************************************
C
SCLX = 160.D0
SCLY = 160.D0
C
C ----- To plot contour lines ---
C
PXV = 0.D0
PYV = 0.D0
C
C *********************************************************
DO 100 L = 1, IXY1
C
C ********************************************
C
DO 200 IH = 2, NM - 1
C ******* Attention *********
C
HV = HVA( IH)
C
ICL = 0
C
C ****************************
DO 300 J = 1, 4
C
I1 = NODE( L, J)
C
IF ( J.NE.4) THEN
I2 = NODE( L,J+1)
C
ELSE
I2 = NODE( L,1)
C
END IF
C
IF ( ABS( CTV( I1)-CTV( I2) ).LE.0.000001 ) THEN
IF ( ABS( CTV( I1)-HV ) .LE.0.000001 ) THEN
C
ICL = ICL + 1
C
PX( ICL) = NINT( X( I1)*SCLX )
PY( ICL) = NINT( Y( I1)*SCLY )
C -----------------------------------
C
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) )
C
PX(ICL) = ( X(I1) + ( X(I2)-X(I1) )* RT )* SCLX
PY(ICL) = ( Y(I1) + ( Y(I2)-Y(I1) )* RT )* SCLY
C
END IF
C
300 CONTINUE
C ******************************
C
IF ( ICL.GE.2) THEN
C
C ********************************
DO 400 J = 1, ICL
C
JM = J
D2 = ( PXV - PX(J) )**2 + ( PYV - PY(J) )**2
C
C *******************
DO 500 JJ = J+1, ICL
C
D2V = ( PXV - PX(JJ) )**2 + ( PYV - PY(JJ) )**2
C
IF ( D2V.LT.D2 ) THEN
JM = JJ
D2 = D2V
END IF
C
500 CONTINUE
C **********************
C
PXV = PX( JM)
PYV = PY( JM)
PX( JM) = PX( J)
PY( JM) = PY( J)
PX( J) = PXV
PY( J) = PYV
C
400 CONTINUE
C *********************************
C
PXV = PX( ICL)
PYV = PY( ICL)
C
END IF
C
IF ( ICL.GT.0 ) THEN
C
C **********************
DO 600 J = 2, ICL
C
CALL DRAW_LINE@
C
1 ( X0+PX( 1), Y0+PY( 1), X0+PX( J), Y0+PY( J), ICR )
C
600 CONTINUE
C **********************
C
END IF
C
200 CONTINUE
C *****************************************
C
100 CONTINUE
C *********************************************************
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PLTVR ( RWK, NPL, KKK )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
INTEGER*2 ICR, IX0, IY0
C
C ----- Attention NPL .LE.500 --------
C
DIMENSION RWK (50000)
INTEGER*2 IVAR(50000), IXX(50000)
C
C -------------------------------------
C
CHARACTER*80 STR3
CHARACTER*6 STR1( 3)
CHARACTER*3 STR2( 4)
C
DATA STR3 /'* F2D-FDM(SV) ( Max.rel_var_of Vor.(%) & Psi(%) )'/
DATA STR1 /'0 ','NPL/2',' NPL'/
DATA STR2 /' 10','7.5',' 5','2.5'/
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
* CALL DRAW_TEXT@ ( STR2( 1), 20, 50, ICR )
* CALL DRAW_TEXT@ ( STR2( 2), 20, 150, ICR )
* CALL DRAW_TEXT@ ( STR2( 3), 20, 250, ICR )
* CALL DRAW_TEXT@ ( STR2( 4), 20, 350, ICR )
C
IX0 = 50
IY0 = 40
C
CALL RECTANGLE@ ( IX0, IY0, IX0+580, IY0+400, 15 )
C
1234 CONTINUE
C
C ********************************
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 )
C
CALL DRAW_TEXT@ ( '(%)', 15, 245, ICR )
C
133 CONTINUE
C
RIWD = 580.D0 / DFLOAT( NPL)
C
DO 150 I = 1, NPL
C
IF ( RWK( I).LE.0.D0 ) GO TO 150
C
RWK( I) = DLOG10( RWK( I) )
C ----------------------------------
150 CONTINUE
C
SCL = 80.D0
C ****************
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 ******************************************
C
DO 100 I = 1, NPL
C
IXX ( I) = IX0 + IDNINT( DFLOAT( I)* RIWD )
C
IVAR( I) = 280 - IDNINT( RWK( I)* SCL )
C
* IVAR( I) = IX0 + 400 - RWK( I)*4.D0
C
100 CONTINUE
C
WRITE(6,*) ' * IVAR( NPL)=', IVAR(NPL)
C
C *********************************
C
CALL POLYLINE@ ( IXX, IVAR, NPL, ICR )
C
C --------------------------------------------
C
RETURN
END
C ************************************************************************