From 0d4f43d355de79178b1142e9735902cf641670b6 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Mon, 11 May 2009 00:27:49 +0000 Subject: Xfoil 6.97 --- orrs/src/conlab.f | 202 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 202 insertions(+) create mode 100755 orrs/src/conlab.f (limited to 'orrs/src/conlab.f') diff --git a/orrs/src/conlab.f b/orrs/src/conlab.f new file mode 100755 index 0000000..53c8599 --- /dev/null +++ b/orrs/src/conlab.f @@ -0,0 +1,202 @@ +C + SUBROUTINE CONLAB(IX,JX,II,JJ,X,Y,F,FCON,XWT,YWT, + & CH,NDIG,ISIDE) + DIMENSION X(IX,JX), Y(IX,JX) + DIMENSION F(IX,JX) +C--------------------------------------------------------------------- +C Puts numerical labels on the contour with value FCON at the +C edge of the domain specified by ISIDE. The number of digits +C in the label(s) after the decimal point is given by NDIG. +C +C Input: +C IX JX dimensions of arrays X, Y, F +C II JJ array limits of arrays X, Y, F +C X(i,j) coordinates of grid point (i,j) +C Y(i,j) +C F(i,j) function value at grid point (i,j) +C FCON value of F on the contour to be generated +C XWT YWT plotting scale factors for X,Y: +C Xplot = X(i,j)*XWT +C Yplot = Y(i,j)*YWT +C CH absolute character height (no scaling is done) +C NDIG number of digits after decimal point in labels +C ISIDE domain side on which labels are to appear: +C +C . 3 . +C +C 4 2 +C +C . 1 . +C +C +C Output: direct plotting calls using Versatec routines +C +C--------------------------------------------------------------------- + LOGICAL LABEL +C + DATA PI, RTOD / 3.141592654, 57.2957795 / +C +C---- total number of digits + decimal point + RDIG = 3.25 + FLOAT(NDIG) +C + IF(ISIDE.EQ.1) THEN + JO = 1 + JP = 2 + KLO = 1 + KHI = II-1 + ELSE IF(ISIDE.EQ.2) THEN + IO = II-1 + IP = II + KLO = 1 + KHI = JJ-1 + ELSE IF(ISIDE.EQ.3) THEN + JO = JJ-1 + JP = JJ + KLO = 1 + KHI = II-1 + ELSE IF(ISIDE.EQ.4) THEN + IO = 1 + IP = 2 + KLO = 1 + KHI = JJ-1 + ENDIF +C +C---- check domain edge specified by ISIDE if the contour touches it + DO 10 K=KLO, KHI +C + IF(ISIDE.EQ.1) THEN + IO = K + IP = K+1 + ELSE IF(ISIDE.EQ.2) THEN + JO = K + JP = K+1 + ELSE IF(ISIDE.EQ.3) THEN + IO = K + IP = K+1 + ELSE IF(ISIDE.EQ.4) THEN + JO = K + JP = K+1 + ENDIF +C +C------ flag indicating if contour crosses current cell + LABEL = .FALSE. +C +C op 3 pp +C +C 4 2 +C +C oo 1 po +C + XOO = X(IO,JO) + XOP = X(IO,JP) + XPO = X(IP,JO) + XPP = X(IP,JP) +C + YOO = Y(IO,JO) + YOP = Y(IO,JP) + YPO = Y(IP,JO) + YPP = Y(IP,JP) +C + FOO = F(IO,JO) + FOP = F(IO,JP) + FPO = F(IP,JO) + FPP = F(IP,JP) +C +C------ bottom edge (side 1) + IF(FCON.GE.FOO .AND. FCON.LT.FPO .OR. + & FCON.LT.FOO .AND. FCON.GE.FPO ) THEN + IF(ISIDE.EQ.1) THEN + XCON2 = XOO + (FCON-FOO)*(XPO-XOO)/(FPO-FOO) + YCON2 = YOO + (FCON-FOO)*(YPO-YOO)/(FPO-FOO) + LABEL = .TRUE. + ELSE + XCON1 = XOO + (FCON-FOO)*(XPO-XOO)/(FPO-FOO) + YCON1 = YOO + (FCON-FOO)*(YPO-YOO)/(FPO-FOO) + ENDIF + ENDIF +C +C------ left edge (side 4) + IF(FCON.GE.FOO .AND. FCON.LT.FOP .OR. + & FCON.LT.FOO .AND. FCON.GE.FOP ) THEN + IF(ISIDE.EQ.4) THEN + XCON2 = XOO + (FCON-FOO)*(XOP-XOO)/(FOP-FOO) + YCON2 = YOO + (FCON-FOO)*(YOP-YOO)/(FOP-FOO) + LABEL = .TRUE. + ELSE + XCON1 = XOO + (FCON-FOO)*(XOP-XOO)/(FOP-FOO) + YCON1 = YOO + (FCON-FOO)*(YOP-YOO)/(FOP-FOO) + ENDIF + ENDIF +C +C------ right edge (side 2) + IF(FCON.GE.FPO .AND. FCON.LT.FPP .OR. + & FCON.LT.FPO .AND. FCON.GE.FPP ) THEN + IF(ISIDE.EQ.2) THEN + XCON2 = XPO + (FCON-FPO)*(XPP-XPO)/(FPP-FPO) + YCON2 = YPO + (FCON-FPO)*(YPP-YPO)/(FPP-FPO) + LABEL = .TRUE. + ELSE + XCON1 = XPO + (FCON-FPO)*(XPP-XPO)/(FPP-FPO) + YCON1 = YPO + (FCON-FPO)*(YPP-YPO)/(FPP-FPO) + ENDIF + ENDIF +C +C------ top edge (side 3) + IF(FCON.GE.FOP .AND. FCON.LT.FPP .OR. + & FCON.LT.FOP .AND. FCON.GE.FPP ) THEN + IF(ISIDE.EQ.3) THEN + XCON2 = XOP + (FCON-FOP)*(XPP-XOP)/(FPP-FOP) + YCON2 = YOP + (FCON-FOP)*(YPP-YOP)/(FPP-FOP) + LABEL = .TRUE. + ELSE + XCON1 = XOP + (FCON-FOP)*(XPP-XOP)/(FPP-FOP) + YCON1 = YOP + (FCON-FOP)*(YPP-YOP)/(FPP-FOP) + ENDIF + ENDIF +C + IF(LABEL) THEN +C +C------- a contour reaching the domain edge has been found - set coordinates +C of contour on the cell edges + X1 = XWT*XCON1 + X2 = XWT*XCON2 + Y1 = YWT*YCON1 + Y2 = YWT*YCON2 +C + DX = X2 - X1 + DY = Y2 - Y1 +C +C------- contour angle + ACON = ATAN2( DY , DX ) + SA = SIN(ACON) + CA = COS(ACON) +C +C------- if contour points to the right ... + IF(ABS(ACON) .LT. 0.5*PI) THEN +C +C-------- set angle and lower left coordinates of number + ANUM = RTOD*ACON + XN = X2 + CH*CA + 0.5*CH*SA + YN = Y2 + CH*SA - 0.5*CH*CA +C +C------- if contour points to the left ... + ELSE +C +C-------- add +/- 180 degrees to number angle to make it read right to left + ANUM = RTOD*ACON - SIGN(180.0,ACON) +C +C-------- set lower left coordinates of number + XN = X2 + CH*RDIG*CA - 0.5*CH*SA + YN = Y2 + CH*RDIG*SA + 0.5*CH*CA +C + ENDIF +C +C------- draw number + CALL NUMBER(XN,YN,CH,FCON,ANUM,NDIG) +C + ENDIF +C + 10 CONTINUE +C + RETURN + END ! CONLAB -- cgit v1.2.3