4        integer  nu, nv, ngr ,icr,icl,i,dd 
28        read(3,102) nu,nv,icr,icl,ngr,tau,solperm,t,tol,lambd,dd 
29        print*, nu,nv,icr,icl,ngr,tau,solperm,t,tol,lambd,dd 
39        call risminput(nv,nu,ngr,dr,r1,tau,
45        subroutine risminput(nv,nu,ngr,dr,r1,tau,
49        real*8 wu(1:nu,1:nu,1:ngr),sgvv(1:nv)
52        integer  nv, ngr, isv(1:nv), mv(1:nv)
57        real*8 r1,dr, dk, rgrid(1:ngr),kgrid(1:ngr),pi 
61        real*8 c3(1:nu,1:nv,1:ngr),hu(1:nu,1:nv,1:ngr) 
62        real*8 gam(1:nu,1:nv,1:ngr)
104        dk=pi/(ngr+1)/dr
105        do i=1,ngr
111        call wucreat(nu,ngr,kgrid,tu,isu,xu,yu,zu,wu) 
116        call rism(nu,nv,nvv,ngr,icl,kgrid,rgrid,tv,isv,den,mv,xv,yv,zv,
201        subroutine wucreat(nu,ngr,kgrid,tu,isu,xu,yu,zu,wu)  argument
203        integer  nu, ngr, isu(1:nu), mu(1:nu)  local
204        real*8 wu(1:nu,1:nu,1:ngr), dist(1:nu,1:nu)
207        real*8 kgrid(1:ngr),sik  
210        do i=1,ngr
234        subroutine chicreat(nd,nv,ngr,ims,nvv,kgrid,tv,  argument
237        real*8 wv(1:nvv,1:nvv,1:ngr), chi(1:nvv,1:nvv,1:ngr),hd(1:ngr)
238        integer  nv, ngr, isv(1:nv), mv(1:nv)
241        real*8 r1, r2, dr, dk, rgrid(1:ngr),kgrid(1:ngr),pi
242        real*8 hsol(1:nd,1:ngr), rr(1:ngr)
243        real*8 h1(1:nvv,1:nvv,1:ngr),h2(1:ngr),h3(1:nvv,1:nvv,1:ngr)
250         do i=1,ngr
263          do i=2,ngr 
267          call sinft(h2,ngr)
269          do i=1,ngr-1
272          h3(j,j1,ngr)=h3(j,j1,ngr-1)
278          do i=1,ngr 
289        call wcreat(nv,ngr,nvv,ims,kgrid,tv,isv,xv,yv,zv,wv) 
297        do i=1,ngr
313        subroutine wcreat(nv,ngr,nvv,ims,kgrid,tv,isv,xv,yv,zv,wv)   argument
315        real*8 wv(1:nvv,1:nvv,1:ngr),dist(1:nv,1:nv)
316        real*8 ws(1:nv,1:nvv,1:ngr)
317        integer  nv, ngr, isv(1:nv),mv(1:nv)  local
320        real*8 kgrid(1:ngr),pi,sik,co(1:nv,1:nv,1:ngr) 
326        do i=1, ngr         
337        do i=1,ngr
352        do i=1,ngr        
367        subroutine potcreat(nvv,nu,ngr,icr,kgrid,rgrid,tau,solperm,  argument
370        integer  nu,nv, ngr,nvv 
374        real*8 r1, r2, dr, dk, rgrid(1:ngr),kgrid(1:ngr),pi 
376        real*8 ul(1:nu,1:nvv,1:ngr),plj(1:nu,1:nvv,1:ngr)
390        do i=1,ngr 
436        subroutine ssoz(nvv,nu,ngr,nv,ims,mv,wu,c3,chi,hu)  argument
438        integer  nu, nvv, nv, ngr, i,j1,j,k1,ims(1:nv),mv(1:nv)          local
439        real*8 rgrid(1:ngr),kgrid(1:ngr)  
441        real*8 c3(1:nu,1:nvv,1:ngr),hu(1:nu,1:nvv,1:ngr)
442        real*8 ctt(1:nu,1:nvv,1:ngr),h1(1:nu,1:nvv,1:ngr)
443        real*8 wu(1:nu,1:nu,1:ngr), chi(1:nvv,1:nvv,1:ngr)  
445        do i=1,ngr
460        do i=1,ngr
472        do i=1,ngr
487        subroutine clos(nvv,nu,ngr,t,plj,cr,gam,icl)  argument
489        integer  nu, nvv, ngr, i,j1,j,icl  local
490        real*8 plj(1:nu,1:nvv,1:ngr)          
492        real*8 cr(1:nu,1:nvv,1:ngr),gam(1:nu,1:nvv,1:ngr)           
494        do i=1,ngr
523        subroutine rism(nu,nv,nvv,ngr,icl,kgrid,rgrid,tv,isv,  argument
529        integer  nu, nv,nd,nvv, ngr, i,j1,j,k1,icl,k        
530        real*8 rgrid(1:ngr),kgrid(1:ngr)  
533        real*8 wu(1:nu,1:nu,1:ngr), chi(1:nvv,1:nvv,1:ngr)   
538        real*8 wv(1:nvv,1:nvv,1:ngr)
542        real*8 plj(1:nu,1:nvv,1:ngr), ul(1:nu,1:nvv,1:ngr)
544        real*8 cr(1:nu,1:nvv,1:ngr),c2(1:ngr),tt(1:nu,1:nvv)  
545        real*8 ht(1:ngr),c3(1:nu,1:nvv,1:ngr),cf3(1:nu,1:nvv,1:ngr)
546        real*8 cold(1:nu,1:nvv,1:ngr),cnew(1:nu,1:nvv,1:ngr)
547        real*8 gfold(1:nu,1:nvv,1:ngr),hu(1:nu,1:nvv,1:ngr) 
548        real*8 gold(1:nu,1:nvv,1:ngr), gnew(1:nu,1:nvv,1:ngr)   
549        real*8 hold(1:nu,1:nvv,1:ngr), hnew(1:nu,1:nvv,1:ngr)             
552        real*8 ggo(1:dd,1:nu,1:nvv,1:ngr),dgg(1:dd,1:nu,1:nvv,1:ngr)
560        call chicreat(nd,nv,ngr,ims,nvv,kgrid,tv,isv,den,mv,xv,yv,zv,chi) 
568        call potcreat(nvv,nu,ngr,icr,kgrid,rgrid,tau,solperm,
575        do i=1,ngr
588        call clos(nvv,nu,ngr,t,plj,cnew,gold,icl)
591          do i=1,ngr
604          do i=1,ngr-1 
607          call sinft(c2,ngr)
609          do i=1,ngr-1
612          cf3(j,j1,ngr)=cf3(j,j1,ngr-1) 
622        do i=1,ngr
632        call ssoz(nvv,nu,ngr,nv,ims,mv,wu,cf3,chi,hu)
640          do i=1,ngr-1 
643          call sinft(ht,ngr)
644          do i=1,ngr-1
648          gnew(j,j1,ngr)=gnew(j,j1,ngr-1)
649          hnew(j,j1,ngr)=hnew(j,j1,ngr-1) 
666          do i=1,ngr
677        del0=(mmaxi/ngr/nu/nvv)**(1.0/2)
679        call  diis(nu,nvv,ngr,lambd,kd,dd,gold,gnew,ggo,dgg)
683          do i=1,ngr
696         do k=1,ngr        
705        subroutine diis(nu,nvv,ngr,lam,k1,dd,hold,hnew,ggo,dgg)  argument
707        real*8 ggo(1:dd,1:nu,1:nvv,1:ngr),dgg(1:dd,1:nu,1:nvv,1:ngr)
708        real*8 ss(1:dd+1,1:dd+1),hold(1:nu,1:nvv,1:ngr)
709        real*8 s0(1:dd+1),s1,lam,hnew(1:nu,1:nvv,1:ngr)
711        integer j,j1,i,nu,nvv,ngr  local
727          do i=1,ngr     
734              ss(jd,jd1)=(dgg(jd,j,j1,i)*dgg(jd1,j,j1,i))/ngr+ss(jd,jd1)
749         do i=1,ngr