C C C SUBROUTINE PWRITF( X,Y , CH,NCH , ISIZ,IOR,ICENT ) C REAL X , Y INTEGER NCH , ISIZ,IOR,ICENT CHARACTER*(*) CH C PARAMETER ( NSAVE = 69999 ) REAL XSTR(NSAVE) , YSTR(NSAVE) INTEGER LSTR(NSAVE) C CHARACTER*6666 CHLOC C....................................................................... PARAMETER ( DG2RAD = .017453292 ) C INCLUDE 'plotpak.inc' C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C Calculate character width in terms of 1/1000 of the x-width. C ISIZE = ISIZ IF( ISIZE .LE. 0 )THEN ISIZE = 8 ELSEIF( ISIZE .EQ. 1 )THEN ISIZE = 12 ELSEIF( ISIZE .EQ. 2 )THEN ISIZE = 16 ELSEIF( ISIZE .EQ. 3 )THEN ISIZE = 24 ENDIF C SIZE = ISIZE * 0.001 * ( XPGMAX - XPGMIN ) C C Rotation/scaling factors for digitization C ORR= DG2RAD * IOR CT = SIZE * COS(ORR) ST = SIZE * SIN(ORR) C C Base location, in internal coordinates C XX = X YY = Y IF( NCH .GE. 0 )CALL ZZPHYS( XX , YY ) C C Get no. of characters in string. Special option 999 must be checked. C NCHAR = ABS( NCH ) IF( NCHAR .EQ. 999 )THEN DO 10 I=1,NCHAR IF( CH(I:I) .EQ. CHAR(0) )GOTO 20 10 CONTINUE 20 NCHAR = I-1 ELSEIF( NCHAR .EQ. 0 )THEN NCHAR = LASTNB( CH ) ENDIF C C Digitize string into line segments C CALL ZZCONV( CH,NCHAR , CHLOC,NCHLOC ) CALL ZZSTRO( CHLOC,NCHLOC , NSTR,XSTR,YSTR,LSTR ) IF( NSTR .LE. 0 )RETURN C C Find min, max of x and y C XBOT = XSTR(1) YBOT = YSTR(1) XTOP = XBOT YTOP = YBOT DO 100 I=2,NSTR XBOT = MIN( XBOT , XSTR(I) ) XTOP = MAX( XTOP , XSTR(I) ) YBOT = MIN( YBOT , YSTR(I) ) YTOP = MAX( YTOP , YSTR(I) ) 100 CONTINUE C C Now compute origin of string, based on centering option; C the origin of the string goes at (XX,YY) C IF( ICENT .EQ. -1 )THEN XORG = XBOT YORG = 0.5*(YBOT+YTOP) ELSEIF( ICENT .EQ. 0 )THEN XORG = 0.5*(XBOT+XTOP) YORG = 0.5*(YBOT+YTOP) ELSEIF( ICENT .EQ. +1 )THEN XORG = XTOP YORG = 0.5*(YBOT+YTOP) ELSE XORG = XBOT YORG = YBOT ENDIF C C Now draw the strokes C DO 200 I=1,NSTR IF( LSTR(I) .LE. 1 )THEN XR = XX + CT*(XSTR(I)-XORG) - ST*(YSTR(I)-YORG) YR = YY + ST*(XSTR(I)-XORG) + CT*(YSTR(I)-YORG) IF( LSTR(I) .EQ. 1 )CALL ZZLINE( XOLD,YOLD , XR,YR ) XOLD = XR YOLD = YR ELSE IF( LSTR(I) .GT. 100 .AND. LSTR(I) .LE. 107 )THEN CALL COLOR( LSTR(I)-100 ) ENDIF 200 CONTINUE C XPHOLD = XOLD YPHOLD = YOLD RETURN END C C C FUNCTION LASTNB( CLINE ) C C Return the position of the last nonblank character in the input C character string. CLINE is CHARACTER*(*). Even if CLINE is all C blanks, LASTNB will be returned as 1 so that operations of the C form CLINE(1:LASTNB) won't be garbage. C CHARACTER*(*) CLINE INTEGER LASTNB C INTEGER NPOS C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C Start at the end and work backwards until a nonblank is found. C Loop back to 100 to check position # NPOS each time. C NPOS = LEN( CLINE ) 100 CONTINUE C quit if at the beginning IF( NPOS .LE. 1 )GOTO 200 C quit if not a blank or a null IF( CLINE(NPOS:NPOS) .NE. ' ' .AND. . CLINE(NPOS:NPOS) .NE. CHAR(0) )GOTO 200 C move back one position and try again NPOS = NPOS - 1 GOTO 100 C....................................................................... 200 CONTINUE LASTNB = NPOS RETURN END C C C SUBROUTINE ZZSTRO( CH,NCH , NSTR,XSTR,YSTR,LSTR ) IMPLICIT NONE C C Convert a string of generalized characters into a set of strokes, C normalized to character size = 1. The stroke tables are taken C from the C source code to the program "axis". C CHARACTER*(*) CH INTEGER NCH , NSTR REAL XSTR(*) , YSTR(*) INTEGER LSTR(*) C INTEGER IS , KST , ICH , IOFF , ISTR , INC REAL XCUR , YCUR , SCALE C..................................................................... C A list of the offsets of the start of the stroke data for each C character. 0 means a control character C INTEGER NOFF(0:255) INTEGER NUMSTR(0:255) C INTEGER NSTROK(3820) INTEGER NS01(100),NS02(100),NS03(100),NS04(100),NS05(100), X NS06(100),NS07(100),NS08(100),NS09(100),NS10(100), X NS11(100),NS12(100),NS13(100),NS14(100),NS15(100), X NS16(100),NS17(100),NS18(100),NS19(100),NS20(100), X NS21(100),NS22(100),NS23(100),NS24(100),NS25(100), X NS26(100),NS27(100),NS28(100),NS29(100),NS30(100), X NS31(100),NS32(100),NS33(100),NS34(100),NS35(100), X NS36(100),NS37(100),NS38(100),NS39( 20) EQUIVALENCE( NSTROK( 1) , NS01(1) ) EQUIVALENCE( NSTROK( 101) , NS02(1) ) EQUIVALENCE( NSTROK( 201) , NS03(1) ) EQUIVALENCE( NSTROK( 301) , NS04(1) ) EQUIVALENCE( NSTROK( 401) , NS05(1) ) EQUIVALENCE( NSTROK( 501) , NS06(1) ) EQUIVALENCE( NSTROK( 601) , NS07(1) ) EQUIVALENCE( NSTROK( 701) , NS08(1) ) EQUIVALENCE( NSTROK( 801) , NS09(1) ) EQUIVALENCE( NSTROK( 901) , NS10(1) ) EQUIVALENCE( NSTROK(1001) , NS11(1) ) EQUIVALENCE( NSTROK(1101) , NS12(1) ) EQUIVALENCE( NSTROK(1201) , NS13(1) ) EQUIVALENCE( NSTROK(1301) , NS14(1) ) EQUIVALENCE( NSTROK(1401) , NS15(1) ) EQUIVALENCE( NSTROK(1501) , NS16(1) ) EQUIVALENCE( NSTROK(1601) , NS17(1) ) EQUIVALENCE( NSTROK(1701) , NS18(1) ) EQUIVALENCE( NSTROK(1801) , NS19(1) ) EQUIVALENCE( NSTROK(1901) , NS20(1) ) EQUIVALENCE( NSTROK(2001) , NS21(1) ) EQUIVALENCE( NSTROK(2101) , NS22(1) ) EQUIVALENCE( NSTROK(2201) , NS23(1) ) EQUIVALENCE( NSTROK(2301) , NS24(1) ) EQUIVALENCE( NSTROK(2401) , NS25(1) ) EQUIVALENCE( NSTROK(2501) , NS26(1) ) EQUIVALENCE( NSTROK(2601) , NS27(1) ) EQUIVALENCE( NSTROK(2701) , NS28(1) ) EQUIVALENCE( NSTROK(2801) , NS29(1) ) EQUIVALENCE( NSTROK(2901) , NS30(1) ) EQUIVALENCE( NSTROK(3001) , NS31(1) ) EQUIVALENCE( NSTROK(3101) , NS32(1) ) EQUIVALENCE( NSTROK(3201) , NS33(1) ) EQUIVALENCE( NSTROK(3301) , NS34(1) ) EQUIVALENCE( NSTROK(3401) , NS35(1) ) EQUIVALENCE( NSTROK(3501) , NS36(1) ) EQUIVALENCE( NSTROK(3601) , NS37(1) ) EQUIVALENCE( NSTROK(3701) , NS38(1) ) EQUIVALENCE( NSTROK(3801) , NS39(1) ) C DATA NOFF /3452,3452,3452,3452,3452,3452,3452,3452,3452,3452,3452, x 3452,3452,3452,3452,3452,3452,3452,3452,3452,3452,3452,3452,3452, X 3452,3452,3452,3452,3452,3452,3452,3452,3448,2598,2646,3307, X 3268,3138,3168,2641,2672,2691,3439,2790,2566,2787,2560,2669, X 2205,2243,2252,2294,2338,2348,2383,2429,2456,2514,2574,2585, X 2832,2820,2836,2611,3215,1,14,54,85,112,129,144, X 180,199,208,226,245,256,277,292,334,359,419,458, X 491,504,524,535,552,567,582,2710,3818,2719,3564,3597, X 2953,595,631,660,687,718,747,766,821,843,857,879, X 898,907,942,964,998,1029,1058,1077,1108,1122,1144,1155, X 1172,1187,1205,2728,2784,2752,3593,3452,2856,3033,2802,2807, X 3600,2980,2916,3615,2776,2780,3384,2795,2840,3316,3759,3783, X 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2890,2655,3022,2971,2962,2944, X 3651,3064,2929,3666,3805,3812,3815,3430,2848,3683,3463,3468,3473, X 3479,3485,3498,3511,3524,3537,3554,2877,3715,3737,3359,2825,2903, X 3689,1,14,1218,1229,112,582,180,1240,199,226,1290,256,277,1301, X 292,1326,334,1341,491,1357,1386,552,1428,1463,3702,3449,3455, X 3450,3454,3451,3453,3456,1502,1539,1591,1616,1658,1681,1711,1740, X 1780,1794,1819,1839,1863,1883,1924,1954,1971,2000,2032,2045,2074, X 2112,2133,2164,3457,3458,3459,3460,3461,3462,3112 / C..................................................................... C List of the number of strokes in each character. C For control characters, the entry is the switch index. C DATA NUMSTR / 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, X 1,1,1,1,1,1,1,1,1,13,9,9, X 39,30,47,5,19,19,9,5,8,3,6,3, X 38,9,42,44,10,35,46,27,58,46,11,13, X 4,5,4,30,53,13,40,31,27,17,15,36, X 19,9,18,19,11,21,15,42,25,60,39,33, X 13,20,11,17,15,15,13,9,3,9,29,3, X 9,36,29,27,31,29,19,55,22,14,22,19, X 9,35,22,34,31,29,19,31,14,22,11,17, X 15,18,13,24,3,24,4,1,21,31,5,13, X 15,42,13,36,4,4,46,7,8,43,24,22, X 1,2,3,4,5,6,7,8,9,10,11,12, X 13,14,15,16,13,14,11,9,9,9,15,48, X 15,17,7,3,3,9,8,6,5,5,6,6, X 13,13,13,13,17,10,13,22,22,25,7,13, X 13,13,40,11,11,17,13,19,50,9,19,11, X 21,15,25,42,15,25,16,13,29,42,15,35, X 39,13,1,1,1,1,1,1,1,37,52,25, X 42,23,30,29,40,14,25,20,24,20,41,30, X 17,29,32,13,29,38,21,31,41,1,1,1,1,1,1,26 / C..................................................................... C List of the strokes, stored in the format C 16384*blanking + 128*(DX+64) + (DY+64) C DATA NS01 / X 8011,23723, 9173,25515, 7378,25390, 6854,25792, 6586,25408, X 9024,25408, 6858, 7371,24619, 8405,24619, 7765,26176,25023, X 24767,24766,24638,24510,24511,24255, 8266,24895,24767,24766, X 24638,24510,24511,24383, 7232,25664,25023,24767,24766,24637, X 24510,24511,24255,23104, 9803,24895,24767,24766,24637,24510, X 24511,24383, 7754, 8904,24765,24646,24509,24386,24257,24384, X 24255,24382,24510,24509,24635,24765,24766,24894,25023,24896, X 25025,24898,24770, 7248,24383,24382,24510,24509,24635,24765, X 24766,24894,24895, 8138, 7371,24619, 8405,24619, 7765,25920, X 25023,24894,24766,24765,24635,24509,24510,24382,24255,23360 / DATA NS02 / X 9557,24895,24894,24766,24765,24635,24509,24510,24382,24383, X 8010, 7371,24619, 8405,24619, 9039,24632, 6990,26688,24634, X 24518, 6838,25408, 6965,26688,24646,24506, 7242, 7371,24619, X 8405,24619, 9039,24632, 6990,26688,24634,24518, 6838,25408, X 6965,25536, 8138, 8904,24765,24646,24509,24386,24257,24384, X 24255,24382,24510,24509,24635,24765,24766,24894,25023,24896, X 25025,24898, 7378,24383,24382,24510,24509,24635,24765,24766, X 24894,24895, 9160,24632, 8392,24632, 7752,25536, 6978, 7371, X 24619, 8405,24619, 9813,24619, 8405,24619, 6101,25536, 9024, X 25536, 6198,26176, 6197,25536, 9024,25536, 6986, 7371,24619 / DATA NS03 / X 8405,24619, 7765,25536, 7339,25536, 6986, 8011,24623,24509, X 24383,24384,24385,24514,24642,24769,24767,24511, 9041,24623, X 24509,24511, 8149,25536, 6965, 7371,24619, 8405,24619, 9941, X 22963, 8900,25652, 7116,25652, 6229,25536, 9024,25408, 5803, X 25536, 9024,25408, 6858, 7371,24619, 8405,24619, 7765,25536, X 7339,26560,24646,24506, 6986, 7371,24619, 8405,25390, 7378, X 25515, 9173,23723, 9173,24619, 8405,24619, 5973,25152, 9920, X 25152, 5547,25408, 9280,25536, 6986, 7371,24619, 8405,26157, X 6737,26157, 8277,24619, 6229,25152, 9408,25408, 5803,25408, X 8650, 8011,24255,24382,24510,24508,24637,24764,24766,24894 / DATA NS04 / X 25023,24896,25025,24898,24770,24772,24643,24516,24514,24386, X 24257,24384, 8256,24383,24382,24510,24508,24637,24764,24766, X 24894,24895, 8512,24897,24898,24770,24772,24643,24516,24514, X 24386,24385, 7989, 7371,24619, 8405,24619, 7765,26176,25023, X 24767,24766,24637,24510,24511,24255,23616, 9291,24895,24767, X 24766,24637,24510,24511,24383, 6710,25536, 8394, 8011,24255, X 24382,24510,24508,24637,24764,24766,24894,25023,24896,25025, X 24898,24770,24772,24643,24516,24514,24386,24257,24384, 8256, X 24383,24382,24510,24508,24637,24764,24766,24894,24895, 8512, X 24897,24898,24770,24772,24643,24516,24514,24386,24385, 7597 / DATA NS05 / X 24641,24770,24897,24768,24895,24766,24761,24767,24896,24770, X 24641, 7621,24764,24766,24767,24768,24769, 7117, 7371,24619, X 8405,24619, 7765,26176,25023,24767,24766,24638,24510,24511, X 24255,23616, 9290,24895,24767,24766,24638,24510,24511,24383, X 6709,25536, 8523,24895,24767,25017,24767,24768,24769, 7368, X 24766,24889,24767,24896,24770,24641, 6983, 8776,24771,24634, X 24515,24386,24257,24256,24255,24382,24638,24766,24767,24895, X 25406,24895,24894, 6473,24894,24895,25406,24895,24767,24766, X 24636,24382,24255,24256,24257,24386,24515,24634,24771, 8775, X 7883,24619, 8405,24619, 7381,24506,24646,26560,24634,24518 / DATA NS06 / X 6955,25536, 7498, 7371,24625,24765,24894,25023,24896,25025, X 24898,24771,24655, 6592,24625,24765,24894,24895, 7125,25536, X 9152,25408, 6965, 7115,25515, 7509,25390, 9170,23723, 7125, X 25408, 9024,25408, 6837, 7243,25131, 7893,25008, 8784,24107, X 8789,25131, 7893,25008, 8784,24107, 6357,25536, 9408,25408, X 6837, 7115,26283, 6741,26283, 8277,22827, 8021,25408, 9024, X 25408, 5931,25408, 9024,25408, 6858, 7115,25525,24630, 7509, X 25525,24630, 9173,23733, 6987,25408, 9152,25408, 6571,25536, X 7626, 8779,22955,10069,22955, 8277,24506,24646,26432, 6443, X 26432,24646,24506, 7242, 7362,24639,24512,24641,24769,24897 / DATA NS07 / X 25152,24895,24767,24766,24633,24766,24767, 7884,24631,24766, X 24895,24768, 7754,24511,23871,24255,24510,24638,24766,25023, X 25024,24897,24898, 7365,24383,24510,24638,24766,24895, 8394, X 7371,24619, 8405,24619, 8267,24898,24897,24896,25023,24894, X 24765,24638,24509,24382,24255,24384,24385,24386, 9035,24895, X 24894,24765,24638,24509,24382,24383, 6997,25152, 8629, 8641, X 24511,24767,24769,24641,24386,24385,24256,24255,24382,24509, X 24638,24765,24894,25023,24896,25025,24898, 7371,24383,24382, X 24509,24638,24765,24894,24895, 8010, 8651,24619, 8405,24619, X 8139,24386,24385,24384,24255,24382,24509,24638,24765,24894 / DATA NS08 / X 25023,24896,24897,24898, 7499,24383,24382,24509,24638,24765, X 24894,24895, 8661,25152, 8107,25152, 6986, 7230,26176,24642, X 24514,24513,24385,24256,24255,24382,24509,24638,24765,24894, X 25023,24896,25025,24898, 8133,24643,24514, 7617,24383,24382, X 24509,24638,24765,24894,24895, 8010, 8010,24511,24767,24769, X 24641,24513,24384,24383,24510,24622, 8661,24511,24510,24622, X 7758,25664, 7218,25536, 7242, 7748,24383,24511,24510,24638, X 24766,24767,24895,24896,24897,24769,24770,24642,24514,24513, X 24385,24384, 7999,24510,24636,24766, 9024,24770,24644,24514, X 8383,24769,24897,24639,24384, 7097,24511,24510,24639,24766 / DATA NS09 / X 25023,25280,25023,24767, 6597,24767,25023,25280,25023,24766, X 24639,24510,24255,23872,24257,24514,24641,24770,25025, 8394, X 7371,24619, 8405,24619, 8267,24898,25025,24896,25023,24766, X 24629, 7758,24895,24766,24629, 6485,25152, 7723,25536, 8768, X 25536, 6986, 7371,24511,24767,24769,24513, 8249,24626, 8398, X 24626, 7758,25152, 7730,25536, 6986, 7499,24511,24767,24769, X 24513, 8377,24622,24510,24383,24384,24513,24641,24769,24767, X 24511, 8788,24622,24510,24511, 8149,25152, 7228, 7371,24619, X 8405,24619, 9550,23350, 8900,25400, 7368,25400, 6485,25152, X 9145,25408, 6066,25536, 8768,25408, 6986, 7371,24619, 8405 / DATA NS10 / X 24619, 7765,25152, 7723,25536, 6986, 7364,24626, 8398,24626, X 8267,24898,25025,24896,25023,24766,24629, 7758,24895,24766, X 24629, 8395,24898,25025,24896,25023,24766,24629, 7758,24895, X 24766,24629, 5070,25152, 7730,25536, 8768,25536, 8768,25536, X 6986, 7364,24626, 8398,24626, 8267,24898,25025,24896,25023, X 24766,24629, 7758,24895,24766,24629, 6478,25152, 7730,25536, X 8768,25536, 6986, 7876,24255,24382,24509,24638,24765,24894, X 25023,24896,25025,24898,24771,24642,24515,24386,24257,24384, X 8256,24383,24382,24509,24638,24765,24894,24895, 8512,24897, X 24898,24771,24642,24515,24386,24385, 7868, 7364,24619, 8405 / DATA NS11 / X 24619, 8274,24898,24897,24896,25023,24894,24765,24638,24509, X 24382,24255,24384,24385,24386, 9035,24895,24894,24765,24638, X 24509,24382,24383, 6990,25152, 7723,25536, 8273, 8644,24619, X 8405,24619, 8146,24386,24385,24384,24255,24382,24509,24638, X 24765,24894,25023,24896,24897,24898, 7499,24383,24382,24509, X 24638,24765,24894,24895, 8633,25536, 6865, 7364,24626, 8398, X 24626, 8264,24771,24898,24897,25024,24767,24639,24511,24513, X 24769, 6721,25152, 7730,25536, 7754, 8386,24770,24636,24514, X 24513,24385,24128,24383,24511,24638,24767,24895,25278,24895, X 24767, 6855,24767,24895,25278,24895,24767,24637,24511,24383 / DATA NS12 / X 24128,24385,24513,24514,24636,24770, 8392, 7371,24623,24765, X 24895,24896,24897,24770, 7378,24623,24765,24767, 7502,25664, X 7356, 7364,24629,24766,25023,24896,25025,24898, 6987,24629, X 24766,24895, 9166,24626, 8398,24626, 6350,25152, 9152,25152, X 8114,25152, 6986, 7108,25394, 7630,25268, 9036,23858, 7246, X 25408, 8768,25408, 6844, 7236,25138, 7886,25013, 8779,24114, X 8782,25138, 7886,25013, 8779,24114, 6350,25536, 9408,25408, X 6844, 7236,26034, 6990,26034, 8270,23090, 8014,25408, 8768, X 25408, 6194,25408, 8768,25408, 6986, 7236,25394, 7630,25268, X 9036,23858,24380,24382,24383,24512,24513,24769,24767, 8020 / DATA NS13 / X 25408, 8768,25408, 6844, 8516,23218, 9806,23218, 8270,24508, X 24644,26176, 6706,26176,24644,24508, 7242, 7371,24619, 8405, X 24619, 7765,26560,24634,24518, 6443,25536, 7882, 8011,23595, X 9301,25643, 7250,25518, 6465,26432, 6335,26688, 6986, 8011, X 24255,24382,24510,24508,24637,24764,24766,24894,25023,24896, X 25025,24898,24770,24772,24643,24516,24514,24386,24257,24384, X 8256,24383,24382,24510,24508,24637,24764,24766,24894,24895, X 8512,24897,24898,24770,24772,24643,24516,24514,24386,24385, X 7737,24633, 9031,24633, 7492,25408, 7487,25408, 7744, 8011, X 23723, 9173,25515, 7378,25390, 6336,25408, 9024,25408, 6858 / DATA NS14 / X 7244,24507,10309,24507, 6972,24507, 9285,24507, 6972,24507, X 10309,24507, 6485,26432, 6463,26432, 6968,25408, 7487,25408, X 6968,26432, 6463,26432, 7241, 7371,24619, 8405,24619, 9813, X 24619, 8405,24619, 6101,27200, 5675,25536, 9024,25536, 6986, X 7115,25526,23605, 8277,25526, 7370,26560,24762,24390, 6572, X 26304, 6463,26560,24774,24378, 7370, 6982,24642,24770,24769, X 24896,24767,24766,24764,24626, 7378,24898,24896,24894, 9406, X 24642,24514,24513,24384,24511,24510,24508,24626, 9170,24386, X 24384,24382, 7598,25536, 7498, 8011,24619, 8405,24619, 7888, X 24255,24511,24510,24637,24766,24767,25023,25280,25025,24769 / DATA NS15 / X 24770,24643,24514,24513,24257,24000, 8256,24383,24511,24510, X 24637,24766,24767,24895, 8896,24897,24769,24770,24643,24514, X 24513,24385, 7493,25536, 7339,25536, 7626, 8139,24619, 8405, X 24619, 6990,24769,24895,24764,24766,24767,24895, 7369,24767, X 24764,24766,24767,25023,25024,25025,24769,24770,24772,24769, X 7351,24897,24769,24770,24772,24897,24767, 6599,25536, 7339, X 25536, 7754, 7097,24765,25152,24388,24388,24515,24644,24771, X 24898,25025,25152,25023,24894,24765,24636,24509,24380,24380, X 25152,24771, 6593,24515,24516,24644,24771,24898,24897, 8768, X 24895,24894,24765,24636,24508,24509, 6717,25024, 9280,25024 / DATA NS16 / X 7241, 8004,24255,24382,24510,24509,24637,24766,25023,24896, X 24897,25027,24899,24900,24771, 7104,24383,24382,24510,24509, X 24637,24766,24895, 8654,24896,24895,24766,24888,24766,24767, X 7374,24767,24766,24888,24766,24895,24768, 7114, 8395,24255, X 24382,24380,24509,24508,24506,24504, 9692,24383,24382,24380, X 24509,24508,24506,24504, 9564,24896,24895,24767,24637,24510, X 24511,24255,24128, 9033,24894,24637,24510,24511,24383, 7744, X 25151,24894,24766,24637,24510,24511,24255,24384,24385,24513, X 24515, 8775,25023,24894,24766,24637,24510,24511,24383, 8010, X 6849,24898,24897,24896,24895,24767,24765,24636,24508,24248 / DATA NS17 / X 7635,24897,25152,24895, 9282,24509,24510,23993,24251,24380, X 9685,24509,24510,24121, 7880, 8387,24385,24384,24255,24381, X 24509,24637,24766,24767,24895,24896,25025,24899,24771,24643, X 24514,24133,24514,24642,24769,24896,24895,24894, 7355,24383, X 24381,24509,24636,24766, 8767,24897,24899,24771,24644,24514, X 24387,24514,24642,24769,24896,25022, 7095, 8515,24385,24256, X 24255,24382,24509,24637,24765,24767,25023,25024,24897, 7757, X 24383,24382,24509,24637,24765,24767,24895, 7751,25664, 7363, X 8139,24383,24511,24639,24767,25023,25280,24641,24255,24126, X 24254,24253,24509,24638,24766,25022,25022,24766,24638,24511 / DATA NS18 / X 24384,24513, 8917,24125,24253,24509,24638,24766,24894, 8138, X 6848,24770,24898,25024,24767,24638,24508,24377, 8398,24767, X 24638,24508,24377, 8647,24900,24898,24897,24896,24895,24767, X 24637,24507,24245, 8405,24894,24637,24507,24245, 7889, 8139, X 24255,24381,24510,24509,24507,24636,24766,24895,24896,25025, X 24899,24770,24771,24773,24644,24514,24385,24384, 8256,24383, X 24381,24510,24509,24507,24636,24766,24767, 8512,24897,24899, X 24770,24771,24773,24644,24514,24513, 7222,25792, 7359, 7492, X 24377,24508,24638,24767,25024,24898,24770, 7882,24377,24508, X 24638,24767, 7626, 7492,24114, 8910,24114, 9934,24767,24768 / DATA NS19 / X 24513,24384,24383,24124,24383,24384, 8512,24895,24890,24767, X 7624,24767,24890,24767,24896,24897,24899, 7110, 7115,24896, X 24895,24767,24766,25394,24766,24767, 6741,24894,24766,25394, X 24766,24895,24768, 7246,23602, 9294,23730, 8906, 7620,23851, X 9173,23851, 8914,24506,24637,24894,24896,24897,24898,24899, X 8520,24245,24638,24767,25024,24898,24770, 7882,24245,24638, X 24767, 7498, 7492,24370, 8654,24506,24507,24509, 9934,24508, X 24380, 8776,24509,24510,24381,24382,24254,24383,24255, 8142, X 25152, 8380, 8139,24383,24511,24639,24767,25023,25024, 7872, X 24127,24383,24510,24638,24894,25023,25024, 8137,24255,24383 / DATA NS20 / X 24510,24638,24894,24895, 8256,24127,24383,24510,24638,24894, X 25278,24767,24638,24383,24384, 8654,24255,24383,24510,24638, X 24894,25150, 7629, 7876,24255,24381,24509,24637,24766,24767, X 24895,24896,25025,24899,24771,24643,24514,24513,24385,24384, X 8256,24383,24381,24509,24636,24766, 8767,24897,24899,24771, X 24644,24514, 7357, 7875,24115, 8781,24243, 9421,24627, 8269, X 24755, 6475,24898,25025,26304, 5949,24897,25025,26304, 6973, X 7227,24765,24767,24895,24896,25025,24899,24771,24643,24514, X 24513,24385,24384,24255,24381,24509,24114, 9543,24897,24899, X 24771,24644,24514, 7745,24383,24381,24509,24114, 9041, 9156 / DATA NS21 / X 23360,24255,24381,24509,24637,24766,24767,24895,24896,25025, X 24899,24771,24643,24514,24513,24385, 8000,24383,24381,24509, X 24636,24766, 8767,24897,24899,24771,24644,24514, 8256,25408, X 6973, 8131,24243, 8653,24371, 7371,24898,25025,26048, 6205, X 24897,25025,26048, 6973, 6848,24770,24898,25024,24767,24638, X 24378,24637,24894, 8014,24767,24638,24378,24637,24767,24895, X 24768,25025,24898,24899,24771,24643,24514,24511,24767,24765, X 8125,24774, 7102, 8523,23844, 9180,23588, 8661,24127,24382, X 24509,24637,24766,24894,25023,25024,25153,24898,24771,24643, X 24514,24386,24257,24256, 8256,24255,24382,24509,24637,24766 / DATA NS22 / X 24894,24895, 8640,25025,24898,24771,24643,24514,24386,24385, X 7868, 6980,24896,24895,24766,25265,24766,24767, 6997,24767, X 24766,25265,24766,24895,24896, 8405,24510,24381,23349,24381, X 24510, 8913, 8651,23844, 9180,23588, 7377,24770,24898,25024, X 24767,24638,24507,24637,24894,25024,24897,25027,24899, 6598, X 24767,24638,24507,24637,24766,24895,25024,24897,24898,24899, X 24770,24902, 6972, 7232,24898,25025,24513,24383,24381,24509, X 24637,24765,24767,24896,24897,24899,24771, 7101,24766,24767, X 24896,24897,24898, 8259,24637,24765,24767,24896,24897,24899, X 24771,24643,24515,24513,24511,24895,24766, 7098,24766,24767 / DATA NS23 / X 24896,24897,24898, 7238, 7883,24255,24381,24507,24637,24763, X 24893,25023,24896,25025,24899,24773,24643,24517,24387,24257, X 24384, 8256,24383,24511,24510,24507,24637,24763,24766,24767, X 24895, 8512,24897,24769,24770,24773,24643,24517,24514,24513, X 24385, 7861, 7495,24897,25027,24619, 8148,24620, 7744,25792, X 7370, 7239,24767,24511,24513,24641,24770,24769,25025,25152, X 25023,24767,24766,24638,24510,24254,23998,24383,24382,24509, X 24637, 9429,24895,24767,24766,24638,24510,24254,24126, 7609, X 24769,24896,25278,25024,24897,24769, 6848,25277,25152,24769, X 24770,24642, 7109, 7239,24767,24511,24513,24641,24770,24769 / DATA NS24 / X 25025,25152,25023,24766,24637,24510,24255,24256, 8649,24895, X 24766,24637,24510,24383, 8256,24895,24894,24766,24637,24510, X 24511,24255,24128,24257,24513,24514,24641,24769,24767,24511, X 9670,24765,24637,24510,24511,24383, 7754, 8265,24621, 8405, X 24619, 8277,23217,26688, 7098,25536, 7242, 7371,24374, 8256, X 24898,25025,25024,25023,24894,24765,24638,24509,24382,24255, X 24256,24257,24513,24514,24641,24769,24767,24511, 9162,24895, X 24894,24765,24638,24509,24382,24383, 7509,25920, 6975,25280, X 25281, 7349, 8648,24511,24767,24769,24641,24514,24385,24256, X 24255,24382,24510,24508,24634,24765,24894,25023,24896,25025 / DATA NS25 / X 24898,24771,24641,24515,24386,24257,24512,24255,24382,24509, X 9038,24383,24382,24510,24508,24634,24765,24894,24895, 8512, X 24897,24898,24771,24641,24515,24386,24385, 7869, 7115,24634, X 8258,24770,24898,24896,25277,24896,24769,24770, 6590,24897, X 24896,25278, 8771,24637,24509,24123,24510,24509,24635, 9039, X 23995,24510,24509,24635, 8138, 7755,24255,24510,24637,24766, X 25023,25152,25025,24770,24643,24514,24257,24128, 8256,24383, X 24510,24637,24766,24895, 8768,24897,24770,24643,24514,24385, X 7735,24255,24511,24510,24636,24766,24767,25023,25152,25025, X 24769,24770,24644,24514,24513,24257, 7744,24383,24511,24510 / DATA NS26 / X 24636,24766,24767,24895, 8768,24897,24769,24770,24644,24514, X 24513,24385, 7742, 8772,24509,24382,24255,24512,24257,24386, X 24515,24641,24771,24898,25025,24896,25023,24894,24765,24634, X 24508,24510,24382,24255,24256,24385,24514,24641,24769,24767, X 24511, 8773,24385,24386,24515,24641,24771,24898,24897, 8512, X 24895,24894,24765,24634,24508,24510,24382,24383, 8010, 7352, X 24511,24767,24769,24513, 7368, 7350,24513,24769,24767,24638, X 24510,24511, 7502, 7364,24511,24767,24769,24513, 8244,24511, X 24767,24769,24513, 7368, 7364,24511,24767,24769,24513, 8242, X 24513,24769,24767,24638,24510,24511, 7502, 7371,24510,24756 / DATA NS27 / X 24780,24514, 8254,24634, 8245,24511,24767,24769,24513, 7368, X 7239,24767,24511,24513,24641,24770,24769,24897,25024,25023, X 24767,24766,24638,24510,24511,24126,24637, 8398,24895,24767, X 24766,24638,24510,24382, 7991,24511,24767,24769,24513, 7880, X 7243,24505, 8519,24377, 7356, 7243,24505, 8519,24377, 9415, X 24505, 8519,24377, 7356, 7499,24383,24510,24638,24766,24895, X 24896,24897,24770,24642,24514,24385,24384, 7733, 9295,22304, X 9297, 8143,24382,24381,24380,24507,24636,24763,24892,24893, X 24894, 8030,24380,24509,24507,24636,24763,24765,24892, 7375, X 7119,24894,24893,24892,24763,24636,24507,24380,24381,24382 / DATA NS28 / X 8542,24892,24765,24763,24636,24507,24509,24380, 7887, 7247, X 24608, 8416,24608, 8160,25536, 7328,25536, 7121, 7887,24608, X 8416,24608, 7392,25536, 7328,25536, 7249, 7887,24253,24509, X 24638,24765,25021, 8012,24509,24636,24765, 8510,24254,25022, X 8256,24253,24509,24638,24765,25021, 8012,24509,24636,24765, X 7631, 7375,25021,24765,24638,24509,24253, 8524,24765,24636, X 24509, 7998,25022,24254, 8256,25021,24765,24638,24509,24253, X 8524,24765,24636,24509, 7631, 8015,23728,25520, 7249, 7247, X 25520,23728, 8017, 7247,24608, 7249, 7231,26944, 7233, 8392, X 24622, 7113,26944, 7233, 8263,24623, 7241,26688, 6199,26688 / DATA NS29 / X 7242, 7238,26418, 8270,22834, 9032, 8392,24511,24767,24769, X 24513, 7095,26944, 7097,24511,24767,24769,24513, 8392, 7234, X 26944, 5946,26944, 7236, 9288,22830, 8012,26944, 5946,26944, X 7236, 9288,22583,26679, 7242, 7240,26679,22583, 9290, 9291, X 22585,26681, 6206,26688, 6203,26688, 7242, 7243,26681,22585, X 8254,26688, 6203,26688, 7242, 9402,24384,24385,24386,24260, X 24513,24385,24384,24383,24510,24638,24766,24895,24896,24897, X 24769,25028,24898,24897,24896, 7228, 9287,23744,24127,24383, X 24382,24509,24638,24765,24894,24895,25151,25536, 7241, 7239, X 24633,24764,24766,24894,25023,24896,25025,24898,24770,24772 / DATA NS30 / X 24647, 7225, 7239,25536,25151,24895,24894,24765,24638,24509, X 24382,24383,24127,23744, 9289, 7223,24647,24772,24770,24898, X 25025,24896,25023,24894,24766,24764,24633, 7241, 9287,23744, X 24127,24383,24382,24509,24638,24765,24894,24895,25151,25536, X 6216,26176, 7745, 9153,25022,24254, 7879,25275,23995, 6725, X 26816, 7361, 7493,24899,24893, 7357,25285,25275, 7621,24623, X 7754, 7617,24254,25022, 8647,23995,25275, 7621,26816, 7233, X 7481,24893,24899, 7363,25275,25285, 7628,24623, 7753, 8639, X 24515,24513,24385,24384,24255,24381,24509,24637,24766,24767, X 24895,24896,25025,24898,24771,24773,24645,24515,24513,24385 / DATA NS31 / X 24256,24383,24511,24639,24768,24641, 8507,24383,24381,24509, X 24636,24766, 8767,24897,24898,24771,24773,24645,24515,24386, X 7605, 6987,25643, 7381,25517, 9299,23595, 7253,26688, 6335, X 26432, 7094, 9422,24511,24767,24769,24641,24513,24384,24383, X 24382,24510,24509,24508,24372,24508,24510, 9308,24510,24508, X 24372,24508,24509,24510,24382,24383,24384,24513,24641,24769, X 24767,24511, 9424, 9422,24511,24767,24769,24641,24513,24384, X 24383,24382,24510,24509,24508,24372,24508,24510, 9308,24510, X 24508,24372,24508,24509,24510,24382,24383,24384,24513,24641, X 24769,24767,24511, 9302,24255,24382,24509,24638,24765,24894 / DATA NS32 / X 25023,24896,25025,24898,24771,24642,24515,24386,24257,24384, X 8378, 9534,24510,24383,24384,24385,24513,24260,24513,24385, X 24384,24383,24510,24638,24766,24895,24896,24897,24769,25028, X 24769,24897,24896,24895,24766,24638, 7106, 9419,22315, 8917, X 24894,24638,24510,24383,24384,24386,24642,24770,24897,24896, X 24895,25023,25024,25025,24897, 7730,24383,24510,24638,24894, X 24896,24897,24770,24642,24386,24384, 7619, 9411,24511,24767, X 24769,24641,24513,24512,24511,24510,24379,24381,24382,24383, X 24256,24257,24514,24643,24770,25412,24898,24770,24642,24514, X 24385,24383,24510,24638,24765,24893,25273,24894,25023,24768 / DATA NS33 / X 24769,24641, 6334,24385,24514,24643,24770,24898, 8262,24766, X 25653,24894,24895, 7370, 9027,24514,24385,24256,24383,24511, X 24509,24637,24766,24895,25024,24897,24770, 7624,24382,24509, X 24637,24766,24767, 9163,24504,24638,24895,24896,24898,24771, X 24642,24515,24514,24386,24385,24257,24256,24255,24383,24382, X 24510,24509,24637,24765,24766,24894,24895,25023,25024,25025, X 24897,24769, 8013,24504,24638,24767, 7749, 7759,24611, 8797, X 24611, 8790,24511,24767,24769,24641,24386,24257,24128,24255, X 24382,24638,24766,24767,24895,25406,24895,24894, 6473,24894, X 24895,25406,24895,24767,24766,24636,24382,24255,24128,24257 / DATA NS34 / X 24386,24641,24769,24767,24511, 8775, 8139,23716, 9948,23716, X 7505,26432, 6330,26432, 7238, 8136,24511,24767,24769,24641, X 24514,24385,24384,24383,24510,24638,24766,24894,25277, 7365, X 25277,24894,24766,24638,24510,24382, 7756,24382,24510,24638, X 24766,24894,25277, 7365,25277,24894,24766,24638,24510,24383, X 24384,24385,24514,24641,24769,24767,24511, 8142, 7755,24510, X 24766,24770,24514, 8256,24612, 8273,24509,24754,24782,24515, X 7492,24895,24897,24385,24383, 8256,26176, 7744,24895,24897, X 24385,24383, 7484, 7755,24510,24766,24770,24514, 8256,24626, X 8260,24510,24892,24510,24514,24900,24514, 8252,24626, 8260 / DATA NS35 / X 24510,24766,24770,24514, 7505,24895,24897,24385,24383, 8256, X 26176, 7744,24895,24897,24385,24383, 7218,24895,24897,24385, X 24383, 8256,26176, 7744,24895,24897,24385,24383, 7498, 8651, X 24619, 6613,26304, 7222,25664, 6581,26304, 7242, 7622,25394, X 8270,23858, 7754,26426, 8262,22842, 8900, 7232, 6720, 6208, X 5696, 5184, 4672, 4160, 3648, 3136, 5196, 5172, 5192, 5176, X 5188, 5180, 7232,26688, 7240,24624, 8264, 7224,26704, 6208, X 26672, 7240, 8248,25672,23624,23608,25656, 8264, 7224,26688, X 24656,22592,24624, 9288, 7232,25152,25156, 8260,24636,25148, X 8768,24128,24124, 8252,24644,24132, 8768, 7224,25156,24648 / DATA NS36 / X 7748,25148,25664, 8772,24124,24632, 8764,24132,23616, 8772, X 7232,26688, 7240,24624, 8768,23616, 7748,24648, 8772,25664, X 8764,24632, 7236, 7224,26704, 6208,26672, 8260,24124, 7232, X 24132, 8264,25156, 9280,25148, 7228, 7744,24128, 8264,25148, X 8768,24644, 9280,24124, 8252,25152, 8248,24132, 7744,24636, X 7232,25156, 8772, 7228,24648,25156,25664,25148,24632,24124, X 23616,24132, 9284, 8644,24511,24767,24769,24641,24386,24385, X 24256,24255,24382,24509,24638,24765,24894,25023,24896,25025, X 24898, 7371,24383,24382,24509,24638,24765,24894,24895, 8401, X 24620, 7882, 7234,26944,24636, 7234, 6964,26944, 6988, 7235 / DATA NS37 / X 24770,24897,24896,25023,24895,25023,24896,24897,24770, 5945, X 26944, 5948,26944, 7237, 7237,24767,24511,24513,24641,24770, X 24769,24897,25024,25023,24767,24766,24638,24510,24511,24126, X 8395,24895,24767,24766,24638,24510,24382, 8013,24510,24753, X 24783,24514, 8254,24632, 8246,24511,24767,24769,24513, 7880, X 7745,24254,25022, 8647,23995,25275, 7621,26944, 7621,25275, X 23995, 8647,25022,24254, 7747, 9287,23744,24127,24383,24382, X 24509,24638,24765,24894,24895,25151,25536, 6216,26176, 8138, X 23980, 8523, 6987,25515,25557, 6714,25920, 7227, 9287,23232, X 24383,24382,24510,24638,24766,24894,24895,26048, 6204,26688 / DATA NS38 / X 7241, 7239,26048,24895,24894,24766,24638,24510,24382,24383, X 23232, 8252,26688, 7241, 7879,24255,24382,24509,24638,24765, X 24894,25023,24896,25025,24898,24771,24642,24515,24386,24257, X 24384, 8382,24630, 7621,25920, 7360, 7879,24255,24382,24509, X 24638,24765,24894,25023,24896,25025,24898,24771,24642,24515, X 24386,24257,24384, 8893,23608, 8264,25656, 7492, 7499,24619, X 8405,24619, 8267,24898,25025,24896,25023,24766,24629, 7758, X 24895,24766,24629, 6485,25152, 7723,25536, 8768,25536, 7636, X 22840, 9406, 7115,24896,24895,24767,24766,25394,24766,24767, X 6741,24894,24766,25394,24766,24895,24768, 7246,23602, 9294 / DATA NS39 / X 23730, 9556,23351, 8895, 7108,25152,25396, 7372,25522,25819, X 6703, 6704,27456, 6736, 6737,27456, 6703, 6991,26912, 6993 / C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ NSTR = 0 XCUR = 0.0 YCUR = 0.0 SCALE = 0.051 C DO 900 INC=1,NCH C C Load the offset into the stroke table and the number of strokes C ICH = ICHAR( CH(INC:INC) ) IF( ICH .LE. 0 )ICH = 256+ICH C IOFF = NOFF(ICH) ISTR = NUMSTR(ICH) C..................................................................... C If the offset is 0, this is a control character, so treat it C specially -- ISTR is the control code in this case: C 1 = start superscript C 2 = end superscript C 3 = start subscript C 4 = end subscript C 5,6,7,8,9,10,11 = change color C IF( IOFF .LE. 0 )THEN IF( ISTR .EQ. 1 )THEN XCUR = XCUR - 2.666667*SCALE YCUR = YCUR + 12.*SCALE SCALE = 0.6666667*SCALE ELSEIF( ISTR .EQ. 2 )THEN SCALE = 1.5 * SCALE XCUR = XCUR + 4.*SCALE YCUR = YCUR - 12.*SCALE ELSEIF( ISTR .EQ. 3 )THEN XCUR = XCUR - 2.666667*SCALE YCUR = YCUR - 12.*SCALE SCALE = 0.6666667*SCALE ELSEIF( ISTR .EQ. 4 )THEN SCALE = 1.5 * SCALE XCUR = XCUR + 4.*SCALE YCUR = YCUR + 12.*SCALE ELSEIF( ISTR .GE. 5 .AND. ISTR .LE. 11 )THEN NSTR = NSTR + 1 LSTR(NSTR) = 96+ISTR XSTR(NSTR) = XCUR YSTR(NSTR) = YCUR ENDIF C..................................................................... C Check if this is a newline character C ELSEIF( ICH .EQ. 10 )THEN XCUR = 0.0 YCUR = YCUR - 1.1 C..................................................................... C Otherwise, this is a real character with real strokes C ELSE DO 500 IS=0,ISTR-1 NSTR = NSTR + 1 KST = NSTROK(IOFF+IS) C LSTR(NSTR) = 0 IF( KST .GE. 16384 )THEN LSTR(NSTR) = 1 KST = KST - 16384 ENDIF C XCUR = XCUR + SCALE*FLOAT( KST/128 - 64 ) YCUR = YCUR + SCALE*FLOAT( MOD(KST,128) - 64 ) IF( IS .EQ. ISTR-1 )XCUR = XCUR + 24.*SCALE C XSTR(NSTR) = XCUR YSTR(NSTR) = YCUR 500 CONTINUE ENDIF C 900 CONTINUE END C C C SUBROUTINE ZZCONV( CHIN,NCHIN , CHOUT,NCHOUT ) IMPLICIT NONE C C Convert input string (using TeX-like escapes) to extended character C set, for plotting with ZZSTRO. C CHARACTER*(*) CHIN , CHOUT INTEGER NCHIN , NCHOUT C....................................................................... INTEGER NTABLE PARAMETER ( NTABLE = 113 ) INTEGER ICHEXT(NTABLE) CHARACTER*15 CHTEX(NTABLE) , CHCONT , CHESC,CHNESC C C super/subscript control characters C INTEGER ICHSP , ICHEP , ICHSB , ICHEB PARAMETER ( ICHSP = 16#90 , ICHEP = 16#91 , X ICHSB = 16#92 , ICHEB = 16#93 ) C....................................................................... C INC = input character being scanned C NUSED = no. of input characters consumed by this operation C NSUPB = super/subscript level C NTSUPB = super/subscript type at each level: C 1 = single character superscript -- like a^b C 2 = multi-character superscript -- like a^{b+c} C -1,-2 = similar for subscripts C LOUT = .TRUE. if we just output something to CHOUT, C otherwise .FALSE. C INTEGER INC , NUSED , NSUPB , NTSUPB(10) , ITOP,I LOGICAL LOUT , LALPH , LESC C C Table of Tex-like escapes C DATA CHESC /'\\esc'/ DATA CHNESC /'\\noesc'/ DATA CHTEX /'\\Plus' , '\\Cross' , '\\Diamond', '\\Box' , X '\\FDiamond','\\FBox','\\FPlus','\\FCross','\\Burst','\\Octagon', X '\\alpha','\\beta' ,'\\gamma' , '\\delta', '\\epsilon','\\zeta' , X '\\eta' ,'\\theta' ,'\\iota' , '\\kappa', '\\lambda' ,'\\mu' , X '\\nu' ,'\\xi' ,'\\omicron', '\\pi' ,'\\rho' ,'\\sigma', X '\\tau' ,'\\upsilon', '\\phi' , '\\chi' ,'\\psi' ,'\\omega', X '\\Alpha', '\\Beta' ,'\\Gamma' , '\\Delta','\\Epsilon','\\Zeta', X '\\Eta' ,'\\Theta' ,'\\Iota' , '\\Kappa','\\Lambda','\\Mu' , X '\\Nu' ,'\\Xi' ,'\\Omicron', '\\Pi' ,'\\Rho' ,'\\Sigma', X '\\Tau' ,'\\Upsilon', '\\Phi' , '\\Chi' ,'\\Psi' ,'\\Omega', X '\\propto', '\\int', '\\times', '\\div', '\\approx', '\\partial', X '\\cap', '\\?','\\langle', '\\rangle','\\ddagger','\\pm' , X '\\leq' , '\\S' , '\\hbar' , '\\lambar' , X '\\cup' , '\\degree' , '\\nabla' , '\\downarrow', X '\\leftarrow', '\\rightarrow', '\\leftrightarrow', '\\oint' , X '\\in' , '\\notin' , '\\surd' , '\\_' , X '\\bar' , '\\exists' , '\\geq' , '\\forall' , X '\\subset' , '\\oplus' , '\\otimes' , '\\dagger' , X '\\neq' , '\\supset' , '\\infty' , '\\uparrow' , X '\\#','\\$','\\%','\\&','\\{','\\}','\\\\','\\cents' , X '\\black','\\red','\\blue','\\green','\\yellow','\\magenta' , X '\\cyan' / C C Corresponding extended character set bytes C DATA ICHEXT / X 16#b0 , 16#b1 , 16#b2 ,16#b3 , 16#b4 , 16#b5 , X 16#b6 , 16#b7 , 16#b8 ,16#b9 , X 16#e1 , 16#e2 , 16#e3 ,16#e4 , 16#e5 , 16#e6 , X 16#e7 , 16#e8 , 16#e9 ,16#ea , 16#eb , 16#ec , X 16#ed , 16#ee , 16#ef ,16#f0 , 16#f1 , 16#f2 , X 16#f3 , 16#f4 , 16#f5 ,16#f6 , 16#f7 , 16#f8 , X 16#c1 , 16#c2 , 16#c3 ,16#c4 , 16#c5 , 16#c6 , X 16#c7 , 16#c8 , 16#c9 ,16#ca , 16#cb , 16#cc , X 16#cd , 16#ce , 16#cf ,16#d0 , 16#d1 , 16#d2 , X 16#d3 , 16#d4 , 16#d5 ,16#d6 , 16#d7 , 16#d8 , X 16#80 , 16#81 ,16#82 , 16#83 ,16#84 , 16#85 ,16#86 , 16#87 , X 16#88 , 16#89 ,16#8a , 16#8b ,16#8c , 16#8d ,16#8e , 16#8f , X 16#a0 , 16#a1 ,16#a2 , 16#a3 ,16#a4 , 16#a5 ,16#a6 , 16#a7 , X 16#a8 , 16#a9 ,16#aa , 16#ab ,16#ac , 16#ad ,16#ae , 16#af , X 16#ba , 16#bb ,16#bc , 16#bd ,16#be , 16#bf ,16#ff , 16#60 , X 16#23 , 16#24 , 16#25 , 16#26 , 16#7b , 16#7d , 16#5c , 16#5e , X 16#94 , 16#95 , 16#96 , 16#97 , 16#98 , 16#99 , 16#9a / C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C Test if a character is alphabetic C LALPH(I) = ( I .GE. ICHAR('A') .AND. I .LE. ICHAR('Z') ) .OR. X ( I .GE. ICHAR('a') .AND. I .LE. ICHAR('z') ) C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ NCHOUT = 0 NSUPB = 0 INC = 1 C----------------------------------------------------------------------- C Process input character no. INC C LESC = .TRUE. 100 CONTINUE C CCC WRITE(*,666) 'ZZCONV at: ' // CHIN(INC:INC) CCC666 FORMAT(A) C LOUT = .FALSE. C C Superscript: ^{ starts a multi-character superscript, otherwise C ^ starts a single-character superscript C IF( LESC .AND. CHIN(INC:INC).EQ.'^' .AND. INC.LT.NCHIN )THEN NSUPB = NSUPB + 1 IF( CHIN(INC+1:INC+1) .EQ. '{' )THEN NTSUPB(NSUPB) = 2 NUSED = 2 ELSE NTSUPB(NSUPB) = 1 NUSED = 1 ENDIF NCHOUT = NCHOUT + 1 CHOUT(NCHOUT:NCHOUT) = CHAR( ICHSP ) CCC WRITE(*,666) ' start superscript' C....................................................................... C Subscript: similar to above code C ELSEIF( LESC .AND. CHIN(INC:INC).EQ.'_' .AND. INC.LT.NCHIN )THEN NSUPB = NSUPB + 1 IF( CHIN(INC+1:INC+1) .EQ. '{' )THEN NTSUPB(NSUPB) = -2 NUSED = 2 ELSE NTSUPB(NSUPB) = -1 NUSED = 1 ENDIF NCHOUT = NCHOUT + 1 CHOUT(NCHOUT:NCHOUT) = CHAR( ICHSB ) CCC WRITE(*,666) ' start subscript' C....................................................................... C If in super/subscript mode and we have a '}', then this terminates C the current level of super/subscripts C ELSEIF( LESC .AND. CHIN(INC:INC).EQ.'}' .AND. NSUPB.GT.0 )THEN NUSED = 1 NCHOUT = NCHOUT + 1 IF( NTSUPB(NSUPB) .GT. 0 )THEN CHOUT(NCHOUT:NCHOUT) = CHAR( ICHEP ) ELSE CHOUT(NCHOUT:NCHOUT) = CHAR( ICHEB ) ENDIF NSUPB = NSUPB - 1 CCC WRITE(*,666) ' end compound super/subscript' C....................................................................... C Anything else that doesn't start with a \ is passed straight through C ELSEIF( .NOT.LESC .OR. CHIN(INC:INC) .NE. '\\' )THEN LOUT = .TRUE. NUSED = 1 NCHOUT = NCHOUT + 1 CHOUT(NCHOUT:NCHOUT) = CHIN(INC:INC) CCC WRITE(*,666) ' passthru' C....................................................................... C If it started with a \ but we are at the last character, quit C ELSEIF( INC .EQ. NCHIN )THEN CCC WRITE(*,666) ' end of input' GOTO 8000 C....................................................................... C TeX-like escapes -- there are 2 possibilities: C 1) \asciistring C 2) \specialcharacter C ELSE ITOP = INC + 1 C C If the next character is alphabetic, then scan until end-of-input C or a non-alphabetic character is found. This will be the end C of the escape sequence. C IF( LALPH(ICHAR(CHIN(ITOP:ITOP))) )THEN 200 CONTINUE ITOP = ITOP + 1 IF( ITOP .GT. NCHIN )GOTO 300 IF( LALPH(ICHAR(CHIN(ITOP:ITOP))) )GOTO 200 300 CONTINUE ITOP = ITOP - 1 C C If the character following the \asciistring is a blank, skip it also C IF( ITOP .LT. NCHIN )THEN IF( CHIN(ITOP+1:ITOP+1).EQ.' ' )ITOP = ITOP+1 ENDIF ENDIF C C At this point, characters INC thru ITOP are the escape sequence. C Check for a match with the table. C NUSED = ITOP - INC + 1 CHCONT = CHIN(INC:ITOP) C DO 400 I=1,NTABLE IF( CHCONT .EQ. CHTEX(I) )GOTO 410 400 CONTINUE I = 0 410 CONTINUE C C If a match, enter the control character into the output; C if no match, just ignore it C IF( I .GT. 0 )THEN LOUT = .TRUE. NCHOUT = NCHOUT + 1 CHOUT(NCHOUT:NCHOUT) = CHAR( ICHEXT(I) ) CCC WRITE(*,666) ' TeX escape: ' // CHCONT CCC ELSE CCC WRITE(*,666) ' unknown TeX escape: ' // CHCONT ELSEIF( CHCONT .EQ. CHNESC )THEN LESC = .FALSE. ELSEIF( CHCONT .EQ. CHESC )THEN LESC = .TRUE. ENDIF ENDIF C....................................................................... C If we are in single-character super/subscript mode, we must drop C out of it after outputting something C IF( LOUT .AND. NSUPB.GT.0 )THEN IF( NTSUPB(NSUPB) .EQ. 1 )THEN NSUPB = NSUPB - 1 NCHOUT = NCHOUT + 1 CHOUT(NCHOUT:NCHOUT) = CHAR( ICHEP ) CCC WRITE(*,666) ' end single-character superscript' ELSEIF( NTSUPB(NSUPB) .EQ. -1 )THEN NSUPB = NSUPB - 1 NCHOUT = NCHOUT + 1 CHOUT(NCHOUT:NCHOUT) = CHAR( ICHEB ) CCC WRITE(*,666) ' end single-character subscript' ENDIF ENDIF C C "Use up" the appropriate number of characters, and go on to C the next bunch C INC = INC + NUSED IF( INC .LE. NCHIN )GOTO 100 C----------------------------------------------------------------------- 8000 CONTINUE RETURN END