c
c ********************************************* c
c
c * program to read the transition probabilities, aji values, from file
c fjj-file (unit 7), and calculate the life time in nsec. 
c 
c * The routine can calculate lifetime for c both LS terms and fine structure 
c  levels.
c
c * input given:
c * atm=ion designation
c * coup=coupling state: 'fs' for fine structure, 'ls' for LS multiplet
c * seni,isi,cli,pri,inm,idm=seniority(alphabetic),(2S+1),L,parity,denominator
c numerator of J value of the excited state
c
      character*1 seni,cli,pri,sen,cl,pr,al1,al(10),arw,udl,s0
      character*10 dtfl,a1,a2*3,atm*7,coup*2
      data al/'S','P','D','F','G','H','I','J','K','L'/
  102 format('=state',5x,'transition',3x,'gi',2x,'gf',2x,'Aij(sec-1)',
     13x,'lifetime',/,'=')
  103 format('=',a1,i1,2a1,i2,'/',i1,22x,1pe11.4,2x,1pe11.4,/,'=')
  104 format('=ion =',a7)
  105 format('=',a1,i1,2a1,26x,1pe11.4,2x,1pe11.4)
  106 format('=',10x,a1,i1,2a1,'->',a1,i1,2a1,1x,2i4,1pe12.4)
  109 format(/,' type seniority,2S+1,L,parity,mj (in fractional form)',
     1    ' of the state in',/,'  a1,i1,2a1,1x,i2,1x,i1, e.g.',/,
     2'z6Po  7/2 (specify 2S+1=0 to end)')
  110 format(/,' type seniority,2S+1,L,parity in  a1,i1,2a1',/,
     1'e.g. z6Po (specify 2S+1=0 to end)')
 1061 format('=',10x,a10,1x,2i4,1pe12.4)
c
c * read name of data file and open it 
c
      print 100
  100 format(' print name of aij-file in a10 [default is aij.dat]')
      read(5,'(a10)')dtfl
      if (dtfl.eq.'          ') dtfl='aij.dat'
      open (unit=7,file=dtfl,status='old')
c
c * read and write the ion 
c 
      print 111
  111 format(' print the ion name in a7, e.g. Fe II')
c
      read(5,'(a7)')atm
      write(6,104)atm
c
c * read and write the coupling scheme, the ion 
c 
    7 print 107
  107 format(' print coupling scheme (fs for fine structure, ls for',
     1' LS multiplet)')
      read(5,'(a2,1x,a7)')coup
c
c * loop to read states for which lifetimes are to be calculated
c 
      if (coup.eq.'fs') then
          print 109
          read(5,'(a1,i1,2a1,1x,i2,a1,i1)',end=9999)
     1         seni,isi,cli,pri,inm,s0,idn
      endif 
      if (coup.eq.'ls') then 
          print 110
          read(5,'(a1,i1,2a1)',end=9999)seni,isi,cli,pri
      endif
c
c * spin multiplicity of the final state=0 indicates end of state list
c
      if (isi.eq.0) stop
c
      write(6,102)
c
c * get statistical weight factor
c
      if (coup.eq.'fs') gji=(2.*inm)/idn+1.
c
      if (coup.eq.'ls') then
          do 8 i=1,10
          if (cli.eq.al(i)) idx=i
    8     continue
          gji=isi*(2.*idx+1.)
      endif
c
      tota=0.
c
c * skip lines before the aji-table
c 
      rewind 7
    1 read(7,'(6x,a1)')arw
      if (arw.ne.'>') goto 1
      backspace 7
c
c * read final state for transition from aij file * c
c
    2 read(7,'(6x,a1)')udl
c
c * END OF FILE 7 condition : write out lifetime when spin multiplicity is zero
c
      if (udl.eq.'_') then
          if (tota.ne.0.) alftm=1./tota
c
C * PRINT RESULTS * c
c
          if (coup.eq.'fs')
     1    write(6,103)seni,isi,cli,pri,inm,idn,tota,alftm
          if (coup.eq.'ls') write(6,105)seni,isi,cli,pri,tota,alftm
c
c * start the next level
c
          goto 7
      endif
c
      ick=0
c
C * read the transition 
c
      if (udl.eq.'>') then
      backspace 7
      read(7,'(1x,a1,i1,2a1,2x,a1,i1,2a1,29x,i3,1x,i3,23x,
     11pe11.4)')sen1,is1,al1,pr1,sen,is,cl,pr,igi,igf,aij
c
c * check for the right transition, if true (ick=1) backspace to read again
c
      if (sen.eq.seni.and.is.eq.isi.and.cl.eq.cli.and.pr.eq.pri) then
c
c * save the right transition
c
          if (coup.eq.'fs') ick=1 
c
c * add LS A-value of the right transition
c
          if (coup.eq.'ls') then
              write(6,106)sen1,is1,al1,pr1,sen,is,cl,pr,igi,igf,aij
              tota=tota+aij
          endif
c
      endif
      endif
c
      if (udl.eq.'u') read(7,'(a1)') 
c
c * read the fine structure transitions and corresponding aji values
c
      read(7,'(a1)')
c
c   3 read(7,'(40x,a3)')a2
    3 read(7,'(6x,a1,33x,a3)')s0,a2
          if (s0.eq.'u') goto 3
      if (a2.ne.'   '.and.ick.eq.0) goto 3
c
      if (a2.ne.'   '.and.ick.eq.1) then
c
c * backspace to read the data again * c
c
          backspace 7
c         read(7,'(38x,2i4,23x,1pe10.3)')igi,igf,aij
          read(7,'(39x,2i4,23x,1pe10.3)')igi,igf,aij
          gf=1.*igf
          if (gf.eq.gji) then
              tota=tota+aij
c             write(6,1061)a1,igi,igf,aij
              write(6,106)sen1,is1,al1,pr1,sen,is,cl,pr,igi,igf,aij
          endif
c
          goto 3
      endif
c
c * read next transition
c
      goto 2
c
 9999 stop
      end