aboutsummaryrefslogtreecommitdiffstats
path: root/test/monniaux/glpk-4.65/src/api/netgen.c
blob: 519fd60965fa3572cafcc4eb3c12fccb0d7cb933 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
/* netgen.c (Klingman's network problem generator) */

/***********************************************************************
*  This code is part of GLPK (GNU Linear Programming Kit).
*
*  This code is the result of translation of the Fortran program NETGEN
*  developed by Dr. Darwin Klingman, which is publically available from
*  NETLIB at <http://www.netlib.org/lp/generators>.
*
*  The translation was made by Andrew Makhorin <mao@gnu.org>.
*
*  GLPK is free software: you can redistribute it and/or modify it
*  under the terms of the GNU General Public License as published by
*  the Free Software Foundation, either version 3 of the License, or
*  (at your option) any later version.
*
*  GLPK is distributed in the hope that it will be useful, but WITHOUT
*  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
*  or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
*  License for more details.
*
*  You should have received a copy of the GNU General Public License
*  along with GLPK. If not, see <http://www.gnu.org/licenses/>.
***********************************************************************/

#include "env.h"
#include "glpk.h"

/***********************************************************************
*  NAME
*
*  glp_netgen - Klingman's network problem generator
*
*  SYNOPSIS
*
*  int glp_netgen(glp_graph *G, int v_rhs, int a_cap, int a_cost,
*     const int parm[1+15]);
*
*  DESCRIPTION
*
*  The routine glp_netgen is a network problem generator developed by
*  Dr. Darwin Klingman. It can create capacitated and uncapacitated
*  minimum cost flow (or transshipment), transportation, and assignment
*  problems.
*
*  The parameter G specifies the graph object, to which the generated
*  problem data have to be stored. Note that on entry the graph object
*  is erased with the routine glp_erase_graph.
*
*  The parameter v_rhs specifies an offset of the field of type double
*  in the vertex data block, to which the routine stores the supply or
*  demand value. If v_rhs < 0, the value is not stored.
*
*  The parameter a_cap specifies an offset of the field of type double
*  in the arc data block, to which the routine stores the arc capacity.
*  If a_cap < 0, the capacity is not stored.
*
*  The parameter a_cost specifies an offset of the field of type double
*  in the arc data block, to which the routine stores the per-unit cost
*  if the arc flow. If a_cost < 0, the cost is not stored.
*
*  The array parm contains description of the network to be generated:
*
*  parm[0]           not used
*  parm[1]  (iseed)  8-digit positive random number seed
*  parm[2]  (nprob)  8-digit problem id number
*  parm[3]  (nodes)  total number of nodes
*  parm[4]  (nsorc)  total number of source nodes (including
*                    transshipment nodes)
*  parm[5]  (nsink)  total number of sink nodes (including
*                    transshipment nodes)
*  parm[6]  (iarcs)  number of arcs
*  parm[7]  (mincst) minimum cost for arcs
*  parm[8]  (maxcst) maximum cost for arcs
*  parm[9]  (itsup)  total supply
*  parm[10] (ntsorc) number of transshipment source nodes
*  parm[11] (ntsink) number of transshipment sink nodes
*  parm[12] (iphic)  percentage of skeleton arcs to be given
*                    the maximum cost
*  parm[13] (ipcap)  percentage of arcs to be capacitated
*  parm[14] (mincap) minimum upper bound for capacitated arcs
*  parm[15] (maxcap) maximum upper bound for capacitated arcs
*
*  The routine generates a transportation problem if:
*
*     nsorc + nsink = nodes, ntsorc = 0, and ntsink = 0.
*
*  The routine generates an assignment problem if the requirements for
*  a transportation problem are met and:
*
*     nsorc = nsink and itsup = nsorc.
*
*  RETURNS
*
*  If the instance was successfully generated, the routine glp_netgen
*  returns zero; otherwise, if specified parameters are inconsistent,
*  the routine returns a non-zero error code.
*
*  REFERENCES
*
*  D.Klingman, A.Napier, and J.Stutz. NETGEN: A program for generating
*  large scale capacitated assignment, transportation, and minimum cost
*  flow networks. Management Science 20 (1974), 814-20. */

struct csa
{     /* common storage area */
      glp_graph *G;
      int v_rhs, a_cap, a_cost;
      int nodes, iarcs, mincst, maxcst, itsup, nsorc, nsink, nonsor,
         nfsink, narcs, nsort, nftsor, ipcap, mincap, maxcap, ktl,
         nodlft, *ipred, *ihead, *itail, *iflag, *isup, *lsinks, mult,
         modul, i15, i16, jran;
};

