C
PROGRAM MAIN
C
C ******************************************************************** C
C C
C Graphics for F 2 D - G F D C
C C
C Fourth & 2nd ordered FDM C
C C
C ( Version : 5.3 ) C
C C
C ( 7 Flow Problems ) C
C C
C V-Shape / Square / Circle / Backstep( 1) C
C C
C Backstep( 2) / Cavity( S) / Cavity( L) C
C C
C Copyright : Yasuhiro MATSUDA C
C C
C ******************************************************************** C
C
IMPLICIT REAL*8 (A-H,O-Z)
C
C ----- Attention --- To set Max. Size of Vectors etc ---
C
PARAMETER ( MXE = 2500, MXN = 2601 )
C
DIMENSION XE( MXE), YE( MXE), UE ( MXE), VE( MXE),
1 XY( 2,MXN), PN( MXN), NDE( MXE,4)
C
COMMON /VARP/ WMX( 5000), PMX( 5000)
C
LOGICAL*1 FLV( MXE)
C
COMMON /CNST/ NPB, FSM, WEI, RE, DT, LOP, IX, IY, RMX, RMN, DX, DY
C
CHARACTER*14 FSM
C
OPEN ( 15,FILE='F2D_GFD_PLT.DAT')
C
CALL TTLE
C
999 CONTINUE
C
CALL PRPS ( UE, VE, PN, FLV, XE, YE, XY, NDE, NNP, NEL,
1 MXE, MXN, *9999 )
C
CALL VGA@
C
C ----- Plotting at the Last Loop ---
C
CALL PLTN ( XE, YE, UE, VE, FLV, NNP, NEL )
C
CALL PLVR ( PMX, 1 )
C
CALL PLVR ( WMX, 2 )
C
CALL PCNT ( XY, PN, NDE, FLV, NNP, NEL, MXE, MXN )
C
GO TO 999
9999 CONTINUE
C
CLOSE ( 15)
C
STOP
END
C **********************************************************************
C
SUBROUTINE PLVR ( RWK, KKK )
C
IMPLICIT REAL*8 (A-H, O-Z)
C
INTEGER*2 ICR, IX0, IY0, IX1, IY1
C
C ----- Attention : N .LE. 2000 ---
C
DIMENSION RWK( 5000)
C
INTEGER*2 IVR( 2000), IXX( 2000)
C
COMMON /CNST/ NPB, FSM, WEI, RE, DT, LOP, IX, IY, RMX, RMN, DX, DY
C
CHARACTER*14 FSM
C
CHARACTER*85 STR0
CHARACTER*80 STR01
CHARACTER*80 STR02
CHARACTER*80 STR03
CHARACTER*4 STR1( 3)
CHARACTER*3 STR2( 4)
C
DATA STR0 /'*** Results for F2D-GFD ** ( Var. of Str.Fn. & Vort.)
1 ***'/
C
DATA STR01 /'( Meshes / Stream function contours )'/
DATA STR02 /'Stream function contours & Velocity distribution'/
DATA STR03 /'Velocity Distr. & Stream function contours & Meshes'/
C
DATA STR1 /'0 ', 'LP/2', 'LOP'/
DATA STR2 /'400','300','200','100'/
C
ICR = 15
C
IF ( KKK.EQ.2) GO TO 999
C ----------------------------------------------------------
C
CALL SET_TEXT_ATTRIBUTE@( 3, 1., 0., 0. )
C
CALL DRAW_TEXT@( STR0, 50, 5, ICR )
C
C ------------------------------------------------
C
IF ( NPB.EQ.5.OR.NPB.EQ.4) CALL DRAW_TEXT@( STR03, 150, 20,ICR)
C
IX0 = 50
IY0 = 40
IX1 = IX0 + 580
IY1 = IY0 + 400
C
CALL RECTANGLE@( IX0, IY0, IX1, IY1, ICR )
C
C ------------------------------------------------
IF ( NPB.EQ.6 .OR. NPB.EQ.7) GO TO 555
C
CALL DRAW_TEXT@( STR2( 1), 20, 30, ICR )
CALL DRAW_TEXT@( STR2( 2), 20, 130, ICR )
CALL DRAW_TEXT@( STR2( 3), 20, 230, ICR )
CALL DRAW_TEXT@( STR2( 4), 20, 330, ICR )
C
555 CONTINUE
C
999 CONTINUE
C ------------------------------------------------
IF ( NPB.EQ.6 .OR. NPB.EQ.7) THEN
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
RIWD = 580.D0/ DFLOAT( LOP)
WRITE(6,*) ' '
WRITE(6,*) ' * RWK( LOP)= ', RWK( LOP)
C
C ----------------------------
DO 150 I = 1, LOP
C
IF ( RWK( I).LE.0.D0) GO TO 150
RWK( I) = DLOG10( RWK( I))
150 CONTINUE
C ----------------------------
C
SCL = 100.D0
CALL DRAW_TEXT@( STR02,120, 20, ICR )
GO TO 333
C
END IF
C ------------------------------------------------
C
333 CONTINUE
C
IF ( NPB.LE.3) CALL DRAW_TEXT@( STR01,120, 20, ICR )
C
CALL DRAW_TEXT@( STR1( 1), 45, 450, ICR )
CALL DRAW_TEXT@( STR1( 2), 315, 450, ICR )
CALL DRAW_TEXT@( STR1( 3), 605, 450, ICR )
C
C ----- Light Magenta ( Pink ): Vorticity ---
C
RIWD = 580.D0/ DFLOAT( LOP)
C
IF ( KKK.EQ.1) ICR = 11 ! Light Cyan : Stream function
IF ( KKK.EQ.2) ICR = 14 ! Light Magenta
C
C ----------------------------------------------------------
DO 100 I = 1, LOP
C
IXX( I) = IX0 + IDNINT( DFLOAT( I)* RIWD )
IVR( I) = IY0 + 400 - IDNINT( RWK( I))
C
IF ( NPB.EQ.6.OR.NPB.EQ.7) IVR( I) = 340 - IDNINT( RWK( I)* SCL)
C
100 CONTINUE
C ----------------------------------------------------------
C
CALL POLYLINE@( IXX, IVR, LOP, ICR )
C
C ----------------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PLTN ( XE, YE, UE, VE, FLV, NNP, NEL )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
INTEGER*2 X0, Y0, X1, Y1, X2, Y2, GX, GY, IX1, IY1, IX2, IY2, ICR
C
LOGICAL*1 FLV( NEL)
DIMENSION XE ( NEL), YE( NEL), UE( NEL), VE( NEL)
C
COMMON /CNST/ NPB, FSM, WEI, RE, DT, LOP, IX, IY, RMX, RMN, DX, DY
CHARACTER*14 FSM
C
ICR = 11
C
IX2 = 1
IY2 = 1
C
WL = 0.D0
C
IF ( NPB.GT.3) GO TO 123
X0 = 100
Y0 = 21
SCX = 250.D0
SCY = 250.D0
WDH = 330.D0
ADH = 250.D0
SCL = 3.D0
Y1 = 70
123 CONTINUE
C
IF ( NPB.NE.4) GO TO 128
X0 = 70
Y0 = 100
SCX = 18.D0
SCY = 36.D0
WDH = 280.D0
ADH = 70.D0
SCL = 3.D0
Y1 = 200
128 CONTINUE
C
IF ( NPB.NE.5) GO TO 124
X0 = 70
Y0 = 150
SCX = 18.D0
SCY = 36.D0
WDH = 250.D0
ADH = 0.D0
SCL = 3.D0
Y1 = 170
124 CONTINUE
C
IF ( NPB.NE.6) GO TO 125
X0 = 80
Y0 = 120
SCX = 170.D0
SCY = 170.D0
WDH = 310.D0
ADH = 130.D0
WL = 180.D0
SCL = 40.D0
Y1 = -10
125 CONTINUE
C
IF ( NPB.NE.7) GO TO 127
X0 = 350
Y0 = 120
SCX = 250.D0
SCY = 250.D0
WDH = 350.D0
ADH = 200.D0
WL = 180.D0
SCL = 30.D0
Y1 = -10
127 CONTINUE
C
TL = DT* DFLOAT( LOP)
C
C -----------------------------------------------------
DO 100 I = 1, NEL
C
IF ( .NOT.FLV( I)) GO TO 100
C
IX1 = X0 + IDNINT( WL + XE( I)* SCX )
IY1 = Y0 + IDNINT( WDH - WL - YE( I)* SCY )
C
IF ( NPB.EQ.7) IX1 = IX1 - IDNINT( WL) - 280
IF ( NPB.EQ.7) IY1 = IY1 + 30
C
CALL FILL_ELLIPSE@( IX1, IY1, IX2, IY2, ICR )
C
100 CONTINUE
C -----------------------------------------------------
C
IF ( NPB.LE.3) RETURN
C
IF ( NPB.EQ.6) X0 = 440
C
C -----------------------------------------------------
DO 200 I = 1, NEL
C
IF ( .NOT.FLV( I)) GO TO 200
C
GX = X0 + IDNINT( XE( I)* SCX )
GY = Y0 + IDNINT( ADH - YE( I)* SCY )
IF ( GX.EQ.X0) GO TO 100
IF ( GY.EQ.Y0) GO TO 100
C
X1 = GX
Y1 = GY
X2 = GX + IDNINT( UE( I)* SCL)
Y2 = GY - IDNINT( VE( I)* SCL)
C
C ----- Attention : Direction of 'j' : Downward ---
C
CALL DRAW_LINE@( X1, Y1, X2, Y2, 11 )
C
200 CONTINUE
C -----------------------------------------------------
C
RETURN
END

