share/hompack/fortran/initp.f

   1       SUBROUTINE INITP(IFLG1,N,NUMT,KDEG,COEF,NN,MMAXT,PAR,IPAR,
   2      &                                 IDEG,FACV,CL,PDG,QDG,R)
   3 C
   4 C INITP  INITIALIZES THE CONSTANTS THAT DEFINE THE POLSYS HOMOTOPY,
   5 C INITIALIZES THE CONSTANTS THAT DEFINE THE PROJECTIVE TRANSFORMATION,
   6 C AND SCALES THE COEFFICIENTS (IF SCALING IS SPECIFIED).
   7 C
   8 C ON INPUT:
   9 C
  10 C IFLG1  IS A FLAG THAT SPECIFIES WHETHER THE COEFFICIENTS ARE TO
  11 C   BE SCALED OR NOT AND WHETHER THE PROJECTIVE TRANSFORMATION IS TO
  12 C   BE USED OR NOT.  IFLG1=A*10+B.  SCALING IS SPECIFIED WHEN B=1.  THE
  13 C   PROJECTIVE TRANSFORMATION IS SPECIFIED WHEN A=1.  OTHERWISE, A AND/OR
  14 C   B =0.  SCALING IS EVOKED BY A CALL TO THE SUBROUTINE  SCLGNP.  THE
  15 C   PROJECTIVE TRANSFORMATION IS EVOKED BY SETTING THE  CL  ARRAY EQUAL
  16 C   TO RANDOM COMPLEX NUMBERS.  OTHERWISE,  CL  IS SET TO NOMINAL VALUES.
  17 C
  18 C N  IS THE NUMBER OF EQUATIONS AND VARIABLES.
  19 C
  20 C NUMT(J)  IS THE NUMBER OF TERMS IN EQUATION J, FOR J=1 TO N.
  21 C
  22 C KDEG(J,L,K)  IS THE DEGREE OF THE L-TH VARIABLE, X(L), IN THE K-TH
  23 C  TERM OF THE J-TH EQUATION, WHERE J=1 TO N, L=1 TO N+1, AND K=1 TO
  24 C  NUMT(J).  THE CASE "L=N+1" IS SPECIAL, AND  KDEG  IS NOT AN INPUT
  25 C  VALUE TO  POLSYS , BUT RATHER IS COMPUTED IN THIS SUBROUTINE.
  26 C
  27 C COEF(J,K)  IS THE COEFFICIENT OF THE K-TH TERM FOR THE J-TH
  28 C   EQUATION, WHERE J=1 TO N AND K=1 TO NUMT(J).
  29 C
  30 C NN  IS THE DECLARED DIMENSION OF SEVERAL ARRAY INDICES.
  31 C
  32 C MMAXT  IS AN UPPER BOUND FOR NUMT(J) FOR J=1 TO N.
  33 C
  34 C PAR  AND  IPAR  ARE WORKSPACE ARRAYS.
  35 C
  36 C ON OUTPUT:
  37 C
  38 C IDEG(J)  IS THE DEGREE OF THE J-TH EQUATION FOR J=1 TO N.
  39 C
  40 C FACV(J)  IS THE SCALE FACTOR FOR THE J-TH VARIABLE.
  41 C
  42 C CL(2,1:N+1)  IS AN ARRAY USED TO DEFINE THE PROJECTIVE
  43 C   TRANSFORMATION.  IT IS USED IN SUBROUTINES  FFUNP  AND  OTPUTP
  44 C   TO DEFINE THE PROJECTIVE COORDINATE, XNP1.
  45 C
  46 C PDG  IS USED IN SUBROUTINE  GFUNP  TO DEFINE THE INITIAL SYSTEM,
  47 C   G(X)=0.
  48 C
  49 C QDG  IS USED IN SUBROUTINE  GFUNP  TO DEFINE THE INITIAL SYSTEM,
  50 C   G(X)=0.
  51 C
  52 C R  IS USED IN SUBROUTINE  STRPTP  TO GENERATE SOLUTIONS TO G(X)=0.
  53 C
  54 C
  55 C DECLARATIONS OF INPUT AND OUTPUT:
  56       INTEGER IFLG1,N,NUMT,KDEG,NN,MMAXT,IPAR,IDEG
  57       DOUBLE PRECISION COEF,PAR,FACV,CL,PDG,QDG,R
  58       DIMENSION NUMT(NN),KDEG(NN,NN+1,MMAXT),IDEG(N),COEF(NN,MMAXT),
  59      &  PAR(2 + 28*N + 6*N**2 + 7*N*MMAXT + 4*N**2*MMAXT),
  60      &  IPAR(42 + 2*N + N*(N+1)*MMAXT),
  61      &  FACV(N),CL(2,N+1),PDG(2,N),QDG(2,N),R(2,N)
  62 C
  63 C DECLARATIONS OF VARIABLES:
  64       INTEGER I,IERR,IIDEG,J,JJ,K,L,N2,NP1
  65       DOUBLE PRECISION P,Q,CCL,ZERO
  66       DIMENSION P(2,10),Q(2,10),CCL(2,11)
  67 C
  68       ZERO=0.0
  69       N2 =2*N
  70       NP1=N+1
  71       DO 15 J=1,N
  72          IDEG(J)=0
  73          DO 15 K=1,NUMT(J)
  74              IIDEG=0
  75              DO 12 L=1,N
  76                 IIDEG=IIDEG+KDEG(J,L,K)
  77  12          CONTINUE
  78              IF(IIDEG.GT.IDEG(J))IDEG(J)=IIDEG
  79  15      CONTINUE
  80       DO 25 J=1,N
  81          DO 25 K=1,NUMT(J)
  82              IIDEG=0
  83              DO 22 L=1,N
  84                 IIDEG=IIDEG+KDEG(J,L,K)
  85  22          CONTINUE
  86              KDEG(J,NP1,K)=IDEG(J)-IIDEG
  87  25      CONTINUE
  88       IF ( IFLG1 .EQ. 10  .OR.  IFLG1 .EQ. 00) THEN
  89 C
  90 C       DON'T SCALE THE COEFFICIENTS.  SET  FACV  EQUAL TO NOMINAL
  91 C       VALUES.
  92 C
  93         DO 30 I=1,N
  94            FACV(I)=0.0
  95   30    CONTINUE
  96       ELSE
  97 C
  98 C SET UP THE WORKSPACE FOR SUBROUTINE  SCLGNP  AND CALL  SCLGNP  TO
  99 C SCALE THE COEFFICIENTS.
 100 C
 101 C*****************************************************************
 102 C VARIABLES THAT ARE PASSED IN ARRAY PAR.
 103 C
 104 C    VARIABLE NAME   LENGTH        OFFSET
 105 C
 106 C    1   CCOEF       N*MMAXT       1
 107 C    2   ALPHA       4*N**2        1+N*MMAXT
 108 C    3   BETA        2*N           1+N*MMAXT+4*N**2
 109 C    4   RWORK       N*(2*N+1)     1+N*MMAXT+4*N**2+2*N
 110 C    5   XWORK       2*N           1+N*MMAXT+4*N**2+2*N+N*(2*N+1)
 111 C    6   FACE        N             1+N*MMAXT+4*N**2+4*N+N*(2*N+1)
 112 C    7   COESCL      N*MMAXT       1+N*MMAXT+4*N**2+5*N+N*(2*N+1)
 113 C
 114 C*****************************************************************
 115 C VARIABLES THAT ARE PASSED IN ARRAY IPAR.
 116 C
 117 C    VARIABLE NAME       LENGTH               OFFSET
 118 C
 119 C    1   NNUMT             N                  1
 120 C    2   KKDEG             N*(N+1)*MMAXT      1+N
 121 C
 122 C*****************************************************************
 123 C
 124         CALL SCLGNP(N,NN,MMAXT,NUMT,KDEG,0,ZERO,COEF,
 125      &   IPAR(1),
 126      &   IPAR(1+N),
 127      &    PAR(1),
 128      &    PAR(1+N*MMAXT),
 129      &    PAR(1+N*MMAXT+4*N**2),
 130      &    PAR(1+N*MMAXT+4*N**2+2*N),
 131      &    PAR(1+N*MMAXT+4*N**2+2*N+N*(2*N+1)),
 132      &     FACV,
 133      &    PAR(1+N*MMAXT+4*N**2+4*N+N*(2*N+1)),
 134      &    PAR(1+N*MMAXT+4*N**2+5*N+N*(2*N+1)),
 135      &     IERR)
 136 C
 137 C       SET COEF EQUAL TO THE SCALED COEFFICIENTS
 138 C
 139         IF (IERR .EQ. 0) THEN
 140           DO 40 J=1,N
 141             DO 40 K=1,NUMT(J)
 142               COEF(J,K)=PAR(N*MMAXT+4*N**2+5*N+N*(2*N+1) + J + N*(K-1))
 143  40       CONTINUE
 144         END IF
 145       END IF
 146 C
 147       P(1, 1)= .12324754231D0
 148           P(2, 1)= .76253746298D0
 149       P(1, 2)= .93857838950D0
 150           P(2, 2)=-.99375892810D0
 151       P(1, 3)=-.23467908356D0
 152           P(2, 3)= .39383930009D0
 153       P(1, 4)= .83542556622D0
 154           P(2, 4)=-.10192888288D0
 155       P(1, 5)=-.55763522521D0
 156           P(2, 5)=-.83729899911D0
 157       P(1, 6)=-.78348738738D0
 158           P(2, 6)=-.10578234903D0
 159       P(1, 7)= .03938347346D0
 160           P(2, 7)= .04825184716D0
 161       P(1, 8)=-.43428734331D0
 162           P(2, 8)= .93836289418D0
 163       P(1, 9)=-.99383729993D0
 164           P(2, 9)=-.40947822291D0
 165       P(1,10)= .09383736736D0
 166           P(2,10)= .26459172298D0
 167 C
 168       Q(1, 1)= .58720452864D0
 169           Q(2, 1)= .01321964722D0
 170       Q(1, 2)= .97884134700D0
 171           Q(2, 2)=-.14433009712D0
 172       Q(1, 3)= .39383737289D0
 173           Q(2, 3)= .41543223411D0
 174       Q(1, 4)=-.03938376373D0
 175           Q(2, 4)=-.61253112318D0
 176       Q(1, 5)= .39383737388D0
 177           Q(2, 5)=-.26454678861D0
 178       Q(1, 6)=-.00938376766D0
 179           Q(2, 6)= .34447867861D0
 180       Q(1, 7)=-.04837366632D0
 181           Q(2, 7)= .48252736790D0
 182       Q(1, 8)= .93725237347D0
 183           Q(2, 8)=-.54356527623D0
 184       Q(1, 9)= .39373957747D0
 185           Q(2, 9)= .65573434564D0
 186       Q(1,10)=-.39380038371D0
 187           Q(2,10)= .98903450052D0
 188 C
 189       CCL(1, 1)=-.03485644332D0
 190           CCL(2, 1)= .28554634336D0
 191       CCL(1, 2)= .91453454766D0
 192           CCL(2, 2)= .35354566613D0
 193       CCL(1, 3)=-.36568737635D0
 194           CCL(2, 3)= .45634642477D0
 195       CCL(1, 4)=-.89089767544D0
 196           CCL(2, 4)= .34524523544D0
 197       CCL(1, 5)= .13523462465D0
 198           CCL(2, 5)= .43534535555D0
 199       CCL(1, 6)=-.34523544445D0
 200           CCL(2, 6)= .00734522256D0
 201       CCL(1, 7)=-.80004678763D0
 202           CCL(2, 7)=-.009387123644D0
 203       CCL(1, 8)=-.875432124245D0
 204           CCL(2, 8)= .00045687651D0
 205       CCL(1, 9)= .65256352333D0
 206           CCL(2, 9)=-.12356777452D0
 207       CCL(1,10)= .09986798321548D0
 208           CCL(2,10)=-.56753456577D0
 209       CCL(1,11)= .29674947394739D0
 210           CCL(2,11)= .93274302173D0
 211 C
 212 C IF THE PROJECTIVE TRANSFORMATION IS TO BE USED, THEN  CL  IS
 213 C SET EQUAL TO THE  CCL  VALUES.  OTHERWISE,  CL  IS SET
 214 C EQUAL TO NOMINAL VALUES.
 215 C
 216       IF (IFLG1 .EQ. 01  .OR.  IFLG1 .EQ. 00) THEN
 217           DO 50 I=1,2
 218           DO 50 J=1,N
 219             CL(I,J)=0.0
 220  50       CONTINUE
 221           CL(1,NP1)=1.0
 222           CL(2,NP1)=0.0
 223       ELSE
 224           DO 60 J=1,NP1
 225             JJ=MOD(J-1,11)+1
 226           DO 60 I=1,2
 227             CL(I,J)=CCL(I,JJ)
 228   60      CONTINUE
 229       END IF
 230 C
 231 C COMPUTE POWERS OF P AND Q, AND R=Q/P
 232       DO 70 J=1,N
 233         JJ=MOD(J-1,10)+1
 234         CALL POWP(IDEG(J),P(1,JJ),PDG(1,J))
 235         CALL POWP(IDEG(J),Q(1,JJ),QDG(1,J))
 236         CALL DIVP(Q(1,JJ),P(1,JJ),R(1,J),IERR)
 237   70  CONTINUE
 238       RETURN
 239       END