subroutine homo(xh,yh,yyh,nshell) 
*
* homology transformation of wdec model 
*
* first group of relations are those that came with the
* code.  The others are empirically derived from
* pre-wd sequences of .601 and .7795 mo 
*
      implicit double precision(a-h,o-z)

      common/shells/ sa(400),ra(400),ba(400),pa(400),ta(400),
     1 ea(400),xca(400),fca(400),s(400),r(400),b(400),
     2 p(400),t(400),e(400),xc(400),sk(400),
     3 rk(400),bk(400),pk(400),tk(400)
      common/contrl/ds,g,sm,wc,it,nite,ja,jb,j,k,l
      common/thermo/u2,up2,ut2,e2,ep2,et2,psi2,pg,o2,op2,ot2,fp,ft,
     1 en2(5),fn,fcc,ce,ci,cif,w,nu
      common/temp/s1,r1,s2,r2,b2,p2,t2,ea2,xc2,xo2,fca2,f2,q2,w2,c

      stt=2.*xh+5.*yh-yyh
      str=-xh-4.*yh+yyh
      stp=6.*xh+16.*yh-4.*yyh 
      stb=10.**(3.*xh+4.*yh)

      open(18,file='homo.dat',status='unknown') 

      do 1 j=1,nshell
         t(j)=t(j)+stt
         r(j)=r(j)+str
         p(j)=p(j)+stp
         b(j)=b(j)*stb
         xc2 = xc(j)
         xo2 = 1-xc2
         if ( xc2 .gt. .000001 .and. xc2 .lt. .999999) then 
            call istatco(p(j),t(j),0,.true.)
         elseif ( xc2 .ge. .999999) then
            call istat1(p(j),t(j),0,12,.true.)
         elseif ( xc2 .le. .000001) then
            call istat1(p(j),t(j),0,16,.true.)
         endif
         e(j)=e2
         write(18,11)s(j),r(j),b(j),p(j),t(j),e(j),xc2
1     continue
11    format(e15.8,f9.6,1pe11.4,0pf10.6,f9.6,e14.7,f8.6)
      close(18)
      stop
      end 

************************************************************************