C **********************************************************************
C
SUBROUTINE PCNT ( XY, TEP, NDE, FLV, NNP, NEL, MXE, MXN )
C
C ----- Plot Contour Lines for Rectangular Meshes ---
C
C ( Linear Interpolation )
C
IMPLICIT REAL*8(A-H,O-Z)
C
INTEGER*2 X00, Y00, X1, Y1, X2, Y2, X0, Y0
C
LOGICAL*1 FLV( MXE)
COMMON /CNST/ NPB, FSM, WEI, RE, DT, LOP, IX, IY, RMX, RMN, DX, DY
CHARACTER*14 FSM
C
DIMENSION XY ( 2,MXN), TEP( MXN), NDE( MXE,4)
C
C ----- Attention -----------------------------
C
DIMENSION PX( 4), PY( 4), HVN( 100)
C ---------------------------------------------
C
X0 = 0
Y0 = 0
C
IF ( NPB.GT.3) GO TO 120
X00 = 100
Y00 = 100
SCX = 250.D0
SCY = 250.D0
ADH = SCY
SCL = 3.D0
NM = 60
C
120 CONTINUE
C
IF ( NPB.NE.4) GO TO 128
X00 = 70
Y00 = 200
SCX = 18.D0
SCY = 36.D0
SCL = 3.D0
NM = 23
128 CONTINUE
C
IF ( NPB.NE.5) GO TO 124
X00 = 70
Y00 = 200
SCX = 18.D0
SCY = 36.D0
SCL = 3.D0
NM = 21
124 CONTINUE
C
IF ( NPB.NE.6) GO TO 125
X00 = 80
X00 = 260
Y00 = 80
SCX = 170.D0
SCY = 170.D0
SCL = 40.D0
NM = 18
125 CONTINUE
C
IF ( NPB.NE.7) GO TO 127
X00 = 70
Y00 = 70
SCX = 250.D0
SCY = 250.D0
SCL = 20.D0
NM = 20
127 CONTINUE
C
X1 = X00 + SCX
Y1 = Y00 + SCY
DINCR = ( RMX - RMN)/ DFLOAT( NM - 1)
C
DO 100 I = 1, NM
C
HVN( I) = RMN + DINCR* DFLOAT( I-1)
100 CONTINUE
C
C ----- Plot Contour Lines ---
C
PXV = 0.D0
PYV = 0.D0
C
IHS = 2
IHE = NM - 1
C
C --------------------------------------
IF ( NPB.LE.5.OR.NPB.EQ.4) THEN
C
C ----- Attention for NPB = 5 ---
C
IHS = 1
IHE = NM
C
HVN( 1) = 1.D0
HVN(NM) = -1.D0
C
END IF
C --------------------------------------
C
C ----------------------------------------------------------
DO 300 L = 1, NEL
C
IF ( .NOT.FLV( L)) GO TO 300
C ------------------------------------------------
DO 350 IH = IHS, IHE
C
HV = HVN( IH)
ICL = 0
C
C --------------------------------------
DO 370 J = 1, 4
C
N1 = NDE( L,J)
IF ( J .NE. 4) THEN
N2 = NDE( L,J+1)
ELSE
N2 = NDE( L,1)
END IF
C
IF ( ABS( TEP( N1) - TEP( N2)).LE.1.D-15) THEN
C
IF ( ABS( TEP( N1) - HV) .LE.1.D-15) THEN
ICL = ICL + 1
PX( ICL) = XY( 1,N1)
PY( ICL) = XY( 2,N1)
END IF
C
ELSE
C
1 IF (( ( TEP( N1).LE.HV ).AND.( HV.LT.TEP( N2)))
2 .OR. (( TEP( N1).GE.HV ).AND.( HV.GT.TEP( N2))))
3 THEN
C
ICL = ICL + 1
RT = ( HV -TEP( N1))/ ( TEP( N2) - TEP( N1))
PX( ICL) = ( XY( 1,N1) + ( XY( 1,N2) - XY( 1,N1))* RT )
PY( ICL) = ( XY( 2,N1) + ( XY( 2,N2) - XY( 2,N1))* RT )
C
END IF
C
370 CONTINUE
C --------------------------------------
C
IF ( ICL.GE.2) THEN
C
C --------------------------------------
DO 380 J = 1, ICL
C
JM = J
D2 = ( PXV - PX( J))** 2 + ( PYV - PY( J))** 2
C
C --------------------------
DO 390 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
390 CONTINUE
C --------------------------
C
PXV = PX( JM)
PYV = PY( JM)
PX( JM) = PX( J)
PY( JM) = PY( J)
PX( J) = PXV
PY( J) = PYV
C
380 CONTINUE
C --------------------------------------
C
PXV = PX( ICL)
PYV = PY( ICL)
C
END IF
C
IF ( ICL.GT.0) THEN
C
X1 = X00 + IDNINT(( DFLOAT( X0) + PX( 1))* SCX)
Y1 = Y00 + IDNINT(( DFLOAT( Y0) + PY( 1))* SCY)
C
C --------------------------------------
DO 395 J = 2, ICL
C
X2 = IDNINT(( DFLOAT( X0) + PX( J))* SCX) + X00
Y2 = IDNINT(( DFLOAT( Y0) + PY( J))* SCY) + Y00
C
CALL DRAW_LINE@( X1, Y1, X2, Y2, 15 )
C
395 CONTINUE
C --------------------------------------
C
IF ( ICL.EQ.4) THEN
X2 = IDNINT(( DFLOAT( X0) + PX( 1))* SCX) + X00
Y2 = IDNINT(( DFLOAT( Y0) + PY( 1))* SCX) + Y00
END IF
C
IF ( ICL.EQ.4) CALL DRAW_LINE@( X1, Y1, X2, Y2, 15 )
C
END IF
C
350 CONTINUE
C ------------------------------------------------
C
300 CONTINUE
C ----------------------------------------------------------
C
RETURN
END
C **********************************************************************
C
SUBROUTINE PRPS ( UE, VE, PN, FLV, XE, YE, XY, NDE,
1 NNP, NEL, MXE, MXN, * )
C
IMPLICIT REAL*8 (A-H,O-Z)
C
C ----- Attention ---
C
DIMENSION XE( MXE), YE( MXE), UE ( MXE), VE( MXE),
1 XY( 2,MXN), PN( MXN), NDE( MXE,4)
C
LOGICAL*1 FLV( MXE)
C
COMMON /VARP/ WMX( 5000), PMX( 5000)
COMMON /CNST/ NPB, FSM, WEI, RE, DT, LOP, IX, IY, RMX, RMN, DX, DY
CHARACTER*14 FSM
C
READ(15,1000,END=999) NPB, FSM, WEI, RE, DT, LOP, NEL, NNP, IX,
1 IY, DX, DY
1000 FORMAT(I2,A14,3F9.3,5I4,2F9.3)
C
WRITE(6,*) ' '
WRITE(6,2000) NPB, FSM, WEI, RE, DT, LOP, NNP, NEL, IX, IY, DX, DY
2000 FORMAT('*** NPB =',I2,' * Problem : ',A14,//,' * WEI =',F5.2,
1 ' * Re =', F7.2,' * DT =',F7.4,' * LOP =',I4,//,
2 ' * NNP =',I5,' * NEL =',I5,' * IX =',I4,' IY =',I4,/,
3 14X,' * DX =',F7.3,' * DY =',F7.3)
C
READ (15,1100) ( XE( I), YE( I), I = 1, NEL )
READ (15,1100) ( UE( I), VE( I), I = 1, NEL )
1100 FORMAT(10F8.4)
C
READ (15,1200) ( WMX( I), I = 1, LOP )
READ (15,1200) ( PMX( I), I = 1, LOP )
1200 FORMAT(10F8.2)
C
READ (15,1200) (( XY( I,J), I = 1, 2), J = 1, NNP )
READ (15,1200) ( PN( I), I = 1, NNP )
C
RMX = -10000.D0
RMN = 10000.D0
C
DO 100 I = 1, NNP
C
IF ( PN(I).GE.RMX) RMX = PN( I)
IF ( PN(I).LE.RMN) RMN = PN( I)
C
100 CONTINUE
C
WRITE(6,2100) RMX, RMN
2100 FORMAT(/,' * Rmax.=', F7.3,' * Rmin.=', F7.3)
C
READ(15,1300) (( NDE(I,J), J=1, 4), I=1, NEL)
1300 FORMAT(20I4)
C
READ(15,1400) ( FLV(I), I=1, NEL)
1400 FORMAT(80L1)
C
RETURN
C
999 RETURN 1
C
END
C **********************************************************************
C
SUBROUTINE TTLE
C
WRITE(6,*) ' '
WRITE(6,2000)
2000 FORMAT(
1 ' ',' C *************************************************** C '/
2 ' ',' C C '/
3 ' ',' C Figure - F2D - GFD C '/
4 ' ',' C C '/
5 ' ',' C Fourth & Second ordered FDM C '/
6 ' ',' C C '/
7 ' ',' C ( Analysis for Seven Flow Problems ) C '/
8 ' ',' C C '/
9 ' ',' C ( Version : 5.3 ) C '/
A ' ',' C C '/
B ' ',' C Copyright 2014 : Yasuhiro MATSUDA C '/
C ' ',' C C '/
D ' ',' C *************************************************** C '/)
C
RETURN
END
C **********************************************************************