SUBROUTINE SIMBOL(X,Y,HT,CBCD,THETA,N) LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI CHARACTER*80 DUMMY DIMENSION Z(3) C? INTEGER TABLE,CHAR,BCD(4),RDBYTE CHARACTER*6 CBCD INTEGER TABLE,ONECHR REAL INCC,INCS LOGICAL SPCL C C CONTINUATION SCHEME FOR NUMBER ONCE STARTED. DATA CONTIN/999./ IF (DEBUGP) THEN WRITE (DUMMY,1000) X,Y,HT,(CBCD(K:K),K=1,4),THETA,N 1000 FORMAT (1X,'SIMBOL: X=',F5.2,', Y=',F5.2,', HT=',F5.2, . ', CBCD=',A6,', THETA=',F5.2,', N=',I4,'.' ) CALL DEBUGR( DUMMY(1:79) ) ENDIF NN=N IF(NN.GT.0) GO TO 5 SPCL= .TRUE. IC=2 IF(NN.EQ.-2) IC=3 NN= 1 X0= X Y0= Y FACT=HT/4. GO TO 10 5 SPCL= .FALSE. IF(ABS(X-CONTIN).GT.0.1)X0=X IF(ABS(Y-CONTIN).GT.0.1)Y0=Y FACT= HT/7. 10 INCS=FACT*SIN(0.0174532925*THETA) INCC=FACT*COS(0.0174532925*THETA) XT=6.*INCC YT=6.*INCS DO 100 I=1,NN IF(SPCL) GO TO 15 IC=2 ONECHR = ICHAR( CBCD( I: I) ) II=TABLE(ONECHR) IF (DEBUGP) THEN WRITE ( DUMMY,1010) (CBCD(K:K),K=1,4),I,ONECHR,II 1010 FORMAT (1X,'SIMBOL: CBCD=', A6,' I=',I2,' ONECHR=',I10, . ' II=',I10,'.' ) CALL DEBUGR( DUMMY(1: 55)) ENDIF GO TO 20 15 IF( CBCD(1:1).LT.CHAR(0) .OR. CBCD(1:1).GT.CHAR(31))RETURN II= TABLE( ICHAR(CBCD(1:1) )) 20 CONTINUE LOC = MOD( II, 1024) LINES=II/1024 IF(LINES.EQ.0) GO TO 40 IF(.NOT.SPCL) GO TO 25 X0= X0+2.*(INCS-INCC) Y0= Y0-2.*(INCS+INCC) 25 CONTINUE OFFX = 0 OFFY = 0 DO 35 II=1,LINES CALL MOVES(LOC,IX,IY) IF ( IX.EQ. 10) THEN OFFY = 3 GOTO 35 ENDIF IF ( IX .EQ. 20) THEN OFFX = 3 GOTO 35 ENDIF IF (DEBUGP) THEN WRITE ( DUMMY,1020) LOC,IX,IY 1020 FORMAT (1X,'SIMBOL: LOC=',I10,' IX=',I3,' IY=',I3,'.' ) CALL DEBUGR( DUMMY(1: 50) ) ENDIF IF(IX.EQ.7)GOTO 30 XS=IX - OFFX YS=IY - OFFY XX= X0+INCC*XS-INCS*YS YY= Y0+INCC*YS+INCS*XS CALL PLOT(XX,YY,IC) IC=3 GO TO 35 30 IC=2 35 LOC=LOC+1 40 X0=X0+XT Y0=Y0+YT 100 CONTINUE RETURN END SUBROUTINE MOVES(LOC,IX,IY) DIMENSION IMOVES(1024),MOV1(100),MOV2(100),MOV3(100) DIMENSION MOV4(100),MOV5(100),MOV6(100),MOV7(100) DIMENSION MOV8(100),MOV9(100),MOV10(100),MOV11(24) EQUIVALENCE (IMOVES(1),MOV1(1)),(IMOVES(101),MOV2(1)), . (IMOVES(201),MOV3(1)),(IMOVES(301),MOV4(1)), . (IMOVES(401),MOV5(1)),(IMOVES(501),MOV6(1)), . (IMOVES(601),MOV7(1)),(IMOVES(701),MOV8(1)), . (IMOVES(801),MOV9(1)),(IMOVES(901),MOV10(1)), . (IMOVES(1001),MOV11(1)) DATA MOV1/ . 205, 407, 406, 307, 107, 6, 1, 100, 300, 401, . 406, 400, 202, 207, 306, 106, 207, 200, 100, 300, . 6, 107, 307, 406, 404, 1, 0, 400, 407, 7, . 0, 400, 0, 7, 407, 7, 4, 304, 6, 107, . 307, 406, 405, 304, 104, 304, 403, 401, 300, 100, . 1, 3, 104, 5, 6, 7, 407, 406, 201, 200, . 100, 101, 201, 700, 202, 207, 200, 700, 2, 302, . 403, 304, 104, 5, 106, 406, 307, 107, 6, 5, . 104, 304, 403, 401, 300, 100, 1, 6, 107, 307, . 406, 401, 300, 0, 7, 307, 406, 405, 304, 4/ DATA MOV2/ . 304, 403, 401, 400, 300, 301, 401, 700, 0, 407, . 700, 107, 106, 6, 7, 107, 206, 201, 100, 300, . 200, 207, 107, 307, 206, 201, 300, 307, 300, 200, . 400, 300, 302, 402, 2, 7, 1, 100, 300, 401, . 407, 7, 207, 200, 101, 301, 200, 205, 7, 205, . 407, 0, 700, 400, 7, 200, 407, 400, 204, 0, . 7, 307, 406, 405, 304, 4, 304, 403, 400, 407, . 203, 7, 0, 700, 400, 205, 3, 407, 400, 7, . 0, 7, 4, 404, 407, 400, 0, 204, 104, 304, . 204, 407, 7, 4, 304, 403, 401, 300, 100, 1/ DATA MOV3/ . 6, 107, 307, 406, 700, 303, 503, 404, 303, 103, . 4, 6, 107, 307, 406, 401, 300, 100, 1, 205, . 401, 5, 203, 405, 1, 203, 201, 205, 203, 3, . 403, 700, 405, 5, 700, 1, 401, 700, 306, 100, . 0, 3, 403, 406, 307, 107, 6, 3, 403, 400, . 2, 404, 6, 700, 1, 401, 700, 402, 4, 406, . 204, 104, 105, 205, 204, 700, 201, 101, 102, 202, . 201, 100, 101, 201, 200, 100, 700, 202, 204, 304, . 405, 406, 307, 107, 6, 3, 403, 304, 302, 403, . 202, 204, 4, 0, 400, 404, 204, 202, 204, 104/ DATA MOV4/ . 3, 1, 100, 300, 401, 403, 304, 204, 202, 204, . 1, 401, 204, 202, 402, 2, 202, 200, 204, 202, . 404, 0, 202, 4, 400, 202, 0, 404, 4, 400, . 202, 204, 2, 200, 402, 204, 202, 200, 204, 2, . 402, 204, 202, 404, 4, 404, 0, 400, 0, 202, . 4, 202, 404, 202, 200, 202, 404, 303, 103, 4, . 103, 101, 0, 101, 301, 400, 301, 303, 202, 404, . 4, 400, 0, 202, 100, 306, 500, 4, 604, 100, . 202, 602, 202, 206, 205, 207, 2, 103, 200, 207, . 407, 200, 201, 101, 301, 201, 205, 105, 305, 205/ DATA MOV5/ . 206, 203, 103, 303, 3, 103, 104, 101, 103, 303, . 304, 301, 303, 503, 504, 501, 503, 603, 1, 205, . 401, 1, 5, 106, 205, 201, 205, 306, 405, 1, . 401, 700, 202, 206, 204, 4, 404, 0, 6, 107, . 307, 406, 400, 200, 101, 103, 204, 304, 300, 2, . 402, 700, 404, 4, 700, 106, 100, 700, 300, 306, . 402, 200, 100, 1, 2, 205, 206, 107, 6, 5, . 400, 0, 403, 400, 750, 402, 303, 203, 102, 101, . 200, 300, 401, 0, 0, 0,1000, 304, 301, 200, . 101, 101, 750, 308, 307, 0, 0, 0, 0, 0/ c . 400, 0, 105, 305, 404, 401, 500, 750, 403, 203, c . 102, 101, 200, 300, 401, 0,1000, 404, 401, 300, c . 200, 101, 700, 406, 405, 0, 0, 0, 0, 0/ DATA MOV6/ . 106, 100, 750, 102, 203, 303, 402, 401, 300, 200, . 101, 0, 402, 303, 203, 102, 101, 200, 300, 401, . 0, 0, 406, 400, 750, 402, 303, 203, 102, 101, . 200, 300, 401, 0, 0, 101, 402, 303, 203, 102, . 101, 200, 300, 401, 0, 305, 206, 105, 100, 750, . 3, 203, 0, 0,1000, 1, 100, 200, 301, 305, . 750, 304, 205, 105, 4, 3, 102, 202, 303, 0, . 106, 100, 750, 102, 203, 303, 402, 400, 0, 0, . 206, 205, 750, 203, 200, 0, 106, 100, 750, 303, . 102, 300, 0, 106, 100, 0, 0, 0, 0, 0/ c . 3, 203, 0, 0,1000, 101, 200, 300, 401, 405, c . 750, 404, 305, 205, 104, 103, 202, 302, 403, 0, c . 106, 100, 750, 102, 203, 303, 402, 400, 0, 0, c . 206, 205, 750, 203, 200, 0, 106, 100, 750, 303, c . 102, 300, 0, 106, 100, 0, 0, 0, 0, 0/ DATA MOV7/ . 3, 0, 750, 2, 103, 202, 200, 750, 202, 303, . 402, 400, 0, 0, 100, 103, 750, 102, 203, 302, . 300, 0, 0, 0, 101, 102, 203, 303, 402, 401, . 300, 200, 101, 0,1000, 106, 100, 750, 105, 206, . 306, 405, 404, 303, 203, 104, 0, 0, 0, 0, . 1000, 405, 306, 206, 105, 104, 203, 303, 404, 750, . 406, 401, 400, 0, 103, 100, 750, 102, 203, 303, . 303, 203, 102, 301, 200, 100, 0, 0, 0, 0, . 205, 201, 300, 750, 104, 304, 0, 0, 0, 0, . 103, 101, 200, 301, 303, 750, 301, 400, 0, 0/ DATA MOV8/ . 103, 200, 303, 0, 103, 200, 302, 400, 503, 0, . 103, 300, 750, 303, 100, 0, 0, 0, 0, 0, . 1000, 106, 105, 204, 305, 750, 306, 302, 201, 0, . 104, 404, 100, 400, 750, 202, 302, 0, 0, 0, . 2000, 300, 307, 505, 105, 307, 0, 0, 0, 0, . 1000,2000, 206, 506, 605, 602, 501, 201, 102, 105, . 206, 750, 304, 404, 403, 303, 304, 0, 0, 0, . 1000,2000, 106, 502, 750, 506, 102, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ DATA MOV9/ . 203, 2, 0, 0, 7, 0, 106, 1, 204, 2, . 0, 0, 1, 0, 106, 1,1400, 2, 0, 0, . 3, 0, 0, 0, 303, 2, 0, 0, 2, 0, . 0, 0, 700, 6, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ DATA MOV10/ . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ DATA MOV11/ . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0/ C IX=IMOVES(LOC+1)/100 IY=IMOVES(LOC+1)-IX*100 RETURN END SUBROUTINE NUMBUR(W,HGHT,FPN,THETA,N) C C ENTRY MODIFIED TO FIT THE NEEDS OF ORTEP C C WHERE - W IS AN ARRAY OF DIMENSION 3CONTAINING THE COORDINATES C X,Y,Z IF THE LOWER LEFT CORNER OF THE FIRST DIGIT OF C OUTPUT.(X,Y) IS IN FLOATING POINT PAGE INCHES. C HGHT IS THE HEIGHT OF THE PLOTTED NUMBER.(FLOATING INCHES) C FPN IS THE FLOATING POINT NUMBER TO BE PLOTTED. C THETA IS THE ANGLE ON THE PAGE FOR THE NUMBER. C N IS THE NUMBER DECIMAL DIGITS FOR OUTPUT. A (-1) VALUE C WILL SUPPRESS THE DECIMAL POINT. C DIMENSION W(3) C CONTINUATION SCHEME FOR REST OF NUMBER ONCE STARTED. DATA CONTIN/999./ C C TFPN=ABS(FPN) * 1.0000002 XT=W(1) YT=W(2) IF(FPN)10,80,20 10 CONTINUE CALL OSIM (XT,YT,HGHT,45,THETA,1) XT=CONTIN YT=CONTIN 20 I=0.4343 * ALOG(TFPN) + 1.0 C? IF(I) 51, 51, 30 IF ( I.GT. 0) THEN 30 DO 40 J=1,I K=TFPN * 10.0 **(J-I) CALL OSIM (XT,YT,HGHT,(K+48),THETA,1) TFPN=TFPN-FLOAT(K*10**(I-J)) XT=CONTIN YT=CONTIN IF(N+1)80,80,50 50 CONTINUE CALL OSIM (XT,YT,HGHT,46,THETA,1) XT=CONTIN 40 YT=CONTIN ELSE CALL OSIM (XT,YT,HGHT,46,THETA,1) XT=CONTIN YT=CONTIN ENDIF C? IF(N)80,80,60 IF ( N.GT. 0) THEN 60 DO 70 I=1,N K=TFPN * 10.0 CALL OSIM (XT,YT,HGHT,(K+48),THETA,1) 70 TFPN=TFPN*10.0-FLOAT(K) ENDIF 80 RETURN 90 CONTINUE C? CALL OSIM( XT, YT, HGHT, '0.0000000000 ', THETA, 2+N) RETURN END INTEGER FUNCTION TABLE( INDEX) C DIMENSION ITABLE(256),IT1(100),IT2(100),IT3(56) DIMENSION LOCTAB( 256) DIMENSION LOCS1( 100), LOCS2( 100), LOCS3( 56) DIMENSION MOVTAB( 256) DIMENSION MOVS1( 100), MOVS2( 100), MOVS3( 56) EQUIVALENCE ( LOCTAB(1),LOCS1),( LOCTAB(101),LOCS2) EQUIVALENCE ( LOCTAB(201),LOCS3) EQUIVALENCE ( MOVTAB(1),MOVS1),( MOVTAB(101),MOVS2) EQUIVALENCE ( MOVTAB(201),MOVS3) DATA LOCS1 / . 290, 297, 308, 313, 319, 330, 336, 325, 342, 349, . 355, 313, 368, 316, 374, 380, 382, 142, 13, 229, . 285, 102, 250, 218, 232, 429, 2, 15, 20, 38, . 127, 191, 0, 58, 331, 449, 65, 102, 460, 384, . 123, 115, 220, 226, 266, 229, 58, 108, 2, 15, . 20, 38, 127, 191, 80, 54, 38, 207, 260, 260, . 257, 232, 250, 271, 437, 240, 91, 2, 89, 31, . 32, 195, 180, 118, 136, 171, 31, 168, 177, 0, . 159, 2, 159, 75, 140, 135, 154, 156, 150, 146, . 185, 28, 153, 26, 418, 232, 789, 472, 500, 512 / DATA MOVS1 / . 8,12, 6, 7, 7, 7, 7, 6, 8, 7, . 14,13, 6, 4, 6, 2, 2, 5, 5, 8, . 5,14, 6, 3, 8, 8, 9, 5, 8,13, . 9, 9, 0, 8, 5,11,11,14,11, 2, . 4, 4,11, 5, 6, 2, 5, 2, 9, 5, . 8,13, 9, 9,11, 6,17,12,11,12, . 3, 5, 3,14,12,10,12, 8, 7, 7, . 6,12, 6, 6, 5, 7, 3, 5, 4,11, . 7,11,10,12, 4, 6, 3, 5, 5, 5, . 8, 4, 2, 4, 4, 8,10,11,11, 8 / DATA LOCS2 / . 522, 535, 545, 554, 570, 580, 486, 586, 593, 600, . 614, 624, 634, 650, 664, 670, 680, 690, 700, 704, . 710, 720, 730, 268, 774, 551, 17, 264, 740, 750, . 770, 514, 35, 268, 526, 799, 262, 12, 291, 24, . 513, 783, 294, 24, 775, 294, 28, 796, 33, 280, . 33, 768, 824, 526, 775, 278, 8, 784, 783, 278, . 792, 24, 32, 538, 770, 1, 280, 807, 23, 265, . 272, 263, 39, 56, 7, 39, 800, 768, 4, 39, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 / DATA MOVS2 / . 11, 9, 7,15, 8, 5, 9, 6, 2,12, . 7, 9,12,13, 6, 6, 6, 8, 3, 5, . 5, 9, 7, 1, 1, 9, 4, 2, 6,17, . 7, 6, 7, 1, 9, 3, 1, 7, 8, 2, . 1, 7, 8, 0, 7, 9, 1, 8, 8, 6, . 14, 4, 6, 8, 1, 2, 8, 1, 4, 6, . 7, 4, 6, 8, 1, 2, 8, 1, 4, 6, . 5, 5, 0, 8, 4, 8, 0, 7, 9, 1, . 8, 9, 1,14, 5, 9, 1, 1, 9, 8, . 5, 7, 9, 1, 8, 6, 0, 3, 9, 6 / DATA LOCS3 / . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0 / DATA MOVS3 / . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, . 0, 0, 0, 0, 0, 0 / TABLE = MOVTAB( INDEX+1)*1024 + LOCTAB(INDEX+1) RETURN END