c     editCHAX
c     ======
c     program for rearranging the data output by the f-value generating 
c     program.
c     -----------------------------------------------------------------
c     The names of the input programs and parameter n (number of lines 
c     of data) may need to be changed for the specific input file used.
c
c     VARIABLES:
c     ----------
c     w(i,k)=wavelength
c     A(i,k)=einstein coefficient
c     Jlo(n), Jloo(n)=lower J value from 'wave' and 'a' files respectively
c                 (they should be the same)
c     Jhigh=Jlo(n)+deltaj of transition
c     gf=gf value (calculated in this program), loggf=log10(gf)
c     des=level designation (eg P1)
c     family, family2=which family the line comes from (eg 0=0)
c                (they should be the same)
c     -----------------------------------------------------------------
c     CH A-X  m=12
c     family    n    format
c     00        58
c     11        52
c     22        46
c     33        40
c
c ----------------------------------------------------------------------
      parameter (n=46, m=12)
      real*8 w(n,m), A(n,m), Jlo(n), Jloo(n), Jhigh, gf, loggf
      integer i, k, deltaj
      character*5 des
      character*10 family, family2

      open (unit = 100, file='/priv/magus4/bessell/OH/chaxwave22.dat',
     &     status='old',access='sequential')
      open (unit = 200, file='/priv/magus4/bessell/OH/chaxa22.dat',
     &     status='old',access='sequential')
      open (unit = 300, file='editCHAX.out22',
     &     status='unknown')
 
 1002 format (f4.1,3x,11(f7.2,4x),f7.2)
 2002 format (f4.1,1x,11(e9.3,2x),e9.3)

c*****Read the wavelength data (wavelengths in Angstroms)

      read(100,1000)
 1000 format(///)
      read(100,1001) family
 1001 format(10a)
      do i=1,n
       read(100,1002) Jlo(i), (w(i,k), k=1,m)
c       write(6,*)  Jlo(i), (w(i,k), k=1,m)
      enddo 
c*****Read the einstein coefficient data (s-1)

      read(200,1000)
      read(200,1001) family2
      do i=1,n
       read(200,2002) Jloo(i), (A(i,k), k=1,m)
c       write(6,*) Jloo(i), (A(i,k), k=1,m)
      enddo
c
      write(6,*) 'a bunch of zeros should appear - if not,
     & somethings wrong            !'
      write(6,*) (Jloo(i)-Jlo(i), i=1,n)
      write(6,*) 'family check:', family, family2

c*****Write the required output

      do i=1,n
         do k=1,m
            if ((k.eq.1).or.(k.eq.2).or.(k.eq.7).or.(k.eq.11)) then
               deltaj=-1
            else
               if ((k.eq.5).or.(k.eq.6).or.(k.eq.8).or.(k.eq.12)) then
                  deltaj=1
               else
                  if((k.eq.3).or.(k.eq.4).or.(k.eq.9).or.(k.eq.10))then     
                     deltaj=0
                  else
                     deltaj=9999
                  endif
               endif
            endif
c            write(6,*) w(i,k), deltaj
c
c           gup = 2Jup+1
c
            gf=1.4992e-16*w(i,k)*w(i,k)*(2*(Jlo(i)+deltaj)+1)*A(i,k)
c
            if (gf.ne.0) then
               loggf=log10(gf)
            else
               loggf=9.999
            endif
c            write(6,*) loggf, gf
            
            if(k.eq.1) des="PP11"
            if(k.eq.2) des="PP22"
            if(k.eq.3) des="QQ11"
            if(k.eq.4) des="QQ22"
            if(k.eq.5) des="RR22"
            if(k.eq.6) des="RR22"
            if(k.eq.7) des="OP12"
            if(k.eq.8) des="QR12"
            if(k.eq.9) des="PQ12"
            if(k.eq.10) des="RQ21"
            if(k.eq.11) des="QP21"
            if(k.eq.12) des="SR21"

c            write(6,*) w(i,k), deltaj, des

            Jhigh=Jlo(i)+deltaj
            write(300,3000) w(i,k),loggf, Jlo(i), Jhigh, "   106.00",
     &         family, des
 3000 format(2x,f9.4,f7.3,f5.1,12x,f5.1,12x,a9,a7,2x,a5)
         enddo
      enddo 
 
      
      end