C N.R. BADNELL                     UoS                            03/03/06
      PROGRAM CLIST
      IMPLICIT REAL*4(A-H,O-Z)
C
C READ A SINGLE OR ARBITRARY CONCATENATED SET OF "cfout" DR FIT FILES
C AND ORDER THEM FOR OUTPUT WITH OUTER LOOP OVER SEQUENCE AND INNER
C LOOP OVER ELEMENT. ALL C-COEFFICIENTS WRITTEN BEFORE E-COEFFICIENTS
C WITH ALL VALUES FOR A SINGLE ION PER LINE.
C *OBVIOUSLY*, USERS CAN TAIL THE FORMAT OF THE OUTPUT TO THEIR OWN DESIRE.
C
C USEFUL VARIABLES/ARRAYS INCLUDE:
C 
C NION= NUMBER OF IONIC DATASETS
C NZ(NION)= NUCLEAR CHARGE OF DATASET NION I.E. ELEMENT
C NE(NION)= NUMBER OF TARGET ELECTRONS FOR DATASET NION I.E. SEQUENCE.
C INDX(M,IZ,IN)=NION POSITION OF METASTABLE M, ELEMENT IZ AND SEQUENCE IN.
C IWGHT(NION)= STATISTICAL WEIGHT OF METASTABLE M OF NION.
C IWD= DEFAULT GROUND LEVEL WEIGHT FOR (OLD) FILES MISSING WEIGHT INFO.
C NCF(NION)=NUMBER OF COEFFICIENT PAIRS (C,E) FOR DATASET NION.
C
C NO USER INPUT REQUIRED, OTHER THAN
C INPUT FILE OF FIT DATA: cfout
C OUTPUT FILE FIT LIST:   clist
C
C
      PARAMETER(MAXION=2500)              !MAX NUMBER OF DATASETS
      PARAMETER(MAXCF =  10)              !MAX NUMBER OF COEFFS PER ION
      PARAMETER(MXMETA=10)                !MAX NUMBER OF METASTABLES PER ION
C
      LOGICAL EX
      CHARACTER*1 CHAR(3)
      CHARACTER*8 DATE
C
      DIMENSION INDX(MXMETA,100,100),NCF(MAXION),IWGHT(MAXION),IWD(100)
      DIMENSION CF(MAXCF,MAXION),EF(MAXCF,MAXION),IMX(100)
C
      DATA DATE/'19581027'/
C
      INQUIRE(FILE='cfout',EXIST=EX)
      IF(.NOT.EX)STOP'*** NO cfout FILE OF FIT DATA FOUND!'
C  
      OPEN(UNIT=7,FILE='cfout',STATUS='OLD')
      OPEN(UNIT=8,FILE='clist',STATUS='UNKNOWN')
C
      IZX=0
      INX=0
      METAX=0
      NION=0
      DO IN=1,100
        DO IZ=1,100
          DO M=1,MXMETA
            INDX(M,IZ,IN)=0
          ENDDO
        ENDDO
      ENDDO
      DO IN=1,100
        IMX(IN)=0
      ENDDO
C
C DEFAULT GROUND-LEVEL WEIGHTS (FOR OLD FILES MISSING W).
C
      IWD(1)=2
      IWD(2)=1
      IWD(3)=2
      IWD(4)=1
      IWD(5)=2
      IWD(6)=1
      IWD(7)=4
      IWD(8)=5
      IWD(9)=4
      IWD(10)=1
      IWD(11)=2
      IWD(12)=1           
C
C LOOK FOR A NEW HEADER
C
  100 READ(7,1000,END=9999)CHAR
 1000 FORMAT(3A1)
C
      IF(CHAR(1).EQ.'Z')THEN                  !WE HAVE A HEADER
        IF(CHAR(3).EQ.'X')THEN
          WRITE(*,*)'*** MISSING ION SPECIFICATION',CHAR
          STOP'*** MISSING ION SPECIFICATION'
        ENDIF
C
        BACKSPACE(7)
        READ(7,1010)IZ,IN,META,IWJ
 1010   FORMAT(2X,I2,3X,I2,3X,I2,3X,I2)
C
        IF(IZ*IN.EQ.0)THEN
          WRITE(*,*)'*** MIX-UP ON HEADER Z,N,M=',IZ,IN,META
          STOP '*** ABORT, CHECK cfout FILE'
        ENDIF
        IF(META.EQ.0)THEN
          META=1
          IF(IN.GT.12)STOP '*** EXTEND DEFAULT GROUND LEVEL WEIGHTS'
          IWJ=IWD(IN)
        ENDIF