#define G      (csa->G)
#define v_rhs  (csa->v_rhs)
#define a_cap  (csa->a_cap)
#define a_cost (csa->a_cost)
#define nodes  (csa->nodes)
#define iarcs  (csa->iarcs)
#define mincst (csa->mincst)
#define maxcst (csa->maxcst)
#define itsup  (csa->itsup)
#define nsorc  (csa->nsorc)
#define nsink  (csa->nsink)
#define nonsor (csa->nonsor)
#define nfsink (csa->nfsink)
#define narcs  (csa->narcs)
#define nsort  (csa->nsort)
#define nftsor (csa->nftsor)
#define ipcap  (csa->ipcap)
#define mincap (csa->mincap)
#define maxcap (csa->maxcap)
#define ktl    (csa->ktl)
#define nodlft (csa->nodlft)
#if 0
/* spent a day to find out this bug */
#define ist    (csa->ist)
#else
#define ist    (ipred[0])
#endif
#define ipred  (csa->ipred)
#define ihead  (csa->ihead)
#define itail  (csa->itail)
#define iflag  (csa->iflag)
#define isup   (csa->isup)
#define lsinks (csa->lsinks)
#define mult   (csa->mult)
#define modul  (csa->modul)
#define i15    (csa->i15)
#define i16    (csa->i16)
#define jran   (csa->jran)

static void cresup(struct csa *csa);
static void chain(struct csa *csa, int lpick, int lsorc);
static void chnarc(struct csa *csa, int lsorc);
static void sort(struct csa *csa);
static void pickj(struct csa *csa, int it);
static void assign(struct csa *csa);
static void setran(struct csa *csa, int iseed);
static int iran(struct csa *csa, int ilow, int ihigh);

