GridSolve: GridSolve/src/comm/ctoms380.c Source File

Go to the documentation of this file.
00001 #include "problem.h"
00002 
00003 /* C     ALGORITHM 380 COLLECTED ALGORITHMS FROM ACM. */
00004 /* C     ALGORITHM APPEARED IN COMM. ACM, VOL. 13, NO. 05, */
00005 /* C     P. 324. */
00006 void ctrans_(A0,M,N,MN,MOVE0,IWRK,IOK)
00007 char *A0;
00008 int M,N,MN,*MOVE0,IWRK,IOK;
00009 {
00010   char B;
00011   char *A = A0--;       /* Makes this 1 indexed */
00012   int *MOVE = MOVE0--;
00013   int NCOUNT,M2,I,IA,IB,KMI,K,MAX,I1,I2,N1,J1,J;
00014   
00015 /* C A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH */
00016 /* C CONTAINS THE M BY N MATRIX TO BE TRANSPOSED (STORED */
00017 /* C COLUMNWISE).MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK */
00018 /* C USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE */
00019 /* C VALUE IWRK=(M+N)/2 IS RECOMMENDED. IOK INDICATES THE */
00020 /* C SUCCESS OR FAILURE OF THE ROUTINE. */
00021 /* C NORMAL RETURN IOK=0 */
00022 /* C ERRORS           IOK=-1, MN NOT EQUAL TO M*N. */
00023 /* C                  IOK=-2, IWRK NEGATIVE OR ZERO. */
00024 /* C                  IOK.GT.0, (SHOULD NEVER OCCUR). IN THIS CASE */
00025 /* C WE SET IOK EQUAL TO THE FINAL VALUE OF I WHEN THE SEARCH */
00026 /* C IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED. */
00027 /*       DIMENSION A(MN),MOVE(IWRK) */
00028 /* C CHECK ARGUMENTS AND INITIALISE */
00029   if (M < 2 || N < 2) goto label60;
00030   if (MN != M*N) goto label92;
00031   if (IWRK < 1) goto label93;
00032   if (M == N) goto label70;
00033   NCOUNT=2;
00034   M2=M-2;
00035   for(I=1; I<=IWRK; I++) 
00036     MOVE[I] = 0;
00037   if (M2 < 1) goto label12;
00038 /* C COUNT NUMBER,NCOUNT, OF SINGLE POINTS. */
00039   for (IA=1; IA<=M2; IA++) {
00040     IB = IA*(N-1)/(M-1);
00041     if (IA*(N-1) != IB*(M-1)) goto label11;
00042     NCOUNT=NCOUNT+1;
00043     I=IA*N+IB;
00044     if (I > IWRK) goto label11;
00045     MOVE[I]=1;
00046   label11: 
00047     continue;
00048   }
00049  label12:
00050 /* C SET INITIAL VALUES FOR SEARCH. */
00051     K=MN-1;
00052     KMI=K-1;
00053     MAX=MN;
00054     I=1;
00055 /* C AT LEAST ONE LOOP MUST BE RE-ARRANGED. */
00056     goto label30;
00057 /* C SEARCH FOR LOOPS TO BE REARRANGED. */
00058  label20:
00059     MAX=K-I;
00060     I=I+1;
00061     KMI=K-I;
00062     if (I > MAX) goto label90;
00063     if (I > IWRK) goto label21;
00064     if (MOVE[I] < 1) goto label30;
00065     goto label20;
00066  label21:
00067     if (I == M*I-K*(I/N)) goto label20;
00068     I1=I;
00069  label22:
00070     I2=M*I1-K*(I1/N);
00071     if (I2 <= I || I2 >= MAX) goto label23;
00072     I1=I2;
00073     goto label22;
00074  label23:
00075     if (I2 != I) goto label20;
00076 /* C REARRANGE ELEMENTS OF A LOOP. */
00077  label30:
00078     I1=I;
00079  label31:
00080     B=A[I1+1];
00081  label32:
00082     I2=M*I1-K*(I1/N);
00083     if (I1 <= IWRK) MOVE[I1]=2;
00084  /*label33:*/
00085     NCOUNT=NCOUNT+1;
00086     if (I2 == I || I2 >= KMI) goto label35;
00087  label34:
00088     A[I1+1]=A[I2+1];
00089     I1=I2;
00090     goto label32;
00091  label35:
00092     if (MAX == KMI || I2 == I) goto label41;
00093     MAX=KMI;
00094     goto label34;
00095 /* C TEST FOR SYMMETRIC PAIR OF LOOPS. */
00096  label41:
00097     A[I1+1]=B;
00098     if (NCOUNT >= MN) goto label60;
00099     if (I2 == MAX || MAX == KMI) goto label20;
00100     MAX=KMI;
00101     I1=MAX;
00102     goto label31;
00103 /* C NORMAL RETURN. */
00104  label60:
00105     IOK=0;
00106     return;
00107 /* C IF MATRIX IS SQUARE, EXCHANGE ELEMENTS A(I,J) AND A(J,I). */
00108  label70:
00109     N1=N-1;
00110     for (I=1; I<=N1; I++) {
00111       J1=I+1;
00112       for (J=J1; J<=N; J++) {
00113     I1=I+(J-1)*N;
00114     I2=J+(I-1)*M;
00115     B=A[I1];
00116     A[I1]=A[I2];
00117     A[I2]=B;
00118       }
00119     }
00120     goto label60;
00121 /* C ERROR RETURNS. */
00122  label90:
00123     IOK=I;
00124  label91:
00125     return;
00126  label92:
00127     IOK=-1;
00128     goto label91;
00129  label93:
00130     IOK=-2;
00131     goto label91;
00132 }
00133  
00134 
00135 
00136 
00137 /* C     ALGORITHM 380 COLLECTED ALGORITHMS FROM ACM. */
00138 /* C     ALGORITHM APPEARED IN COMM. ACM, VOL. 13, NO. 05, */
00139 /* C     P. 324. */
00140 void dtrans_(A0,M,N,MN,MOVE0,IWRK,IOK)
00141 double *A0;
00142 int M,N,MN,*MOVE0,IWRK,IOK;
00143 {
00144   double B;
00145   double *A = A0--;     /* Makes this 1 indexed */
00146   int *MOVE = MOVE0--;
00147   int NCOUNT,M2,I,IA,IB,KMI,K,MAX,I1,I2,N1,J1,J;
00148   
00149 /* C A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH */
00150 /* C CONTAINS THE M BY N MATRIX TO BE TRANSPOSED (STORED */
00151 /* C COLUMNWISE).MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK */
00152 /* C USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE */
00153 /* C VALUE IWRK=(M+N)/2 IS RECOMMENDED. IOK INDICATES THE */
00154 /* C SUCCESS OR FAILURE OF THE ROUTINE. */
00155 /* C NORMAL RETURN IOK=0 */
00156 /* C ERRORS           IOK=-1, MN NOT EQUAL TO M*N. */
00157 /* C                  IOK=-2, IWRK NEGATIVE OR ZERO. */
00158 /* C                  IOK.GT.0, (SHOULD NEVER OCCUR). IN THIS CASE */
00159 /* C WE SET IOK EQUAL TO THE FINAL VALUE OF I WHEN THE SEARCH */
00160 /* C IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED. */
00161 /*       DIMENSION A(MN),MOVE(IWRK) */
00162 /* C CHECK ARGUMENTS AND INITIALISE */
00163   if (M < 2 || N < 2) goto label60;
00164   if (MN != M*N) goto label92;
00165   if (IWRK < 1) goto label93;
00166   if (M == N) goto label70;
00167   NCOUNT=2;
00168   M2=M-2;
00169   for(I=1; I<=IWRK; I++) 
00170     MOVE[I] = 0;
00171   if (M2 < 1) goto label12;
00172 /* C COUNT NUMBER,NCOUNT, OF SINGLE POINTS. */
00173   for (IA=1; IA<=M2; IA++) {
00174     IB = IA*(N-1)/(M-1);
00175     if (IA*(N-1) != IB*(M-1)) goto label11;
00176     NCOUNT=NCOUNT+1;
00177     I=IA*N+IB;
00178     if (I > IWRK) goto label11;
00179     MOVE[I]=1;
00180   label11: 
00181     continue;
00182   }
00183  label12:
00184 /* C SET INITIAL VALUES FOR SEARCH. */
00185     K=MN-1;
00186     KMI=K-1;
00187     MAX=MN;
00188     I=1;
00189 /* C AT LEAST ONE LOOP MUST BE RE-ARRANGED. */
00190     goto label30;
00191 /* C SEARCH FOR LOOPS TO BE REARRANGED. */
00192  label20:
00193     MAX=K-I;
00194     I=I+1;
00195     KMI=K-I;
00196     if (I > MAX) goto label90;
00197     if (I > IWRK) goto label21;
00198     if (MOVE[I] < 1) goto label30;
00199     goto label20;
00200  label21:
00201     if (I == M*I-K*(I/N)) goto label20;
00202     I1=I;
00203  label22:
00204     I2=M*I1-K*(I1/N);
00205     if (I2 <= I || I2 >= MAX) goto label23;
00206     I1=I2;
00207     goto label22;
00208  label23:
00209     if (I2 != I) goto label20;
00210 /* C REARRANGE ELEMENTS OF A LOOP. */
00211  label30:
00212     I1=I;
00213  label31:
00214     B=A[I1+1];
00215  label32:
00216     I2=M*I1-K*(I1/N);
00217     if (I1 <= IWRK) MOVE[I1]=2;
00218  /*label33:*/
00219     NCOUNT=NCOUNT+1;
00220     if (I2 == I || I2 >= KMI) goto label35;
00221  label34:
00222     A[I1+1]=A[I2+1];
00223     I1=I2;
00224     goto label32;
00225  label35:
00226     if (MAX == KMI || I2 == I) goto label41;
00227     MAX=KMI;
00228     goto label34;
00229 /* C TEST FOR SYMMETRIC PAIR OF LOOPS. */
00230  label41:
00231     A[I1+1]=B;
00232     if (NCOUNT >= MN) goto label60;
00233     if (I2 == MAX || MAX == KMI) goto label20;
00234     MAX=KMI;
00235     I1=MAX;
00236     goto label31;
00237 /* C NORMAL RETURN. */
00238  label60:
00239     IOK=0;
00240     return;
00241 /* C IF MATRIX IS SQUARE, EXCHANGE ELEMENTS A(I,J) AND A(J,I). */
00242  label70:
00243     N1=N-1;
00244     for (I=1; I<=N1; I++) {
00245       J1=I+1;
00246       for (J=J1; J<=N; J++) {
00247     I1=I+(J-1)*N;
00248     I2=J+(I-1)*M;
00249     B=A[I1];
00250     A[I1]=A[I2];
00251     A[I2]=B;
00252       }
00253     }
00254     goto label60;
00255 /* C ERROR RETURNS. */
00256  label90:
00257     IOK=I;
00258  label91:
00259     return;
00260  label92:
00261     IOK=-1;
00262     goto label91;
00263  label93:
00264     IOK=-2;
00265     goto label91;
00266 }
00267  
00268 
00269 
00270 
00271 /* C     ALGORITHM 380 COLLECTED ALGORITHMS FROM ACM. */
00272 /* C     ALGORITHM APPEARED IN COMM. ACM, VOL. 13, NO. 05, */
00273 /* C     P. 324. */
00274 void strans_(A0,M,N,MN,MOVE0,IWRK,IOK)
00275 float *A0;
00276 int M,N,MN,*MOVE0,IWRK,IOK;
00277 {
00278   float B;
00279   float *A = A0--;      /* Makes this 1 indexed */
00280   int *MOVE = MOVE0--;
00281   int NCOUNT,M2,I,IA,IB,KMI,K,MAX,I1,I2,N1,J1,J;
00282   
00283 /* C A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH */
00284 /* C CONTAINS THE M BY N MATRIX TO BE TRANSPOSED (STORED */
00285 /* C COLUMNWISE).MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK */
00286 /* C USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE */
00287 /* C VALUE IWRK=(M+N)/2 IS RECOMMENDED. IOK INDICATES THE */
00288 /* C SUCCESS OR FAILURE OF THE ROUTINE. */
00289 /* C NORMAL RETURN IOK=0 */
00290 /* C ERRORS           IOK=-1, MN NOT EQUAL TO M*N. */
00291 /* C                  IOK=-2, IWRK NEGATIVE OR ZERO. */
00292 /* C                  IOK.GT.0, (SHOULD NEVER OCCUR). IN THIS CASE */
00293 /* C WE SET IOK EQUAL TO THE FINAL VALUE OF I WHEN THE SEARCH */
00294 /* C IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED. */
00295 /*       DIMENSION A(MN),MOVE(IWRK) */
00296 /* C CHECK ARGUMENTS AND INITIALISE */
00297   if (M < 2 || N < 2) goto label60;
00298   if (MN != M*N) goto label92;
00299   if (IWRK < 1) goto label93;
00300   if (M == N) goto label70;
00301   NCOUNT=2;
00302   M2=M-2;
00303   for(I=1; I<=IWRK; I++) 
00304     MOVE[I] = 0;
00305   if (M2 < 1) goto label12;
00306 /* C COUNT NUMBER,NCOUNT, OF SINGLE POINTS. */
00307   for (IA=1; IA<=M2; IA++) {
00308     IB = IA*(N-1)/(M-1);
00309     if (IA*(N-1) != IB*(M-1)) goto label11;
00310     NCOUNT=NCOUNT+1;
00311     I=IA*N+IB;
00312     if (I > IWRK) goto label11;
00313     MOVE[I]=1;
00314   label11: 
00315     continue;
00316   }
00317  label12:
00318 /* C SET INITIAL VALUES FOR SEARCH. */
00319     K=MN-1;
00320     KMI=K-1;
00321     MAX=MN;
00322     I=1;
00323 /* C AT LEAST ONE LOOP MUST BE RE-ARRANGED. */
00324     goto label30;
00325 /* C SEARCH FOR LOOPS TO BE REARRANGED. */
00326  label20:
00327     MAX=K-I;
00328     I=I+1;
00329     KMI=K-I;
00330     if (I > MAX) goto label90;
00331     if (I > IWRK) goto label21;
00332     if (MOVE[I] < 1) goto label30;
00333     goto label20;
00334  label21:
00335     if (I == M*I-K*(I/N)) goto label20;
00336     I1=I;
00337  label22:
00338     I2=M*I1-K*(I1/N);
00339     if (I2 <= I || I2 >= MAX) goto label23;
00340     I1=I2;
00341     goto label22;
00342  label23:
00343     if (I2 != I) goto label20;
00344 /* C REARRANGE ELEMENTS OF A LOOP. */
00345  label30:
00346     I1=I;
00347  label31:
00348     B=A[I1+1];
00349  label32:
00350     I2=M*I1-K*(I1/N);
00351     if (I1 <= IWRK) MOVE[I1]=2;
00352  /*label33:*/
00353     NCOUNT=NCOUNT+1;
00354     if (I2 == I || I2 >= KMI) goto label35;
00355  label34:
00356     A[I1+1]=A[I2+1];
00357     I1=I2;
00358     goto label32;
00359  label35:
00360     if (MAX == KMI || I2 == I) goto label41;
00361     MAX=KMI;
00362     goto label34;
00363 /* C TEST FOR SYMMETRIC PAIR OF LOOPS. */
00364  label41:
00365     A[I1+1]=B;
00366     if (NCOUNT >= MN) goto label60;
00367     if (I2 == MAX || MAX == KMI) goto label20;
00368     MAX=KMI;
00369     I1=MAX;
00370     goto label31;
00371 /* C NORMAL RETURN. */
00372  label60:
00373     IOK=0;
00374     return;
00375 /* C IF MATRIX IS SQUARE, EXCHANGE ELEMENTS A(I,J) AND A(J,I). */
00376  label70:
00377     N1=N-1;
00378     for (I=1; I<=N1; I++) {
00379       J1=I+1;
00380       for (J=J1; J<=N; J++) {
00381     I1=I+(J-1)*N;
00382     I2=J+(I-1)*M;
00383     B=A[I1];
00384     A[I1]=A[I2];
00385     A[I2]=B;
00386       }
00387     }
00388     goto label60;
00389 /* C ERROR RETURNS. */
00390  label90:
00391     IOK=I;
00392  label91:
00393     return;
00394  label92:
00395     IOK=-1;
00396     goto label91;
00397  label93:
00398     IOK=-2;
00399     goto label91;
00400 }
00401  
00402 
00403 
00404 
00405 
00406 /* C     ALGORITHM 380 COLLECTED ALGORITHMS FROM ACM. */
00407 /* C     ALGORITHM APPEARED IN COMM. ACM, VOL. 13, NO. 05, */
00408 /* C     P. 324. */
00409 void itrans_(A0,M,N,MN,MOVE0,IWRK,IOK)
00410 int *A0;
00411 int M,N,MN,*MOVE0,IWRK,IOK;
00412 {
00413   int B;
00414   int *A = A0--;        /* Makes this 1 indexed */
00415   int *MOVE = MOVE0--;
00416   int NCOUNT,M2,I,IA,IB,KMI,K,MAX,I1,I2,N1,J1,J;
00417   
00418 /* C A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH */
00419 /* C CONTAINS THE M BY N MATRIX TO BE TRANSPOSED (STORED */
00420 /* C COLUMNWISE).MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK */
00421 /* C USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE */
00422 /* C VALUE IWRK=(M+N)/2 IS RECOMMENDED. IOK INDICATES THE */
00423 /* C SUCCESS OR FAILURE OF THE ROUTINE. */
00424 /* C NORMAL RETURN IOK=0 */
00425 /* C ERRORS           IOK=-1, MN NOT EQUAL TO M*N. */
00426 /* C                  IOK=-2, IWRK NEGATIVE OR ZERO. */
00427 /* C                  IOK.GT.0, (SHOULD NEVER OCCUR). IN THIS CASE */
00428 /* C WE SET IOK EQUAL TO THE FINAL VALUE OF I WHEN THE SEARCH */
00429 /* C IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED. */
00430 /*       DIMENSION A(MN),MOVE(IWRK) */
00431 /* C CHECK ARGUMENTS AND INITIALISE */
00432   if (M < 2 || N < 2) goto label60;
00433   if (MN != M*N) goto label92;
00434   if (IWRK < 1) goto label93;
00435   if (M == N) goto label70;
00436   NCOUNT=2;
00437   M2=M-2;
00438   for(I=1; I<=IWRK; I++) 
00439     MOVE[I] = 0;
00440   if (M2 < 1) goto label12;
00441 /* C COUNT NUMBER,NCOUNT, OF SINGLE POINTS. */
00442   for (IA=1; IA<=M2; IA++) {
00443     IB = IA*(N-1)/(M-1);
00444     if (IA*(N-1) != IB*(M-1)) goto label11;
00445     NCOUNT=NCOUNT+1;
00446     I=IA*N+IB;
00447     if (I > IWRK) goto label11;
00448     MOVE[I]=1;
00449   label11: 
00450     continue;
00451   }
00452  label12:
00453 /* C SET INITIAL VALUES FOR SEARCH. */
00454     K=MN-1;
00455     KMI=K-1;
00456     MAX=MN;
00457     I=1;
00458 /* C AT LEAST ONE LOOP MUST BE RE-ARRANGED. */
00459     goto label30;
00460 /* C SEARCH FOR LOOPS TO BE REARRANGED. */
00461  label20:
00462     MAX=K-I;
00463     I=I+1;
00464     KMI=K-I;
00465     if (I > MAX) goto label90;
00466     if (I > IWRK) goto label21;
00467     if (MOVE[I] < 1) goto label30;
00468     goto label20;
00469  label21:
00470     if (I == M*I-K*(I/N)) goto label20;
00471     I1=I;
00472  label22:
00473     I2=M*I1-K*(I1/N);
00474     if (I2 <= I || I2 >= MAX) goto label23;
00475     I1=I2;
00476     goto label22;
00477  label23:
00478     if (I2 != I) goto label20;
00479 /* C REARRANGE ELEMENTS OF A LOOP. */
00480  label30:
00481     I1=I;
00482  label31:
00483     B=A[I1+1];
00484  label32:
00485     I2=M*I1-K*(I1/N);
00486     if (I1 <= IWRK) MOVE[I1]=2;
00487  /*label33:*/
00488     NCOUNT=NCOUNT+1;
00489     if (I2 == I || I2 >= KMI) goto label35;
00490  label34:
00491     A[I1+1]=A[I2+1];
00492     I1=I2;
00493     goto label32;
00494  label35:
00495     if (MAX == KMI || I2 == I) goto label41;
00496     MAX=KMI;
00497     goto label34;
00498 /* C TEST FOR SYMMETRIC PAIR OF LOOPS. */
00499  label41:
00500     A[I1+1]=B;
00501     if (NCOUNT >= MN) goto label60;
00502     if (I2 == MAX || MAX == KMI) goto label20;
00503     MAX=KMI;
00504     I1=MAX;
00505     goto label31;
00506 /* C NORMAL RETURN. */
00507  label60:
00508     IOK=0;
00509     return;
00510 /* C IF MATRIX IS SQUARE, EXCHANGE ELEMENTS A(I,J) AND A(J,I). */
00511  label70:
00512     N1=N-1;
00513     for (I=1; I<=N1; I++) {
00514       J1=I+1;
00515       for (J=J1; J<=N; J++) {
00516     I1=I+(J-1)*N;
00517     I2=J+(I-1)*M;
00518     B=A[I1];
00519     A[I1]=A[I2];
00520     A[I2]=B;
00521       }
00522     }
00523     goto label60;
00524 /* C ERROR RETURNS. */
00525  label90:
00526     IOK=I;
00527  label91:
00528     return;
00529  label92:
00530     IOK=-1;
00531     goto label91;
00532  label93:
00533     IOK=-2;
00534     goto label91;
00535 }
00536  
00537 
00538 
00539 
00540 /* C     ALGORITHM 380 COLLECTED ALGORITHMS FROM ACM. */
00541 /* C     ALGORITHM APPEARED IN COMM. ACM, VOL. 13, NO. 05, */
00542 /* C     P. 324. */
00543 void dctrans_(A0,M,N,MN,MOVE0,IWRK,IOK)
00544 gs_dcomplex *A0;
00545 int M,N,MN,*MOVE0,IWRK,IOK;
00546 {
00547   gs_dcomplex B;
00548   gs_dcomplex *A = A0--;        /* Makes this 1 indexed */
00549   int *MOVE = MOVE0--;
00550   int NCOUNT,M2,I,IA,IB,KMI,K,MAX,I1,I2,N1,J1,J;
00551   
00552 /* C A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH */
00553 /* C CONTAINS THE M BY N MATRIX TO BE TRANSPOSED (STORED */
00554 /* C COLUMNWISE).MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK */
00555 /* C USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE */
00556 /* C VALUE IWRK=(M+N)/2 IS RECOMMENDED. IOK INDICATES THE */
00557 /* C SUCCESS OR FAILURE OF THE ROUTINE. */
00558 /* C NORMAL RETURN IOK=0 */
00559 /* C ERRORS           IOK=-1, MN NOT EQUAL TO M*N. */
00560 /* C                  IOK=-2, IWRK NEGATIVE OR ZERO. */
00561 /* C                  IOK.GT.0, (SHOULD NEVER OCCUR). IN THIS CASE */
00562 /* C WE SET IOK EQUAL TO THE FINAL VALUE OF I WHEN THE SEARCH */
00563 /* C IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED. */
00564 /*       DIMENSION A(MN),MOVE(IWRK) */
00565 /* C CHECK ARGUMENTS AND INITIALISE */
00566   if (M < 2 || N < 2) goto label60;
00567   if (MN != M*N) goto label92;
00568   if (IWRK < 1) goto label93;
00569   if (M == N) goto label70;
00570   NCOUNT=2;
00571   M2=M-2;
00572   for(I=1; I<=IWRK; I++) 
00573     MOVE[I] = 0;
00574   if (M2 < 1) goto label12;
00575 /* C COUNT NUMBER,NCOUNT, OF SINGLE POINTS. */
00576   for (IA=1; IA<=M2; IA++) {
00577     IB = IA*(N-1)/(M-1);
00578     if (IA*(N-1) != IB*(M-1)) goto label11;
00579     NCOUNT=NCOUNT+1;
00580     I=IA*N+IB;
00581     if (I > IWRK) goto label11;
00582     MOVE[I]=1;
00583   label11: 
00584     continue;
00585   }
00586  label12:
00587 /* C SET INITIAL VALUES FOR SEARCH. */
00588     K=MN-1;
00589     KMI=K-1;
00590     MAX=MN;
00591     I=1;
00592 /* C AT LEAST ONE LOOP MUST BE RE-ARRANGED. */
00593     goto label30;
00594 /* C SEARCH FOR LOOPS TO BE REARRANGED. */
00595  label20:
00596     MAX=K-I;
00597     I=I+1;
00598     KMI=K-I;
00599     if (I > MAX) goto label90;
00600     if (I > IWRK) goto label21;
00601     if (MOVE[I] < 1) goto label30;
00602     goto label20;
00603  label21:
00604     if (I == M*I-K*(I/N)) goto label20;
00605     I1=I;
00606  label22:
00607     I2=M*I1-K*(I1/N);
00608     if (I2 <= I || I2 >= MAX) goto label23;
00609     I1=I2;
00610     goto label22;
00611  label23:
00612     if (I2 != I) goto label20;
00613 /* C REARRANGE ELEMENTS OF A LOOP. */
00614  label30:
00615     I1=I;
00616  label31:
00617     B.r=A[I1+1].r;
00618     B.i=A[I1+1].i;
00619  label32:
00620     I2=M*I1-K*(I1/N);
00621     if (I1 <= IWRK) MOVE[I1]=2;
00622  /*label33:*/
00623     NCOUNT=NCOUNT+1;
00624     if (I2 == I || I2 >= KMI) goto label35;
00625  label34:
00626     A[I1+1].r=A[I2+1].r;
00627     A[I1+1].i=A[I2+1].i;
00628     I1=I2;
00629     goto label32;
00630  label35:
00631     if (MAX == KMI || I2 == I) goto label41;
00632     MAX=KMI;
00633     goto label34;
00634 /* C TEST FOR SYMMETRIC PAIR OF LOOPS. */
00635  label41:
00636     A[I1+1].r=B.r;
00637     A[I1+1].i=B.i;
00638     if (NCOUNT >= MN) goto label60;
00639     if (I2 == MAX || MAX == KMI) goto label20;
00640     MAX=KMI;
00641     I1=MAX;
00642     goto label31;
00643 /* C NORMAL RETURN. */
00644  label60:
00645     IOK=0;
00646     return;
00647 /* C IF MATRIX IS SQUARE, EXCHANGE ELEMENTS A(I,J) AND A(J,I). */
00648  label70:
00649     N1=N-1;
00650     for (I=1; I<=N1; I++) {
00651       J1=I+1;
00652       for (J=J1; J<=N; J++) {
00653     I1=I+(J-1)*N;
00654     I2=J+(I-1)*M;
00655     B.r=A[I1].r;
00656     B.i=A[I1].i;
00657     A[I1].r=A[I2].r;
00658     A[I1].i=A[I2].i;
00659     A[I2].r=B.r;
00660     A[I2].i=B.i;
00661       }
00662     }
00663     goto label60;
00664 /* C ERROR RETURNS. */
00665  label90:
00666     IOK=I;
00667  label91:
00668     return;
00669  label92:
00670     IOK=-1;
00671     goto label91;
00672  label93:
00673     IOK=-2;
00674     goto label91;
00675 }
00676  
00677 
00678 
00679 /* C     ALGORITHM 380 COLLECTED ALGORITHMS FROM ACM. */
00680 /* C     ALGORITHM APPEARED IN COMM. ACM, VOL. 13, NO. 05, */
00681 /* C     P. 324. */
00682 void sctrans_(A0,M,N,MN,MOVE0,IWRK,IOK)
00683 gs_scomplex *A0;
00684 int M,N,MN,*MOVE0,IWRK,IOK;
00685 {
00686   gs_scomplex B;
00687   gs_scomplex *A = A0--;        /* Makes this 1 indexed */
00688   int *MOVE = MOVE0--;
00689   int NCOUNT,M2,I,IA,IB,KMI,K,MAX,I1,I2,N1,J1,J;
00690   
00691 /* C A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH */
00692 /* C CONTAINS THE M BY N MATRIX TO BE TRANSPOSED (STORED */
00693 /* C COLUMNWISE).MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK */
00694 /* C USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE */
00695 /* C VALUE IWRK=(M+N)/2 IS RECOMMENDED. IOK INDICATES THE */
00696 /* C SUCCESS OR FAILURE OF THE ROUTINE. */
00697 /* C NORMAL RETURN IOK=0 */
00698 /* C ERRORS           IOK=-1, MN NOT EQUAL TO M*N. */
00699 /* C                  IOK=-2, IWRK NEGATIVE OR ZERO. */
00700 /* C                  IOK.GT.0, (SHOULD NEVER OCCUR). IN THIS CASE */
00701 /* C WE SET IOK EQUAL TO THE FINAL VALUE OF I WHEN THE SEARCH */
00702 /* C IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED. */
00703 /*       DIMENSION A(MN),MOVE(IWRK) */
00704 /* C CHECK ARGUMENTS AND INITIALISE */
00705   if (M < 2 || N < 2) goto label60;
00706   if (MN != M*N) goto label92;
00707   if (IWRK < 1) goto label93;
00708   if (M == N) goto label70;
00709   NCOUNT=2;
00710   M2=M-2;
00711   for(I=1; I<=IWRK; I++) 
00712     MOVE[I] = 0;
00713   if (M2 < 1) goto label12;
00714 /* C COUNT NUMBER,NCOUNT, OF SINGLE POINTS. */
00715   for (IA=1; IA<=M2; IA++) {
00716     IB = IA*(N-1)/(M-1);
00717     if (IA*(N-1) != IB*(M-1)) goto label11;
00718     NCOUNT=NCOUNT+1;
00719     I=IA*N+IB;
00720     if (I > IWRK) goto label11;
00721     MOVE[I]=1;
00722   label11: 
00723     continue;
00724   }
00725  label12:
00726 /* C SET INITIAL VALUES FOR SEARCH. */
00727     K=MN-1;
00728     KMI=K-1;
00729     MAX=MN;
00730     I=1;
00731 /* C AT LEAST ONE LOOP MUST BE RE-ARRANGED. */
00732     goto label30;
00733 /* C SEARCH FOR LOOPS TO BE REARRANGED. */
00734  label20:
00735     MAX=K-I;
00736     I=I+1;
00737     KMI=K-I;
00738     if (I > MAX) goto label90;
00739     if (I > IWRK) goto label21;
00740     if (MOVE[I] < 1) goto label30;
00741     goto label20;
00742  label21:
00743     if (I == M*I-K*(I/N)) goto label20;
00744     I1=I;
00745  label22:
00746     I2=M*I1-K*(I1/N);
00747     if (I2 <= I || I2 >= MAX) goto label23;
00748     I1=I2;
00749     goto label22;
00750  label23:
00751     if (I2 != I) goto label20;
00752 /* C REARRANGE ELEMENTS OF A LOOP. */
00753  label30:
00754     I1=I;
00755  label31:
00756     B.r=A[I1+1].r;
00757     B.i=A[I1+1].i;
00758  label32:
00759     I2=M*I1-K*(I1/N);
00760     if (I1 <= IWRK) MOVE[I1]=2;
00761  /*label33:*/
00762     NCOUNT=NCOUNT+1;
00763     if (I2 == I || I2 >= KMI) goto label35;
00764  label34:
00765     A[I1+1].r=A[I2+1].r;
00766     A[I1+1].i=A[I2+1].i;
00767     I1=I2;
00768     goto label32;
00769  label35:
00770     if (MAX == KMI || I2 == I) goto label41;
00771     MAX=KMI;
00772     goto label34;
00773 /* C TEST FOR SYMMETRIC PAIR OF LOOPS. */
00774  label41:
00775     A[I1+1].r=B.r;
00776     A[I1+1].i=B.i;
00777     if (NCOUNT >= MN) goto label60;
00778     if (I2 == MAX || MAX == KMI) goto label20;
00779     MAX=KMI;
00780     I1=MAX;
00781     goto label31;
00782 /* C NORMAL RETURN. */
00783  label60:
00784     IOK=0;
00785     return;
00786 /* C IF MATRIX IS SQUARE, EXCHANGE ELEMENTS A(I,J) AND A(J,I). */
00787  label70:
00788     N1=N-1;
00789     for (I=1; I<=N1; I++) {
00790       J1=I+1;
00791       for (J=J1; J<=N; J++) {
00792     I1=I+(J-1)*N;
00793     I2=J+(I-1)*M;
00794     B.r=A[I1].r;
00795     B.i=A[I1].i;
00796     A[I1].r=A[I2].r;
00797     A[I1].i=A[I2].i;
00798     A[I2].r=B.r;
00799     A[I2].i=B.i;
00800       }
00801     }
00802     goto label60;
00803 /* C ERROR RETURNS. */
00804  label90:
00805     IOK=I;
00806  label91:
00807     return;
00808  label92:
00809     IOK=-1;
00810     goto label91;
00811  label93:
00812     IOK=-2;
00813     goto label91;
00814 }
00815  
00816 
00817