c
c *****************************************************************
c
c Ref: "Atomic data from the Iron Project LXII. Allowed and forbidden
c   transitions in Fe~XVIII in relativistic Breit-Pauli approximation"
c
c   Sultana N. Nahar, A&A (in press, 2006)
c
c   Manuscript A&A/2003/0356
c
c *****************************************************************
c
c
c ************************************************************* c
c
c     Program lifetime.f
c
c    - Sultana N. Nahar 
c
c ************************************************************* c
c
c *  Program to calculate lifetimes from A-values
c
c * It reads the A-values from file "f.allowed.fe18.user" 
c
c * input files = lftmin, f.allowed.fe18.user
c
c * output file = fort.7
c
c * lftmin = input parameter file (fort.11). It contains, for example:
c
c bpx f.allowed.fe18.user      NOTE: output: fort.7
c 2 0 1
c 4 0 1
c 6 1 1
c -1 0 0 0. 0
c
c * where
c typ='bpx' to read oscillator strengths and radiative decay rates from
c     BPRM calculations 
c dtfl=name of the datafile containing the A-values, 'f.allowed.fe18.user"
c igi,ip,ilv = 2 0 1
c igi=statistical weight factor of the interested decaying level (e.g. 2)
c ip=parity of the decaying level (0 = even, 1 = odd)
c ilv=level number in symmetry. In the example above, 1 means the first
c level of symmety 2J+1=2 even
c igi=a negative number for end of interested levels
c
c 
      character dtfl*20,typ*3
c
  100 format(/,'Method: ',a3,', Radiative decay rates file: ',a20,/)
c
c * read name and type of f-file:
c
      read(11,'(a3,1x,a20)')typ,dtfl
      open(file=dtfl,unit=8,status='old')
c
      write(7,100)typ,dtfl
c
c * read BPRM A-values for the lifetime
c
      if (typ.eq.'bpx') call lftmrmx(8)
c
      stop
      end
c
c ***************************************************************** c
c
       subroutine lftmrmx(iu)
c
c ***************************************************************** c
c
c * calculate lifetime from BPRM A-values where energies have been
c replaced by the available measured values
c
      character pr(2)*1,prm*3,p0*1,prt*1,cfg0*27,cf*3,p1*1,p2*2
      dimension aa(2)
      data pr/'e','o'/
  100 format(/,' nz =',i4,2x,', No. of core electrons=',i3)
  101 format(/,2x,'k',2x,'Conf_j',28x,'gj p  lv',5x,'wl',7x,'Aij',7x,
     1'Ej',/,52x,'(A)',5x,'(sec-1)',4x,'(Ry)',/)
  102 format(/,i5,' = number of levels',/)
  103 format(/,' lifetime of level',1x,f4.1,1x,a1,1x,i3,1x,'(E =',
     11pe11.4,'Ry) :',8x,1pe10.3,' sec',/)
  104 format(1x,'sum(Aji)=',46x,1pe12.3)
  105 format(i3,'. Level i: ',a27,f4.1,1x,i2,' (E=',1pe11.4,'Ry) ',
     1'decays to:')
  107 format(i5,1x,f4.1,1x,a1,1x,i3,5x,1pe12.5,2x,a27)
c
c * read and write the ion
c
    4 read(8,'(a3)')prm
      if (prm.ne.' nz') goto 4
c
      backspace 8
      read(8,'(7x,i2,27x,i2)')nz,nelc
c
      z2=(nz-nelc)*(nz-nelc)
      write(7,100)nz,nelc
c
c * read number of energy levels
c
      read(8,'(a1)')
      read(8,'(i7)')nen
      write(7,102)nen
c
c * read level id (statistical wt factor, parity, level no) for lifetime value 
c
      i1=0
c
    1 read(11,*)igi,ip,ilv
c
      if (igi.lt.0) stop
c
      i1=i1+1
      j2=igi-1
      aj=j2/2.
      p0=pr(ip+1)
c
c * identify the level in the A-file
c
    5 read(8,'(2x,a3)')prm
      if (prm.ne.'  i') goto 5
      read(8,'(a1)')
c
      do 9 i=1,nen
c
      read(8,107)ii,ajj,prt,lv,en0,cfg0
c
      if (ajj.eq.aj.and.prt.eq.p0.and.lv.eq.ilv) then
      write(7,105)i1,cfg0,aj,ilv,en0
      goto 10
      endif
c
    9 continue
c
c *  go to the transitions
c
   10 sm=0.
c
      write(7,101)
c
   11 read(8,'(14x,a3)')prm
      if (prm.ne.'wl(') goto 11
c
      read(8,'(a1)')
c
      i2=0
c
c * read transitions
c
    8 ick=0
c
      read(8,*)ig1,ip1,ig2,ip2,n1,n2,ntr
c
      if (ig1.eq.ig2.and.ip1.eq.ip2.and.ntr.eq.0) goto 3
c
c * check for transitions from the interested level
c
      if (igi.eq.ig1.and.ip.eq.ip1) ick=1
      if (igi.eq.ig2.and.ip.eq.ip2) ick=2
c
      if (ick.eq.1.or.ick.eq.2) then
c
c * read A-values if it is checked
c
      do 7 ia=1,ntr
c
      read(8,*)lv1,lv2,wl,e1,e2,fl,s,a
c
      if (ick.eq.1.and.lv1.eq.ilv.and.fl.gt.0.) then
      sm=sm+a
      i2=i2+1
      write(7,108)i2,ig2,pr(ip2+1),lv2,wl,a,e2
      endif
c
      if (ick.eq.2.and.lv2.eq.ilv.and.fl.lt.0.) then
      sm=sm+a
      i2=i2+1
      write(7,108)i2,ig1,pr(ip1+1),lv1,wl,a,e1
      endif
c
  108 format(i3,35x,i3,1x,a1,i4,0pf10.2,1x,1pe10.3,1pe11.3)
c
    7 continue
c
c * else skip the lines
c
      else
      do 2 i=1,ntr
    2 read(8,'(a1)')
      endif
c
      goto 8
c
c * get and print out the lifetime
c
    3 write(7,104)sm
      alftm=1./sm
c
      write(7,103)aj,pr(ip+1),ilv,en0,alftm
c
c * rewind file for the next level
c
      rewind 8
c
c * start a new decaying level
c
      goto 1
c
      end