Google
 

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