Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0049/unpack.for
There is 1 other file named unpack.for in the archive. Click here to see a list.
C GENPLT-II UTILITY PROGRAM UNPACK
C UNPACK 09/20/67
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C THIS PROGRAM UNPACKS THE ADVANCED LTRPLT COORDINATE ARRAYS
C LOCATN DATA STATEMENTS FOLLOWED BY KRD DATA STATEMENTS ARE READ
C ALL COMMENT CARDS MUST BE REMOVED FROM THE DATA STATEMENTS READ
C OUTPUT CONSISTS OF A SET OF PUNCHED CARDS WITH 3 POINTS PER CARD
C PROGRAM PACK CAN RETURN THESE CARDS TO DATA STATEMENT FORM
DOUBLE PRECISION TITLE,NAME,LOCATE,LETTER,LABEL
DIMENSION NAME(128),KIND(1000),KODE(1000),LETTER(1000),LOCATN(64),
1KRD(50),TITLE(6)
DATA (NAME(I), I= 1, 64) /6H0 ,6H1 ,6H2 ,6H3 ,
1 6H4 ,6H5 ,6H6 ,6H7 ,6H8 ,6H9 ,6H ,
2 6H= ,6H* ,6H ,6H ,6H ,6H+ ,6HA ,
3 6HB ,6HC ,6HD ,6HE ,6HF ,6HG ,6HH ,
4 6HI ,6H ,6H. ,6H) ,6HLFTARO,6HLFTARO,6H ,
5 6H- ,6HJ ,6HK ,6HL ,6HM ,6HN ,6HO ,
6 6HP ,6HQ ,6HR ,6H ,6H$ ,6H* ,6H ,
7 6H ,6H ,6HBLANK ,6H/ ,6HS ,6HT ,6HU ,
8 6HV ,6HW ,6HX ,6HY ,6HZ ,6H ,6H, ,
9 6H( ,6HVRTICL,6HRITARO,6HRITARO/
DATA (NAME(I), I= 65,128) /6H0 ,6H1 ,6H2 ,6H3 ,
1 6H4 ,6H5 ,6H6 ,6H7 ,6H8 ,6H9 ,6H ,
2 6H= ,6H* ,6H ,6H ,6H ,6H+ ,6HALPHA ,
3 6HBETA ,6HGAMMA ,6HDELTA ,6HEPSILO,6HZETA ,6HETA ,6HTHETA ,
4 6HIOTA ,6H ,6H. ,6H) ,6HLFTARO,6HLFTARO,6H ,
5 6H- ,6HKAPPA ,6HLAMBDA,6HMU ,6HNU ,6HXI ,6HOMICRO,
6 6HPI ,6HRHO ,6HSIGMA ,6H ,6H$ ,6H* ,6H ,
7 6H ,6H ,6HBLANK ,6H/ ,6HTAU ,6HUPSILO,6HPHI ,
8 6HCHI ,6HPSI ,6HOMEGA ,6H ,6H ,6H ,6H, ,
9 6H( ,6HVRTICL,6HRITARO,6HRITARO/
DATA LOCATE/6HLOCATN/
DO 1 I=1,1000
1 KIND(I)=0
INDIC1=10000000
INDIC2=1000000
KEEP=0
WRITE(6,2)
2 FORMAT(1H1,5X,27HDATA READ AND CARDS PUNCHED//)
3 READ(5,4)(TITLE(I),I=1,6),(LOCATN(I),I=1,32)
WRITE(6,5)(TITLE(I),I=1,6),(LOCATN(I),I=1,32)
READ(5,4)(TITLE(I),I=1,6),(LOCATN(I),I=33,64)
WRITE(6,5)(TITLE(I),I=1,6),(LOCATN(I),I=33,64)
4 FORMAT(3X,6A6,3(I10,1X)/4(6X,6(I10,1X)/),6X,6(I10,1X))
5 FORMAT(3X,6A6,3(I10,1H,)/4(6X,6(I10,1H,)/),6X,6(I10,1H,))
DO 6 I=1,64
INDEX1=LOCATN(I)/10000
INDEX2=LOCATN(I)-(10000*INDEX1)
INDEX1=INDEX1-(10000*(INDEX1/10000))
KIND(INDEX1)=KIND(INDEX1)+INDIC1
KIND(INDEX2)=KIND(INDEX2)+INDIC2
KODE(INDEX1)=I-1
KODE(INDEX2)=I-1
INDEX=I+KEEP
LETTER(INDEX1)=NAME(INDEX)
6 LETTER(INDEX2)=NAME(INDEX)
INDIC1=INDIC1/100
INDIC2=INDIC2/100
KEEP=KEEP+64
READ(5,7)LABEL
7 FORMAT(14X,1A6)
BACKSPACE 5
IF(LABEL-LOCATE)8,3,8
8 KIND(1)=11110000
KODE(1)=48
LETTER(1)=NAME(49)
INDEX1=2
INDEX2=50
9 READ(5,10)(TITLE(I),I=1,6),(KRD(I),I=1,50)
WRITE(6,11)(TITLE(I),I=1,6),(KRD(I),I=1,50)
10 FORMAT(3X,6A6,3(I10,1X)/7(6X,6(I10,1X)/),6X,6(I10,1X))
11 FORMAT(1H1,2X,6A6,3(I10,1H,)/7(6X,6(I10,1H,)/),6X,6(I10,1H,))
DO 16 I=INDEX1,INDEX2
J=50-INDEX2+I
IF(KRD(J))19,19,12
12 IF(KIND(I))14,14,13
13 N=1
GO TO 15
14 N=N+1
KIND(I)=KIND(I-1)
KODE(I)=KODE(I-1)
LETTER(I)=LETTER(I-1)
15 KRD5=KRD(J)/32
KRD4=KRD5/32
KRD3=KRD4/32
KRD2=KRD3/32
KRD1=KRD2/32
KRD6=KRD(J)-(32*KRD5)
KRD5=KRD5-(32*KRD4)
KRD4=KRD4-(32*KRD3)
KRD3=KRD3-(32*KRD2)
KRD2=KRD2-(32*KRD1)
WRITE(6,17)KRD1,KRD2,KRD3,KRD4,KRD5,KRD6,KIND(I),KODE(I),LETTER(I)
1,N
16 WRITE(7,18)KRD1,KRD2,KRD3,KRD4,KRD5,KRD6,KIND(I),KODE(I),LETTER(I)
1,N
17 FORMAT(10X,2I2,1X,2I2,1X,2I2,6X,I8,2X,I2,8X,A6,3H - ,I2)
18 FORMAT(2I2,1X,2I2,1X,2I2,6X,I8,2X,I2,8X,A6,3H - ,I2)
INDEX1=INDEX2+1
INDEX2=INDEX2+50
GO TO 9
19 STOP
END