Contents of: J/A+A/293/967/./prog.f

The following document lists the file prog.f from catalogue J/A+A/293/967.
A plain copy of the file (without headers/trailers) may be downloaded.


c ********************************************* c
c * program to read the transition probabilities, aji values, (unit 7),
c and calculate the life time in nsec. The routine can calculate lifetime for
c both LS terms and fine structure levels.
c Program will need some modifications for the few levels  that do not have
c aji values.
c * coup=coupling state: 'fs' for fine structure, 'ls' for LS multiplet
c * atm=ion designation
c * seni,isi,cli,pri,inm,idm=degeneracy(in alphabet),(2S+1),L,parity,denominator
c numerator of J value of the excited state
      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,',  coupling=',a2,/,'=')
  105 format('=',a1,i1,2a1,26x,1pe11.4,2x,1pe11.4)
  106 format('=',10x,a1,i1,2a1,'->',a1,i1,2a1,1x,2i4,1pe12.4)
 1061 format('=',10x,a10,1x,2i4,1pe12.4)
c * read name of data file, open it and read 
      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 * read and write coupling scheme, ion 
      print 107
  107 format(' print coupling scheme (fs for fine structure, ls for',
     1' LS multiplet) and atom',/,' name in a2,1x,a7, e.g.',/,
     2'fs Fe II')
      read(5,'(a2,1x,a7)')coup,atm
      if (atm.eq.'       ')atm='Fe II'
  109 format(/,' type degeneracy,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')
  110 format(/,' type degeneracy,2S+1,L,parity in  a1,i1,2a1')
c * loop to read states for which lifetimes are to be calculated
    7 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 * spin multiplicity of the final state=0 indicates end of state list
      if (isi.eq.0) stop
c * get statistical weight factor
      if (coup.eq.'fs') gji=(2.*inm)/idn+1.
      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
      tota=0.
C	PRINT RESULTS
      write(6,104)atm,coup
      write(6,102)
c * skip lines before the aji-table 
      rewind 7
    1 read(7,'(6x,a1)')arw
      if (arw.ne.'>') goto 1
      backspace 7
c * read final state for transition from aij file * c
    2 read(7,'(1x,a1)')udl
c * write out lifetime when spin multiplicity is zero * c
      if (udl.eq.'_') then
C		END OF FILE 7
          if (tota.ne.0.) alftm=1./tota
          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
          goto 7
      endif
C		JUST READ ONE RECORD
      backspace 7
      read(7,'(7x,a1,i1,2a1)')sen,is,cl,pr
c * check for the right transition, if true (ick=1) backspace to read again
      ick=0
      if (sen.eq.seni.and.is.eq.isi.and.cl.eq.cli.and.pr.eq.pri) then
          backspace 7
          if (coup.eq.'fs') then
             read(7,'(1x,a10)')a1
             ick=1
          endif
          if (coup.eq.'ls') then
              read(7,'(1x,a1,i1,2a1,2x,a1,i1,2a1,28x,i3,1x,i3,23x,
     1        1pe11.4)')sen1,is1,al1,pr1,sen,is,cl,pr,igi,igf,aij
              write(6,106)sen1,is1,al1,pr1,sen,is,cl,pr,igi,igf,aij
              tota=tota+aij
          endif
      endif
c * read the fine structure transitions and corresponding aji values 
      read(7,'(a1)') 
    3 read(7,'(40x,a3)')a2
      if (a2.ne.'   '.and.ick.eq.0) goto 3 
      if (a2.ne.'   '.and.ick.eq.1) then 
c * backspace to read the data again * c
          backspace 7
          read(7,'(38x,2i4,23x,1pe10.3)')igi,igf,aij
          gf=1.*igf
          if (gf.eq.gji) then
              tota=tota+aij
              write(6,1061)a1,igi,igf,aij
          endif
          goto 3
      endif
c * read next transition
      goto 2
 9999 stop
      end