C
        NION=NION+1
        IF(NION.GT.MAXION)STOP '*** INCREASE PARAMETER MAXION'
        IF(META.GT.MXMETA)STOP '*** INCREASE PARAMETER MXMETA'
C
        IF(INDX(META,IZ,IN).NE.0)THEN
          WRITE(*,*)'*** DUPLICATE DATASES FOR Z,N,M=',IZ,IN,META
          STOP '*** ABORT, CHECK cfout FILE'
        ENDIF
        INDX(META,IZ,IN)=NION
        NCF(NION)=0
        IWGHT(NION)=IWJ
        IZX=MAX(IZX,IZ)
        INX=MAX(INX,IN)
        IMX(IN)=MAX(IMX(IN),META)
        METAX=MAX(METAX,META)
      ELSE
        IF(CHAR(3).EQ.'N')THEN
          WRITE(*,*)'*** MISSING HEADER? Z,N,M=',IZ,IN,META
          STOP'*** MISSING HEADER??'
        ENDIF
        GO TO 100
      ENDIF
C
C LOOK FOR FIRST COEFFICIENT LINE
C
  150 READ(7,1000)CHAR
      IF(CHAR(3).NE.'N')GO TO 150             !NOT FOUND YET
C
  160 READ(7,1020)N,C,E                       !COEFFS
 1020 FORMAT(I3,E11.3,E12.3)
C
      IF(N.GT.0)THEN
        NCF(NION)=NCF(NION)+1
        IF(NCF(NION).GT.MAXCF)STOP'*** INCREASE PARAMETER MAXCF'
        CF(NCF(NION),NION)=C
        EF(NCF(NION),NION)=E
        GO TO 160
      ELSE
        GO TO 100                             !LOOK FOR A NEW HEADER
      ENDIF
C
C NO MORE DATA SO CHECK COMPLETENESS
C
 9999 DO IN=1,INX
        DO IZ=IN+1,IZX
          DO IM=1,IMX(IN)
            IF(INDX(IM,IZ,IN).EQ.0.AND.
     X             (IZ.LE.30.OR.IZ.EQ.36.OR.IZ.EQ.42.OR.IZ.EQ.54))
     X         WRITE(*,*)'***MISSING DATASET FOR Z,N,M=',IZ,IN,IM
          ENDDO
        ENDDO
      ENDDO
C
C****************************************************
C NOW WRITE IT ALL BACK OUT AGAIN ***USER SPECIFIC***
C****************************************************
C
C FIRST, HEADER INFO
C
      CALL DATE_AND_TIME(DATE)  !F90 - COMMENT-OUT IF USUNG F77.
C
      WRITE(8,2222)DATE
 2222 FORMAT('DR RATE COEFFICIENT FITS (C)',A8,' N. R. BADNELL,',
     X' DEPARTMENT OF PHYSICS, UNIVERSITY OF STRATHCLYDE,',
     X' GLASGOW G4 0NG, UK.'/)
C
C FOR EACH METASTABLE
C
c      DO 777 M=1,METAX
C
C THEN, ALL C-COEFFICIENTS
C
      WRITE(8,2000)(J,J=1,9)
 2000 FORMAT('  Z','  N','  M','  W',2X,9(4X,'C',I1,5X))  !***OPTIONAL HEADER
C
      DO IN=1,INX
        DO 775 IZ=IN+1,IZX
          DO M=1,IMX(IN)
            J=INDX(M,IZ,IN)
            IF(J.EQ.0)GO TO 775
            WRITE(8,2001)IZ,IN,M,IWGHT(J),(CF(N,J),N=1,NCF(J))
 2001       FORMAT(4I3,10(1PE11.3))             !*** USER SPECIFIC
          ENDDO
  775   CONTINUE
      ENDDO
C
      WRITE(8,*)' '
C
C THEN, ALL E-COEFFICIENTS
C
      WRITE(8,2002)(J,J=1,9)
 2002 FORMAT('  Z','  N','  M','  W',2X,9(4X,'E',I1,5X))  !***OPTIONAL HEADER
C
      DO IN=1,INX
        DO 776 IZ=1,IZX
          DO M=1,IMX(IN)
            J=INDX(M,IZ,IN)
            IF(J.EQ.0)GO TO 776
            WRITE(8,2001)IZ,IN,M,IWGHT(J),(EF(N,J),N=1,NCF(J))
                                        !***SAME FORMAT AS C-COEFFICIENTS
          ENDDO
  776   CONTINUE
      ENDDO
C
      WRITE(8,*)' '
C
c  777 CONTINUE
C
      STOP 'MASTER COEFFICIENT LIST IN FILE clist'
      END