int glp_netgen(glp_graph *G_, int _v_rhs, int _a_cap, int _a_cost,
      const int parm[1+15])
{     struct csa _csa, *csa = &_csa;
      int iseed, nprob, ntsorc, ntsink, iphic, i, nskel, nltr, ltsink,
         ntrans, npsink, nftr, npsorc, ntravl, ntrrem, lsorc, lpick,
         nsksr, nsrchn, j, item, l, ks, k, ksp, li, n, ii, it, ih, icap,
         jcap, icost, jcost, ret;
      G = G_;
      v_rhs = _v_rhs;
      a_cap = _a_cap;
      a_cost = _a_cost;
      if (G != NULL)
      {  if (v_rhs >= 0 && v_rhs > G->v_size - (int)sizeof(double))
            xerror("glp_netgen: v_rhs = %d; invalid offset\n", v_rhs);
         if (a_cap >= 0 && a_cap > G->a_size - (int)sizeof(double))
            xerror("glp_netgen: a_cap = %d; invalid offset\n", a_cap);
         if (a_cost >= 0 && a_cost > G->a_size - (int)sizeof(double))
            xerror("glp_netgen: a_cost = %d; invalid offset\n", a_cost);
      }
      /* Input the user's random number seed and fix it if
         non-positive. */
      iseed = parm[1];
      nprob = parm[2];
      if (iseed <= 0) iseed = 13502460;
      setran(csa, iseed);
      /* Input the user's problem characteristics. */
      nodes = parm[3];
      nsorc = parm[4];
      nsink = parm[5];
      iarcs = parm[6];
      mincst = parm[7];
      maxcst = parm[8];
      itsup = parm[9];
      ntsorc = parm[10];
      ntsink = parm[11];
      iphic = parm[12];
      ipcap = parm[13];
      mincap = parm[14];
      maxcap = parm[15];
      /* Check the size of the problem. */
      if (!(10 <= nodes && nodes <= 100000))
      {  ret = 1;
         goto done;
      }
      /* Check user supplied parameters for consistency. */
      if (!(nsorc >= 0 && nsink >= 0 && nsorc + nsink <= nodes))
      {  ret = 2;
         goto done;
      }
      if (iarcs < 0)
      {  ret = 3;
         goto done;
      }
      if (mincst > maxcst)
      {  ret = 4;
         goto done;
      }
      if (itsup < 0)
      {  ret = 5;
         goto done;
      }
      if (!(0 <= ntsorc && ntsorc <= nsorc))
      {  ret = 6;
         goto done;
      }
      if (!(0 <= ntsink && ntsink <= nsink))
      {  ret = 7;
         goto done;
      }
      if (!(0 <= iphic && iphic <= 100))
      {  ret = 8;
         goto done;
      }
      if (!(0 <= ipcap && ipcap <= 100))
      {  ret = 9;
         goto done;
      }
      if (mincap > maxcap)
      {  ret = 10;
         goto done;
      }
      /* Initailize the graph object. */
      if (G != NULL)
      {  glp_erase_graph(G, G->v_size, G->a_size);
         glp_add_vertices(G, nodes);
         if (v_rhs >= 0)
         {  double zero = 0.0;
            for (i = 1; i <= nodes; i++)
            {  glp_vertex *v = G->v[i];
               memcpy((char *)v->data + v_rhs, &zero, sizeof(double));
            }
         }
      }
      /* Allocate working arrays. */
      ipred = xcalloc(1+nodes, sizeof(int));
      ihead = xcalloc(1+nodes, sizeof(int));
      itail = xcalloc(1+nodes, sizeof(int));
      iflag = xcalloc(1+nodes, sizeof(int));
      isup = xcalloc(1+nodes, sizeof(int));
      lsinks = xcalloc(1+nodes, sizeof(int));
      /* Print the problem documentation records. */
      if (G == NULL)
      {  xprintf("BEGIN\n");
         xprintf("NETGEN PROBLEM%8d%10s%10d NODES AND%10d ARCS\n",
            nprob, "", nodes, iarcs);
         xprintf("USER:%11d%11d%11d%11d%11d%11d\nDATA:%11d%11d%11d%11d%"
            "11d%11d\n", iseed, nsorc, nsink, mincst,
            maxcst, itsup, ntsorc, ntsink, iphic, ipcap,
            mincap, maxcap);
      }
      else
         glp_set_graph_name(G, "NETGEN");
      /* Set various constants used in the program. */
      narcs = 0;
      nskel = 0;
      nltr = nodes - nsink;
      ltsink = nltr + ntsink;
      ntrans = nltr - nsorc;
      nfsink = nltr + 1;
      nonsor = nodes - nsorc + ntsorc;
      npsink = nsink - ntsink;
      nodlft = nodes - nsink + ntsink;
      nftr = nsorc + 1;
      nftsor = nsorc - ntsorc + 1;
      npsorc = nsorc - ntsorc;
      /* Randomly distribute the supply among the source nodes. */
      if (npsorc + npsink == nodes && npsorc == npsink &&
          itsup == nsorc)
      {  assign(csa);
         nskel = nsorc;
         goto L390;
      }
      cresup(csa);
      /* Print the supply records. */
      if (G == NULL)
      {  xprintf("SUPPLY\n");
         for (i = 1; i <= nsorc; i++)
            xprintf("%6s%6d%18s%10d\n", "", i, "", isup[i]);
         xprintf("ARCS\n");
      }
      else
      {  if (v_rhs >= 0)
         {  for (i = 1; i <= nsorc; i++)
            {  double temp = (double)isup[i];
               glp_vertex *v = G->v[i];
               memcpy((char *)v->data + v_rhs, &temp, sizeof(double));
            }
         }
      }
      /* Make the sources point to themselves in ipred array. */
      for (i = 1; i <= nsorc; i++)
         ipred[i] = i;
      if (ntrans == 0) goto L170;
      /* Chain the transshipment nodes together in the ipred array. */
      ist = nftr;
      ipred[nltr] = 0;
      for (i = nftr; i < nltr; i++)
         ipred[i] = i+1;
      /* Form even length chains for 60 percent of the transshipments.*/
      ntravl = 6 * ntrans / 10;
      ntrrem = ntrans - ntravl;
L140: lsorc = 1;
      while (ntravl != 0)
      {  lpick = iran(csa, 1, ntravl + ntrrem);
         ntravl--;
         chain(csa, lpick, lsorc);
         if (lsorc == nsorc) goto L140;
         lsorc++;
      }
      /* Add the remaining transshipments to the chains. */
      while (ntrrem != 0)
      {
         lpick = iran(csa, 1, ntrrem);
         ntrrem--;
         lsorc = iran(csa, 1, nsorc);
         chain(csa, lpick, lsorc);
      }
L170: /* Set all demands equal to zero. */
      for (i = nfsink; i <= nodes; i++)
         ipred[i] = 0;
      /* The following loop takes one chain at a time (through the use
         of logic contained in the loop and calls to other routines) and
         creates the remaining network arcs. */
      for (lsorc = 1; lsorc <= nsorc; lsorc++)
      {  chnarc(csa, lsorc);
         for (i = nfsink; i <= nodes; i++)
            iflag[i] = 0;
         /* Choose the number of sinks to be hooked up to the current
            chain. */
         if (ntrans != 0)
            nsksr = (nsort * 2 * nsink) / ntrans;
         else
            nsksr = nsink / nsorc + 1;
         if (nsksr < 2) nsksr = 2;
         if (nsksr > nsink) nsksr = nsink;
         nsrchn = nsort;
         /* Randomly pick nsksr sinks and put their names in lsinks. */
         ktl = nsink;
         for (j = 1; j <= nsksr; j++)
         {  item = iran(csa, 1, ktl);
            ktl--;
            for (l = nfsink; l <= nodes; l++)
            {  if (iflag[l] != 1)
               {  item--;
                  if (item == 0) goto L230;
               }
            }
            break;
L230:       lsinks[j] = l;
            iflag[l] = 1;
         }
         /* If last source chain, add all sinks with zero demand to
            lsinks list. */
         if (lsorc == nsorc)
         {  for (j = nfsink; j <= nodes; j++)
            {  if (ipred[j] == 0 && iflag[j] != 1)
               {  nsksr++;
                  lsinks[nsksr] = j;
                  iflag[j] = 1;
               }
            }
         }
         /* Create demands for group of sinks in lsinks. */
         ks = isup[lsorc] / nsksr;
         k = ipred[lsorc];
         for (i = 1; i <= nsksr; i++)
         {  nsort++;
            ksp = iran(csa, 1, ks);
            j = iran(csa, 1, nsksr);
            itail[nsort] = k;
            li = lsinks[i];
            ihead[nsort] = li;
            ipred[li] += ksp;
            li = lsinks[j];
            ipred[li] += ks - ksp;
            n = iran(csa, 1, nsrchn);
            k = lsorc;
            for (ii = 1; ii <= n; ii++)
               k = ipred[k];
         }
         li = lsinks[1];
         ipred[li] += isup[lsorc] - ks * nsksr;
         nskel += nsort;
         /* Sort the arcs in the chain from source lsorc using itail as
            sort key. */
         sort(csa);
         /* Print this part of skeleton and create the arcs for these
            nodes. */
         i = 1;
         itail[nsort+1] = 0;
L300:    for (j = nftsor; j <= nodes; j++)
            iflag[j] = 0;
         ktl = nonsor - 1;
         it = itail[i];
         iflag[it] = 1;
L320:    ih = ihead[i];
         iflag[ih] = 1;
         narcs++;
         ktl--;
         /* Determine if this skeleton arc should be capacitated. */
         icap = itsup;
         jcap = iran(csa, 1, 100);
         if (jcap <= ipcap)
         {  icap = isup[lsorc];
            if (mincap > icap) icap = mincap;
         }
         /* Determine if this skeleton arc should have the maximum
            cost. */
         icost = maxcst;
         jcost = iran(csa, 1, 100);
         if (jcost > iphic)
            icost = iran(csa, mincst, maxcst);
         if (G == NULL)
            xprintf("%6s%6d%6d%2s%10d%10d\n", "", it, ih, "", icost,
               icap);
         else
         {  glp_arc *a = glp_add_arc(G, it, ih);
            if (a_cap >= 0)
            {  double temp = (double)icap;
               memcpy((char *)a->data + a_cap, &temp, sizeof(double));
            }
            if (a_cost >= 0)
            {  double temp = (double)icost;
               memcpy((char *)a->data + a_cost, &temp, sizeof(double));
            }
         }
         i++;
         if (itail[i] == it) goto L320;
         pickj(csa, it);
         if (i <= nsort) goto L300;
      }
      /* Create arcs from the transshipment sinks. */
      if (ntsink != 0)
      {  for (i = nfsink; i <= ltsink; i++)
         {  for (j = nftsor; j <= nodes; j++)
               iflag[j] = 0;
            ktl = nonsor - 1;
            iflag[i] = 1;
            pickj(csa, i);
         }
      }
L390: /* Print the demand records and end record. */
      if (G == NULL)
      {  xprintf("DEMAND\n");
         for (i = nfsink; i <= nodes; i++)
            xprintf("%6s%6d%18s%10d\n", "", i, "", ipred[i]);
         xprintf("END\n");
      }
      else
      {  if (v_rhs >= 0)
         {  for (i = nfsink; i <= nodes; i++)
            {  double temp = - (double)ipred[i];
               glp_vertex *v = G->v[i];
               memcpy((char *)v->data + v_rhs, &temp, sizeof(double));
            }
         }
      }
      /* Free working arrays. */
      xfree(ipred);
      xfree(ihead);
      xfree(itail);
      xfree(iflag);
      xfree(isup);
      xfree(lsinks);
      /* The instance has been successfully generated. */
      ret = 0;
done: return ret;
}

