      PROGRAM MDSTG2                                       !NRB 12/08/13
      IMPLICIT REAL*8(A-H,O-Z)
C
C PROGRAM TO SET-UP A DSTG2 INPUT FILE LISTING ONLY TERMS
C TO BE RETAINED AND APPROPRIATE SKIP INFO. READS THE TERMS
C FILE FROM AUTOSTRUCTURE THAT CONTAINS ALL TERMS THAT ISKP
C IS TO OPERATE ON IN STG2 (THOSE TERMS THAT WILL BE 
C ELIMINATED ON ENERGY GROUNDS USING ESKPL,ESKH,ECORR *MUST*
C BE DELETED FROM TERMS FIRST). 
C TO TAG A TERM TO BE SKIPPED JUST ADD A NEGATIVE SIGN
C TO THE 2S+1 SPECIFICATION. THE FILE CANNOT CONTAIN ANY
C INITIAL SKIP INFO, JUST THE TERMS MUST BE PRESENT.
C
      PARAMETER (MZTAR=1000)
      DIMENSION JSKP(MZTAR),ISKP(0:10,0:10,0:1)
      DIMENSION LL(MZTAR),LP(MZTAR),IS(MZTAR)
     X         ,ICF(MZTAR),INI(MZTAR),ENAT(MZTAR)       !NEW STYLE TERMS
C
      OPEN(5,FILE='TERMS',STATUS='OLD')
      OPEN(6,FILE='dstg2_EO',STATUS='UNKNOWN')
      OPEN(7,FILE='dstg2_SO',STATUS='UNKNOWN')

C
      READ(5,*)
C
      DO K=0,1
        DO J=0,10
          DO I=0,10
            ISKP(I,J,K)=0
          ENDDO
        ENDDO
      ENDDO
      JNAST=0
      INAST=0
      DO J=1,MZTAR
        READ(5,*,END=100)IR1,IR2,IR3   ,IR4,IR5,EE   !ADD NEW TERMS INFO
        INAST=INAST+1
        IF(IR1.GT.0)THEN
          JNAST=JNAST+1
          JSKP(JNAST)=0
          IR3=MOD(IR3,2)
          IF(ISKP(IR1,IR2,IR3).GT.0)THEN
            JSKP(JNAST)=ISKP(IR1,IR2,IR3)
            ISKP(IR1,IR2,IR3)=0
            IR1=-IR1
          ENDIF
          IS(JNAST)=IR1
          LL(JNAST)=IR2
          LP(JNAST)=IR3
          ICF(JNAST)=IR4
          INI(JNAST)=IR5
          ENAT(JNAST)=EE
        ELSEIF(IR1.LT.0)THEN
          IR1=-IR1
          IR3=MOD(IR3,2)
          IF(IR2.GT.10)STOP 'INPUT L>10!'
          ISKP(IR1,IR2,IR3)=ISKP(IR1,IR2,IR3)+1
        ELSE
          INAST=INAST-1
          GO TO 100
        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,1000)IS(J),LL(J),LP(J),ICF(J),INI(J),ENAT(J)
        IF(IS(J).LT.0)WRITE(6,'(I2)')JSKP(J)
        ICHK=ICHK+JSKP(J)
      ENDDO
C
      ICHK0=0
      DO K=0,1
        DO J=0,10
          DO I=0,10
            ICHK0=ICHK0+ISKP(I,J,K)
          ENDDO
        ENDDO
      ENDDO
C
      ICHK=ICHK+ICHK0
C
      IF(INAST.NE.JNAST+ICHK)THEN
        WRITE(0,*)'CHECKSUM EO ERROR:'
        WRITE(0,*)'INPUT   TERMS =',INAST
        WRITE(0,*)'OUTPUT  TERMS =',JNAST
        WRITE(0,*)'SKIPPED TERMS =',ICHK
      ENDIF
C
C NOW OUTPUT IN SYMMETRY ORDER
C
      ICHK=0
      WRITE(7,'(I5)')JNAST
      DO J=1,JNAST
        DO K=J,JNAST
          IF(IS(K).NE.0.AND.ABS(IS(K)).EQ.ABS(IS(J))
     X      .AND.LL(K).EQ.LL(J).AND.LP(K).EQ.LP(J))THEN
            WRITE(7,1000)IS(K),LL(K),LP(K),ICF(K),INI(K),ENAT(K)
            IF(IS(K).LT.0)WRITE(7,'(I2)')JSKP(K)
            ICHK=ICHK+JSKP(K)
            IF(K.GT.J)IS(K)=0
          ENDIF
        ENDDO
      ENDDO
C
      ICHK=ICHK+ICHK0
C
      IF(INAST.NE.JNAST+ICHK)THEN
        WRITE(0,*)'CHECKSUM SO ERROR:'
        WRITE(0,*)'INPUT   TERMS =',INAST
        WRITE(0,*)'OUTPUT  TERMS =',JNAST
        WRITE(0,*)'SKIPPED TERMS =',ICHK
      ENDIF
C
      STOP
C
 1000 FORMAT(3I2,2I5,F18.6)
      END
