1 /***********************************************************************
2 *
3 *               *****   ***    ***
4 *                  *   *   *  *   *
5 *                 *     ***    ***
6 *                *     *   *  *   *
7 *               *****   ***    ***
8 *
9 * A FREE Finite Elements Analysis Program in ANSI C for the Windows &
10 * the UNIX OS.
11 *
12 * Composed and edited and copyright by
13 * Professor Dr.-Ing. Frank Rieg, University of Bayreuth, Germany
14 *
15 * eMail:
16 * frank.rieg@uni-bayreuth.de
17 * dr.frank.rieg@t-online.de
18 *
19 * V15.0  November 18, 2015
20 *
21 * This program is free software; you can redistribute it and/or modify
22 * it under the terms of the GNU General Public License as published by
23 * the Free Software Foundation; either version 2, or (at your option)
24 * any later version.
25 *
26 * This program is distributed in the hope that it will be useful,
27 * but WITHOUT ANY WARRANTY; without even the implied warranty of
28 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
29 * GNU General Public License for more details.
30 *
31 * You should have received a copy of the GNU General Public License
32 * along with this program; see the file COPYING.  If not, write to
33 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
34 ***********************************************************************/
35 /***********************************************************************
36 * Z88H
37 * 14.12.2015 Rieg
38 * Cuthill-McKee Algorithmus fuer Z88I1.TXT, Z88I2.TXT und Z88I5.TXT.
39 ***********************************************************************/
40 
41 /***********************************************************************
42 * Includes UNIX
43 ***********************************************************************/
44 #ifdef FR_UNIX
45 #include <z88h.h>
46 #include <stdio.h>
47 #include <stdlib.h>
48 #include <string.h>
49 #endif
50 
51 /***********************************************************************
52 * Formatbeschreiber
53 ***********************************************************************/
54 #ifdef FR_XINT
55 #define CFORMA "%s %d"
56 #define PDB "%d "
57 #define PD "%d"
58 #define PD9B "%9d "
59 #define PD9 "%9d"
60 #endif
61 
62 #ifdef FR_XLONG
63 #define CFORMA "%s %ld"
64 #define PDB "%ld "
65 #define PD "%ld"
66 #define PD9B "%9ld "
67 #define PD9 "%9ld"
68 #endif
69 
70 #ifdef FR_XLOLO
71 #define CFORMA "%s %lld"
72 #define PDB "%lld "
73 #define PD "%lld"
74 #define PD9B "%9lld "
75 #define PD9 "%9lld"
76 #endif
77 
78 #ifdef FR_XDOUB
79 #define PFB "%lf "
80 #define PF "%lf"
81 #define PE13B "%+#13.5lE "
82 #define PE13 "%+#13.5lE"
83 #endif
84 
85 #ifdef FR_XQUAD
86 #define PFB "%Lf "
87 #define PF "%Lf"
88 #define PE13B "%+#13.5LE "
89 #define PE13 "%+#13.5LE"
90 #endif
91 
92 /****************************************************************************
93 *  globale Variable
94 ****************************************************************************/
95 /*--------------------------------------------------------------------------
96 * Files
97 *-------------------------------------------------------------------------*/
98 FILE *fdyn,*fwlo;
99 
100 char cdyn[8] = "z88.dyn";
101 char clgd[9] = "z88h.log";
102 
103 /*--------------------------------------------------------------------------
104 * Variable
105 *-------------------------------------------------------------------------*/
106 FR_INT4 ICFLAG=1;   /* Reverse Cuthill-McKee fest eingestellt */
107 FR_INT4 LANG;
108 FR_INT4 MAXGRA,MAXNDL;
109 FR_INT4 iqflag;
110 
111 /***********************************************************************
112 * Functions
113 ***********************************************************************/
114 int who88h(void);
115 int z882cut(void);
116 int cut88(void);
117 int cut2z88(void);
118 int rdy88h(void);
119 int ale88h(int);
120 int wrim88h(FR_INT4,int);
121 int wlog88h(FR_INT4,int);
122 int lan88h(void);
123 void stop88h(void);
124 FR_INT4 max(FR_INT4,FR_INT4);
125 FR_INT4 min(FR_INT4,FR_INT4);
126 
127 /***********************************************************************
128 * Typen
129 ***********************************************************************/
130 typedef  int  BOOL;
131 
132 #define TRUE 1
133 #define FALSE 0
134 
135 /***********************************************************************
136 * Main
137 ***********************************************************************/
main(void)138 int main(void)
139 {
140 int iret;
141 
142 /*---------------------------------------------------------------------------
143 *  Die Sprache feststellen
144 *--------------------------------------------------------------------------*/
145 LANG = 0;
146 iret= lan88h();
147 
148 if(iret != 0)
149   {
150   ale88h(iret);
151   stop88h();
152   }
153 
154 /*---------------------------------------------------------------------------
155 *  Ueberschrift
156 *--------------------------------------------------------------------------*/
157 who88h();
158 
159 /*---------------------------------------------------------------------------
160 *  Hauptroutine
161 *--------------------------------------------------------------------------*/
162               iret= z882cut();    /* Z88I1.TXT in Z88H.IN */
163 if(iret == 0) iret= cut88();      /* Cuthill-McKee --> Z88H.OUT */
164 if(iret == 0) iret= cut2z88();    /* Z88I1.TXT + Z88I2.TXT umbauen */
165 
166 return iret;
167 }
168 
169 /***********************************************************************
170 * Z882CUT
171 ***********************************************************************/
z882cut(void)172 int z882cut(void)
173 {
174 extern FR_INT4 iqflag;
175 
176 FILE *fz88i1,*fcut,*fz88i5;
177 
178 FR_INT4 nkp,ndim,ne,newnum,ianz,nfg,kflag,npr;
179 FR_INT4 koi[21];
180 FR_INT4 idummy,ityp;
181 FR_INT4 i;
182 
183 char cstring[255];
184 char cfcut[]="z88h.in";
185 char cfi1[]= "z88i1.txt";
186 char cfi5[]= "z88i5.txt";
187 
188 /*----------------------------------------------------------------------
189 * Files oeffnen
190 *---------------------------------------------------------------------*/
191 /*======================================================================
192 * Z88H.IN
193 *=====================================================================*/
194 if ((fcut=fopen(cfcut,"w"))==NULL)
195   {
196   ale88h(AL_NOIN);
197   wlog88h(0,LOG_NOIN);
198   return 1;
199   }
200 else
201   wrim88h(0,TX_INOPEN);
202 
203 rewind(fcut);
204 
205 /*======================================================================
206 * Z88I1.TXT
207 *=====================================================================*/
208 if ((fz88i1=fopen(cfi1,"r"))==NULL)
209   {
210   ale88h(AL_NOI1);
211   return 1;
212   }
213 else
214   wrim88h(0,TX_I1OPEN);
215 
216 rewind(fz88i1);
217 
218 /*======================================================================
219 * Z88I5.TXT
220 *=====================================================================*/
221 if ((fz88i5=fopen(cfi5,"r"))==NULL)
222   {
223   ale88h(AL_NOI5);
224   return 1;
225   }
226 else
227   wrim88h(0,TX_I5OPEN);
228 
229 rewind(fz88i5);
230 
231 /*----------------------------------------------------------------------
232 * Vorbereiten
233 *---------------------------------------------------------------------*/
234 newnum= -1;                            /* nur eine Startnummer */
235 
236 fgets(cstring,254,fz88i1);
237 sscanf(cstring,PDB PDB PDB PD,&ndim,&nkp,&ne,&nfg);
238 
239 fprintf(fcut,PD9B PD9 "\n",nkp,newnum);
240 
241 fgets(cstring,254,fz88i5);
242 sscanf(cstring,PD,&npr);
243 
244 if(npr > 0) iqflag= 1;
245 else        iqflag= 0;
246 
247 /*----------------------------------------------------------------------
248 * 1. Durchlauf: Rewind, Leerlesen Koordinaten, Elementtyp feststellen
249 *---------------------------------------------------------------------*/
250 rewind(fz88i1);
251 
252 fgets(cstring,254,fz88i1);             /* leerlesen 1. Zeile */
253 
254 for(i = 1;i <= nkp; i++)               /* leerlesen Koordinaten */
255   fgets(cstring,254,fz88i1);
256 
257 fgets(cstring,254,fz88i1);
258 sscanf(cstring,PDB PD,&idummy,&ityp); /* Typ des 1.Elements */
259 
260 /*----------------------------------------------------------------------
261 * 2. Durchlauf: Rewind, Leerlesen Koordinaten
262 *---------------------------------------------------------------------*/
263 rewind(fz88i1);
264 
265 fgets(cstring,254,fz88i1);             /* leerlesen 1. Zeile */
266 
267 for(i = 1;i <= nkp; i++)               /* leerlesen Koordinaten */
268   fgets(cstring,254,fz88i1);
269 
270 /*----------------------------------------------------------------------
271 * Schreiben der Elemente Nr.1, Nr.7, Nr.8, Nr.20 und Nr.23
272 *---------------------------------------------------------------------*/
273 if (ityp == 1 || ityp == 7 || ityp == 8 || ityp == 20 || ityp == 23)
274   {
275   ianz= 8;
276   fprintf(fcut,PD "\n",ianz);
277 
278   for (i = 1; i <= ne; i++)
279     {
280     fgets (cstring,254,fz88i1);
281     sscanf(cstring,PDB PD,&idummy,&ityp);
282     fgets (cstring,254,fz88i1);
283 
284     sscanf(cstring,PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
285     &koi[1],&koi[2],&koi[3],&koi[4],&koi[5],&koi[6],&koi[7],&koi[8],&koi[9],&koi[10]);
286 
287     fprintf(fcut,PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
288     koi[1],koi[2],koi[3],koi[4],koi[5],koi[6],koi[7],koi[8],koi[9],koi[10]);
289     }
290   fprintf(fcut, "-1 0 0 0 0 0 0 0 0 0\n");
291   goto L999;
292   }
293 
294 /*----------------------------------------------------------------------
295 * Schreiben der Balken Nr.2, 13, 25, Welle Nr.5, Stab Nr.4, Nr.9
296 *---------------------------------------------------------------------*/
297 if (ityp == 2 || ityp == 4  || ityp == 5
298  || ityp == 9 || ityp == 13 || ityp == 25)
299   {
300   ianz= 2;
301   fprintf(fcut,PD "\n",ianz);
302 
303   for (i = 1; i <= ne; i++)
304     {
305     fgets (cstring,254,fz88i1);
306     sscanf(cstring,PDB PD,&idummy,&ityp);
307     fgets (cstring,254,fz88i1);
308 
309     sscanf(cstring,PDB PD,&koi[1],&koi[2]);
310 
311     fprintf(fcut,PD9B PD9 "\n",koi[1],koi[2]);
312     }
313   fprintf(fcut, "-1 0\n");
314   goto L999;
315   }
316 
317 /*----------------------------------------------------------------------
318 * Schreiben der Dreiecke Nr.3, 14, 15, 18 und 24
319 *---------------------------------------------------------------------*/
320 if (ityp == 3 || ityp == 14 || ityp == 15 || ityp == 18 || ityp == 24)
321   {
322   ianz= 6;
323   fprintf(fcut,PD "\n",ianz);
324 
325   for (i = 1; i <= ne; i++)
326     {
327     fgets (cstring,254,fz88i1);
328     sscanf(cstring,PDB PD,&idummy,&ityp);
329     fgets (cstring,254,fz88i1);
330 
331     sscanf(cstring,PDB PDB PDB PDB PDB PD,
332     &koi[1],&koi[2],&koi[3],&koi[4],&koi[5],&koi[6]);
333 
334     fprintf(fcut,PD9B PD9B PD9B PD9B PD9B PD9 "\n",
335     koi[1],koi[2],koi[3],koi[4],koi[5],koi[6]);
336     }
337   fprintf(fcut, "-1 0 0 0 0 0\n");
338   goto L999;
339   }
340 
341 /*----------------------------------------------------------------------
342 * Schreiben der Torus Nr.6
343 *---------------------------------------------------------------------*/
344 if (ityp == 6)
345   {
346   ianz= 3;
347   fprintf(fcut,PD "\n",ianz);
348 
349   for (i = 1; i <= ne; i++)
350     {
351     fgets (cstring,254,fz88i1);
352     sscanf(cstring,PDB PD,&idummy,&ityp);
353     fgets (cstring,254,fz88i1);
354 
355     sscanf(cstring,PDB PDB PD,&koi[1],&koi[2],&koi[3]);
356 
357     fprintf(fcut,PD9B PD9B PD9 "\n",koi[1],koi[2],koi[3]);
358     }
359   fprintf(fcut, "-1 0 0 0 0 0\n");
360   goto L999;
361   }
362 
363 /*----------------------------------------------------------------------
364 * Schreiben der Hexaeder Typ 10
365 *---------------------------------------------------------------------*/
366 if (ityp == 10)
367   {
368   ianz= 20;
369   fprintf(fcut,PD "\n",ianz);
370 
371   for (i = 1; i <= ne; i++)
372     {
373     fgets (cstring,254,fz88i1);
374     sscanf(cstring,PDB PD,&idummy,&ityp);
375     fgets (cstring,254,fz88i1);
376 
377     sscanf(cstring,
378     PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
379     &koi[ 1],&koi[ 2],&koi[ 3],&koi[ 4],&koi[ 5],
380     &koi[ 6],&koi[ 7],&koi[ 8],&koi[ 9],&koi[10],
381     &koi[11],&koi[12],&koi[13],&koi[14],&koi[15],
382     &koi[16],&koi[17],&koi[18],&koi[19],&koi[20]);
383 
384     fprintf(fcut,PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B
385  PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
386     koi[ 1],koi[ 2],koi[ 3],koi[ 4],koi[ 5],
387     koi[ 6],koi[ 7],koi[ 8],koi[ 9],koi[10],
388     koi[11],koi[12],koi[13],koi[14],koi[15],
389     koi[16],koi[17],koi[18],koi[19],koi[20]);
390     }
391   fprintf(fcut, "-1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0\n");
392   goto L999;
393   }
394 
395 /*----------------------------------------------------------------------
396 * Schreiben der Platte Typ 19 und der Volumenschale 21
397 *---------------------------------------------------------------------*/
398 if (ityp == 19 || ityp == 21)
399   {
400   ianz= 16;
401   fprintf(fcut,PD "\n",ianz);
402 
403   for (i = 1; i <= ne; i++)
404     {
405     fgets (cstring,254,fz88i1);
406     sscanf(cstring,PDB PD,&idummy,&ityp);
407     fgets (cstring,254,fz88i1);
408 
409     sscanf(cstring,PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
410     &koi[ 1],&koi[ 2],&koi[ 3],&koi[ 4],&koi[ 5],&koi[ 6],&koi[ 7],&koi[ 8],
411     &koi[ 9],&koi[10],&koi[11],&koi[12],&koi[13],&koi[14],&koi[15],&koi[16]);
412 
413     fprintf(fcut,PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B
414  PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
415     koi[ 1],koi[ 2],koi[ 3],koi[ 4],koi[ 5],koi[ 6],koi[ 7],koi[ 8],
416     koi[ 9],koi[10],koi[11],koi[12],koi[13],koi[14],koi[15],koi[16]);
417     }
418   fprintf(fcut, "-1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0\n");
419   goto L999;
420   }
421 
422 /*----------------------------------------------------------------------
423 * Schreiben der Scheiben Nr.11,Torus Nr.12 u. Volumenschale 22
424 *---------------------------------------------------------------------*/
425 if (ityp == 11 || ityp == 12 || ityp == 22)
426   {
427   ianz= 12;
428   fprintf(fcut,PD "\n",ianz);
429 
430   for (i = 1; i <= ne; i++)
431     {
432     fgets (cstring,254,fz88i1);
433     sscanf(cstring,PDB PD,&idummy,&ityp);
434     fgets (cstring,254,fz88i1);
435 
436     sscanf(cstring,PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
437     &koi[ 1],&koi[ 2],&koi[ 3],&koi[ 4],&koi[ 5], &koi[ 6],
438     &koi[ 7],&koi[ 8],&koi[ 9],&koi[10],&koi[11],&koi[12]);
439 
440     fprintf(fcut,PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
441     koi[ 1],koi[ 2],koi[ 3],koi[ 4],koi[ 5],koi[ 6],
442     koi[ 7],koi[ 8],koi[ 9],koi[10],koi[11],koi[12]);
443     }
444   fprintf(fcut, "-1 0 0 0 0 0 0 0 0 0 0 0\n");
445   goto L999;
446   }
447 
448 /*----------------------------------------------------------------------
449 * Schreiben der Tetraeder Nr.16
450 *---------------------------------------------------------------------*/
451 if (ityp == 16)
452   {
453   ianz= 10;
454   fprintf(fcut,PD "\n",ianz);
455 
456   for (i = 1; i <= ne; i++)
457     {
458     fgets (cstring, 254,fz88i1);
459     sscanf(cstring,PDB PD,&idummy,&ityp);
460     fgets (cstring,254,fz88i1);
461 
462     sscanf(cstring,PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
463     &koi[1],&koi[2],&koi[3],&koi[4],&koi[5],
464     &koi[6],&koi[7],&koi[8],&koi[9],&koi[10]);
465 
466     fprintf(fcut,PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
467     koi[1],koi[2],koi[3],koi[4],koi[5],
468     koi[6],koi[7],koi[8],koi[9],koi[10]);
469     }
470   fprintf(fcut, "-1 0 0 0 0 0 0 0 0 0\n");
471   goto L999;
472   }
473 
474 /*----------------------------------------------------------------------
475 * Schreiben der Tetraeder Nr.17
476 *---------------------------------------------------------------------*/
477 if (ityp == 17)
478   {
479   ianz= 4;
480   fprintf(fcut,PD "\n",ianz);
481 
482   for (i = 1; i <= ne; i++)
483     {
484     fgets (cstring,254,fz88i1);
485     sscanf(cstring,PDB PD,&idummy,&ityp);
486     fgets (cstring,254,fz88i1);
487 
488     sscanf(cstring,PDB PDB PDB PD,&koi[1],&koi[2],&koi[3],&koi[4]);
489     fprintf(fcut,PD9B PD9B PD9B PD9 "\n",koi[1],koi[2],koi[3],koi[4]);
490     }
491   fprintf(fcut, "-1 0 0 0\n");
492   goto L999;
493   }
494 
495 /*----------------------------------------------------------------------
496 * Files schliessen
497 *---------------------------------------------------------------------*/
498 L999:;
499 
500 fprintf(fcut, "-1\n");
501 fclose(fz88i1);
502 fclose(fz88i5);
503 fclose(fcut);
504 
505 return 0;
506 }
507 
508 /***********************************************************************
509 * CUT88
510 ***********************************************************************/
cut88(void)511 int cut88(void)
512 {
513 extern FR_INT4 MAXGRA,MAXNDL;
514 
515 FILE *fcut,*fpermdat;
516 
517 FR_INT4 *igraph,*igrad,*istart;
518 FR_INT4 *neu,*irneu,*neuin,*irneuin;
519 FR_INT4 *level,*ipermb,*iperme;
520 
521 FR_INT4 np[21];
522 
523 FR_INT4 nkp,maxgr,ndl;
524 FR_INT4 igradzp,ifcm,ifrcm,krcm;
525 FR_INT4 isizegr,neunum,nknot,izeile= 0;
526 FR_INT4 i,j,k,is,nzp,nnp,maxgd,mingd;
527 FR_INT4 nstart,levs,leve,nlev,l;
528 FR_INT4 mingr,m,nprcm,nprrcm,nzprcm,iflag=0;
529 
530 int iret;
531 
532 BOOL *num;
533 
534 char cpermdat[]="z88h.out";
535 char cutfile[]= "z88h.in";
536 char cstring[255];
537 
538 /*----------------------------------------------------------------------
539 * File- Operationen
540 *---------------------------------------------------------------------*/
541 if((fpermdat=fopen(cpermdat,"w"))==NULL)
542   {
543   ale88h(AL_NOOUT);;
544   return 1;
545   }
546 else
547   wrim88h(0,TX_OUTOPEN);
548 
549 rewind(fpermdat);
550 
551 if((fcut=fopen(cutfile,"r"))==NULL)
552   {
553   ale88h(AL_NOIN);
554   return 1;
555   }
556 else
557   wrim88h(0,TX_INOPEN);
558 
559 rewind(fcut);
560 
561 /*----------------------------------------------------------------------
562 * max. Groesse maxgr und ndl
563 *---------------------------------------------------------------------*/
564 iret= rdy88h();
565 if(iret != 0)
566   {
567   ale88h(iret);
568 #ifdef FR_WIN
569   return(iret);
570 #endif
571 #ifdef FR_UNIX
572   stop88h();
573 #endif
574   }
575 
576 maxgr= MAXGRA;
577 ndl=   MAXNDL;
578 
579 /*----------------------------------------------------------------------
580 * File- Operationen
581 *---------------------------------------------------------------------*/
582 fgets(cstring,254,fcut);
583 sscanf(cstring,PDB PD,&nkp,&neunum); /* neunum = -1 */
584 
585 isizegr= (maxgr+1)*(nkp+1);            /* +1 wg. FORTAN 77 */
586 
587 /*----------------------------------------------------------------------
588 * Memory anlegen
589 *---------------------------------------------------------------------*/
590 if(((igraph =(FR_INT4 *)calloc((size_t)isizegr,sizeof(FR_INT4)))==NULL) ||
591    ((igrad  =(FR_INT4 *)calloc((size_t)(nkp+1),sizeof(FR_INT4)))==NULL) ||
592    ((istart =(FR_INT4 *)calloc((size_t)(nkp+1),sizeof(FR_INT4)))==NULL) ||
593    ((neu    =(FR_INT4 *)calloc((size_t)(nkp+1),sizeof(FR_INT4)))==NULL) ||
594    ((irneu  =(FR_INT4 *)calloc((size_t)(nkp+1),sizeof(FR_INT4)))==NULL) ||
595    ((neuin  =(FR_INT4 *)calloc((size_t)(nkp+1),sizeof(FR_INT4)))==NULL) ||
596    ((irneuin=(FR_INT4 *)calloc((size_t)(nkp+1),sizeof(FR_INT4)))==NULL) ||
597    ((level  =(FR_INT4 *)calloc((size_t)(ndl+1),sizeof(FR_INT4)))==NULL) ||
598    ((ipermb =(FR_INT4 *)calloc((size_t)(nkp+1),sizeof(FR_INT4)))==NULL) ||
599    ((iperme =(FR_INT4 *)calloc((size_t)(nkp+1),sizeof(FR_INT4)))==NULL) ||
600    ((num    =(BOOL *)   calloc((size_t)(nkp+1),sizeof(BOOL   )))==NULL) )
601   {
602   ale88h(AL_NOMEM);
603   wlog88h(0,LOG_NOMEM);
604   return 1;
605   }
606 
607 wrim88h(0,TX_MEMOK);
608 
609 /*----------------------------------------------------------------------
610 * Aufbau des Graphen auf Grund Knotennummern der Elemente
611 *---------------------------------------------------------------------*/
612 L30:;
613 
614 fgets(cstring,254,fcut);
615 sscanf(cstring,PD,&nknot);
616 
617 if (nknot > 0)
618   {
619   L40:;
620   fgets(cstring,254,fcut);
621   izeile++;
622 
623   if (nknot == 2)
624     sscanf(cstring,PDB PD,&np[1],&np[2]);
625 
626   if (nknot == 3)
627     sscanf(cstring,PDB PDB PD,&np[1],&np[2],&np[3]);
628 
629   if (nknot == 4)
630     sscanf(cstring,PDB PDB PDB PD,&np[1],&np[2],&np[3],&np[4]);
631 
632   if (nknot == 6)
633     sscanf(cstring,PDB PDB PDB PDB PDB PD,
634     &np[1],&np[2],&np[3],&np[4],&np[5],&np[6]);
635 
636   if (nknot == 8)
637     sscanf(cstring,PDB PDB PDB PDB PDB PDB PDB PD,&np[1],&np[2],&np[3],
638     &np[4],&np[5],&np[6],&np[7],&np[8]);
639 
640   if (nknot == 10)
641     sscanf(cstring,PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
642     &np[1],&np[2],&np[3],&np[4],&np[5],
643     &np[6],&np[7],&np[8],&np[9],&np[10]);
644 
645   if (nknot == 12)
646     sscanf(cstring,PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
647     &np[ 1],&np[ 2],&np[ 3],&np[ 4],&np[ 5],&np[ 6],
648     &np[ 7],&np[ 8],&np[ 9],&np[10],&np[11],&np[12]);
649 
650   if (nknot == 16)
651     sscanf(cstring,PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
652     &np[ 1],&np[ 2],&np[ 3],&np[ 4],&np[ 5],&np[ 6],&np[ 7],&np[ 8],
653     &np[ 9],&np[10],&np[11],&np[12],&np[13],&np[14],&np[15],&np[16]);
654 
655   if (nknot == 20)
656     sscanf(cstring,
657     PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
658     &np[ 1],&np[ 2],&np[ 3],&np[ 4],&np[ 5],&np[ 6],&np[ 7],&np[ 8],&np[ 9],&np[10],
659     &np[11],&np[12],&np[13],&np[14],&np[15],&np[16],&np[17],&np[18],&np[19],&np[20]);
660 
661   if (np[1] <= 0) goto L30;
662 
663   for (i = 1; i <= nknot-1; i++)
664     {
665     nzp = np[i];
666     for (j= i+1; j <= nknot; j++)
667       {
668       nnp = np[j];
669       for (k = 1; k <= maxgr; k++)
670         {
671 	if (igraph[(k-1)*nkp + nzp] == nnp) goto L80;
672 	if (igraph[(k-1)*nkp + nzp] > 0 )   continue;
673 	igraph[(k-1)*nkp + nzp] = nnp;
674 	igrad[nzp]++;
675 	goto L60;
676 	}
677 
678       wlog88h(igrad[nzp],LOG_1STOP);
679       wrim88h(igrad[nzp],TX_1STOP);
680       ale88h(AL_1STOP);
681       return 1;
682 
683 L60:;
684       igrad[nnp]++;
685       if (igrad[nnp] <= maxgr) goto L70;
686       wlog88h(igrad[nzp],LOG_1STOP);
687       wrim88h(igrad[nzp],TX_1STOP);
688       ale88h(AL_1STOP);
689       return 1;
690 L70:;
691       igraph[(igrad[nnp]-1)*nkp + nnp]= nzp;
692 L80:;
693       }
694     }
695 
696   goto L40;
697   }
698 
699 maxgd= igrad[1];
700 mingd= igrad[1];
701 
702 for (i = 2; i <= nkp; i++)
703   {
704   maxgd= max(maxgd,igrad[i]);
705   mingd= min(mingd,igrad[i]);
706   }
707 
708 wrim88h(maxgd,TX_MAXGR);
709 
710 /*----------------------------------------------------------------------
711 * Vorgabe bzw. Bestimmung der Startpunkte
712 *---------------------------------------------------------------------*/
713 if (neunum > 0)
714   {
715   for (i = 1; i <= neunum; i++)
716     fscanf(fcut,PD,&istart[i]);
717   }
718 else
719   {
720   neunum= -neunum;
721   k=0;
722 
723 L110:;
724 
725   for (i = 1; i <= nkp; i++)
726     {
727     if (igrad[i]== mingd)
728       {
729       k++;
730       istart[k]= i;
731       if (k >= neunum) goto L130;
732       }
733     }
734   mingd++;
735   goto L110;
736 
737 L130:;
738 
739   for (i = 1; i <= neunum; i++)
740     wrim88h(istart[i],TX_STARTNUM);
741   }
742 
743 /*----------------------------------------------------------------------
744 * Neunummerierung der Knotenpunkte
745 *---------------------------------------------------------------------*/
746 for(is = 1; is <= neunum; is++)
747   {
748   nstart= istart[is];
749   neu[1]= nstart;
750   neuin[nstart]	= 1;
751   irneu[nkp]= nstart;
752   irneuin[nstart]= nkp;
753 
754   for(i = 1; i <= nkp; i++) num[i] = FALSE;
755 
756   num[nstart]= TRUE;
757   level[1]= 1;
758   levs= 1;
759   leve= 1;
760   nlev= 1;
761   l= 1;
762 
763 L150:;
764 
765   for (j = levs; j <= leve; j++)
766     {
767     nzp= neu[j];
768     igradzp= igrad[nzp];
769 
770 L160:;
771 
772     mingr= maxgr;
773     k= 0;
774 
775     for (i = 1; i <= igradzp; i++)
776       {
777       nnp= igraph[(i-1)*nkp + nzp];
778       if (num[nnp] || igrad[nnp] > mingr) continue;
779       mingr = igrad[nnp];
780       k = nnp;
781       }
782 
783     if (k == 0) goto L180;
784     l++;
785     neu[l]= k;
786     neuin[k]= l;
787     irneu[nkp-l+1]= k;
788     irneuin[k]= nkp-l+1;
789     num[k]= TRUE;
790     goto L160;
791 
792 L180:;
793   }
794 
795   levs+= level[nlev];
796   nlev++;
797   wrim88h(nlev,TX_LEVEL);
798   level[nlev] = l - levs + 1;
799   leve+= level[nlev];
800   if (leve < nkp) goto L150;
801 
802 /*----------------------------------------------------------------------
803 * Bandbreite m und Profil nprcm der Neunumerierung
804 *---------------------------------------------------------------------*/
805   m=      0;
806   nprcm=  0;
807   nprrcm= 0;
808 
809   for (i = 1; i <= nkp; i++)
810     {
811     nzp=      neuin[i];
812     nzprcm=   irneuin[i];
813     ifcm=     nzp;
814     ifrcm=    nzprcm;
815     igradzp=  igrad[i];
816 
817     for (j = 1; j <= igradzp; j++)
818       {
819       k=    neuin[igraph[(j-1)*nkp + i]];
820       m=    max(m, abs(k-nzp));
821       ifcm= min(ifcm, k);
822       krcm= irneuin[igraph[(j-1)*nkp + i]];
823       ifrcm=min(ifrcm, krcm);
824       }
825 
826     nprcm= nprcm + nzp - ifcm + 1;
827     nprrcm= nprrcm + nzprcm - ifrcm + 1;
828     }
829 
830   wrim88h(nprcm,TX_NPRCM);
831   wrim88h(nprrcm,TX_NPRRCM);
832 
833   if (ICFLAG == 1)                 /* reverse Cuthill-McKee */
834     {
835     iflag=  1;
836     for (i = 1; i <= nkp; i++) iperme[i]= irneuin[i];
837     }
838 
839   if (ICFLAG == 2)                 /* normaler Cuthill-McKee */
840     {
841     iflag=  2;
842     for (i = 1; i <= nkp; i++) iperme[i]= neuin[i];
843     }
844 
845   }
846 
847 /*----------------------------------------------------------------------
848 * Abspeichern des Permutationsvektors
849 *---------------------------------------------------------------------*/
850 wrim88h(iflag,TX_STOPERM);
851 
852 j= 1;
853 for (i = 1; i <= nkp; i++)
854   {
855   if (j < 10)
856     {
857     fprintf(fpermdat,PD9,iperme[i]);
858     j++;
859     }
860   else
861     {
862     fprintf(fpermdat,PD9 "\n",iperme[i]);
863     j= 1;
864     }
865   }
866 
867 /*----------------------------------------------------------------------
868 * Files schliessen, Speicher freigeben fuer CUT2Z88
869 *---------------------------------------------------------------------*/
870 fclose(fcut);
871 fclose(fpermdat);
872 
873 free(igraph);
874 free(igrad);
875 free(istart);
876 free(neu);
877 free(irneu);
878 free(neuin);
879 free(irneuin);
880 free(level);
881 free(ipermb);
882 free(iperme);
883 free(num);
884 
885 return 0;
886 }
887 
888 /***********************************************************************
889 * max
890 ***********************************************************************/
max(FR_INT4 i,FR_INT4 j)891 FR_INT4 max(FR_INT4 i, FR_INT4 j)
892 {
893 if (i > j) return i;
894 else       return j;
895 }
896 
897 /***********************************************************************
898 * min
899 ***********************************************************************/
min(FR_INT4 i,FR_INT4 j)900 FR_INT4 min(FR_INT4 i, FR_INT4 j)
901 {
902 if (i < j) return i;
903 else       return j;
904 }
905 
906 /***********************************************************************
907 * CUT2Z88
908 ***********************************************************************/
cut2z88(void)909 int cut2z88(void)
910 {
911 extern FR_INT4 iqflag;
912 
913 FILE *fpermdat,*fz88i1old,*fz88i2old,*fz88i5old,*fz88i1,*fz88i2,*fz88i5;
914 
915 FR_DOUBLE *x,*y,*z;
916 FR_DOUBLE *wert;
917 FR_DOUBLE pree,tr1e,tr2e;
918 
919 FR_INT4   *iperm;
920 FR_INT4   koi[21];
921 
922 FR_INT4   i,j;
923 FR_INT4   nkp=0,ne=0,ndim=0,nfg=0,ifrei=0,idummy=0,ityp=0;
924 
925 FR_INT4   nrb,npr,jele;
926 FR_INT4   k1,k2,k3,k4,k5,k6,k7,k8;
927 
928 FR_INT4   *node;
929 FR_INT4   *kfrei;
930 FR_INT4   *iflag;
931 FR_INT4   *ktyp;
932 
933 char cpermdat[]= "z88h.out";
934 char cz88i1[]=   "z88i1.txt";
935 char cz88i2[]=   "z88i2.txt";
936 char cz88i5[]=   "z88i5.txt";
937 char cz88i1old[]="z88i1.old";
938 char cz88i2old[]="z88i2.old";
939 char cz88i5old[]="z88i5.old";
940 
941 char cstring[255];
942 
943 /*----------------------------------------------------------------------
944 * Vektor koi loeschen
945 *---------------------------------------------------------------------*/
946 wrim88h(0,TX_UMSPEI);
947 
948 for(i = 0;i <= 20; i++) koi[i]= 0;
949 
950 /*----------------------------------------------------------------------
951 * File- Operationen: Z88I1.TXT, Z88I2.TXT, Z88I5.TXT ->
952 *                    Z88I1.OLD, Z88I2.OLD, Z88I5.OLD
953 *---------------------------------------------------------------------*/
954 if ((fz88i1old= fopen(cz88i1old,"r")) != NULL)
955   {
956   fclose(fz88i1old);
957   remove(cz88i1old);
958   }
959 
960 if ((fz88i2old= fopen(cz88i2old,"r")) != NULL)
961   {
962   fclose(fz88i2old);
963   remove(cz88i2old);
964   }
965 
966 if(iqflag == 1)
967   {
968   if ((fz88i5old= fopen(cz88i5old,"r")) != NULL)
969     {
970     fclose(fz88i5old);
971     remove(cz88i5old);
972     }
973   }
974 
975 rename(cz88i1,cz88i1old);
976 rename(cz88i2,cz88i2old);
977 if(iqflag == 1) rename(cz88i5,cz88i5old);
978 
979 fpermdat= fopen(cpermdat,"r");
980 
981 fz88i1old= fopen(cz88i1old,"r");
982 fz88i2old= fopen(cz88i2old,"r");
983 if(iqflag == 1) fz88i5old= fopen(cz88i5old,"r");
984 
985 fz88i1=    fopen(cz88i1,"w");
986 fz88i2=    fopen(cz88i2,"w");
987 if(iqflag == 1) fz88i5=    fopen(cz88i5,"w");
988 
989 wrim88h(0,TX_TXT2OLD);
990 
991 /*----------------------------------------------------------------------
992 * Z88I1.TXT
993 *---------------------------------------------------------------------*/
994 
995 /*======================================================================
996 * 1.Zeile
997 *=====================================================================*/
998 fgets(cstring,254,fz88i1old);
999 fputs(cstring,fz88i1);
1000 
1001 sscanf(cstring,PDB PDB PDB PD,&ndim,&nkp,&ne,&nfg);
1002 
1003 /*======================================================================
1004 * Memory anlegen
1005 *=====================================================================*/
1006 if(((iperm= (FR_INT4 *)   calloc((size_t)nkp+1,sizeof(FR_INT4  )))==NULL) ||
1007    ((  x  = (FR_DOUBLE *) calloc((size_t)nkp+1,sizeof(FR_DOUBLE)))==NULL) ||
1008    ((  y  = (FR_DOUBLE *) calloc((size_t)nkp+1,sizeof(FR_DOUBLE)))==NULL) ||
1009    ((  z  = (FR_DOUBLE *) calloc((size_t)nkp+1,sizeof(FR_DOUBLE)))==NULL) ||
1010    ((ktyp = (FR_INT4 *)   calloc((size_t)ne+1, sizeof(FR_INT4  )))==NULL))
1011   {
1012   ale88h(AL_NOMEM);
1013   wlog88h(0,LOG_NOMEM);
1014   return 1;
1015   }
1016 
1017 wrim88h(0,TX_MEMOK);
1018 
1019 /*======================================================================
1020 * Knoten
1021 *=====================================================================*/
1022 wrim88h(0,TX_WRII1);
1023 
1024 for(i = 1; i <= nkp; i++)
1025   fscanf(fpermdat,PD,&iperm[i]);
1026 
1027 for(i = 1; i <= nkp; i++)
1028   {
1029   fgets(cstring,254,fz88i1old);
1030   sscanf(cstring,PDB PDB PFB PFB PF,
1031   &idummy,&ifrei,&x[iperm[i]],&y[iperm[i]],&z[iperm[i]]);
1032   }
1033 
1034 for(i = 1; i <= nkp; i++)
1035   fprintf(fz88i1,PD9B PD9B PE13B PE13B PE13 "\n",i,ifrei,x[i],y[i],z[i]);
1036 
1037 /*======================================================================
1038 * Koinzidenz
1039 *=====================================================================*/
1040 for(i = 1; i <= ne; i++)
1041   {
1042   fgets (cstring,254,fz88i1old);
1043   sscanf(cstring,PDB PD,&idummy,&ityp);
1044   fputs (cstring,fz88i1);
1045 
1046   ktyp[i]= ityp;
1047 
1048   fgets (cstring,254,fz88i1old);
1049 
1050   if(ityp == 1 || ityp == 7 || ityp == 8 || ityp == 20 || ityp == 23)
1051     {
1052     sscanf(cstring,PDB PDB PDB PDB PDB PDB PDB PD,
1053     &koi[1],&koi[2],&koi[3],&koi[4],&koi[5],&koi[6],&koi[7],&koi[8]);
1054 
1055     fprintf(fz88i1,PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
1056     iperm[koi[1]],iperm[koi[2]],iperm[koi[3]],iperm[koi[4]],
1057     iperm[koi[5]],iperm[koi[6]],iperm[koi[7]],iperm[koi[8]]);
1058     }
1059 
1060   if(ityp == 2 || ityp == 4 || ityp == 5 || ityp == 9 || ityp == 13 || ityp == 25)
1061     {
1062     sscanf(cstring,PDB PD,&koi[1],&koi[2]);
1063 
1064     fprintf(fz88i1,PD9B PD9 "\n",iperm[koi[1]],iperm[koi[2]]);
1065     }
1066 
1067   if(ityp == 3 || ityp == 14 || ityp == 15 || ityp == 18 || ityp == 24)
1068     {
1069     sscanf(cstring,PDB PDB PDB PDB PDB PD,
1070     &koi[1],&koi[2],&koi[3],&koi[4],&koi[5],&koi[6]);
1071 
1072     fprintf(fz88i1,PD9B PD9B PD9B PD9B PD9B PD9 "\n",
1073     iperm[koi[1]],iperm[koi[2]],iperm[koi[3]],
1074     iperm[koi[4]],iperm[koi[5]],iperm[koi[6]]);
1075     }
1076 
1077   if(ityp == 6)
1078     {
1079     sscanf(cstring,PDB PDB PD,&koi[1],&koi[2],&koi[3]);
1080 
1081     fprintf(fz88i1,PD9B PD9B PD9 "\n",
1082     iperm[koi[1]],iperm[koi[2]],iperm[koi[3]]);
1083     }
1084 
1085   if(ityp == 10)
1086     {
1087     sscanf(cstring,
1088     PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
1089     &koi[ 1],&koi[ 2],&koi[ 3],&koi[ 4],&koi[ 5],
1090     &koi[ 6],&koi[ 7],&koi[ 8],&koi[ 9],&koi[10],
1091     &koi[11],&koi[12],&koi[13],&koi[14],&koi[15],
1092     &koi[16],&koi[17],&koi[18],&koi[19],&koi[20]);
1093 
1094     fprintf(fz88i1,
1095     PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B
1096  PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
1097     iperm[koi[ 1]],iperm[koi[ 2]],iperm[koi[ 3]],iperm[koi[ 4]],iperm[koi[ 5]],
1098     iperm[koi[ 6]],iperm[koi[ 7]],iperm[koi[ 8]],iperm[koi[ 9]],iperm[koi[10]],
1099     iperm[koi[11]],iperm[koi[12]],iperm[koi[13]],iperm[koi[14]],iperm[koi[15]],
1100     iperm[koi[16]],iperm[koi[17]],iperm[koi[18]],iperm[koi[19]],iperm[koi[20]]);
1101     }
1102 
1103   if(ityp == 19 || ityp == 21)
1104     {
1105     sscanf(cstring,
1106     PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
1107     &koi[ 1],&koi[ 2],&koi[ 3],&koi[ 4],&koi[ 5],
1108     &koi[ 6],&koi[ 7],&koi[ 8],&koi[ 9],&koi[10],
1109     &koi[11],&koi[12],&koi[13],&koi[14],&koi[15],
1110     &koi[16]);
1111 
1112     fprintf(fz88i1,
1113     PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
1114     iperm[koi[ 1]],iperm[koi[ 2]],iperm[koi[ 3]],iperm[koi[ 4]],iperm[koi[ 5]],
1115     iperm[koi[ 6]],iperm[koi[ 7]],iperm[koi[ 8]],iperm[koi[ 9]],iperm[koi[10]],
1116     iperm[koi[11]],iperm[koi[12]],iperm[koi[13]],iperm[koi[14]],iperm[koi[15]],
1117     iperm[koi[16]]);
1118     }
1119 
1120   if(ityp == 11 || ityp == 12 || ityp == 22)
1121     {
1122     sscanf(cstring,PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
1123     &koi[ 1],&koi[ 2],&koi[ 3],&koi[ 4],&koi[ 5],&koi[ 6],
1124     &koi[ 7],&koi[ 8],&koi[ 9],&koi[10],&koi[11],&koi[12]);
1125 
1126     fprintf(fz88i1,PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
1127     iperm[koi[ 1]],iperm[koi[ 2]],iperm[koi[ 3]],iperm[koi[ 4]],
1128     iperm[koi[ 5]],iperm[koi[ 6]],iperm[koi[ 7]],iperm[koi[ 8]],
1129     iperm[koi[ 9]],iperm[koi[10]],iperm[koi[11]],iperm[koi[12]]);
1130     }
1131 
1132   if(ityp == 16)
1133     {
1134     sscanf(cstring,PDB PDB PDB PDB PDB PDB PDB PDB PDB PD,
1135     &koi[1],&koi[2],&koi[3],&koi[4],&koi[5],
1136     &koi[6],&koi[7],&koi[8],&koi[9],&koi[10]);
1137 
1138     fprintf(fz88i1,PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
1139     iperm[koi[1]],iperm[koi[2]],iperm[koi[3]],iperm[koi[4]],iperm[koi[5]],
1140     iperm[koi[6]],iperm[koi[7]],iperm[koi[8]],iperm[koi[9]],iperm[koi[10]]);
1141     }
1142 
1143   if(ityp == 17)
1144     {
1145     sscanf(cstring,PDB PDB PDB PD,&koi[1],&koi[2],&koi[3],&koi[4]);
1146 
1147     fprintf(fz88i1,PD9B PD9B PD9B PD9 "\n",
1148     iperm[koi[1]],iperm[koi[2]],iperm[koi[3]],iperm[koi[4]]);
1149     }
1150   }
1151 
1152 /*======================================================================
1153 * Files schliessen
1154 *=====================================================================*/
1155 fclose(fz88i1);
1156 fclose(fz88i1old);
1157 fclose(fpermdat);
1158 
1159 /*----------------------------------------------------------------------
1160 * Z88I2.TXT
1161 *---------------------------------------------------------------------*/
1162 /*======================================================================
1163 * Anzahl Randbedingungen
1164 *=====================================================================*/
1165 fgets(cstring,254,fz88i2old);
1166 sscanf(cstring,PD,&nrb);
1167 fputs(cstring,fz88i2);
1168 
1169 /*======================================================================
1170 * Memory anlegen
1171 *=====================================================================*/
1172 if(
1173 ((node = (FR_INT4 *)calloc((size_t)nrb+1,sizeof(FR_INT4)))==NULL) ||
1174 ((kfrei= (FR_INT4 *)calloc((size_t)nrb+1,sizeof(FR_INT4)))==NULL) ||
1175 ((iflag= (FR_INT4 *)calloc((size_t)nrb+1,sizeof(FR_INT4)))==NULL) ||
1176 ((wert = (FR_DOUBLE  *)calloc((size_t)nrb+1,sizeof(FR_DOUBLE )))==NULL))
1177   {
1178   ale88h(AL_NOMEM);
1179   wlog88h(0,LOG_NOMEM);
1180   return 1;
1181   }
1182 
1183 wrim88h(0,TX_MEMOK);
1184 wrim88h(0,TX_WRII2);
1185 
1186 for(i = 1; i <= nrb; i++)
1187   {
1188   fgets(cstring,254,fz88i2old);
1189   sscanf(cstring,PDB PDB PDB PF,&node[i],&kfrei[i],&iflag[i],&wert[i]);
1190   }
1191 
1192 for (i = 1; i <= nkp; i++)
1193   {
1194   for (j = 1; j <= nrb; j++)
1195     {
1196     if(i == iperm[node[j]])
1197       fprintf(fz88i2,PD9B PD9B PD9B PE13 "\n",i,kfrei[j],iflag[j],wert[j]);
1198     }
1199   }
1200 
1201 /*======================================================================
1202 * Files schliessen
1203 *=====================================================================*/
1204 fclose(fz88i2);
1205 fclose(fz88i2old);
1206 
1207 /*----------------------------------------------------------------------
1208 * Z88I5.TXT
1209 *---------------------------------------------------------------------*/
1210 /*======================================================================
1211 * Anzahl Elemente mit Lasten
1212 *=====================================================================*/
1213 if(iqflag == 1)
1214   {
1215   fgets(cstring,254,fz88i5old);
1216   sscanf(cstring,PD,&npr);
1217   fputs(cstring,fz88i5);
1218 
1219   wrim88h(0,TX_MEMOK);
1220   wrim88h(0,TX_WRII5);
1221 
1222   for(j = 1; j <= npr; j++)
1223     {
1224     fgets(cstring,254,fz88i5old);
1225     sscanf(cstring,PD,&jele);
1226 
1227 /*======================================================================
1228 * Elemente 7,8,14 und 15:
1229 *=====================================================================*/
1230     if(ktyp[jele]== 7  || ktyp[jele]== 8 ||
1231        ktyp[jele]== 14 || ktyp[jele]== 15)
1232       {
1233       sscanf(cstring,PDB PFB PFB PDB PDB PD,&jele,&pree,&tr1e,&k1,&k2,&k3);
1234       fprintf(fz88i5,PD9B PE13B PE13B PD9B PD9B PD9 "\n",
1235         jele,pree,tr1e,iperm[k1],iperm[k2],iperm[k3]);
1236       }
1237 
1238 /*======================================================================
1239 * Element 17:
1240 *=====================================================================*/
1241     if(ktyp[jele]== 17)
1242       {
1243       sscanf(cstring,PDB PFB PDB PDB PD,&jele,&pree,&k1,&k2,&k3);
1244       fprintf(fz88i5,PD9B PE13B PD9B PD9B PD9 "\n",
1245         jele,pree,iperm[k1],iperm[k2],iperm[k3]);
1246       }
1247 
1248 /*======================================================================
1249 * Elemente 11 und 12:
1250 *=====================================================================*/
1251     if(ktyp[jele]== 11 || ktyp[jele]== 12)
1252       {
1253       sscanf(cstring,PDB PFB PFB PDB PDB PDB PD,&jele,&pree,&tr1e,&k1,&k2,&k3,&k4);
1254       fprintf(fz88i5,PD9B PE13B PE13B PD9B PD9B PD9B PD9 "\n",
1255         jele,pree,tr1e,iperm[k1],iperm[k2],iperm[k3],iperm[k4]);
1256       }
1257 
1258 /*======================================================================
1259 * Element 1:
1260 *=====================================================================*/
1261     if(ktyp[jele]== 1)
1262       {
1263       sscanf(cstring,PDB PFB PFB PFB PDB PDB PDB PD,
1264         &jele,&pree,&tr1e,&tr2e,&k1,&k2,&k3,&k4);
1265       fprintf(fz88i5,PD9B PE13B PE13B PE13B PD9B PD9B PD9B PD9 "\n",
1266         jele,pree,tr1e,tr2e,iperm[k1],iperm[k2],iperm[k3],iperm[k4]);
1267       }
1268 
1269 /*======================================================================
1270 * Element 16
1271 *=====================================================================*/
1272     if(ktyp[jele]== 16)
1273       {
1274       sscanf(cstring,PDB PFB PDB PDB PDB PDB PDB PD,
1275         &jele,&pree,&k1,&k2,&k3,&k4,&k5,&k6);
1276       fprintf(fz88i5,PD9B PE13B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
1277         jele,pree,iperm[k1],iperm[k2],iperm[k3],iperm[k4],iperm[k5],iperm[k6]);
1278       }
1279 
1280 /*======================================================================
1281 * Element 10 u. 21:
1282 *=====================================================================*/
1283     if(ktyp[jele]== 10 || ktyp[jele]== 21)
1284       {
1285       sscanf(cstring,PDB PFB PFB PFB PDB PDB PDB PDB PDB PDB PDB PD,
1286         &jele,&pree,&tr1e,&tr2e,&k1,&k2,&k3,&k4,&k5,&k6,&k7,&k8);
1287       fprintf(fz88i5,
1288         PD9B PE13B PE13B PE13B PD9B PD9B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
1289         jele,pree,tr1e,tr2e,iperm[k1],iperm[k2],iperm[k3],iperm[k4],
1290         iperm[k5],iperm[k6],iperm[k7],iperm[k8]);
1291       }
1292 
1293 /*======================================================================
1294 * Element 22:
1295 *=====================================================================*/
1296     if(ktyp[jele]== 22)
1297       {
1298       sscanf(cstring,PDB PFB PFB PFB PDB PDB PDB PDB PDB PD,
1299         &jele,&pree,&tr1e,&tr2e,&k1,&k2,&k3,&k4,&k5,&k6);
1300       fprintf(fz88i5,
1301         PD9B PE13B PE13B PE13B PD9B PD9B PD9B PD9B PD9B PD9 "\n",
1302         jele,pree,tr1e,tr2e,iperm[k1],iperm[k2],iperm[k3],iperm[k4],
1303         iperm[k5],iperm[k6]);
1304       }
1305 
1306 /*======================================================================
1307 * die drei Plattenelemente 18,19 und 20 und Schalen 23 & 24
1308 *=====================================================================*/
1309     if(ktyp[jele]== 18 || ktyp[jele]== 19 || ktyp[jele]== 20 ||
1310        ktyp[jele]== 23 || ktyp[jele]== 24)
1311       {
1312       sscanf(cstring,PDB PF,&jele,&pree);
1313       fprintf(fz88i5,PD9B PE13 "\n",jele,pree);
1314       }
1315 
1316     }
1317 
1318   fclose(fz88i5);
1319   fclose(fz88i5old);
1320   }
1321 
1322 /*----------------------------------------------------------------------
1323 * Ende Z88H
1324 *---------------------------------------------------------------------*/
1325 wrim88h(0,TX_Z88DONE);
1326 
1327 return 0;
1328 }
1329