/***********************************************************************
*  The routine cresup randomly distributes the total supply among the
*  source nodes. */

static void cresup(struct csa *csa)
{     int i, j, ks, ksp;
      xassert(itsup > nsorc);
      ks = itsup / nsorc;
      for (i = 1; i <= nsorc; i++)
         isup[i] = 0;
      for (i = 1; i <= nsorc; i++)
      {  ksp = iran(csa, 1, ks);
         j = iran(csa, 1, nsorc);
         isup[i] += ksp;
         isup[j] += ks - ksp;
      }
      j = iran(csa, 1, nsorc);
      isup[j] += itsup - ks * nsorc;
      return;
}

/***********************************************************************
*  The routine chain adds node lpick to the end of the chain with source
*  node lsorc. */

static void chain(struct csa *csa, int lpick, int lsorc)
{     int i, j, k, l, m;
      k = 0;
      m = ist;
      for (i = 1; i <= lpick; i++)
      {  l = k;
         k = m;
         m = ipred[k];
      }
      ipred[l] = m;
      j = ipred[lsorc];
      ipred[k] = j;
      ipred[lsorc] = k;
      return;
}

/***********************************************************************
*  The routine chnarc puts the arcs in the chain from source lsorc into
*  the ihead and itail arrays for sorting. */

