CoCalc -- read

GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
gap4r8 / pkg / carat / carat-2.1b1 / functions / Datei / read_symbol.c
⁵⁶³⁵⁹⁵ views
1
#include "typedef.h"    
2

3
#include "matrix.h"
4
#include"getput.h"
5
#include"datei.h"
6
#include"longtools.h"
7

8
/**************************************************************************\
9
@---------------------------------------------------------------------------
10
@---------------------------------------------------------------------------
11
@ FILE: read_symbol.c
12
@---------------------------------------------------------------------------
13
@---------------------------------------------------------------------------
14
@
15
\**************************************************************************/
16
static void clear(merk)
17
char *merk;
18
{
19
  int i, k;
20
  k = strlen(merk);
21
  for(i=0; i<k; i++)
22
    merk[i] = '\0';
23
}
24

25

26
/**************************************************************************\
27
@---------------------------------------------------------------------------
28
@ symbol_out *read_symbol(file_name)
29
@ char *file_name;
30
@
31
@   reads the symbol for the Crystal-fammily used in the 'Datei' programm
32
@   and constructs the first almost decomposable group by reading the
33
@   atoms from the libary.
34
@---------------------------------------------------------------------------
35
@
36
\**************************************************************************/
37
symbol_out *read_symbol(file_name)
38
char *file_name;
39

