SUBROUTINE POLYP(N,NUMT,COEF,KDEG,IFLG1,IFLG2,EPSBIG,EPSSML, $ NUMRR,NN,MMAXT,TTOTDG,LAMBDA,ROOTS,ARCLEN,NFE,TOTDG, $ PDG,QDG,R,FACV,CL,Y,YP,YOLD,YPOLD,QR,ALPHA,TZ,W, $ WP,Z0,Z1,SSPAR,PAR,IDEG,ICOUNT,PIVOT,IPAR) C C THE PURPOSE OF POLYP IS TO ALIAS THE WORKSPACES "WK" AND C "IWK" IN POLSYS TO THE VARIABLES "PDG" THROUGH "IPAR". C POLYP GENERATES THE START POINTS FOR THE PATHS AND CALLS THE C PATH TRACKER POLYNF . C C SUBROUTINES CALLED: INITP, STRPTP, POLYNF, OTPUTP . C C ON INPUT: C C N,NUMT,COEF,KDEG,IFLG1,IFLG2,EPSBIG,EPSSML,NUMRR,NN, C MMAXT,TTOTDG ARE AS DESCRIBED IN POLSYS. C C TOTDG IS THE TOTAL DEGREE OF THE SYSTEM. C C PDG,QDG,R,FACV,CL,Y,YP,YOLD,YPOLD,QR,ALPHA,TZ,W,WP,Z0, C Z1,SSPAR,PAR,IDEG,ICOUNT,PIVOT,IPAR ARE VARIABLES. C C ON OUTPUT: C C LAMBDA,ROOTS,ARCLEN,NFE ARE AS DESCRIBED IN POLSYS. C ---------------------------------------------------------------------- C C TYPE DECLARATIONS INTEGER N,NUMT,KDEG,IFLG1,IFLG2,NUMRR,NN,MMAXT, $ TTOTDG,NFE,TOTDG,IDEG,ICOUNT,PIVOT,IPAR INTEGER I,I1,I2,I3,IDUMMY,IFLAG,IJ,IJP1,INDEX,IPROFF,J,LIPAR, $ LPAR,N2,N2P1,NNFE,NP1,NUMPAT,PROFF,TRACE DOUBLE PRECISION COEF,EPSBIG,EPSSML,LAMBDA,ROOTS, $ ARCLEN,PDG,QDG,R,FACV,CL,Y,YP,YOLD,YPOLD, $ QR,ALPHA,TZ,W,WP,Z0,Z1,SSPAR,PAR DOUBLE PRECISION AARCLN,ANSAE,ANSRE,ARCAE,ARCRE,XNP1 C C ARRAY DECLARATIONS DIMENSION NUMT(NN),KDEG(NN,NN+1,MMAXT),IFLG2(TTOTDG), $ NFE(TTOTDG),IDEG(N),ICOUNT(N),PIVOT(2*N+1), $ IPAR(42 + 2*N + N*(N+1)*MMAXT) DIMENSION IPROFF(15),LIPAR(15),LPAR(25),PROFF(25) DIMENSION COEF(NN,MMAXT),LAMBDA(TTOTDG), $ ROOTS(2,NN+1,TTOTDG), ARCLEN(TTOTDG), $ PDG(2,N),QDG(2,N),R(2,N),FACV(N),CL(2,N+1), $ Y(2*N+1),YP(2*N+1),YOLD(2*N+1),YPOLD(2*N+1), $ QR(2*N,2*N+2),ALPHA(2*N+1),TZ(2*N+1),W(2*N+1), $ WP(2*N+1),Z0(2*N+1),Z1(2*N+1),SSPAR(8), $ PAR(2 + 28*N + 6*N**2 + 7*N*MMAXT + 4*N**2*MMAXT) DIMENSION XNP1(2) C N2=2*N NP1=N+1 N2P1=N2+1 IF (NUMRR .LE. 0) NUMRR=1 C C INITIALIZATION C CALL INITP(IFLG1,N,NUMT,KDEG,COEF,NN,MMAXT,PAR,IPAR, $ IDEG,FACV,CL,PDG,QDG,R) C C INTEGER VARIABLES AND ARRAYS TO BE PASSED IN IPAR: C C IPAR INDEX VARIABLE NAME LENGTH C ---------- ------------- ----------------- C 1 N 1 C 2 MMAXT 1 C 3 PROFF 25 C 4 IPROFF 15 C 5 IDEG N C 6 NUMT N C 7 KDEG N*(N+1)*MMAXT C C C DOUBLE PRECISION VARIABLES AND ARRAYS TO BE PASSED IN PAR: C C PAR INDEX VARIABLE NAME LENGTH C ---------- ------------- ----------------- C 1 PDG 2*N C 2 CL 2*(N+1) C 3 COEF N*MMAXT C 4 H N2 C 5 DHX N2*N2 C 6 DHT N2 C 7 XDGM1 2*N C 8 XDG 2*N C 9 G 2*N C 10 DG 2*N C 11 PXDGM1 2*N C 12 PXDG 2*N C 13 F 2*N C 14 DF 2*N*(N+1) C 15 XX 2*N*(N+1)*MMAXT C 16 TRM 2*N*MMAXT C 17 DTRM 2*N*(N+1)*MMAXT C 18 CLX 2*N C 19 DXNP1 2*N C C SET LENGTHS OF VARIABLES LIPAR(1)=1 LIPAR(2)=1 LIPAR(3)=25 LIPAR(4)=15 LIPAR(5)=N LIPAR(6)=N LIPAR(7)=N*(N+1)*MMAXT LPAR( 1)=2*N LPAR( 2)=2*NP1 LPAR( 3)=N*MMAXT LPAR( 4)=N2 LPAR( 5)=N2*N2 LPAR( 6)=N2 LPAR( 7)=2*N LPAR( 8)=2*N LPAR( 9)=2*N LPAR(10)=2*N LPAR(11)=2*N LPAR(12)=2*N LPAR(13)=2*N LPAR(14)=2*N*NP1 LPAR(15)=2*N*NP1*MMAXT LPAR(16)=2*N*MMAXT LPAR(17)=2*N*NP1*MMAXT LPAR(18)=2*N LPAR(19)=2*N C C PROFF AND IPROFF ARE OFFSETS THAT DEFINE THE VARIABLES LISTED ABOVE PROFF(1)=1 DO 10 I=2,19 PROFF(I)=PROFF(I-1)+LPAR(I-1) 10 CONTINUE IPROFF(1)=1 DO 11 I=2,7 IPROFF(I)=IPROFF(I-1)+LIPAR(I-1) 11 CONTINUE C C DEFINE VARIABLES IPAR(1)=N IPAR(2)=MMAXT DO 16 I=1,19 IPAR(IPROFF(3) + (I-1))= PROFF(I) 16 CONTINUE DO 18 I=1,7 IPAR(IPROFF(4) + (I-1))= IPROFF(I) 18 CONTINUE DO 20 I=1,N IPAR(IPROFF(5) + (I-1))= IDEG(I) IPAR(IPROFF(6) + (I-1))= NUMT(I) 20 CONTINUE DO 22 I1=1, N DO 22 I2=1, NP1 DO 22 I3=1, NUMT(I1) INDEX=IPROFF(7) + (I1-1) + N*(I2-1) + N*NP1*(I3-1) IPAR(INDEX) = KDEG(I1,I2,I3) 22 CONTINUE DO 36 I1=1,2 DO 36 I2=1,N PAR(PROFF( 1) +(I1-1) + 2*(I2-1))= PDG(I1,I2) 36 CONTINUE DO 37 I1=1,2 DO 37 I2=1,NP1 PAR(PROFF( 2) +(I1-1) +2*(I2-1))= CL(I1,I2) 37 CONTINUE DO 38 I1=1,N DO 38 I2=1, NUMT(I1) PAR(PROFF( 3) +(I1-1) + N*(I2-1))=COEF(I1,I2) 38 CONTINUE C C ICOUNT IS A COUNTER USED BY "STRPTP" ICOUNT(1)=0 DO 50 J=2,N ICOUNT(J)=1 50 CONTINUE C C PATHS LOOP -- ITERATE THROUGH PATHS C DO 1000 NUMPAT = 1,TOTDG C GET A START POINT, Y, FOR THE PATH. Y(1) = 0.0 CALL STRPTP(N,ICOUNT,IDEG,R ,Y(2)) C CHECK WHETHER PATH IS TO BE FOLLOWED. IFLAG = IFLG2(NUMPAT) IF (IFLAG .NE. -2) GO TO 1000 ARCRE = EPSBIG ARCAE = ARCRE ANSRE = EPSSML ANSAE = ANSRE TRACE = 0 C TRACK A HOMOTOPY PATH. DO 65 IDUMMY=1,NUMRR CALL POLYNF(N2,Y,IFLAG,ARCRE,ARCAE,ANSRE,ANSAE,TRACE, $ QDG,NNFE,AARCLN,YP,YOLD,YPOLD,QR,ALPHA,TZ,PIVOT,W,WP, $ Z0,Z1,SSPAR,PAR,IPAR) IF (IFLAG .NE. 2 .AND. IFLAG .NE. 3) GOTO 66 65 CONTINUE 66 CONTINUE C UNSCALE AND UNTRANSFORM COMPUTED SOLUTION. CALL OTPUTP(N,NUMPAT,CL,FACV,PAR(PROFF(18)),Y(2),XNP1) LAMBDA(NUMPAT) = Y(1) DO 70 J=1,N DO 70 I=1,2 IJ=2*J+I-2 IJP1=IJ+1 ROOTS(I,J,NUMPAT) = Y(IJP1) 70 CONTINUE DO 72 I=1,2 ROOTS(I,NP1,NUMPAT) = XNP1(I) 72 CONTINUE ARCLEN(NUMPAT)= AARCLN NFE(NUMPAT) = NNFE IFLG2(NUMPAT) = IFLAG 1000 CONTINUE C RETURN END