static void chnarc(struct csa *csa, int lsorc)
{     int ito, ifrom;
      nsort = 0;
      ito = ipred[lsorc];
L10:  if (ito == lsorc) return;
      nsort++;
      ifrom = ipred[ito];
      ihead[nsort] = ito;
      itail[nsort] = ifrom;
      ito = ifrom;
      goto L10;
}

/***********************************************************************
*  The routine sort sorts the nsort arcs in the ihead and itail arrays.
*  ihead is used as the sort key (i.e. forward star sort order). */

static void sort(struct csa *csa)
{     int i, j, k, l, m, n, it;
      n = nsort;
      m = n;
L10:  m /= 2;
      if (m == 0) return;
      k = n - m;
      j = 1;
L20:  i = j;
L30:  l = i + m;
      if (itail[i] <= itail[l]) goto L40;
      it = itail[i];
      itail[i] = itail[l];
      itail[l] = it;
      it = ihead[i];
      ihead[i] = ihead[l];
      ihead[l] = it;
      i -= m;
      if (i >= 1) goto L30;
L40:  j++;
      if (j <= k) goto L20;
      goto L10;
}

/***********************************************************************
*  The routine pickj creates a random number of arcs out of node 'it'.
*  Various parameters are dynamically adjusted in an attempt to ensure
*  that the generated network has the correct number of arcs. */

static void pickj(struct csa *csa, int it)
{     int j, k, l, nn, nupbnd, icap, jcap, icost;
      if ((nodlft - 1) * 2 > iarcs - narcs - 1)
      {  nodlft--;
         return;
      }
      if ((iarcs - narcs + nonsor - ktl - 1) / nodlft - nonsor + 1 >= 0)
         k = nonsor;
      else
      {  nupbnd = (iarcs - narcs - nodlft) / nodlft * 2;
L40:     k = iran(csa, 1, nupbnd);
         if (nodlft == 1) k = iarcs - narcs;
         if ((nodlft - 1) * (nonsor - 1) < iarcs - narcs - k) goto L40;
      }
      nodlft--;
      for (j = 1; j <= k; j++)
      {  nn = iran(csa, 1, ktl);
         ktl--;
         for (l = nftsor; l <= nodes; l++)
         {  if (iflag[l] != 1)
            {  nn--;
               if (nn == 0) goto L70;
            }
         }
         return;
L70:     iflag[l] = 1;
         icap = itsup;
         jcap = iran(csa, 1, 100);
         if (jcap <= ipcap)
            icap = iran(csa, mincap, maxcap);
         icost = iran(csa, mincst, maxcst);
         if (G == NULL)
            xprintf("%6s%6d%6d%2s%10d%10d\n", "", it, l, "", icost,
               icap);
         else
         {  glp_arc *a = glp_add_arc(G, it, l);
            if (a_cap >= 0)
            {  double temp = (double)icap;
               memcpy((char *)a->data + a_cap, &temp, sizeof(double));
            }
            if (a_cost >= 0)
            {  double temp = (double)icost;
               memcpy((char *)a->data + a_cost, &temp, sizeof(double));
            }
         }
         narcs++;
      }
      return;
}

