C************************************************************           
      SUBROUTINE FEVII_NEW(TE,EDENS,FECOOL)
C************************************************************           
C
C  Calculates the forbidden line emission of Fe VII. Atomic data
C  from Nussbaumer&Storey (A&A, 1982, 113 p.21), and Keenan&
C  Norrington (A&A, 1987, 181 p.370).
C  Fe VII is treated as a 9-level atom.
C  Updated with Berrington et al. (2000) and corrected by
C  P. Young in 2005 for typos in the Berrington et al. paper.
C************************************************************           
      IMPLICIT REAL*8(A-H,O-Z)                                          
C                                                                       
      parameter (mmatr=80)
C
      COMMON/MSTUFF/X(mmatr),A(mmatr,mmatr),EPS,NERR
      COMMON/FBFE7/FEADD(17)
C                                                                       
      DIMENSION OME(9,9),ENE(9),G(9),CIJ(9,9),AIJ(9,9),FBFVII(9,9),
     &om12(8),om13(8),om14(8),om15(8),om16(8),om17(8),om18(8),
     &om19(8),om23(8),om24(8),om25(8),om26(8),om27(8),om28(8),
     &om29(8),om34(8),om35(8),om36(8),om37(8),om38(8),om39(8),
     &om45(8),om46(8),om47(8),om48(8),om49(8),om56(8),om57(8),
     &om58(8),om59(8),om67(8),om68(8),om69(8),om78(8),om79(8),
     &om89(8),tberr(8)
C
      DATA G/5.D0,7.D0,9.D0,5.D0,1.D0,3.D0,5.D0,9.D0,1.D0/
      DATA ENE/0.0D0,0.1304D0,0.2927D0,2.168D0,2.486D0,2.534D0,
     &2.64D0,3.588D0,8.318D0/
      data om12/3.71d0,3.35d0,2.98d0,2.69d0,2.48d0,2.20d0,
     &1.79d0,1.35d0/
      data om13/1.30d0,1.17d0,1.02d0,.962d0,.862d0,.776d0,
     &.634d0,.469d0/
      data om14/1.01d0,.959d0,.918d0,.873d0,.813d0,.721d0,
     &.593d0,.455d0/
      data om15/.295d0,.299d0,.299d0,.302d0,.305d0,.292d0,
     &.259d0,.217d0/
      data om16/.619d0,.633d0,.628d0,.623d0,.619d0,.585d0,
     &.504d0,.403d0/
      data om17/.516d0,.549d0,.548d0,.534d0,.518d0,.473d0,
     &.387d0,.288d0/
      data om18/1.14d0,1.24d0,1.26d0,1.20d0,1.11d0,.971d0,
     &.786d0,.595d0/
      data om19/.134d0,.115d0,.097d0,.087d0,.080d0,.071d0,
     &.057d0,.043d0/
      data om23/4.55d0,4.11d0,3.64d0,3.30d0,3.04d0,2.71d0,
     &2.21d0,1.66d0/
      data om24/1.38d0,1.29d0,1.23d0,1.16d0,1.08d0,.952d0,
     &.78d0,.596d0/
      data om25/.228d0,.235d0,.231d0,.226d0,.222d0,.207d0,
     &.174d0,.133d0/
      data om26/.807d0,.833d0,.837d0,.837d0,.837d0,.794d0,
     &.693d0,.564d0/
      data om27/1.02d0,1.06d0,1.06d0,1.05d0,1.03d0,.964d0,
     &.818d0,.637d0/
      data om28/1.59d0,1.74d0,1.76d0,1.68d0,1.56d0,1.36d0,
     &1.11d0,.837d0/
      data om29/.190d0,.162d0,.138d0,.123d0,.113d0,.1d0,
     &.081d0,.061d0/
      data om34/1.72d0,1.60d0,1.51d0,1.42d0,1.32d0,1.16d0,
     &.943d0,.716d0/
      data om35/.171d0,.187d0,.191d0,.186d0,.181d0,.167d0,
     &.139d0,.104d0/
      data om36/.649d0,.690d0,.692d0,.677d0,.663d0,.616d0,
     &.516d0,.390d0/
      data om37/1.89d0,1.94d0,1.95d0,1.94d0,1.93d0,1.84d0,
     &1.60d0,1.30d0/
      data om38/2.06d0,2.25d0,2.28d0,2.18d0,2.02d0,1.77d0,
     &1.43d0,1.09d0/
      data om39/.249d0,.213d0,.181d0,.162d0,.149d0,.132d0,
     &.107d0,.080d0/
      data om45/.159d0,.172d0,.179d0,.178d0,.170d0,.154d0,
     &.128d0,.099d0/
      data om46/.490d0,.531d0,.553d0,.544d0,.515d0,.462d0,
     &.382d0,.292d0/
      data om47/1.022d0,1.06d0,1.07d0,1.03d0,.952d0,.833d0,
     &.668d0,.495d0/
      data om48/2.01d0,2.02d0,1.91d0,1.76d0,1.62d0,1.43d0,
     &1.16d0,.889d0/
      data om49/.509d0,.473d0,.468d0,.483d0,.492d0,.480d0,
     &.439d0,.384d0/
      data om56/.350d0,.370d0,.380d0,.380d0,.389d0,.402d0,
     &.375d0,.306d0/
      data om57/.315d0,.324d0,.324d0,.329d0,.347d0,.363d0,
     &.342d0,.287d0/
      data om58/.155d0,.164d0,.178d0,.186d0,.183d0,.166d0,
     &.138d0,.106d0/
      data om59/.030d0,.035d0,.040d0,.041d0,.039d0,.034d0,
     &.028d0,.021d0/
      data om67/1.13d0,1.17d0,1.18d0,1.20d0,1.25d0,1.31d0,
     &1.23d0,1.03d0/
      data om68/.466d0,.495d0,.536d0,.558d0,.549d0,.500d0,
     &.416d0,.320d0/
      data om69/.088d0,.105d0,.120d0,.123d0,.116d0,.103d0,
     &.084d0,.064d0/
      data om78/.857d0,.903d0,.961d0,.988d0,.965d0,.875d0,
     &.726d0,.558d0/
      data om79/.173d0,.197d0,.220d0,.225d0,.215d0,.192d0,
     &.159d0,.122d0/
      data om89/.255d0,.310d0,.346d0,.345d0,.320d0,.273d0,
     &.209d0,.146d0/
      data tberr/4.3d0,4.5d0,4.75d0,5.0d0,5.25d0,5.5d0,5.75d0,
     &6.0d0/
