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 ************************************************************************