/***********************************************************************
*  The routine assign generate assignment problems. It defines the unit
*  supplies, builds a skeleton, then calls pickj to create the arcs. */

static void assign(struct csa *csa)
{     int i, it, nn, l, ll, icost;
      if (G == NULL)
         xprintf("SUPPLY\n");
      for (i = 1; i <= nsorc; i++)
      {  isup[i] = 1;
         iflag[i] = 0;
         if (G == NULL)
            xprintf("%6s%6d%18s%10d\n", "", i, "", isup[i]);
         else
         {  if (v_rhs >= 0)
            {  double temp = (double)isup[i];
               glp_vertex *v = G->v[i];
               memcpy((char *)v->data + v_rhs, &temp, sizeof(double));
            }
         }
      }
      if (G == NULL)
         xprintf("ARCS\n");
      for (i = nfsink; i <= nodes; i++)
         ipred[i] = 1;
      for (it = 1; it <= nsorc; it++)
      {  for (i = nfsink; i <= nodes; i++)
            iflag[i] = 0;
         ktl = nsink - 1;
         nn = iran(csa, 1, nsink - it + 1);
         for (l = 1; l <= nsorc; l++)
         {  if (iflag[l] != 1)
            {  nn--;
               if (nn == 0) break;
            }
         }
         narcs++;
         ll = nsorc + l;
         icost = iran(csa, mincst, maxcst);
         if (G == NULL)
            xprintf("%6s%6d%6d%2s%10d%10d\n", "", it, ll, "", icost,
               isup[1]);
         else
         {  glp_arc *a = glp_add_arc(G, it, ll);
            if (a_cap >= 0)
            {  double temp = (double)isup[1];
               memcpy((char *)a->data + a_cap, &temp, sizeof(double));
            }
            if (a_cost >= 0)
            {  double temp = (double)icost;
               memcpy((char *)a->data + a_cost, &temp, sizeof(double));
            }
         }
         iflag[l] = 1;
         iflag[ll] = 1;
         pickj(csa, it);
      }
      return;
}

/***********************************************************************
*  Portable congruential (uniform) random number generator:
*
*     next_value = ((7**5) * previous_value) modulo ((2**31)-1)
*
*  This generator consists of three routines:
*
*  (1) setran - initializes constants and seed
*  (2) iran   - generates an integer random number
*  (3) rran   - generates a real random number
*
*  The generator requires a machine with at least 32 bits of precision.
*  The seed (iseed) must be in the range [1,(2**31)-1]. */

static void setran(struct csa *csa, int iseed)
{     xassert(iseed >= 1);
      mult = 16807;
      modul = 2147483647;
      i15 = 1 << 15;
      i16 = 1 << 16;
      jran = iseed;
      return;
}

/***********************************************************************
*  The routine iran generates an integer random number between ilow and
*  ihigh. If ilow > ihigh then iran returns ihigh. */

static int iran(struct csa *csa, int ilow, int ihigh)
{     int ixhi, ixlo, ixalo, leftlo, ixahi, ifulhi, irtlo, iover,
         irthi, j;
      ixhi = jran / i16;
      ixlo = jran - ixhi * i16;
      ixalo = ixlo * mult;
      leftlo = ixalo / i16;
      ixahi = ixhi * mult;
      ifulhi = ixahi + leftlo;
      irtlo = ixalo - leftlo * i16;
      iover = ifulhi / i15;
      irthi = ifulhi - iover * i15;
      jran = ((irtlo - modul) + irthi * i16) + iover;
      if (jran < 0) jran += modul;
      j = ihigh - ilow + 1;
      if (j > 0)
         return jran % j + ilow;
      else
         return ihigh;
}