C
      T4=TE/1.D4
      TEV=TE/1.1605D4
      TLG=DLOG10(TE)
      CONS=(8.63D-6*EDENS)/DSQRT(TE)
       do 101 ii=1,9
        do 102 jj=1,9
        ome(ii,jj)=0.0d0
        a(ii,jj)=0.0d0
        aij(ii,jj)=0.0d0
        cij(ii,jj)=0.0d0
  102   continue
       x(ii)=0.0d0
  101  continue
      do 7870 iis=1,7
         tefix=tberr(iis)
         if(tlg.ge.tberr(iis).and.tlg.lt.tberr(iis+1)) then
            iit=iis
            goto 7871
         endif
 7870 continue
 7871 continue
      if(tlg.lt.4.3d0) iit=1
      if(tlg.lt.4.3d0) tefix=4.3d0
      if(tlg.ge.6.d0) iit=7
      if(tlg.ge.6.d0) tefix=5.75d0
      qq=(tlg-tefix)/(tberr(iit+1)-tberr(iit))
       ome(1,2)=1.d1**((dlog10(om12(iit)))*(1.d0-qq)+
     &              (dlog10(om12(iit+1)))*qq)
       ome(1,3)=1.d1**((dlog10(om13(iit)))*(1.d0-qq)+
     &              (dlog10(om13(iit+1)))*qq)
       ome(1,4)=1.d1**((dlog10(om14(iit)))*(1.d0-qq)+
     &              (dlog10(om14(iit+1)))*qq)
       ome(1,5)=1.d1**((dlog10(om15(iit)))*(1.d0-qq)+
     &              (dlog10(om15(iit+1)))*qq)
       ome(1,6)=1.d1**((dlog10(om16(iit)))*(1.d0-qq)+
     &              (dlog10(om16(iit+1)))*qq)
       ome(1,7)=1.d1**((dlog10(om17(iit)))*(1.d0-qq)+
     &              (dlog10(om17(iit+1)))*qq)
       ome(1,8)=1.d1**((dlog10(om18(iit)))*(1.d0-qq)+
     &              (dlog10(om18(iit+1)))*qq)
       ome(1,9)=1.d1**((dlog10(om19(iit)))*(1.d0-qq)+
     &              (dlog10(om19(iit+1)))*qq)
       ome(2,3)=1.d1**((dlog10(om23(iit)))*(1.d0-qq)+
     &              (dlog10(om23(iit+1)))*qq)
       ome(2,4)=1.d1**((dlog10(om24(iit)))*(1.d0-qq)+
     &              (dlog10(om24(iit+1)))*qq)
       ome(2,5)=1.d1**((dlog10(om25(iit)))*(1.d0-qq)+
     &              (dlog10(om25(iit+1)))*qq)
       ome(2,6)=1.d1**((dlog10(om26(iit)))*(1.d0-qq)+
     &              (dlog10(om26(iit+1)))*qq)
       ome(2,7)=1.d1**((dlog10(om27(iit)))*(1.d0-qq)+
     &              (dlog10(om27(iit+1)))*qq)
       ome(2,8)=1.d1**((dlog10(om28(iit)))*(1.d0-qq)+
     &              (dlog10(om28(iit+1)))*qq)
       ome(2,9)=1.d1**((dlog10(om29(iit)))*(1.d0-qq)+
     &              (dlog10(om29(iit+1)))*qq)
       ome(3,4)=1.d1**((dlog10(om34(iit)))*(1.d0-qq)+
     &              (dlog10(om34(iit+1)))*qq)
       ome(3,5)=1.d1**((dlog10(om35(iit)))*(1.d0-qq)+
     &              (dlog10(om35(iit+1)))*qq)
       ome(3,6)=1.d1**((dlog10(om36(iit)))*(1.d0-qq)+
     &              (dlog10(om36(iit+1)))*qq)
       ome(3,7)=1.d1**((dlog10(om37(iit)))*(1.d0-qq)+
     &              (dlog10(om37(iit+1)))*qq)
       ome(3,8)=1.d1**((dlog10(om38(iit)))*(1.d0-qq)+
     &              (dlog10(om38(iit+1)))*qq)
       ome(3,9)=1.d1**((dlog10(om39(iit)))*(1.d0-qq)+
     &              (dlog10(om39(iit+1)))*qq)
       ome(4,5)=1.d1**((dlog10(om45(iit)))*(1.d0-qq)+
     &              (dlog10(om45(iit+1)))*qq)
       ome(4,6)=1.d1**((dlog10(om46(iit)))*(1.d0-qq)+
     &              (dlog10(om46(iit+1)))*qq)
       ome(4,7)=1.d1**((dlog10(om47(iit)))*(1.d0-qq)+
     &              (dlog10(om47(iit+1)))*qq)
       ome(4,8)=1.d1**((dlog10(om48(iit)))*(1.d0-qq)+
     &              (dlog10(om48(iit+1)))*qq)
       ome(4,9)=1.d1**((dlog10(om49(iit)))*(1.d0-qq)+
     &              (dlog10(om49(iit+1)))*qq)
       ome(5,6)=1.d1**((dlog10(om56(iit)))*(1.d0-qq)+
     &              (dlog10(om56(iit+1)))*qq)
       ome(5,7)=1.d1**((dlog10(om57(iit)))*(1.d0-qq)+
     &              (dlog10(om57(iit+1)))*qq)
       ome(5,8)=1.d1**((dlog10(om58(iit)))*(1.d0-qq)+
     &              (dlog10(om58(iit+1)))*qq)
       ome(5,9)=1.d1**((dlog10(om59(iit)))*(1.d0-qq)+
     &              (dlog10(om59(iit+1)))*qq)
       ome(6,7)=1.d1**((dlog10(om67(iit)))*(1.d0-qq)+
     &              (dlog10(om67(iit+1)))*qq)
       ome(6,8)=1.d1**((dlog10(om68(iit)))*(1.d0-qq)+
     &              (dlog10(om68(iit+1)))*qq)
       ome(6,9)=1.d1**((dlog10(om69(iit)))*(1.d0-qq)+
     &              (dlog10(om69(iit+1)))*qq)
       ome(7,8)=1.d1**((dlog10(om78(iit)))*(1.d0-qq)+
     &              (dlog10(om78(iit+1)))*qq)
       ome(7,9)=1.d1**((dlog10(om79(iit)))*(1.d0-qq)+
     &              (dlog10(om79(iit+1)))*qq)
       ome(8,9)=1.d1**((dlog10(om89(iit)))*(1.d0-qq)+
     &              (dlog10(om89(iit+1)))*qq)
