160 REAL(KIND=
rp) z(1),w(1), alpha, beta
163 CALL zwgj (z,w,np,alpha,beta)
177 REAL(KIND=
rp) z(1),w(1), alpha, beta
180 CALL zwglj (z,w,np,alpha,beta)
184 SUBROUTINE zwgj (Z,W,NP,ALPHA,BETA)
194 parameter(nzd = nmax)
195 REAL(KIND=
rp) zd(nzd),wd(nzd),alphad,betad
196 REAL(KIND=
rp) z(1),w(1),alpha,beta
199 IF (np.GT.npmax)
THEN
200 WRITE (6,*)
'Too large polynomial degree in ZWGJ'
201 WRITE (6,*)
'Maximum polynomial degree is',nmax
202 WRITE (6,*)
'Here NP=',np
207 CALL zwgjd (zd,wd,np,alphad,betad)
215 SUBROUTINE zwgjd (Z,W,NP,ALPHA,BETA)
224 IMPLICIT REAL(KIND=RP) (a-h,o-z)
225 REAL(KIND=
rp) z(1),w(1),alpha,beta
234 WRITE (6,*)
'ZWGJD: Minimum number of Gauss points is 1',np
237 IF ((alpha.LE.-one).OR.(beta.LE.-one))
THEN
238 WRITE (6,*)
'ZWGJD: Alpha and Beta must be greater than -1'
243 z(1) = (beta-alpha)/(apb+two)
249 CALL jacg (z,np,alpha,beta)
255 fac1 = dnp1+alpha+beta+one
258 fnorm =
pnormj(np1,alpha,beta)
259 rcoef = (fnorm*fac2*fac3)/(two*fac1*dnp2)
261 CALL jacobf (p,pd,pm1,pdm1,pm2,pdm2,np2,alpha,beta,z(i))
262 w(i) = -rcoef/(p*pdm1)
267 SUBROUTINE zwglj (Z,W,NP,ALPHA,BETA)
277 parameter(nzd = nmax)
278 REAL(KIND=
rp) zd(nzd),wd(nzd),alphad,betad
279 REAL(KIND=
rp) z(1),w(1),alpha,beta
282 IF (np.GT.npmax)
THEN
283 WRITE (6,*)
'Too large polynomial degree in ZWGLJ'
284 WRITE (6,*)
'Maximum polynomial degree is',nmax
285 WRITE (6,*)
'Here NP=',np
290 CALL zwgljd (zd,wd,np,alphad,betad)
307 IMPLICIT REAL(KIND=RP) (a-h,o-z)
308 REAL(KIND=
rp) z(np),w(np),alpha,beta
316 WRITE (6,*)
'ZWGLJD: Minimum number of Gauss-Lobatto points is 2'
317 WRITE (6,*)
'ZWGLJD: alpha,beta:',alpha,beta,np
320 IF ((alpha.LE.-one).OR.(beta.LE.-one))
THEN
321 WRITE (6,*)
'ZWGLJD: Alpha and Beta must be greater than -1'
328 CALL zwgjd (z(2),w(2),nm1,alpg,betg)
333 w(i) = w(i)/(one-z(i)**2)
335 CALL jacobf (p,pd,pm1,pdm1,pm2,pdm2,n,alpha,beta,z(1))
336 w(1) =
endw1(n,alpha,beta)/(two*pd)
337 CALL jacobf (p,pd,pm1,pdm1,pm2,pdm2,n,alpha,beta,z(np))
338 w(np) =
endw2(n,alpha,beta)/(two*pd)
344 IMPLICIT REAL(KIND=RP) (a-h,o-z)
345 REAL(kind=
rp) alpha,beta
357 f1 = f1*(apb+two)*two**(apb+two)/two
363 fint1 = fint1*two**(apb+two)
365 fint2 = fint2*two**(apb+three)
366 f2 = (-two*(beta+two)*fint1 + (apb+four)*fint2) &
376 a1 = -(two*(di+alpha)*(di+beta))/(abn*abnn*(abnn+one))
377 a2 = (two*(alpha-beta))/(abnn*(abnn+two))
378 a3 = (two*(abn+one))/((abnn+two)*(abnn+one))
379 f3 = -(a2*f2+a1*f1)/a3
388 IMPLICIT REAL(KIND=RP) (a-h,o-z)
389 REAL(kind=
rp) alpha,beta
401 f1 = f1*(apb+two)*two**(apb+two)/two
407 fint1 = fint1*two**(apb+two)
409 fint2 = fint2*two**(apb+three)
410 f2 = (two*(alpha+two)*fint1 - (apb+four)*fint2) &
420 a1 = -(two*(di+alpha)*(di+beta))/(abn*abnn*(abnn+one))
421 a2 = (two*(alpha-beta))/(abnn*(abnn+two))
422 a3 = (two*(abn+one))/((abnn+two)*(abnn+one))
423 f3 = -(a2*f2+a1*f1)/a3
432 IMPLICIT REAL(KIND=RP) (a-h,o-z)
441 IF (x.EQ.-half)
gammaf = -two*sqrt(pi)
442 IF (x.EQ. half)
gammaf = sqrt(pi)
443 IF (x.EQ. one )
gammaf = one
444 IF (x.EQ. two )
gammaf = one
445 IF (x.EQ. 1.5 )
gammaf = sqrt(pi)/2.
446 IF (x.EQ. 2.5)
gammaf = 1.5*sqrt(pi)/2.
447 IF (x.EQ. 3.5)
gammaf = 0.5*(2.5*(1.5*sqrt(pi)))
448 IF (x.EQ. 3. )
gammaf = 2.
449 IF (x.EQ. 4. )
gammaf = 6.
450 IF (x.EQ. 5. )
gammaf = 24.
451 IF (x.EQ. 6. )
gammaf = 120.
456 IMPLICIT REAL(KIND=RP) (a-h,o-z)
457 REAL(kind=
rp) alpha,beta
461 const = alpha+beta+one
465 pnormj = prod * two**const/(two*dn+const)
469 prod = prod/(two*(one+const)*
gammaf(const+one))
470 prod = prod*(one+alpha)*(two+alpha)
471 prod = prod*(one+beta)*(two+beta)
474 frac = (dindx+alpha)*(dindx+beta)/(dindx*(dindx+alpha+beta))
477 pnormj = prod * two**const/(two*dn+const)
481 SUBROUTINE jacg (XJAC,NP,ALPHA,BETA)
492 IMPLICIT REAL(KIND=RP) (a-h,o-z)
493 REAL(KIND=
rp) xjac(1)
498 dth = 4.*atan(one)/(2.*((n))+2.)
501 x = cos((2.*(((j))-1.)+1.)*dth)
503 x1 = cos((2.*(((j))-1.)+1.)*dth)
508 CALL jacobf (p,pd,pm1,pdm1,pm2,pdm2,np,alpha,beta,x)
512 recsum = recsum+1./(x-xjac(np-i+1))
514 delx = -p/(pd-recsum*p)
516 IF (abs(delx) .LT. eps)
GOTO 31
525 IF (xjac(j).LT.xmin)
THEN
539 SUBROUTINE jacobf (POLY,PDER,POLYM1,PDERM1,POLYM2,PDERM2,N,ALP,BET,X)
546 IMPLICIT REAL(KIND=RP) (a-h,o-z)
553 poly = (alp-bet+(apb+2.)*x)/2.
558 a1 = 2.*dk*(dk+apb)*(2.*dk+apb-2.)
559 a2 = (2.*dk+apb-1.)*(alp**2-bet**2)
561 a3 = b3*(b3+1.)*(b3+2.)
562 a4 = 2.*(dk+alp-1.)*(dk+bet-1.)*(2.*dk+apb)
563 polyn = ((a2+a3*x)*poly-a4*polyl)/a1
564 pdern = ((a2+a3*x)*pder-a4*pderl+a3*poly)/a1
579 REAL(kind=
rp)
FUNCTION hgj (II,Z,ZGJ,NP,ALPHA,BETA)
588 parameter(nzd = nmax)
589 REAL(kind=
rp) zd,zgjd(nzd),alphad,betad
590 REAL(kind=
rp) z,zgj(1),alpha,beta
592 IF (np.GT.npmax)
THEN
593 WRITE (6,*)
'Too large polynomial degree in HGJ'
594 WRITE (6,*)
'Maximum polynomial degree is',nmax
595 WRITE (6,*)
'Here NP=',np
604 hgj =
hgjd(ii,zd,zgjd,np,alphad,betad)
608 REAL(kind=
rp)
FUNCTION hgjd (II,Z,ZGJ,NP,ALPHA,BETA)
616 IMPLICIT REAL(KIND=RP) (a-h,o-z)
617 REAL(kind=
rp) z,zgj(1),alpha,beta
622 IF (abs(dz).LT.eps)
THEN
626 CALL jacobf (pzi,pdzi,pm1,pdm1,pm2,pdm2,np,alpha,beta,zi)
627 CALL jacobf (pz,pdz,pm1,pdm1,pm2,pdm2,np,alpha,beta,z)
628 hgjd = pz/(pdzi*(z-zi))
632 REAL(kind=
rp)
FUNCTION hglj (II,Z,ZGLJ,NP,ALPHA,BETA)
641 parameter(nzd = nmax)
642 REAL(kind=
rp) zd,zgljd(nzd),alphad,betad
643 REAL(kind=
rp) z,zglj(1),alpha,beta
645 IF (np.GT.npmax)
THEN
646 WRITE (6,*)
'Too large polynomial degree in HGLJ'
647 WRITE (6,*)
'Maximum polynomial degree is',nmax
648 WRITE (6,*)
'Here NP=',np
657 hglj =
hgljd(ii,zd,zgljd,np,alphad,betad)
661 REAL(kind=
rp)
FUNCTION hgljd (I,Z,ZGLJ,NP,ALPHA,BETA)
669 IMPLICIT REAL(KIND=RP) (a-h,o-z)
670 REAL(kind=
rp) z,zglj(1),alpha,beta
675 IF (abs(dz).LT.eps)
THEN
681 eigval = -dn*(dn+alpha+beta+one)
682 CALL jacobf (pi,pdi,pm1,pdm1,pm2,pdm2,n,alpha,beta,zi)
683 const = eigval*pi+alpha*(one+zi)*pdi-beta*(one-zi)*pdi
684 CALL jacobf (p,pd,pm1,pdm1,pm2,pdm2,n,alpha,beta,z)
685 hgljd = (one-z**2)*pd/(const*(z-zi))
689 SUBROUTINE dgj (D,DT,Z,NZ,NZD,ALPHA,BETA)
700 parameter(nzdd = nmax)
701 REAL(KIND=
rp) dd(nzdd,nzdd),dtd(nzdd,nzdd),zd(nzdd),alphad,betad
702 REAL(KIND=
rp) d(nzd,nzd),dt(nzd,nzd),z(1),alpha,beta
705 WRITE (6,*)
'DGJ: Minimum number of Gauss points is 1'
708 IF (nz .GT. nmax)
THEN
709 WRITE (6,*)
'Too large polynomial degree in DGJ'
710 WRITE (6,*)
'Maximum polynomial degree is',nmax
711 WRITE (6,*)
'Here Nz=',nz
714 IF ((alpha.LE.-1.).OR.(beta.LE.-1.))
THEN
715 WRITE (6,*)
'DGJ: Alpha and Beta must be greater than -1'
723 CALL dgjd (dd,dtd,zd,nz,nzdd,alphad,betad)
733 SUBROUTINE dgjd (D,DT,Z,NZ,NZD,ALPHA,BETA)
743 IMPLICIT REAL(KIND=RP) (a-h,o-z)
744 REAL(KIND=
rp) d(nzd,nzd),dt(nzd,nzd),z(1),alpha,beta
751 WRITE (6,*)
'DGJD: Minimum number of Gauss-Lobatto points is 2'
754 IF ((alpha.LE.-one).OR.(beta.LE.-one))
THEN
755 WRITE (6,*)
'DGJD: Alpha and Beta must be greater than -1'
761 CALL jacobf (pi,pdi,pm1,pdm1,pm2,pdm2,nz,alpha,beta,z(i))
762 CALL jacobf (pj,pdj,pm1,pdm1,pm2,pdm2,nz,alpha,beta,z(j))
763 IF (i.NE.j) d(i,j) = pdi/(pdj*(z(i)-z(j)))
764 IF (i.EQ.j) d(i,j) = ((alpha+beta+two)*z(i)+alpha-beta)/ &
772 SUBROUTINE dglj (D,DT,Z,NZ,NZD,ALPHA,BETA)
783 parameter(nzdd = nmax)
784 REAL(KIND=
rp) dd(nzdd,nzdd),dtd(nzdd,nzdd),zd(nzdd),alphad,betad
785 REAL(KIND=
rp) d(nzd,nzd),dt(nzd,nzd),z(1),alpha,beta
788 WRITE (6,*)
'DGLJ: Minimum number of Gauss-Lobatto points is 2'
791 IF (nz .GT. nmax)
THEN
792 WRITE (6,*)
'Too large polynomial degree in DGLJ'
793 WRITE (6,*)
'Maximum polynomial degree is',nmax
794 WRITE (6,*)
'Here NZ=',nz
797 IF ((alpha.LE.-1.).OR.(beta.LE.-1.))
THEN
798 WRITE (6,*)
'DGLJ: Alpha and Beta must be greater than -1'
806 CALL dgljd (dd,dtd,zd,nz,nzdd,alphad,betad)
816 SUBROUTINE dgljd (D,DT,Z,NZ,NZD,ALPHA,BETA)
826 IMPLICIT REAL(KIND=RP) (a-h,o-z)
827 REAL(KIND=
rp) d(nzd,nzd),dt(nzd,nzd),z(1),alpha,beta
832 eigval = -dn*(dn+alpha+beta+one)
835 WRITE (6,*)
'DGLJD: Minimum number of Gauss-Lobatto points is 2'
838 IF ((alpha.LE.-one).OR.(beta.LE.-one))
THEN
839 WRITE (6,*)
'DGLJD: Alpha and Beta must be greater than -1'
845 CALL jacobf (pi,pdi,pm1,pdm1,pm2,pdm2,n,alpha,beta,z(i))
846 CALL jacobf (pj,pdj,pm1,pdm1,pm2,pdm2,n,alpha,beta,z(j))
847 ci = eigval*pi-(beta*(one-z(i))-alpha*(one+z(i)))*pdi
848 cj = eigval*pj-(beta*(one-z(j))-alpha*(one+z(j)))*pdj
849 IF (i.NE.j) d(i,j) = ci/(cj*(z(i)-z(j)))
850 IF ((i.EQ.j).AND.(i.NE.1).AND.(i.NE.nz)) &
851 d(i,j) = (alpha*(one+z(i))-beta*(one-z(i)))/ &
853 IF ((i.EQ.j).AND.(i.EQ.1)) &
854 d(i,j) = (eigval+alpha)/(two*(beta+two))
855 IF ((i.EQ.j).AND.(i.EQ.nz)) &
856 d(i,j) = -(eigval+beta)/(two*(alpha+two))
863 SUBROUTINE dgll (D,DT,Z,NZ,NZD)
872 IMPLICIT REAL(KIND=RP) (a-h,o-z)
874 REAL(KIND=
rp) d(nzd,nzd),dt(nzd,nzd),z(1)
876 IF (nz .GT. nmax)
THEN
877 WRITE (6,*)
'Subroutine DGLL'
878 WRITE (6,*)
'Maximum polynomial degree =',nmax
879 WRITE (6,*)
'Polynomial degree =',nz
890 IF (i.NE.j) d(i,j) =
pnleg(z(i),n)/ &
891 (
pnleg(z(j),n)*(z(i)-z(j)))
892 IF ((i.EQ.j).AND.(i.EQ.1)) d(i,j) = -d0
893 IF ((i.EQ.j).AND.(i.EQ.nz)) d(i,j) = d0
900 REAL(kind=
rp)
FUNCTION hgll (I,Z,ZGLL,NZ)
907 IMPLICIT REAL(KIND=RP) (a-h,o-z)
908 REAL(kind=
rp) zgll(1), eps, dz, z
911 IF (abs(dz) .LT. eps)
THEN
918 (alfan*
pnleg(zgll(i),n)*(z-zgll(i)))
922 REAL(kind=
rp)
FUNCTION hgl (I,Z,ZGL,NZ)
929 REAL(kind=
rp) zgl(1), z, eps, dz
932 IF (abs(dz) .LT. eps)
THEN
953 IMPLICIT REAL(KIND=RP) (a-h,o-z)
954 REAL(kind=
rp) z, p1, p2, p3
955 IF(abs(z) .LT. 1.0e-25) z = 0.0
967 p3 = ((2.*fk+1.)*z*p2 - fk*p1)/(fk+1.)
972 if (n.eq.0)
pnleg = 1.
984 IMPLICIT REAL(KIND=RP) (a-h,o-z)
985 REAL(kind=
rp) p1, p2, p1d, p2d, p3d, z
993 p3 = ((2.*fk+1.)*z*p2 - fk*p1)/(fk+1.)
994 p3d = ((2.*fk+1.)*p2 + (2.*fk+1.)*z*p2d - fk*p1d)/(fk+1.)
1005 SUBROUTINE dgllgl (D,DT,ZM1,ZM2,IM12,NZM1,NZM2,ND1,ND2)
1017 REAL(KIND=
rp) d(nd2,nd1), dt(nd1,nd2), zm1(nd1), zm2(nd2), im12(nd2,nd1)
1018 REAL(KIND=
rp) eps, zp, zq
1030 IF ((abs(zp) .LT. eps).AND.(abs(zq) .LT. eps))
THEN
1034 -im12(ip,jq))/(zp-zq)
1036 dt(jq,ip) = d(ip,jq)
1042 SUBROUTINE dgljgj (D,DT,ZGL,ZG,IGLG,NPGL,NPG,ND1,ND2,ALPHA,BETA)
1055 REAL(KIND=
rp) d(nd2,nd1), dt(nd1,nd2), zgl(nd1), zg(nd2), iglg(nd2,nd1)
1057 parameter(ndd = nmax)
1058 REAL(KIND=
rp) dd(ndd,ndd), dtd(ndd,ndd)
1059 REAL(KIND=
rp) zgd(ndd), zgld(ndd), iglgd(ndd,ndd)
1060 REAL(KIND=
rp) alphad, betad
1063 WRITE(6,*)
'DGLJGJ: Minimum number of Gauss-Lobatto points is 2'
1066 IF (npgl.GT.nmax)
THEN
1067 WRITE(6,*)
'Polynomial degree too high in DGLJGJ'
1068 WRITE(6,*)
'Maximum polynomial degree is',nmax
1069 WRITE(6,*)
'Here NPGL=',npgl
1072 IF ((alpha.LE.-1.).OR.(beta.LE.-1.))
THEN
1073 WRITE(6,*)
'DGLJGJ: Alpha and Beta must be greater than -1'
1082 iglgd(i,j) = iglg(i,j)
1088 CALL dgljgjd (dd,dtd,zgld,zgd,iglgd,npgl,npg,ndd,ndd,alphad,betad)
1098 SUBROUTINE dgljgjd (D,DT,ZGL,ZG,IGLG,NPGL,NPG,ND1,ND2,ALPHA,BETA)
1111 IMPLICIT REAL(KIND=RP) (a-h,o-z)
1112 REAL(KIND=
rp) d(nd2,nd1), dt(nd1,nd2), zgl(nd1), zg(nd2)
1113 REAL(KIND=
rp) iglg(nd2,nd1), alpha, beta
1116 WRITE(6,*)
'DGLJGJD: Minimum number of Gauss-Lobatto points is 2'
1119 IF ((alpha.LE.-1.).OR.(beta.LE.-1.))
THEN
1120 WRITE(6,*)
'DGLJGJD: Alpha and Beta must be greater than -1'
1129 eigval = -dn*(dn+alpha+beta+one)
1133 dz = abs(zg(i)-zgl(j))
1135 d(i,j) = (alpha*(one+zg(i))-beta*(one-zg(i)))/ &
1136 (two*(one-zg(i)**2))
1138 CALL jacobf (pi,pdi,pm1,pdm1,pm2,pdm2,ngl,alpha,beta,zg(i))
1139 CALL jacobf (pj,pdj,pm1,pdm1,pm2,pdm2,ngl,alpha,beta,zgl(j))
1140 faci = alpha*(one+zg(i))-beta*(one-zg(i))
1141 facj = alpha*(one+zgl(j))-beta*(one-zgl(j))
1142 const = eigval*pj+facj*pdj
1143 d(i,j) = ((eigval*pi+faci*pdi)*(zg(i)-zgl(j)) &
1144 -(one-zg(i)**2)*pdi)/(const*(zg(i)-zgl(j))**2)
1152 SUBROUTINE iglm (I12,IT12,Z1,Z2,NZ1,NZ2,ND1,ND2)
1162 REAL(KIND=
rp) i12(nd2,nd1),it12(nd1,nd2),z1(nd1),z2(nd2), zi
1163 IF (nz1 .EQ. 1)
THEN
1171 i12(i,j) =
hgl(j,zi,z1,nz1)
1172 it12(j,i) = i12(i,j)
1178 SUBROUTINE igllm (I12,IT12,Z1,Z2,NZ1,NZ2,ND1,ND2)
1188 REAL(KIND=
rp) i12(nd2,nd1),it12(nd1,nd2),z1(nd1),z2(nd2),zi
1189 IF (nz1 .EQ. 1)
THEN
1197 i12(i,j) =
hgll(j,zi,z1,nz1)
1198 it12(j,i) = i12(i,j)
1202 end subroutine igllm
1204 SUBROUTINE igjm (I12,IT12,Z1,Z2,NZ1,NZ2,ND1,ND2,ALPHA,BETA)
1215 REAL(KIND=
rp) i12(nd2,nd1),it12(nd1,nd2),z1(nd1),z2(nd2),zi,alpha,beta
1216 IF (nz1 .EQ. 1)
THEN
1224 i12(i,j) =
hgj(j,zi,z1,nz1,alpha,beta)
1225 it12(j,i) = i12(i,j)
1231 SUBROUTINE igljm (I12,IT12,Z1,Z2,NZ1,NZ2,ND1,ND2,ALPHA,BETA)
1242 REAL(KIND=
rp) i12(nd2,nd1),it12(nd1,nd2),z1(nd1),z2(nd2),zi,alpha,beta
1243 IF (nz1 .EQ. 1)
THEN
1251 i12(i,j) =
hglj(j,zi,z1,nz1,alpha,beta)
1252 it12(j,i) = i12(i,j)
1256 end subroutine igljm
integer, parameter, public rp
Global precision used in computations.
LIBRARY ROUTINES FOR SPECTRAL METHODS.
real(kind=rp) function pnormj(N, ALPHA, BETA)
subroutine zwgll(Z, W, NP)
real(kind=rp) function pnleg(Z, N)
real(kind=rp) function hgj(II, Z, ZGJ, NP, ALPHA, BETA)
subroutine dgljgj(D, DT, ZGL, ZG, IGLG, NPGL, NPG, ND1, ND2, ALPHA, BETA)
subroutine zwgj(Z, W, NP, ALPHA, BETA)
subroutine dgj(D, DT, Z, NZ, NZD, ALPHA, BETA)
subroutine jacg(XJAC, NP, ALPHA, BETA)
subroutine zwgjd(Z, W, NP, ALPHA, BETA)
subroutine dgll(D, DT, Z, NZ, NZD)
real(kind=rp) function hglj(II, Z, ZGLJ, NP, ALPHA, BETA)
subroutine zwglj(Z, W, NP, ALPHA, BETA)
subroutine dglj(D, DT, Z, NZ, NZD, ALPHA, BETA)
real(kind=rp) function pndleg(Z, N)
subroutine igjm(I12, IT12, Z1, Z2, NZ1, NZ2, ND1, ND2, ALPHA, BETA)
real(kind=rp) function hgl(I, Z, ZGL, NZ)
real(kind=rp) function gammaf(X)
subroutine dgljgjd(D, DT, ZGL, ZG, IGLG, NPGL, NPG, ND1, ND2, ALPHA, BETA)
subroutine igljm(I12, IT12, Z1, Z2, NZ1, NZ2, ND1, ND2, ALPHA, BETA)
real(kind=rp) function hgjd(II, Z, ZGJ, NP, ALPHA, BETA)
subroutine iglm(I12, IT12, Z1, Z2, NZ1, NZ2, ND1, ND2)
subroutine zwgl(Z, W, NP)
Generate NP Gauss Legendre points Z and weights W associated with Jacobi polynomial ....
real(kind=rp) function hgljd(I, Z, ZGLJ, NP, ALPHA, BETA)
real(kind=rp) function endw1(N, ALPHA, BETA)
subroutine dgljd(D, DT, Z, NZ, NZD, ALPHA, BETA)
real(kind=rp) function hgll(I, Z, ZGLL, NZ)
real(kind=rp) function endw2(N, ALPHA, BETA)
subroutine zwgljd(Z, W, NP, ALPHA, BETA)
subroutine dgjd(D, DT, Z, NZ, NZD, ALPHA, BETA)
subroutine jacobf(POLY, PDER, POLYM1, PDERM1, POLYM2, PDERM2, N, ALP, BET, X)
subroutine dgllgl(D, DT, ZM1, ZM2, IM12, NZM1, NZM2, ND1, ND2)
subroutine igllm(I12, IT12, Z1, Z2, NZ1, NZ2, ND1, ND2)