/***********************************************************************
*  NAME
*
*  glp_netgen_prob - Klingman's standard network problem instance
*
*  SYNOPSIS
*
*  void glp_netgen_prob(int nprob, int parm[1+15]);
*
*  DESCRIPTION
*
*  The routine glp_netgen_prob provides the set of parameters for
*  Klingman's network problem generator (see the routine glp_netgen),
*  which describe a standard network problem instance.
*
*  The parameter nprob (101 <= nprob <= 150) specifies the problem
*  instance number.
*
*  The array parm contains description of the network, provided by the
*  routine. (For detailed description of these parameters see comments
*  to the routine glp_netgen.)
*
*  PROBLEM CHARACTERISTICS
*
*  The table below shows characteristics of Klingman's standard network
*  problem instances.
*
*  Problem   Nodes    Arcs      Optimum
*  -------   -----   -----   ----------
*    101      5000   25336      6191726
*    102      5000   25387     72337144
*    103      5000   25355    218947553
*    104      5000   25344    -19100371
*    105      5000   25332     31192578
*    106      5000   12870      4314276
*    107      5000   37832      7393769
*    108      5000   50309      8405738
*    109      5000   75299      9190300
*    110      5000   12825      8975048
*    111      5000   37828      4747532
*    112      5000   50325      4012671
*    113      5000   75318      2979725
*    114      5000   26514      5821181
*    115      5000   25962      6353310
*    116      5000   25304      5915426
*    117      5000   12816      4420560
*    118      5000   37797      7045842
*    119      5000   50301      7724179
*    120      5000   75330      8455200
*    121      5000   25000     66366360
*    122      5000   25000     30997529
*    123      5000   25000     23388777
*    124      5000   25000     17803443
*    125      5000   25000     14119622
*    126      5000   12500     18802218
*    127      5000   37500     27674647
*    128      5000   50000     30906194
*    129      5000   75000     40905209
*    130      5000   12500     38939608
*    131      5000   37500     16752978
*    132      5000   50000     13302951
*    133      5000   75000      9830268
*    134      1000   25000      3804874
*    135      2500   25000     11729616
*    136      7500   25000     33318101
*    137     10000   25000     46426030
*    138      5000   25000     60710879
*    139      5000   25000     32729682
*    140      5000   25000     27183831
*    141      5000   25000     19963286
*    142      5000   25000     20243457
*    143      5000   25000     18586777
*    144      5000   25000      2504591
*    145      5000   25000    215956138
*    146      5000   25000   2253113811
*    147      5000   25000   -427908373
*    148      5000   25000    -92965318
*    149      5000   25000     86051224
*    150      5000   25000    619314919 */

