home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / fchek284.zip / test / t208x.f < prev    next >
Text File  |  1995-03-13  |  17KB  |  604 lines
  1. c-----------------------------------------------------------------------
  2. c     ftnchek test file: t208x.f, Mon Mar 13 14:13:16 1995
  3. c     Adapted from a benchmark program at the University of Utah, with
  4. c     code bodies and most comments eliminated.  ftnchek's -makedcls
  5. c     option and the dcl2inc program have been subsequently used on
  6. c     the original copy of this program to replace all in-line COMMON
  7. c     blocks with INCLUDE statements and separate include files.
  8. c-----------------------------------------------------------------------
  9.       program prob5_4dim
  10.       parameter(l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  11.       parameter(ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  12.       parameter(nr=32, nt=16, nr2=nr+2, nt1=nt+1)
  13.       parameter(nw=2*nt+15)
  14.       parameter(mmax=200)
  15. c
  16. c common block variables
  17. c
  18.       double precision u,f,fb,elf,elfn
  19.       double precision phin,phinn,phia,phian
  20.       double precision c,cn
  21.       double precision xm
  22.       double precision h,dlt
  23.       double precision zag,zagn
  24.       double precision k0
  25.       double precision uy,vy,ux,vx
  26.       double precision wsave,dr,r
  27. c
  28. c other variables
  29. c
  30.       character*15 rname
  31.       character*18 ufile,ffile,pafile,zfile
  32.       character*18 pnfile,efile
  33.       character*18 cfile,mfile,parfile,fmfile
  34.       character*18 mmfile,maifile,symfile
  35.       character*18 e1file,e2file,e3file,e4file,e5file
  36.       character*18 e6file,e7file,e8file,e9file,e10file
  37.       character*18 e11file,e12file,e13file,e14file,e15file
  38.       character*18 e16file,e17file,e18file,e19file,e20file
  39.       character*18 e21file,e22file,e23file,e24file
  40.       integer      rlen
  41.       double precision uold(0:nbp1,0:nbp1,2)
  42.       double precision zagi(0:nbp1,0:nbp1)
  43. c
  44.       common/vel   /u(0:nbp1,0:nbp1,2)
  45.       common/vel   /uy(0:nbp1,0:nbp1),vy(0:nbp1,0:nbp1)
  46.       common/vel   /ux(0:nbp1,0:nbp1),vx(0:nbp1,0:nbp1)
  47.       common/force /f(0:nbp1,0:nbp1,2)
  48.       common/link  /elf (0:nbp1,0:nbp1,0:nr2,nt1)
  49.       common/link  /elfn(0:nbp1,0:nbp1,0:nr2,nt1)
  50.       common/phi   /phin (0:nbp1,0:nbp1)
  51.       common/phi   /phinn(0:nbp1,0:nbp1)
  52.       common/phi   /phia (0:nbp1,0:nbp1)
  53.       common/phi   /phian(0:nbp1,0:nbp1)
  54.       common/adp   /c  (0:nbp1,0:nbp1)
  55.       common/adp   /cn (0:nbp1,0:nbp1)
  56.       common/agg   /zag   (0:nbp1,0:nbp1)
  57.       common/agg   /zagn  (0:nbp1,0:nbp1)
  58.       common/forceb/fb(0:nbp1,0:nbp1,2)
  59.       common/stiff /k0
  60.       common/steps /h,dlt
  61.       common/rsize  /dr(nr2),r(0:nr2),nk
  62.       common/wave   /wsave(nw)
  63.       common/mth    /method,mthlim
  64.       common/efnum  /nfil
  65. c
  66.       common/fmarkers/xm(mmax,2)
  67. c
  68.       double precision cmax,cmin,phiamax,phiamin
  69.       double precision phinmax,phinmin,zagmax,zagmin
  70. c
  71.       double precision umax,usmax,fbmax,flmax,q
  72.       double precision tcoef,time,tfreq,tpi,f0
  73. c
  74. c.... code body eliminated ....
  75. c
  76.       end
  77. c
  78. c-------------------------------------------------
  79. c
  80.       subroutine uinit
  81. c
  82. c
  83.       parameter(l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  84.       parameter(ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  85.       parameter(nr=32, nt=16, nr2=nr+2, nt1=nt+1)
  86.       parameter(mmax=200)
  87. c
  88. c common block variables
  89. c
  90.       double precision u,fb
  91.       double precision elf,elfn
  92.       double precision phin,phinn,phia,phian
  93.       double precision c,cn
  94.       double precision zag,zagn,xm
  95.       double precision h,dlt,s1,s2,s3,a
  96.       double precision re,pen,pec,cnd1,cnd2,cnd3,cnd4,cnd5
  97.       double precision uy,vy,ux,vx,x,y
  98.       double precision theta,dr,r
  99.       double precision k0,alpha0,beta0
  100. c
  101. c
  102. c other variables
  103. c
  104.       double precision ro,mu,achem,ct,r0,a2,a0
  105.       double precision c0,c1,c2,d,pi,tpi,u0,b0
  106.       double precision s0,phi0,z0,elf0,adp0,xlow,ylow,wl
  107.       double precision xchar,uchar,tchar,pchar,fchar
  108.       double precision elfchar,phichar,zchar,cchar
  109.       double precision ang,ax,ay,co,cx,cxh,cy,cyh
  110.       double precision dc,dn,si,sx,sxh,sy,syh,th,xh,yh
  111.       double precision cmax,cmin
  112. c
  113.       common/vel   /u (0:nbp1,0:nbp1,2)
  114.       common/vel   /uy(0:nbp1,0:nbp1),vy(0:nbp1,0:nbp1)
  115.       common/vel   /ux(0:nbp1,0:nbp1),vx(0:nbp1,0:nbp1)
  116.       common/forceb/fb(0:nbp1,0:nbp1,2)
  117.       common/link  /elf  (0:nbp1,0:nbp1,0:nr2,nt1)
  118.       common/link  /elfn (0:nbp1,0:nbp1,0:nr2,nt1)
  119.       common/phi   /phin (0:nbp1,0:nbp1)
  120.       common/phi   /phinn(0:nbp1,0:nbp1)
  121.       common/phi   /phia (0:nbp1,0:nbp1)
  122.       common/phi   /phian(0:nbp1,0:nbp1)
  123.       common/adp   /c  (0:nbp1,0:nbp1)
  124.       common/adp   /cn (0:nbp1,0:nbp1)
  125.       common/agg   /zag   (0:nbp1,0:nbp1)
  126.       common/agg   /zagn  (0:nbp1,0:nbp1)
  127.       common/coefs /s1,s2,s3,re,a
  128.       common/cnd   /cnd1,cnd2,cnd3,cnd4,cnd5
  129.       common/steps /h,dlt
  130.       common/psteps /theta
  131.       common/rsize  /dr(nr2),r(0:nr2),nk
  132.       common/grid  /x(0:nbp1),y(0:nbp1)
  133.       common/diffn /pen
  134.       common/diffc /pec
  135. c
  136.       common/stiff /k0
  137.       common/linkf /alpha0
  138.       common/linkb /beta0
  139.       common/char  /fchar,zchar,phichar
  140. c
  141.       common/fmarkers/xm(mmax,2)
  142. c
  143. c.... code body eliminated ....
  144. c
  145.       end
  146. c
  147. c--------------------------------------------------------------
  148. c
  149.           subroutine xinit
  150. c
  151.       parameter(l2ng=6,ng=2**l2ng,nb =ng+2,ngm1=ng-1)
  152.       parameter(nbp1=nb+1)
  153. c
  154.       double precision sinsq,bzero,z
  155.       double precision h,dlt
  156.       double precision re,s1,s2,s3,a
  157.       double precision pi,tpon,si,sj
  158. c
  159.       common/fft   /sinsq(0:nbp1,0:nbp1)
  160.       common/fft   /bzero(0:nbp1,0:nbp1)
  161.       common/ptds  /z(0:nbp1,0:nbp1)
  162.       common/steps /h,dlt
  163.       common/coefs /s1,s2,s3,re,a
  164. c
  165. c.... code body eliminated ....
  166. c
  167.       end
  168. c
  169. c-------------------------------------------------
  170. c
  171.       subroutine navs2d
  172. c
  173.       parameter(l2ng=6,ng=2**l2ng,nb =ng+2,ngm1=ng-1)
  174.       parameter(nbp1=nb+1)
  175. c
  176.       double precision u,f,sinsq,bzero,z
  177.       double precision h,dlt,re,s1,s2,s3,a
  178.       double precision uy,vy,ux,vx
  179. c
  180.       double precision w1,w2,b,r,yp,c,lam,yh,p,d
  181.       double precision pro,xl,yl
  182. c
  183.       common/vel   /u(0:nbp1,0:nbp1,2)
  184.       common/vel   /uy(0:nbp1,0:nbp1),vy(0:nbp1,0:nbp1)
  185.       common/vel   /ux(0:nbp1,0:nbp1),vx(0:nbp1,0:nbp1)
  186.       common/force /f(0:nbp1,0:nbp1,2)
  187.       common/pres  /p(0:nbp1,0:nbp1)
  188.       common/fft   /sinsq(0:nbp1,0:nbp1)
  189.       common/fft   /bzero(0:nbp1,0:nbp1)
  190.       common/ptds  /z(0:nbp1,0:nbp1)
  191.       common/steps /h,dlt
  192.       common/coefs /s1,s2,s3,re,a
  193. c
  194.       dimension w1(0:nbp1,0:nbp1,1:2)
  195.       dimension w2(0:nbp1,0:nbp1,1:2)
  196. c
  197.       dimension b (0:nbp1,0:nbp1)
  198.       dimension r (0:nbp1,0:nbp1)
  199.       dimension yp(0:nbp1,0:nbp1)
  200.       dimension c (0:nbp1,0:nbp1)
  201.       dimension yh(0:nbp1,0:nbp1)
  202.       dimension d (0:nbp1,0:nbp1)
  203.       dimension lam(ng)
  204. c
  205.       equivalence(f,w1,w2)
  206.       equivalence(d,p)
  207. c
  208. c.... code body eliminated ....
  209. c
  210.       end
  211. c
  212. c---------------------------------------------------------------
  213. c
  214.       subroutine tridgx(a,b,c,w,y)
  215. c
  216.       parameter(l2ng=6,ng=2**l2ng,nb =ng+2,ngm1=ng-1)
  217.       parameter(n=ng-1,np1=n+1,nm1=n-1)
  218.       parameter(nbp1=nb+1)
  219. c
  220.       double precision a,b,c,w,y
  221. c
  222.       double precision x,l,r,d
  223. c
  224.       common/tdspace/x(0:nbp1,0:nbp1)
  225.       common/tdspace/l(0:nbp1,0:nbp1)
  226.       common/tdspace/r(0:nbp1,0:nbp1)
  227.       common/tdspace/d(0:nbp1,0:nbp1)
  228. c
  229.       dimension y(0:nbp1,0:nbp1)
  230.       dimension b(0:nbp1,0:nbp1)
  231.       dimension c(0:nbp1,0:nbp1)
  232.       dimension w(0:nbp1,0:nbp1)
  233. c
  234. c.... code body eliminated ....
  235. c
  236.       end
  237. c
  238. c---------------------------------------------------------------
  239. c
  240.       subroutine tridgy(a,b,c,w,y)
  241. c
  242.       parameter(l2ng=6,ng=2**l2ng,nb =ng+2,ngm1=ng-1)
  243.       parameter(n=ng-1,np1=n+1,nm1=n-1)
  244.       parameter(nbp1=nb+1)
  245. c
  246.       double precision a,b,c,w,y
  247. c
  248.       double precision x,l,r,d
  249. c
  250.       common/tdspace/x(0:nbp1,0:nbp1)
  251.       common/tdspace/l(0:nbp1,0:nbp1)
  252.       common/tdspace/r(0:nbp1,0:nbp1)
  253.       common/tdspace/d(0:nbp1,0:nbp1)
  254. c
  255.       dimension y(0:nbp1,0:nbp1)
  256.       dimension b(0:nbp1,0:nbp1)
  257.       dimension c(0:nbp1,0:nbp1)
  258.       dimension w(0:nbp1,0:nbp1)
  259. c
  260. c.... code body eliminated ....
  261. c
  262.       end
  263. c
  264. c------------------------------------------------------------
  265. c
  266.       subroutine newu(w2,p)
  267. c
  268.       parameter(l2ng=6,ng=2**l2ng,nb =ng+2,ngm1=ng-1)
  269.       parameter(nbp1=nb+1)
  270. c
  271.       double precision u,uy,vy,ux,vx
  272.       double precision h,k
  273.       common/vel   /u(0:nbp1,0:nbp1,2)
  274.       common/vel   /uy(0:nbp1,0:nbp1),vy(0:nbp1,0:nbp1)
  275.       common/vel   /ux(0:nbp1,0:nbp1),vx(0:nbp1,0:nbp1)
  276.       common/steps /h,k
  277. c
  278.       double precision p (0:nbp1,0:nbp1)
  279.       double precision w2(0:nbp1,0:nbp1,2),s
  280. c
  281. c.... code body eliminated ....
  282. c
  283.       end
  284. c
  285. c------------------------------------------------------------
  286. c
  287.       subroutine div(s3,w2,d)
  288. c
  289.       parameter(l2ng=6,ng=2**l2ng,nb =ng+2,ngm1=ng-1)
  290.       parameter(nbp1=nb+1)
  291. c
  292.       double precision w2(0:nbp1,0:nbp1,2)
  293.       double precision d (0:nbp1,0:nbp1)
  294.       double precision s3
  295. c
  296. c.... code body eliminated ....
  297. c
  298.       end
  299. c
  300. c------------------------------------------------------------------
  301. c
  302.       subroutine fft2d(a,b,isign)
  303.       parameter(l2ng=6,ng=2**l2ng,nb =ng+2,ngm1=ng-1)
  304.       parameter(n=ng,m=l2ng)
  305.       parameter(nbp1=nb+1)
  306. c
  307.       double precision a(0:nbp1,0:nbp1)
  308.       double precision b(0:nbp1,0:nbp1)
  309.       double precision t1(n),t2(n),t3(n),t4(n)
  310.       double precision pi,ang,ssign,tu1,u1,u2,w1,w2
  311. c
  312. c.... code body eliminated ....
  313. c
  314.       end
  315. c
  316. c-----------------------------------------------------
  317. c
  318.       subroutine phia2d(n)
  319.       parameter(l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  320.       parameter(ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  321. c
  322. c common block variables
  323. c
  324.       double precision k,h
  325.       double precision u,phin,phinn,phia,phian
  326.       double precision uy,vy,ux,vx
  327. c
  328. c other variables
  329. c
  330. c
  331.       common/vel   /u(0:nbp1,0:nbp1,2)
  332.       common/vel   /uy(0:nbp1,0:nbp1),vy(0:nbp1,0:nbp1)
  333.       common/vel   /ux(0:nbp1,0:nbp1),vx(0:nbp1,0:nbp1)
  334. c
  335.       common/phi   /phin (0:nbp1,0:nbp1)
  336.       common/phi   /phinn(0:nbp1,0:nbp1)
  337.       common/phi   /phia (0:nbp1,0:nbp1)
  338.       common/phi   /phian(0:nbp1,0:nbp1)
  339. c
  340.       common/steps /h,k
  341. c
  342. c.... code body eliminated ....
  343. c
  344.       end
  345. c
  346. c----------------------------------------------------------------
  347. c
  348.       subroutine zag2d(n)
  349.       parameter(l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  350.       parameter(ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  351. c
  352. c common block variables
  353. c
  354.       double precision k,h
  355.       double precision u,zag,zagn
  356.       double precision uy,vy,ux,vx
  357. c
  358. c other variables
  359. c
  360. c
  361.       common/vel   /u(0:nbp1,0:nbp1,2)
  362.       common/vel   /uy(0:nbp1,0:nbp1),vy(0:nbp1,0:nbp1)
  363.       common/vel   /ux(0:nbp1,0:nbp1),vx(0:nbp1,0:nbp1)
  364.       common/agg   /zag   (0:nbp1,0:nbp1)
  365.       common/agg   /zagn  (0:nbp1,0:nbp1)
  366. c
  367.       common/steps /h,k
  368. c
  369. c.... code body eliminated ....
  370. c
  371.       end
  372. c
  373. c--------------------------------------------------------------------
  374. c
  375.       subroutine plot(time,n,u,f,phia,phin,c,zag,xm,elf,nk)
  376. c
  377. c prints out data(0:ng,0:ng) for subsequent plotting
  378. c
  379.       parameter(l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  380.       parameter(ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  381.       parameter(nr=32, nt=16, nr2=nr+2, nt1=nt+1)
  382.       parameter(mmax=200)
  383. c
  384. c argument list variables
  385. c
  386.       double precision u,f,elf
  387.       double precision phin,phia
  388.       double precision c
  389.       double precision zag
  390.       double precision xm
  391.       double precision time
  392.       integer n,nk
  393. c
  394.       dimension u(0:nbp1,0:nbp1,2)
  395.       dimension f(0:nbp1,0:nbp1,2)
  396.       dimension phia (0:nbp1,0:nbp1)
  397.       dimension zag   (0:nbp1,0:nbp1)
  398. c
  399.       dimension xm(mmax,2)
  400. c
  401.       dimension elf (0:nbp1,0:nbp1,0:nr2,nt1)
  402.       dimension phin (0:nbp1,0:nbp1)
  403.       dimension c    (0:nbp1,0:nbp1)
  404.       common/efnum/nfil
  405. c
  406. c.... code body eliminated ....
  407. c
  408.       end
  409. c
  410. c---------------------------------------------------------------------
  411. c
  412.       subroutine markers
  413.       parameter(l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  414.       parameter(ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  415.       parameter(mmax=200)
  416. c
  417. c common block variables
  418. c
  419.       double precision u
  420.       double precision h,dlt
  421.       double precision uy,vy,ux,vx,xm
  422. c
  423. c argument list variables
  424. c
  425.       double precision ax,ay,um,umn,vm,vmn,x,xn,y,yn
  426. c
  427.       common/vel   /u(0:nbp1,0:nbp1,2)
  428.       common/vel   /uy(0:nbp1,0:nbp1),vy(0:nbp1,0:nbp1)
  429.       common/vel   /ux(0:nbp1,0:nbp1),vx(0:nbp1,0:nbp1)
  430. c
  431.       common/steps /h,dlt
  432.       common/fmarkers/xm(mmax,2)
  433. c
  434. c.... code body eliminated ....
  435. c
  436.        end
  437. c
  438. c-------------------------------------------------------------
  439. c
  440.       subroutine phin2d(n)
  441.       parameter(l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  442.       parameter(ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  443.       parameter(mmax=200)
  444. c
  445. c common block variables
  446. c
  447.       double precision k,h
  448.       double precision u,phin,phinn,phia,phian
  449.       double precision pen
  450.       double precision uy,vy,ux,vx
  451. c
  452.       common/vel   /u(0:nbp1,0:nbp1,2)
  453.       common/vel   /uy(0:nbp1,0:nbp1),vy(0:nbp1,0:nbp1)
  454.       common/vel   /ux(0:nbp1,0:nbp1),vx(0:nbp1,0:nbp1)
  455.       common/phi   /phin (0:nbp1,0:nbp1)
  456.       common/phi   /phinn(0:nbp1,0:nbp1)
  457.       common/phi   /phia (0:nbp1,0:nbp1)
  458.       common/phi   /phian(0:nbp1,0:nbp1)
  459. c
  460.       common/diffn /pen
  461. c
  462.       common/steps /h,k
  463. c
  464. c.... code body eliminated ....
  465. c
  466.       end
  467. c
  468. c-------------------------------------------------------------
  469. c
  470.       subroutine chem2d(n)
  471.       parameter(l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  472.       parameter(ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  473.       parameter(mmax=200)
  474. c
  475. c common block variables
  476. c
  477.       double precision k,h
  478.       double precision u,c,cn
  479.       double precision pec
  480.       double precision uy,vy,ux,vx
  481. c
  482.       common/vel   /u(0:nbp1,0:nbp1,2)
  483.       common/vel   /uy(0:nbp1,0:nbp1),vy(0:nbp1,0:nbp1)
  484.       common/vel   /ux(0:nbp1,0:nbp1),vx(0:nbp1,0:nbp1)
  485.       common/adp   /c  (0:nbp1,0:nbp1)
  486.       common/adp   /cn (0:nbp1,0:nbp1)
  487. c
  488.       common/steps /h,k
  489.       common/diffc /pec
  490. c
  491. c.... code body eliminated ....
  492. c
  493.       end
  494. c
  495. c-------------------------------------------------
  496. c
  497.       subroutine chlfac(diag,subd,nn)
  498.       double precision   diag(nn),subd(nn)
  499. c
  500. c.... code body eliminated ....
  501. c
  502.       end
  503. c
  504. c-------------------------------------------------
  505. c
  506.       subroutine chlslv(diag,sub,nm1,b,x)
  507.       parameter(l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  508.       parameter(ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  509.       parameter (max = nbp1)
  510. c
  511.       double precision   diag(nm1), sub(nm1), b(nm1+1), x(nm1), y(max)
  512. c
  513. c.... code body eliminated ....
  514. c
  515.       end
  516. c
  517. c-------------------------------------------------
  518. c
  519.       subroutine period(ph)
  520. c
  521. c extend ph periodically
  522. c
  523.       parameter(l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  524.       parameter(ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  525.       double precision ph
  526.       dimension ph(0:nbp1,0:nbp1)
  527. c
  528. c.... code body eliminated ....
  529. c
  530.       end
  531. c
  532. c-------------------------------------------------
  533. c
  534.       function sol(v,l,r)
  535.       double precision v,l,r,sol
  536. c
  537. c.... code body eliminated ....
  538. c
  539.       end
  540. c
  541. c-----------------------------------------------------------------------
  542. c
  543.       subroutine diffu(ph,phn,k1,alpha)
  544.       parameter (l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  545.       parameter (ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  546. c
  547. c common block variables
  548. c
  549.       double precision h,k
  550. c
  551. c other variables
  552. c
  553.       double precision k1,alpha,ph,phn
  554.       double precision gdiag,gsub,b,z,y,lam,eta
  555. c
  556.       dimension gdiag(nb-1),gsub(nb-1),b(nb)
  557.       dimension z(nb-1),y(nb-1)
  558.       dimension ph (0:nbp1,0:nbp1)
  559.       dimension phn(0:nbp1,0:nbp1)
  560. c
  561.       common/steps /h,k
  562. c
  563. c.... code body eliminated ....
  564. c
  565.       end
  566. c
  567. c-----------------------------------------------------------------------
  568. c
  569.       subroutine react
  570.       parameter(l2ng=6,ng=2**l2ng,nb=ng+2,ngm1=ng-1)
  571.       parameter(ngp1=ng+1,ngp2=ng+2,nbp1=nb+1)
  572.       parameter(nr=32, nt=16, nr2=nr+2, nt1=nt+1)
  573. c
  574. c common block variables
  575. c
  576.       double precision k,h,cnd1,cnd2,cnd3,cnd4,cnd5
  577.       double precision elf,elfn,phin,phinn,phia,phian,c,cn,zag,zagn
  578.       double precision dr,r
  579. c
  580. c other variables
  581. c
  582.       double precision rc,y,yn,temp1,temp2,temp3,temp4,c4,alpha
  583. c
  584.       common/link  /elf (0:nbp1,0:nbp1,0:nr2,nt1)
  585.       common/link  /elfn(0:nbp1,0:nbp1,0:nr2,nt1)
  586.       common/phi   /phin (0:nbp1,0:nbp1)
  587.       common/phi   /phinn(0:nbp1,0:nbp1)
  588.       common/phi   /phia (0:nbp1,0:nbp1)
  589.       common/phi   /phian(0:nbp1,0:nbp1)
  590.       common/adp   /c  (0:nbp1,0:nbp1)
  591.       common/adp   /cn (0:nbp1,0:nbp1)
  592.       common/agg   /zag(0:nbp1,0:nbp1)
  593.       common/agg   /zagn(0:nbp1,0:nbp1)
  594.       common/cnd   /cnd1,cnd2,cnd3,cnd4,cnd5
  595.       common/steps /h,k
  596.       common/rsize/dr(nr2),r(0:nr2),nk
  597. c
  598.       dimension rc (0:nbp1)
  599.       dimension y  (0:nbp1,4), yn(0:nbp1,4)
  600. c
  601. c.... code body eliminated ....
  602. c
  603.       end
  604.