      PROGRAM MDSTGJK                                 !NRB 12/06/07
      IMPLICIT REAL*8(A-H,O-Z)
C
C PROGRAM TO SET-UP A DSTGJK INPUT FILE LISTING ONLY LEVELS
C TO BE RETAINED AND APPROPRIATE SKIP INFO. READS THE LEVELS
C FILE FROM AUTOSTRUCTURE THAT CONTAINS ALL LEVELS THAT ISKP
C IS TO OPERATE ON IN STGJK (THOSE LEVELS THAT WILL BE 
C ELIMINATED ON ENERGY GROUNDS USING ESKPL,ESKH,ECORR *MUST*
C BE DELETED FROM LEVELS FIRST). 
C TO TAG A LEVEL TO BE SKIPPED JUST ADD A NEGATIVE INTEGER
C BEFORE THE 2J SPECIFICATION.
C
      PARAMETER (MZTAR=1000)
      DIMENSION JJ(MZTAR),JP(MZTAR),JSKP(MZTAR),ISKP(0:20,0:1)
      DIMENSION LL(MZTAR),LP(MZTAR)
C
      OPEN(5,FILE='LEVELS',STATUS='OLD')
      OPEN(6,FILE='dstgjk.ini',STATUS='UNKNOWN')
C
      READ(5,*)
C
      DO J=0,1
        DO I=0,20
          ISKP(I,J)=0
        ENDDO
      ENDDO
      JNAST=0
      INAST=0
      DO J=1,MZTAR
        READ(5,*,END=100)IR1,IR2,IR3,IR4
        INAST=INAST+1
        IF(IR1.GE.0)THEN
          IF(IR3.EQ.0)THEN
            INAST=INAST-1
            GO TO 100
          ENDIF
          IF(IR2.LT.0)THEN
            WRITE(0,*)'CANNOT HAVE SKIP INFO IN INPUT LEVEL ',J
            STOP 'CANNOT HAVE SKIP INFO IN INPUT LEVELS'
          ENDIF
          JNAST=JNAST+1
          JSKP(JNAST)=0
          IR2=MOD(IR2,2)
          IF(ISKP(IR1,IR2).GT.0)THEN
            JSKP(JNAST)=ISKP(IR1,IR2)
            ISKP(IR1,IR2)=0
            IF(IR2.EQ.0)IR2=2
            IR2=-IR2
          ENDIF
          JJ(JNAST)=IR1
          JP(JNAST)=IR2
          LL(JNAST)=IR3
          LP(JNAST)=IR4
        ELSE
          IF(IR3.LT.0)THEN
            WRITE(0,*)'CANNOT HAVE SKIP INFO IN INPUT LEVEL ',J
            STOP 'CANNOT HAVE SKIP INFO IN INPUT LEVELS'
          ENDIF
          IR3=MOD(IR3,2)
          IF(IR2.GT.20)STOP 'INPUT 2J>20!'
          ISKP(IR2,IR3)=ISKP(IR2,IR3)+1
        ENDIF
      ENDDO
C
 100  IF(INAST.GT.MZTAR)STOP 'INCREASE MZTAR!'
C
C FIRST OUTPUT IN ENERGY ORDER
C
      ICHK=0
      WRITE(6,'(I5)')JNAST
      DO J=1,JNAST
        WRITE(6,'(I2,I3,I4,I2)')JJ(J),JP(J),LL(J),LP(J)
        IF(JP(J).LT.0)WRITE(6,'(I2)')JSKP(J)
        ICHK=ICHK+JSKP(J)
      ENDDO
C
      ICHK0=0
      DO J=0,1
        DO I=0,20
          ICHK0=ICHK0+ISKP(I,J)
        ENDDO
      ENDDO
C
      ICHK=ICHK+ICHK0
C
      IF(INAST.NE.JNAST+ICHK)THEN
        WRITE(0,*)'CHECKSUM ERROR:'
        WRITE(0,*)'INPUT   LEVELS =',INAST
        WRITE(0,*)'OUTPUT  LEVELS =',JNAST
        WRITE(0,*)'SKIPPED LEVELS =',ICHK
      ENDIF
C
      STOP
      END