static const int data[50][1+15] =
{  {  0, 13502460, 101, 5000, 2500, 2500, 25000,
      1, 100, 250000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 4281922, 102, 5000, 2500, 2500, 25000,
      1, 100, 2500000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 44820113, 103, 5000, 2500, 2500, 25000,
      1, 100, 6250000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 13450451, 104, 5000, 2500, 2500, 25000,
      -100, -1, 250000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 14719436, 105, 5000, 2500, 2500, 25000,
      101, 200, 250000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 17365786, 106, 5000, 2500, 2500, 12500,
      1, 100, 125000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 19540113, 107, 5000, 2500, 2500, 37500,
      1, 100, 375000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 19560313, 108, 5000, 2500, 2500, 50000,
      1, 100, 500000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 2403509, 109, 5000, 2500, 2500, 75000,
      1, 100, 750000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 92480414, 110, 5000, 2500, 2500, 12500,
      1, 100, 250000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 4230140, 111, 5000, 2500, 2500, 37500,
      1, 100, 250000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 10032490, 112, 5000, 2500, 2500, 50000,
      1, 100, 250000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 17307474, 113, 5000, 2500, 2500, 75000,
      1, 100, 250000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 4925114, 114, 5000, 500, 4500, 25000,
      1, 100, 250000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 19842704, 115, 5000, 1500, 3500, 25000,
      1, 100, 250000, 0, 0, 0, 100, 1, 1000
   },
   {  0, 88392060, 116, 5000, 2500, 2500, 25000,
      1, 100, 250000, 0, 0, 0, 0, 1, 1000
   },
   {  0, 12904407, 117, 5000, 2500, 2500, 12500,
      1, 100, 125000, 0, 0, 0, 0, 1, 1000
   },
   {  0, 11811811, 118, 5000, 2500, 2500, 37500,
      1, 100, 375000, 0, 0, 0, 0, 1, 1000
   },
   {  0, 90023593, 119, 5000, 2500, 2500, 50000,
      1, 100, 500000, 0, 0, 0, 0, 1, 1000
   },
   {  0, 93028922, 120, 5000, 2500, 2500, 75000,
      1, 100, 750000, 0, 0, 0, 0, 1, 1000
   },
   {  0, 72707401, 121, 5000, 50, 50, 25000,
      1, 100, 250000, 50, 50, 0, 100, 1, 1000
   },
   {  0, 93040771, 122, 5000, 250, 250, 25000,
      1, 100, 250000, 250, 250, 0, 100, 1, 1000
   },
   {  0, 70220611, 123, 5000, 500, 500, 25000,
      1, 100, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 52774811, 124, 5000, 1000, 1000, 25000,
      1, 100, 250000, 1000, 1000, 0, 100, 1, 1000
   },
   {  0, 22492311, 125, 5000, 1500, 1500, 25000,
      1, 100, 250000, 1500, 1500, 0, 100, 1, 1000
   },
   {  0, 35269337, 126, 5000, 500, 500, 12500,
      1, 100, 125000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 30140502, 127, 5000, 500, 500, 37500,
      1, 100, 375000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 49205455, 128, 5000, 500, 500, 50000,
      1, 100, 500000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 42958341, 129, 5000, 500, 500, 75000,
      1, 100, 750000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 25440925, 130, 5000, 500, 500, 12500,
      1, 100, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 75294924, 131, 5000, 500, 500, 37500,
      1, 100, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 4463965, 132, 5000, 500, 500, 50000,
      1, 100, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 13390427, 133, 5000, 500, 500, 75000,
      1, 100, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 95250971, 134, 1000, 500, 500, 25000,
      1, 100, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 54830522, 135, 2500, 500, 500, 25000,
      1, 100, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 520593, 136, 7500, 500, 500, 25000,
      1, 100, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 52900925, 137, 10000, 500, 500, 25000,
      1, 100, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 22603395, 138, 5000, 500, 500, 25000,
      1, 100, 250000, 500, 500, 0, 100, 1, 50
   },
   {  0, 55253099, 139, 5000, 500, 500, 25000,
      1, 100, 250000, 500, 500, 0, 100, 1, 250
   },
   {  0, 75357001, 140, 5000, 500, 500, 25000,
      1, 100, 250000, 500, 500, 0, 100, 1, 500
   },
   {  0, 10072459, 141, 5000, 500, 500, 25000,
      1, 100, 250000, 500, 500, 0, 100, 1, 2500
   },
   {  0, 55728492, 142, 5000, 500, 500, 25000,
      1, 100, 250000, 500, 500, 0, 100, 1, 5000
   },
   {  0, 593043, 143, 5000, 500, 500, 25000,
      1, 100, 250000, 500, 500, 0, 0, 1, 1000
   },
   {  0, 94236572, 144, 5000, 500, 500, 25000,
      1, 10, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 94882955, 145, 5000, 500, 500, 25000,
      1, 1000, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 48489922, 146, 5000, 500, 500, 25000,
      1, 10000, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 75578374, 147, 5000, 500, 500, 25000,
      -100, -1, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 44821152, 148, 5000, 500, 500, 25000,
      -50, 49, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 45224103, 149, 5000, 500, 500, 25000,
      101, 200, 250000, 500, 500, 0, 100, 1, 1000
   },
   {  0, 63491741, 150, 5000, 500, 500, 25000,
      1001, 1100, 250000, 500, 500, 0, 100, 1, 1000
   },
};

void glp_netgen_prob(int nprob, int parm[1+15])
{     int k;
      if (!(101 <= nprob && nprob <= 150))
         xerror("glp_netgen_prob: nprob = %d; invalid problem instance "
            "number\n", nprob);
      for (k = 1; k <= 15; k++)
         parm[k] = data[nprob-101][k];
      return;
}

/**********************************************************************/

#if 0
static int scan(char card[80+1], int pos, int len)
{     char buf[10+1];
      memcpy(buf, &card[pos-1], len);
      buf[len] = '\0';
      return atoi(buf);
}

int main(void)
{     int parm[1+15];
      char card[80+1];
      xassert(fgets(card, sizeof(card), stdin) == card);
      parm[1] = scan(card, 1, 8);
      parm[2] = scan(card, 9, 8);
      xassert(fgets(card, sizeof(card), stdin) == card);
      parm[3] = scan(card, 1, 5);
      parm[4] = scan(card, 6, 5);
      parm[5] = scan(card, 11, 5);
      parm[6] = scan(card, 16, 5);
      parm[7] = scan(card, 21, 5);
      parm[8] = scan(card, 26, 5);
      parm[9] = scan(card, 31, 10);
      parm[10] = scan(card, 41, 5);
      parm[11] = scan(card, 46, 5);
      parm[12] = scan(card, 51, 5);
      parm[13] = scan(card, 56, 5);
      parm[14] = scan(card, 61, 10);
      parm[15] = scan(card, 71, 10);
      glp_netgen(NULL, 0, 0, 0, parm);
      return 0;
}
#endif

/* eof */