SUBROUTINE INITP(IFLG1,N,NUMT,KDEG,COEF,NN,MMAXT,PAR,IPAR, & IDEG,FACV,CL,PDG,QDG,R) C C INITP INITIALIZES THE CONSTANTS THAT DEFINE THE POLSYS HOMOTOPY, C INITIALIZES THE CONSTANTS THAT DEFINE THE PROJECTIVE TRANSFORMATION, C AND SCALES THE COEFFICIENTS (IF SCALING IS SPECIFIED). C C ON INPUT: C C IFLG1 IS A FLAG THAT SPECIFIES WHETHER THE COEFFICIENTS ARE TO C BE SCALED OR NOT AND WHETHER THE PROJECTIVE TRANSFORMATION IS TO C BE USED OR NOT. IFLG1=A*10+B. SCALING IS SPECIFIED WHEN B=1. THE C PROJECTIVE TRANSFORMATION IS SPECIFIED WHEN A=1. OTHERWISE, A AND/OR C B =0. SCALING IS EVOKED BY A CALL TO THE SUBROUTINE SCLGNP. THE C PROJECTIVE TRANSFORMATION IS EVOKED BY SETTING THE CL ARRAY EQUAL C TO RANDOM COMPLEX NUMBERS. OTHERWISE, CL IS SET TO NOMINAL VALUES. C C N IS THE NUMBER OF EQUATIONS AND VARIABLES. C C NUMT(J) IS THE NUMBER OF TERMS IN EQUATION J, FOR J=1 TO N. C C KDEG(J,L,K) IS THE DEGREE OF THE L-TH VARIABLE, X(L), IN THE K-TH C TERM OF THE J-TH EQUATION, WHERE J=1 TO N, L=1 TO N+1, AND K=1 TO C NUMT(J). THE CASE "L=N+1" IS SPECIAL, AND KDEG IS NOT AN INPUT C VALUE TO POLSYS , BUT RATHER IS COMPUTED IN THIS SUBROUTINE. C C COEF(J,K) IS THE COEFFICIENT OF THE K-TH TERM FOR THE J-TH C EQUATION, WHERE J=1 TO N AND K=1 TO NUMT(J). C C NN IS THE DECLARED DIMENSION OF SEVERAL ARRAY INDICES. C C MMAXT IS AN UPPER BOUND FOR NUMT(J) FOR J=1 TO N. C C PAR AND IPAR ARE WORKSPACE ARRAYS. C C ON OUTPUT: C C IDEG(J) IS THE DEGREE OF THE J-TH EQUATION FOR J=1 TO N. C C FACV(J) IS THE SCALE FACTOR FOR THE J-TH VARIABLE. C C CL(2,1:N+1) IS AN ARRAY USED TO DEFINE THE PROJECTIVE C TRANSFORMATION. IT IS USED IN SUBROUTINES FFUNP AND OTPUTP C TO DEFINE THE PROJECTIVE COORDINATE, XNP1. C C PDG IS USED IN SUBROUTINE GFUNP TO DEFINE THE INITIAL SYSTEM, C G(X)=0. C C QDG IS USED IN SUBROUTINE GFUNP TO DEFINE THE INITIAL SYSTEM, C G(X)=0. C C R IS USED IN SUBROUTINE STRPTP TO GENERATE SOLUTIONS TO G(X)=0. C C C DECLARATIONS OF INPUT AND OUTPUT: INTEGER IFLG1,N,NUMT,KDEG,NN,MMAXT,IPAR,IDEG DOUBLE PRECISION COEF,PAR,FACV,CL,PDG,QDG,R DIMENSION NUMT(NN),KDEG(NN,NN+1,MMAXT),IDEG(N),COEF(NN,MMAXT), & PAR(2 + 28*N + 6*N**2 + 7*N*MMAXT + 4*N**2*MMAXT), & IPAR(42 + 2*N + N*(N+1)*MMAXT), & FACV(N),CL(2,N+1),PDG(2,N),QDG(2,N),R(2,N) C C DECLARATIONS OF VARIABLES: INTEGER I,IERR,IIDEG,J,JJ,K,L,N2,NP1 DOUBLE PRECISION P,Q,CCL,ZERO DIMENSION P(2,10),Q(2,10),CCL(2,11) C ZERO=0.0 N2 =2*N NP1=N+1 DO 15 J=1,N IDEG(J)=0 DO 15 K=1,NUMT(J) IIDEG=0 DO 12 L=1,N IIDEG=IIDEG+KDEG(J,L,K) 12 CONTINUE IF(IIDEG.GT.IDEG(J))IDEG(J)=IIDEG 15 CONTINUE DO 25 J=1,N DO 25 K=1,NUMT(J) IIDEG=0 DO 22 L=1,N IIDEG=IIDEG+KDEG(J,L,K) 22 CONTINUE KDEG(J,NP1,K)=IDEG(J)-IIDEG 25 CONTINUE IF ( IFLG1 .EQ. 10 .OR. IFLG1 .EQ. 00) THEN C C DON'T SCALE THE COEFFICIENTS. SET FACV EQUAL TO NOMINAL C VALUES. C DO 30 I=1,N FACV(I)=0.0 30 CONTINUE ELSE C C SET UP THE WORKSPACE FOR SUBROUTINE SCLGNP AND CALL SCLGNP TO C SCALE THE COEFFICIENTS. C C***************************************************************** C VARIABLES THAT ARE PASSED IN ARRAY PAR. C C VARIABLE NAME LENGTH OFFSET C C 1 CCOEF N*MMAXT 1 C 2 ALPHA 4*N**2 1+N*MMAXT C 3 BETA 2*N 1+N*MMAXT+4*N**2 C 4 RWORK N*(2*N+1) 1+N*MMAXT+4*N**2+2*N C 5 XWORK 2*N 1+N*MMAXT+4*N**2+2*N+N*(2*N+1) C 6 FACE N 1+N*MMAXT+4*N**2+4*N+N*(2*N+1) C 7 COESCL N*MMAXT 1+N*MMAXT+4*N**2+5*N+N*(2*N+1) C C***************************************************************** C VARIABLES THAT ARE PASSED IN ARRAY IPAR. C C VARIABLE NAME LENGTH OFFSET C C 1 NNUMT N 1 C 2 KKDEG N*(N+1)*MMAXT 1+N C C***************************************************************** C CALL SCLGNP(N,NN,MMAXT,NUMT,KDEG,0,ZERO,COEF, & IPAR(1), & IPAR(1+N), & PAR(1), & PAR(1+N*MMAXT), & PAR(1+N*MMAXT+4*N**2), & PAR(1+N*MMAXT+4*N**2+2*N), & PAR(1+N*MMAXT+4*N**2+2*N+N*(2*N+1)), & FACV, & PAR(1+N*MMAXT+4*N**2+4*N+N*(2*N+1)), & PAR(1+N*MMAXT+4*N**2+5*N+N*(2*N+1)), & IERR) C C SET COEF EQUAL TO THE SCALED COEFFICIENTS C IF (IERR .EQ. 0) THEN DO 40 J=1,N DO 40 K=1,NUMT(J) COEF(J,K)=PAR(N*MMAXT+4*N**2+5*N+N*(2*N+1) + J + N*(K-1)) 40 CONTINUE END IF END IF C P(1, 1)= .12324754231D0 P(2, 1)= .76253746298D0 P(1, 2)= .93857838950D0 P(2, 2)=-.99375892810D0 P(1, 3)=-.23467908356D0 P(2, 3)= .39383930009D0 P(1, 4)= .83542556622D0 P(2, 4)=-.10192888288D0 P(1, 5)=-.55763522521D0 P(2, 5)=-.83729899911D0 P(1, 6)=-.78348738738D0 P(2, 6)=-.10578234903D0 P(1, 7)= .03938347346D0 P(2, 7)= .04825184716D0 P(1, 8)=-.43428734331D0 P(2, 8)= .93836289418D0 P(1, 9)=-.99383729993D0 P(2, 9)=-.40947822291D0 P(1,10)= .09383736736D0 P(2,10)= .26459172298D0 C Q(1, 1)= .58720452864D0 Q(2, 1)= .01321964722D0 Q(1, 2)= .97884134700D0 Q(2, 2)=-.14433009712D0 Q(1, 3)= .39383737289D0 Q(2, 3)= .41543223411D0 Q(1, 4)=-.03938376373D0 Q(2, 4)=-.61253112318D0 Q(1, 5)= .39383737388D0 Q(2, 5)=-.26454678861D0 Q(1, 6)=-.00938376766D0 Q(2, 6)= .34447867861D0 Q(1, 7)=-.04837366632D0 Q(2, 7)= .48252736790D0 Q(1, 8)= .93725237347D0 Q(2, 8)=-.54356527623D0 Q(1, 9)= .39373957747D0 Q(2, 9)= .65573434564D0 Q(1,10)=-.39380038371D0 Q(2,10)= .98903450052D0 C CCL(1, 1)=-.03485644332D0 CCL(2, 1)= .28554634336D0 CCL(1, 2)= .91453454766D0 CCL(2, 2)= .35354566613D0 CCL(1, 3)=-.36568737635D0 CCL(2, 3)= .45634642477D0 CCL(1, 4)=-.89089767544D0 CCL(2, 4)= .34524523544D0 CCL(1, 5)= .13523462465D0 CCL(2, 5)= .43534535555D0 CCL(1, 6)=-.34523544445D0 CCL(2, 6)= .00734522256D0 CCL(1, 7)=-.80004678763D0 CCL(2, 7)=-.009387123644D0 CCL(1, 8)=-.875432124245D0 CCL(2, 8)= .00045687651D0 CCL(1, 9)= .65256352333D0 CCL(2, 9)=-.12356777452D0 CCL(1,10)= .09986798321548D0 CCL(2,10)=-.56753456577D0 CCL(1,11)= .29674947394739D0 CCL(2,11)= .93274302173D0 C C IF THE PROJECTIVE TRANSFORMATION IS TO BE USED, THEN CL IS C SET EQUAL TO THE CCL VALUES. OTHERWISE, CL IS SET C EQUAL TO NOMINAL VALUES. C IF (IFLG1 .EQ. 01 .OR. IFLG1 .EQ. 00) THEN DO 50 I=1,2 DO 50 J=1,N CL(I,J)=0.0 50 CONTINUE CL(1,NP1)=1.0 CL(2,NP1)=0.0 ELSE DO 60 J=1,NP1 JJ=MOD(J-1,11)+1 DO 60 I=1,2 CL(I,J)=CCL(I,JJ) 60 CONTINUE END IF C C COMPUTE POWERS OF P AND Q, AND R=Q/P DO 70 J=1,N JJ=MOD(J-1,10)+1 CALL POWP(IDEG(J),P(1,JJ),PDG(1,J)) CALL POWP(IDEG(J),Q(1,JJ),QDG(1,J)) CALL DIVP(Q(1,JJ),P(1,JJ),R(1,J),IERR) 70 CONTINUE RETURN END