PROGRAM CALBAK
C PROGRAM TO TAKE CATALOG FORMAT AND CREATE FILE OF EXP. LINES FOR CALPAR
      INTEGER*4 ID,IQFMT
      INTEGER IQ(12),NQN,NQNX,I
      REAL*8  FQ,ERRX,STR
      CHARACTER*36 INFIL,OUTFIL
      CHARACTER*24 QNBUF,QNSTR
      WRITE(*,*) 'ENTER CATALOG NAME'
      READ(*,102) INFIL
      OPEN(50,FILE=INFIL,STATUS='OLD')
      WRITE(*,*) 'ENTER OUTPUT FILE NAME'
      READ(*,102) OUTFIL
      OPEN(60,FILE=OUTFIL,STATUS='UNKNOWN')
1     READ(50,100,END=90,ERR=1) FQ,ERRX,STR,ID,IQFMT,QNBUF
100   FORMAT(F13.4,2F8.4,15X,I7,I4,A)
      IF(ID.GT.0) GO TO 1
      NQN=MOD(IQFMT,10)
      NQNX=NQN+NQN
      QNSTR=QNBUF(1:NQNX)//QNBUF(13:24)
      CALL READQN(QNSTR,IQ,NQNX)
      WRITE(OUTFIL,'(12I3)') (IQ(I),I=1,NQNX)
      STR=10.**STR
      IF(ERRX.GE.0.0001) THEN
         WRITE(60,101) OUTFIL,FQ,ERRX,STR
      ELSE
         WRITE(60,103) OUTFIL,FQ,ERRX,STR
      ENDIF
      GO TO 1
101   FORMAT(A,F15.4,F10.4,E10.3)
103   FORMAT(A,F15.6,F10.5,E10.3)
90    STOP
102   FORMAT(A)
      END
      SUBROUTINE READQN(QNSTR,IQN,N)
      CHARACTER*(*) QNSTR
      INTEGER IQN(*),N,I,II,K
      CHARACTER*1 ,CH
      II=0
      DO 1 I=1,N
         II=II+1
         CH=QNSTR(II:II)
         II=II+1
         K=ICHAR(QNSTR(II:II))-ICHAR('0')
         IF(K.LT.0.OR.K.GT.9) K=0
         IF(CH.NE.' ') THEN
           IF(CH.EQ.'-') THEN
               K=-K
           ELSE IF(CH.GE.'0'.AND.CH.LE.'9') THEN
               K= K+10*(ICHAR(CH)-ICHAR('0'))
           ELSE IF(CH.GE.'a'.AND.CH.LE.'z') THEN
               K=-K-10*(ICHAR(CH)-ICHAR('a')+1)
           ELSE IF(CH.GE.'A'.AND.CH.LE.'Z') THEN
               K= K+10*(ICHAR(CH)-ICHAR('A')+10)
           ELSE     
               K=999
           ENDIF
         ENDIF
         IQN(I)=K
  1      CONTINUE
      RETURN
      END