C       write(6,1011)tlg,ome(1,2)
 1011  format(1x,20e12.4)
C       goto 9988
       aij(9,1)=1.34d-1
       aij(9,4)=2.67d1
       aij(9,6)=6.88d0
       aij(9,7)=1.11d0
       aij(8,1)=9.59d-4
       aij(8,2)=3.43d-1
       aij(8,3)=5.03d-1
       aij(8,4)=4.14d-3
       aij(8,7)=4.54d-5
C       aij(7,1)=1.74d-1
       aij(7,1)=1.50d-2
       aij(7,2)=6.97d-2
       aij(7,3)=7.35d-2
C       aij(7,4)=1.91d-1
       aij(7,4)=1.82d-1
       aij(7,5)=1.39d-8
       aij(7,6)=7.43d-3
       aij(6,1)=5.02d-2
       aij(6,2)=7.62d-2
       aij(6,4)=5.72d-2
       aij(6,5)=1.15d-3
       aij(5,1)=1.35d-1
       aij(5,4)=4.72d-7
C       aij(4,1)=3.25d0
       aij(4,1)=3.72d-1
       aij(4,2)=6.03d-1
       aij(4,3)=1.39d-3
       aij(3,1)=1.67d-9
       aij(3,2)=4.66d-2
       aij(2,1)=3.25d-2
        do 111 ii=1,8
         do 112 jj=ii+1,9
         exiijj=expfn((ene(jj)-ene(ii))/tev)
         cij(ii,jj)=(cons*ome(ii,jj)*exiijj)/g(ii)
         cij(jj,ii)=(g(ii)*cij(ii,jj))/(exiijj*g(jj))
  112    continue
  111   continue
        do 113 ii=1,9
         do 114 jj=1,9
         if(ii.eq.1) then
          a(ii,jj)=1.d0
         else
          if(ii.eq.jj) goto 114
          a(ii,ii)=a(ii,ii)-aij(ii,jj)-cij(ii,jj)
          a(ii,jj)=aij(jj,ii)+cij(jj,ii)
         endif
  114    continue
  113   continue
       x(1)=1.d0
       CALL MATRIX(9)
        do 7891 ii=1,9
        if(x(ii).lt.0.0d0) x(ii)=1.d-50
 7891   continue
       cool=0.0d0
        do 131 ii=1,8
         do 132 jj=ii+1,9
         fbfvii(jj,ii)=(1.6022d-12*aij(jj,ii)*(ene(jj)-ene(ii))*x(jj))
     &   /edens
         cool=cool+fbfvii(jj,ii)
  132    continue
  131   continue
       feadd(1)=fbfvii(9,1)
       feadd(2)=fbfvii(9,4)
       feadd(3)=fbfvii(9,6)
       feadd(4)=fbfvii(9,7)
       feadd(5)=fbfvii(8,1)
       feadd(6)=fbfvii(8,2)
       feadd(7)=fbfvii(8,3)
       feadd(8)=fbfvii(7,1)
       feadd(9)=fbfvii(6,1)
       feadd(10)=fbfvii(7,2)
       feadd(11)=fbfvii(5,1)
       feadd(12)=fbfvii(6,2)
       feadd(13)=fbfvii(7,3)
       feadd(14)=fbfvii(4,1)
       feadd(15)=fbfvii(4,2)
       feadd(16)=fbfvii(4,3)
       feadd(17)=fbfvii(8,4)
       FECOOL=cool
C
 9988 continue
      RETURN
      END
C************************************************************           
