Content-Type: application/octet-stream

c
c
c ************************************************************* c
c
c     Program lifetm.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 efbpss.ion 
c
c * lftmin = input parameter file (fort.11). It contains:
c
c dtfl=name of the datafile containing the A-values
c
c
      character dtfl*20
c
c * read name and type of f-file:
c
      read(11,'(a20)')dtfl
      open(file=dtfl,unit=8,status='old')
c
c * calculate lifetimes from superstructure output 
c
      call lftmrss(8)
c
      stop
      end
c 
c **************************************************** c
c
      subroutine lftmrss(iu)
c
c ***************************************************** c
c
c * if lifetimes are to be obtained from f-values of superstructure, 
c file = "efbpss" 
c
c * isi,ili,ipi,aj,ici=spin multiplicity, angular momentum, parity, j-value
c  and configuration number of the interested level
c
      parameter(nl=10)
      character*1 prm*3,trsn(6)*3,trs*3,p1*1,p2*1,p0*1,l1*1,l2*1,l0*1,
     1pr(2)*1,cfg*14,ili,ipi
      dimension aa(2),ss(2),ne(nl),eni(nl)
      data pr/'e','o'/,trsn/'E1d','E1i','E3 ','E2 ','M2 ','M1 '/
  100 format(/,' nz =',i4,2x,', No. of core electrons=',i3,//,1x,
     1'Radiative decay rates of level j to various levels(j -> i):')
  101 format(i5,2x,i1,2a1,1x,i2,3x,i2,24x,a14,7x,1pe11.4)
  103 format(/,5x,'LS cf_i',4x,'gi p lvi',2x,'<-',3x,'LS cf_j',3x,
     1'gj p',' lvj',1x,'f(E1)/S(E2',3x,'Aji',6x,'Eij',/,50x,'E3,M1,M2)',
     13x,'(sec-1)',3x,'(A)',/)
  104 format(1x,'sum-Aji(',i3,' transitions)=',31x,1pe12.3)
c
c * read and write the ion
c
    9 read(iu,'(5x,a3)')prm
      if (prm.ne.' nz') goto 9
c
      backspace iu
      read(iu,'(10x,i3,9x,i2)')nz,nelc
c
      z2=(nz-nelc)*(nz-nelc)
      write(7,100)nz,nelc
c
c * read the symmetry of the interested level for lifetime
c
    1 read(11,*)isi,ili,ipi,aj,ici
      if (isi.lt.0) stop
c
      j2=2*aj
      igi=j2+1
c
      write(7,103)
c
c * pass lines to the energy table 
c
    2 read(iu,'(1x,a3)')prm
      if (prm.ne.'Fin') goto 2
c
      do 5 i=1,5
    5 read(iu,'(a1)')
c
c * find and save the level numbers, ne, of the decaying level symmetry
c There may be more than one level matching the given symmetry of the
c same configuration
c
      ie=0
    4 read(iu,'(2x,a3)')prm
c
      if (prm.ne.'   ') then
      backspace iu
      read(iu,101)lv,is0,l0,p0,ic0,j20,cfg,en0
c
      if (is0.eq.isi.and.l0.eq.ili.and.p0.eq.ipi.and.ic0.eq.ici.and.
     1j20.eq.j2) then
      ie=ie+1
      ne(ie)=lv
      eni(ie)=en0
      endif
      goto 4
      endif
c
c * initialize variables to start lifetime computation
c
      je=0
    7 je=je+1
      if (je.gt.ie) goto 1
      lv=ne(je)
c
      sma=0.
      ii=1
      it=1
      ism=0
c
c * check the transition tables of type E1, E2, M1 etc
c
    8 read(iu,'(16x,a3)')prm
      if (prm.ne.trsn(ii)) goto 8
      trs=trsn(ii)
      asm=0.
c
      do 12 i=1,3
   12 read(iu,'(a1)')
c
      print 130,ii,trs,asm
  130 format(i3,3x,a3,2x,1pe12.4)
c
c * read transitions of various types
c
   14 read(iu,'(a3)')prm
c
      if (prm.ne.'   ') then
      backspace iu
c
      if (ii.le.2) 
     1read(iu,118,end=3)
     1i1,i2,is1,l1,p1,ic1,is2,l2,p2,ic2,ig1,ig2,wl,e1,e2,fl,s,a
c
      if (ii.gt.2) 
     1read(iu,114,end=3)
     1i1,i2,is1,l1,p1,ic1,is2,l2,p2,ic2,ig1,ig2,wl,ss(1),aa(1),ss(2),
     1aa(2)
c
  118  format(i3,1x,i3,2(1x,i1,2a1,i2),2i3,f10.2,2f8.2,1pe9.2,
     11pe11.3,1pe9.2)
  114 format(i3,i4,2(1x,i1,2a1,i2),2i3,f10.2,2(1pe10.2,1pe9.2))
c
c * determine the parity of the level
c
      if (p2.eq.'e') ip2=0
      if (p2.eq.'o') ip2=1
c
c * process to add A-values if the level matched to the interested one
c
      if (igi.eq.ig2.and.ipi.eq.p2.and.lv.eq.i2) then
c
c * add contributions of two types of transitions, e.g. E2,M1 and E3,M2
c
      do 18 k=1,it
c
      if (ii.gt.2) then
      if (aa(k).gt.0.) then
      if (k.eq.1) trs=trsn(ii)
      if (k.eq.2) trs=trsn(ii+2)
      a=aa(k)
      fl=ss(k)
      else
      goto 18
      endif
      endif
c
      asm=asm+a
c
      write(7,112)trs,is1,l1,p1,ic1,ig1,p1,i1,is2,l2,p2,ic2,
     1ig2,p2,i2,fl,a,wl
      ism=ism+1
   18 continue 
c
  112 format(1x,a3,1x,i1,2a1,1x,i2,5x,i2,1x,a1,1x,i3,7x,i1,2a1,1x,i2,4x,
     1i2,1x,a1,1x,i3,1x,1pe9.2,1pe10.3,1pe11.4)
      endif
c
      goto 14
      endif
c
c * go to next type of transitions: two types of transition beyond E1 tables 
c
      sma=sma+asm
      print 130,ii,trs,asm
c
      ii=ii+1
      if (ii.gt.2) it=2
      if (ii.gt.4) goto 3
c
c * go to the start of the next type of transitions
c
      goto 8
c
c * compute and print out the lifetime
c
    3 write(7,104)ism,sma
c
      if (sma.gt.0.) then
      alftm=1./sma
      write(7,107)isi,ili,ipi,j2,ici,eni(je),lv,alftm
      else
      write(7,102)is1,ili,ipi,j2,ici,eni(je),lv
      endif
c
  107 format(/,' lifetime of level:',1x,i1,2a1,1x,i2,'/2(',i2,
     1',',1pe10.3,' Ry)[sslvl',i4,']=',1x,1pe10.3,' s',/)
  102 format(/,' lifetime of level:',1x,i1,2a1,1x,i2,'/2(',i2,
     1',',1pe10.3,' Ry)[sslvl',i4,']=',1x,'0. -No Transitions!',/)
c
c * rewind file to read and compute lifetime of the next level
c
      rewind iu
c
      goto 7
c
      end