40
{
41
char  string[80],
42
      slash, *str ;
43
char f[80];
44
/* changed from "static char fn[80]" to switch away from static variables */
45
char *fn;
46
char *dat;
47
FILE *infile;
48
int i, j, k, l, m, n, p, q, x, groesser;
49
int no;
50
int breite;
51
char merk[15];
52
char merk1[10];
53
int index;
54
char konst[MAXDIM][80];
55
int konst_dim;
56
int komp[MAXDIM];
57
int artgleich[MAXDIM];
58
int dim = 0, konstit = 0;
59
int zerleg[MAXDIM][5];
60
bravais_TYP **grps;
61
symbol_out *erg;
62
matrix_TYP *In;
63

64
/* it is assumed that string contains a 0-string, all not all
65
   compiler will asure that (inserted 24/4/97 tilman) */
66
for (i=0;i<80;i++) string[i] = 0;
67

68
/* inserted to switch away from static variables */
69
fn = (char *) calloc(80,sizeof(char));
70

71
/*------------------------------------------------------------*\
72
| Open input file               	         	       |
73
\*------------------------------------------------------------*/
74
if ( file_name == NULL )
75
	infile = stdin;
76
else
77
	if ( (infile = fopen (file_name, "r")) == NULL ) {
78
		fprintf (stderr, "read_symbol: Could not open input-file %s\n", file_name);
79
		exit (4);
80
		}
81
/*------------------------------------------------------------*\
82
| Read and scan header line										|
83
\*------------------------------------------------------------*/
84
for( i=0; i<MAXDIM; i++)
85
  komp[i] = 0;
86
for(i=0; i<MAXDIM; i++)
87
  for(j=0; j<5;j++)
88
    zerleg[i][j] = 0;
89
printf("Please input the symbol for the crystal-family: ");
90
fscanf (infile, "%[ \t\n]", string);
91
fscanf (infile, "%[^\n]",string);
92
strtok (string, "%");
93

94
right_order(string);
95

96
printf("%s\n",string);
97

98
str = string;
99
while( strlen(str) != 0)
100
{
101
  i = strcspn(str, ";,");
102
  if(i>0)
103
  {
104
    sscanf(str, "%d", &konst_dim);
105
    dim += konst_dim;
106
    if(dim > MAXDIM)
107
    {
108
       printf("dimension of a.d. bravais-group is to big\n");
109
       exit(3);
110
    }
111
    zerleg[konstit][0] = konst_dim;
112
    itoa(konst_dim, konst[konstit]);
113
    k = strcspn(str, ";");
114
    if(k == i)
115
      zerleg[konstit][3] = 1;
116
    j = strcspn(str, "-");
117
    l = strcspn(str, "'");
118
    if(j<i)
119
    {
120
       strcat(konst[konstit], "-");
121
       str = str+j+1;
122
       sscanf(str, "%d", &index);
123
       zerleg[konstit][1] = index;
124
       itoa(index, merk);
125
       strcat(konst[konstit], merk);
126
       clear(merk);
127
       if(l<i)
128
       {
129
         strcat(konst[konstit], "'");
130
         zerleg[konstit][2] = 1;
131
       }
132
       i = i-j-1;
133
    }
134
    konstit++;
135
  }
136
  str = str+i+1;
137
}
138

139
/*------------------------------------------------------------*\
140
| Close input file												|
141
\*------------------------------------------------------------*/
142
if ( infile != stdin )
143
	fclose (infile);
144

145
erg = (symbol_out *) malloc(sizeof(symbol_out));
146
erg->grp = (bravais_TYP *) calloc(1, sizeof(bravais_TYP));
147
erg->grp->dim = dim;
148

149
/*--------------------------------------------------------------------*\
150
|  swap the atoms into the right order                                 |
151
\*--------------------------------------------------------------------*/
152
for(i=0; i<MAXDIM-1; i++)
153
{
154
  if(zerleg[i][0] != zerleg[i+1][0] || zerleg[i][1] != zerleg[i+1][1] || zerleg[i][2]  != zerleg[i+1][2])
155
    zerleg[i][3] = 1;
156
}
157
if(zerleg[MAXDIM-1][0] != 0)
158
  zerleg[MAXDIM-1][3] = 1;
159
i=0;
160
while(i<MAXDIM)
161
{
162
  while( i< MAXDIM && zerleg[i][0] == 0)
163
    i++;
164
  k = 1;
165
  while(i<MAXDIM && zerleg[i][3] == 0 && zerleg[i][0] != 0)
166
  {  i++; k++;}
167
  if(i != MAXDIM)
168
    zerleg[i][4] = k;
169
  i++;
170
}
171
for(i=0; i<MAXDIM; i++)
172
{
173
  for(j=i+1; j<MAXDIM; j++)
174
  {
175
    groesser = 1;
176
    if(zerleg[i][4] == 0 && zerleg[j][4] != 0)
177
       groesser = 0;
178
    for(k=0; k<3 && zerleg[j][k] == zerleg[i][k]; k++);
179
    if(k == 0 && zerleg[i][k] < zerleg[j][k])
180
      groesser = 0;
181
    if(k == 1 && zerleg[i][1] > zerleg[j][1])
182
      groesser = 0;
183
    if(k == 2 && zerleg[i][2] < zerleg[j][2])
184
      groesser = 0;
185
    if(k == 3 && zerleg[i][4] < zerleg[j][4])
186
      groesser = 0;
187
    if(groesser == 0)
188
    {
189
      for(k=0; k<5; k++)
190
      {
191
         x = zerleg[i][k]; zerleg[i][k] = zerleg[j][k]; zerleg[j][k] = x;
192
      }
193
    }
194
  } 
195
}
196
/************************
197
for(i=0; i<konstit; i++)
198
{
199
  for(j=0; j<5; j++)
200
     printf("%d ", zerleg[i][j]);
201
  printf("\n");
202
}
203
*************************/
204

205
konstit = 0;
206
for(i=0; i<MAXDIM; i++)
207
{
208
  if(zerleg[i][4] != 0)
209
  {
210
    itoa(zerleg[i][0], konst[konstit]);
211
    if(zerleg[i][1] != 0)
212
    {
213
       strcat(konst[konstit], "-");
214
       itoa(zerleg[i][1], merk);
215
       strcat(konst[konstit], merk);
216
       clear(merk);
217
       if(zerleg[i][2] != 0)
218
         strcat(konst[konstit], "\'");
219
    }
220
    konstit++;
221
  }
222
}
223

224
/*--------------------------------------------------------------------*\
225
|  read the atoms                                                      |
226
\*--------------------------------------------------------------------*/
227
grps = (bravais_TYP **) malloc(konstit *sizeof(bravais_TYP *));
228
dat = ATOMS;
229
/**************
230
dat = TOPDIR "/lib/atoms/";
231
f = (char **) malloc(konstit *sizeof(char *));
232
***************/
233
for(i=0; i<konstit; i++)
234
{
235
   strcpy(f, dat);
236
   itoa(zerleg[i][0], merk);
237
   strcat(f, merk);
238
   if(zerleg[i][1] != 0)
239
   {
240
     strcat(f, "-");
241
     itoa(zerleg[i][1], merk);
242
     strcat(f, merk);
243
     clear(merk);
244
   }
245
   if(zerleg[i][2] != 0)
246
   {
247
     strcat(f, "\'");
248
   }    
249
   /* fprintf(stderr,"file-name: %s\n",f); */
250
   grps[i] = get_bravais(f);
251
   for(j=0; j<grps[i]->form_no; j++)
252
     Check_mat(grps[i]->form[j]);
253
}
254

255
/*--------------------------------------------------------------------*\
256
|  calculate the generators of erg->grp                                |
257
\*--------------------------------------------------------------------*/
258
erg->grp->gen_no = 0;
259
erg->grp->form_no = 0;
260
erg->grp->zentr_no = 0;
261
erg->grp->normal_no = 0;
262
for(i=0; i<konstit; i++)
263
  erg->grp->gen_no += grps[i]->gen_no;
264
erg->grp->gen = (matrix_TYP **)malloc(erg->grp->gen_no *sizeof(matrix_TYP));
265
for(i=0; i<erg->grp->gen_no; i++)
266
  erg->grp->gen[i]  = init_mat(erg->grp->dim, erg->grp->dim, "");
267
j=0;
268
p=0;
269
for(i=0; i<konstit; i++)
270
{
271
 for(k=0; k<grps[i]->gen_no; k++)
272
 {
273
  for(l=0; l<zerleg[i][4] * grps[i]->dim; l += grps[i]->dim)
274
  {
275
   for(m=0; m<grps[i]->dim; m++)
276
    for(n=0; n<grps[i]->dim; n++)
277
     erg->grp->gen[p+k]->array.SZ[j+l+m][j+l+n]=grps[i]->gen[k]->array.SZ[m][n];
278
  }
279
  for(m=0; m<j; m++)
280
     erg->grp->gen[p+k]->array.SZ[m][m] = 1;
281
  for(m=( j + zerleg[i][4] * grps[i]->dim); m<erg->grp->dim; m++)
282
     erg->grp->gen[p+k]->array.SZ[m][m] = 1;
283
 }
284
   j = j + zerleg[i][4] * grps[i]->dim; 
285
   p = p + grps[i]->gen_no;
286
}
287

288
/*--------------------------------------------------------------------*\
289
|  calculate the invariant forms of erg->grp                           |
290
\*--------------------------------------------------------------------*/
291
for(i=0; i<konstit; i++)
292
{
293
  for(j=0; j<grps[i]->form_no; j++)
294
  {
295
     if(grps[i]->form[j]->flags.Symmetric == TRUE)
296
        erg->grp->form_no += (zerleg[i][4] * (zerleg[i][4] +1)/2);
297
     if(grps[i]->form[j]->flags.Symmetric == FALSE)
298
        erg->grp->form_no += (zerleg[i][4] * (zerleg[i][4] -1)/2);
299
  }
300
}
301
erg->grp->form = (matrix_TYP **)malloc(erg->grp->form_no *sizeof(matrix_TYP *));
302
for(i=0; i<erg->grp->form_no; i++)
303
  erg->grp->form[i]  = init_mat(erg->grp->dim, erg->grp->dim, "");
304
j=0;
305
q=0;
306
for(i=0; i<konstit; i++)
307
{
308
 for(k=0; k<grps[i]->form_no; k++)
309
 {
310
  for(l=j; l< j+zerleg[i][4] * grps[i]->dim; l += grps[i]->dim)
311
  {
312
   if(grps[i]->form[k]->flags.Symmetric == TRUE)
313
   {
314
    for(n=0; n<grps[i]->dim; n++) 
315
    {
316
     for(p=0; p<grps[i]->dim; p++)
317
     {
318
       erg->grp->form[q]->array.SZ[l+n][l+p] = grps[i]->form[k]->array.SZ[n][p];
319
     }
320
    }
321
    q++;
322
   }
323
   for(m=(l+grps[i]->dim); m<(j+zerleg[i][4] * grps[i]->dim); m +=grps[i]->dim)
324
   {
325
    for(n=0; n<grps[i]->dim; n++) 
326
    {
327
     for(p=0; p<grps[i]->dim; p++)
328
     {
329
       erg->grp->form[q]->array.SZ[l+n][m+p] = grps[i]->form[k]->array.SZ[n][p];
330
       erg->grp->form[q]->array.SZ[m+p][l+n] = grps[i]->form[k]->array.SZ[n][p];
331
     }
332
    }
333
    q++;
334
   }
335
  }
336
 }
337
 j = j + zerleg[i][4] * grps[i]->dim; 
338
}
339
/* inserted 06/05/97 tilman: assure that the full integral lattice is passed */
340
long_rein_formspace(erg->grp->form,erg->grp->form_no,1);
341

342
/*--------------------------------------------------------------------*\
343
| calculate the centralizer of the group                               |
344
\*--------------------------------------------------------------------*/
345
for(i=0; i<konstit; i++)
346
{
347
  erg->grp->cen_no = erg->grp->cen_no + grps[i]->cen_no;
348
  if(zerleg[i][4] >= 2)
349
    erg->grp->cen_no = erg->grp->cen_no + grps[i]->zentr_no + 1;
350
  if(zerleg[i][4] > 2)
351
    erg->grp->cen_no ++;
352
}
353
erg->grp->cen = (matrix_TYP **)malloc(erg->grp->cen_no *sizeof(matrix_TYP));
354
for(i=0; i<erg->grp->cen_no; i++)
355
  erg->grp->cen[i]  = init_mat(erg->grp->dim, erg->grp->dim, "");
356
j=0;
357
no = 0;
358
for(i=0; i<konstit; i++)
359
{
360
   for(k=0; k<grps[i]->cen_no; k++)
361
   {
362
     for(l=0; l<j; l++)
363
       erg->grp->cen[no]->array.SZ[l][l] = 1;
364
     for(l=j+grps[i]->dim; l<erg->grp->dim; l++)
365
       erg->grp->cen[no]->array.SZ[l][l] = 1;
366
     for(l=0; l<grps[i]->dim; l++)
367
       for(m=0; m<grps[i]->dim; m++)
368
        erg->grp->cen[no]->array.SZ[j+l][j+m] = grps[i]->cen[k]->array.SZ[l][m];
369
     no++;
370
   }
371
   if(zerleg[i][4] >=2)
372
   {
373
     for(k=0; k<grps[i]->zentr_no; k++)
374
     {
375
       for(l=0; l<j; l++)
376
         erg->grp->cen[no]->array.SZ[l][l] = 1;
377
       for(l=j; l<j+grps[i]->dim; l++)
378
         erg->grp->cen[no]->array.SZ[l][l] = -1;
379
       for(l=j+grps[i]->dim; l<erg->grp->dim; l++)
380
         erg->grp->cen[no]->array.SZ[l][l] = 1;
381
       for(l=0; l<grps[i]->dim; l++)
382
          for(m=0; m<grps[i]->dim; m++)
383
            erg->grp->cen[no]->array.SZ[j+l+grps[i]->dim][j+m] = grps[i]->zentr[k]->array.SZ[l][m];
384
       no++;
385
     }
386
       for(l=0; l<j; l++)
387
         erg->grp->cen[no]->array.SZ[l][l] = 1;
388
       for(l=j+(2 * grps[i]->dim); l<erg->grp->dim; l++)
389
         erg->grp->cen[no]->array.SZ[l][l] = 1;
390
       for(l=0; l<grps[i]->dim; l++)
391
       {
392
          erg->grp->cen[no]->array.SZ[j+l+grps[i]->dim][j+l] = 1;
393
          erg->grp->cen[no]->array.SZ[j+l][j+l+grps[i]->dim] = 1;
394
       }
395
       no++;
396
   }
397
   if(zerleg[i][4] > 2)
398
   {
399
       for(l=0; l<j; l++)
400
         erg->grp->cen[no]->array.SZ[l][l] = 1;
401
       for(l=j+(zerleg[i][4] * grps[i]->dim); l<erg->grp->dim; l++)
402
         erg->grp->cen[no]->array.SZ[l][l] = 1;
403
       for(l=0; l< ((zerleg[i][4] -1) * grps[i]->dim); l++)
404
          erg->grp->cen[no]->array.SZ[l+j+grps[i]->dim][l+j] = 1;
405
       for(l=0; l<grps[i]->dim; l++)
406
          erg->grp->cen[no]->array.SZ[j+l][l+j+((zerleg[i][4]-1) * grps[i]->dim)] = 1;
407
     no++;
408
   }
409
   
410
   j = j + zerleg[i][4] * grps[i]->dim; 
411
}
412

413
/*--------------------------------------------------------------------*\
414
| calculate the normalizer of the group                               |
415
\*--------------------------------------------------------------------*/
416

417
for(i=0; i<konstit; i++)
418
{
419
        artgleich[i] = 0;
420
        erg->grp->normal_no += grps[i]->normal_no;
421
        if(i+1 < konstit)
422
        {
423
          if(zerleg[i][0] == zerleg[i+1][0] && zerleg[i][1] == zerleg[i+1][1] &&
424
             zerleg[i][2] == zerleg[i+1][2] && zerleg[i][3] == zerleg[i+1][3] &&
425
             zerleg[i][4] == zerleg[i+1][4])
426
          {
427
             artgleich[i] = TRUE;
428
             erg->grp->normal_no++;
429
          }
430
        }
431
}
432
erg->grp->normal = (matrix_TYP **)malloc(erg->grp->normal_no *sizeof(matrix_TYP));
433
for(i=0; i<erg->grp->normal_no; i++)
434
  erg->grp->normal[i]  = init_mat(erg->grp->dim, erg->grp->dim, "");
435
j=0;
436
no = 0;
437
for(i=0; i<konstit; i++)
438
{
439
   for(k=0; k<grps[i]->normal_no; k++)
440
   {
441
      for(l=0; l<j;l++)
442
        erg->grp->normal[no]->array.SZ[l][l] = 1;
443
      for(l=(j+zerleg[i][4] * grps[i]->dim); l<erg->grp->dim; l++)
444
        erg->grp->normal[no]->array.SZ[l][l] = 1;
445
      for(l=j; l< (j+zerleg[i][4] * grps[i]->dim); l += grps[i]->dim)
446
      {
447
         for(m=0; m<grps[i]->dim; m++)
448
           for(p=0; p<grps[i]->dim; p++)
449
         erg->grp->normal[no]->array.SZ[m+l][p+l] = grps[i]->normal[k]->array.SZ[m][p];
450
      }
451
      no++;
452
   }
453
   if(artgleich[i] == TRUE)
454
   {
455
     breite = grps[i]->dim * zerleg[i][4];
456
     for(l=0; l<j; l++)
457
       erg->grp->normal[no]->array.SZ[l][l] = 1;
458
     for(l=(j + 2 * breite); l<erg->grp->dim; l++)
459
       erg->grp->normal[no]->array.SZ[l][l] = 1;
460
     for(l=j; l< (j+breite); l++)
461
     {
462
       erg->grp->normal[no]->array.SZ[l][l+breite] = 1;
463
       erg->grp->normal[no]->array.SZ[l+breite][l] = 1;
464
     }
465
     no++;
466
   }
467
   j = j + zerleg[i][4] * grps[i]->dim; 
468
}
469

470
/*--------------------------------------------------------------------*\
471
| if no additional normalizer or centraliser nessecarry, put identity  |
472
\*--------------------------------------------------------------------*/
473
if(erg->grp->normal_no == 0 || erg->grp->cen_no == 0)
474
{
475
  if(erg->grp->normal_no == 0)
476
  {
477
     erg->grp->normal_no = 1;
478
     erg->grp->normal = (matrix_TYP **) malloc(1 *sizeof(matrix_TYP *));
479
     erg->grp->normal[0] = einheitsmatrix(erg->grp->dim);
480
  }
481
  if(erg->grp->cen_no == 0)
482
  {
483
     erg->grp->cen_no = 1;
484
     erg->grp->cen = (matrix_TYP **) malloc(1 *sizeof(matrix_TYP *));
485
     erg->grp->cen[0] = einheitsmatrix(erg->grp->dim);
486
  }
487
}
488

489
/*--------------------------------------------------------------------*\
490
| calculate the order of erg->grp                                      |
491
\*--------------------------------------------------------------------*/
492
for(j=0; j<100; j++)
493
  erg->grp->divisors[j] = 0;
494
erg->grp->order = 1;
495
for(i=0; i<konstit; i++)
496
{
497
  for(j=0; j<100; j++)
498
    erg->grp->divisors[j] += grps[i]->divisors[j];
499
  erg->grp->order *= grps[i]->order;
500
}
501

502
/*--------------------------------------------------------------------*\
503
| find file where erg->grp->zentr are stored                           |
504
\*--------------------------------------------------------------------*/
505
strcpy(fn, TABLEDIM);
506
/*********************************
507
strcpy(fn, TOPDIR "/lib/dim");
508
*********************************/
509
itoa(erg->grp->dim, merk);
510
strcat(fn, merk);
511
strcat(fn, "/");
512
for(i=0; i<konstit; i++)
513
{
514
  itoa(zerleg[i][0], merk);
515
  if(zerleg[i][1] != 0)
516
  {
517
    strcat(merk, "-");
518
    itoa(zerleg[i][1], merk1);
519
    strcat(merk, merk1);
520
  }
521
  if(zerleg[i][2] != 0)
522
    strcat(merk, "\'");
523
  for(j=0; j<zerleg[i][4]; j++)
524
  {
525
    strcat(fn, merk);
526
    if(j != (zerleg[i][4] -1))
527
      strcat(fn, ",");
528
    else
529
    {
530
      if(i!= (konstit -1))
531
        strcat(fn, ";");
532
    }
533
  }
534
}
535
erg->fn = fn;
536

537
/* printf("%s\n", erg->fn); */
538

539
 return(erg);
540
}
541
/*{{{}}}*/
542

543
Product

Resources

Company
