      SUBROUTINE SPPTRD (ITEXT,IHG,IHC,ISY,LI,NC,IB,V,F0,R,
     +NAT,NDIM9,NDIM10,NUMKPT,IQ1,IQ2,IQ3,WVK0,LWGHT,WVLIST,
     +A1,A2,A3,B1,B2,B3)
C
C     READ A SET OF SPECIAL POINTS FROM FILE IN290
C
      INTEGER ITEXT(80),F0(48,NDIM9),IB(48),LWGHT(NDIM10)
      DIMENSION V(3,48),R(49,3,3),WVK0(3),WVLIST(3,NDIM10)
      DIMENSION A1(3),A2(3),A3(3),B1(3),B2(3),B3(3),XKAPA(3)
C
C.....COMMON BLOCK FOR KEEPING TRACK OF POSSIBLE WARNINGS
C     MACHINE TYPE
      COMMON /MACH1/ MACTYP
      COMMON /MACH2/ MACHIN(0:10)
      CHARACTER*7  MACHIN
      DATA INIT /0/
C.....FILES
          IN290 = 3
          IOUT  = 6
C-----------------------------------------------------------------------
      IF (INIT .NE. 0) GOTO 2300
      INIT = 1
C
C     READING FROM FILE WITH GROUP THEORY AND SPECIAL POINTS
C     (FIRST CALL: READ SYMMETRY INFORMATION)
C
      NUMKPT = 0
      READ (IN290,*,ERR=1000,END=1000)
     + NPRGR,IDAY,MONTH,IYEAR,IVERSN,IDUMMY
      MACTYP = IDUMMY
      WRITE (IOUT,100) NPRGR,IVERSN,MACHIN(MACTYP),IDAY,MONTH,IYEAR
100   FORMAT(' READING SPECIAL POINTS GENERATED BY K',I3,
     +' (VER.',I3,') ON ',A7,' COMPUTER'/
     +' DATE:  ',I2,'-TH OF ',I2,',19',I2)
C
      READ (IN290,180) (ITEXT(J),J=1,79)
180   FORMAT(1X,79A1)
      WRITE (IOUT,180) (ITEXT(J),J=1,79)
      READ (IN290,*) IDUMMY
      IRECTP = IDUMMY
      WRITE(IOUT,*) ' IRECTP ', IRECTP
      READ (IN290,*) IDUMMY
      NAT1 = IDUMMY
      WRITE(IOUT,*) ' NAT1 ', NAT1
      READ (IN290,*) A1,A2,A3,B1,B2,B3
      WRITE(IOUT,981) ' A1 ', (A1(I),I=1,3)
      WRITE(IOUT,981) ' A2 ', (A2(I),I=1,3)
      WRITE(IOUT,981) ' A3 ', (A3(I),I=1,3)
      WRITE(IOUT,981) ' B1 ', (B1(I),I=1,3)
      WRITE(IOUT,981) ' B2 ', (B2(I),I=1,3)
      WRITE(IOUT,981) ' B3 ', (B3(I),I=1,3)
981   FORMAT(1X,A4,3F10.6)
      DO 240 K=1,NAT1
C       DUMMY INPUT:
        READ (IN290,*) ITYPE,XKAPA
        WRITE(IOUT,982) ITYPE,XKAPA
240     CONTINUE
982   FORMAT(1X,I4,3F10.6)
C WE DO NOT CHECK WHETHER ALL THIS INFORMATION AGREES WITH
C THE ONE READ PREVIOUSLY, BECAUSE MOST OF IT (NAT1,XKAPA,TY)
C CAN VERY WELL BE DIFFERENT IF SOME "GHOST-ATOMS" WERE
C INTRODUCED. IF SO, WE ISSUE A REMINDER:
      IF (NAT .NE. NAT1) WRITE (IOUT,250) NAT - NAT1
250   FORMAT ('0SUBROUTINE SPPTRD - REMINDER: THE LAST ',I3,
     +' SITES IN THE ABOVE LISTS'/' ARE OCCUPIED BY GHOST ATOMS')
C     GROUP-THEORETICAL INFORMATION
      READ (IN290,980) IHG,IHC,ISY,LI,NC,(IB(J),J=1,48)
980   FORMAT (1X,5I5,4(/12I3))
C      WRITE (*,980) IHG,IHC,ISY,LI,NC,(IB(J),J=1,48)
C     FORMAT (1X,5I5/(12I3))
      READ (IN290,*) ((V(J,I),J=1,3),I=1,48)
C      write (*,'(3f10.6)') ((V(J,I),J=1,3),I=1,48)
      READ (IN290,'(1X,9I4)') ((F0(I,J),J=1,NAT),I=1,48)
C      write (*,'(1X,9I4)') ((F0(I,J),J=1,NAT),I=1,48)
      READ (IN290,*) (((R(K,I,J),J=1,3),I=1,3),K=1,49)
C      write (*,'(3f10.6)') (((R(K,I,J),J=1,3),I=1,3),K=1,49)
C-----------------------------------------------------------------------
C
C     READING ONE SET OF SPECIAL POINTS
C
2300  READ (IN290,*,ERR=1000,END=1000) IRECTP
C     CHECK THAT WE REALLY HAVE A RECORD WITH SPECIAL POINTS:
      IF (IRECTP .NE. 2) GOTO 2320
      READ (IN290,*) N
      IF (N .GT. NDIM10) GOTO 2340
      NUMKPT = N
      READ (IN290,*) IDUM1,IDUM2,IDUM3,WVK0
      IQ1 = IDUM1
      IQ2 = IDUM2
      IQ3 = IDUM3
      DO 2350 I=1,NUMKPT
        READ (IN290,*) IDUMMY, (WVLIST(J,I),J=1,3)
        LWGHT(I) = IDUMMY
2350    CONTINUE
1040    FORMAT (1X,I5,1X,3E14.6)
      WRITE (IOUT,2360) NUMKPT,IQ1,IQ2,IQ3,WVK0
2360  FORMAT(I4,' SPECIAL POINTS READ, IQ1,2,3 =',3I3,'; WVK0 =',3F8.3)
C
      RETURN
C-----------------------------------------------------------------------
C
C     ERROR MESSAGES
C
1000  WRITE (IOUT,*) 'SUBROUTINE SPPTRD *** WARNING ***'
      WRITE (IOUT,*) 'ERROR READING SPECIAL POINTS FILE, UNIT=',IN290
      WRITE (IOUT,*) 'FILE CLOSED - EXECUTION CONTINUES'
      CLOSE (UNIT = IN290 , STATUS = 'KEEP')
      RETURN
C
2320  WRITE (IOUT,*) 'SUBROUTINE SPPTRD - WARNING:'
      WRITE (IOUT,2310) IRECTP
2310  FORMAT (' RECORD WE ARE ATTEMPTING TO READ FROM THE SPECIAL-POINTS
     + FILE'/' IS NOT A RECORD WITH SPECIAL POINTS BUT DATAOF',
     +' RECORD-TYPE  IRECTP =',I3/
     +' K207 CONTINUES WITH THE PREVIOUS SET OF SPECIAL POINTS')
      IWARN = 2
      RETURN
C
2340  WRITE (IOUT,*) 'SUBROUTINE SPPTRD - WARNING:'
      WRITE (IOUT,2330) N,NDIM10
2330  FORMAT (1X,I4,' SPECIAL POINTS IN THIS RECORD CANNOT BE ',
     +'ACCOMMODATED'/' INTO THE LIST WHICH ONLY WAS DIMENSIONED',
     +I4,' IN K207'/
     +' K207 CONTINUES WITH THE PREVIOUS SET OF SPECIAL POINTS')
      IWARN = 2
      RETURN
C
      END
