From K193301%CZHRZU1A.BitNet@wigate.nic.wisc.edu Wed Nov 17 17:34:38 1993
Received: from cs.wisc.edu by tilsit.cs.wisc.edu; Wed, 17 Nov 93 17:34:35 -0600
Received: from vms3.macc.wisc.edu by cs.wisc.edu; Wed, 17 Nov 93 17:34:31 -0600
Received: from CEARN by WISCMACC.BitNet; Wed, 17 Nov 93 17:35 CDT
Received: from CZHRZU1A.BITNET (NJE origin K193301@CZHRZU1A)
          by CEARN.CERN.CH (LMail V1.1d/1.7f) with RFC822 id 9016;
          Thu, 18 Nov 1993 00:32:13 +0100
Message-Id: <23111717352173@WISCMACC.BitNet>
Date: Thu, 18 Nov 93 00:32:19 GMT
From: "P. Kall" <K193301%CZHRZU1A.BitNet@wigate.nic.wisc.edu>
Subject: genslpn.for
To: Spyros Kontogiorgis <kontogio>
*Destination: CS.WISC.EDU
Status: R


C====================================================================
C                        G E N S L P N
C====================================================================
C
C  This file contains the main program of GENSLP. It performs I/O and
C  controls problem generation.
C  Besides this the system consists of the following files:
C
C  GENMAT:        matrix generation
C  SPARSE:        sparse-matrix manipulation
C  SERVICE:       service procedures
C  RANDOM:        procedures which call the pseudorandom number
C                 generator
C====================================================================
      PROGRAM GENSLPN
C
C  Last update: 1.04.92
C
C  This is a new version of GENSLP under development by P. Kall,
C  E. Keller and J. Mayer. The code is an experimental one, not all
C  of the options documented below are available with it (see Usage
C  Notes below). The development of a final version along with a
C  User's Guide is in progress.
C
C====================================================================
C  Introduction:
C  -------------
C  The program serves for generating the various arrays appearing
C  in the formulation of a two-stage problem or as a special case
C  in an LP-problem. For the problem formulation see P. Kall and
C  J. Mayer: "SLP-IOR: A model management system for stochastic linear
C  programming, - System design", Preprint, IOR University of Zurich,
C  April 1991. Considering the recourse random-, general fixed-,
C  complete-, and simple-recourse are the possible options. The
C  existence of an optimal solution is enforced in the complete-
C  recourse case (for minimization).
C
C  The structure of the generated problems is as follows:
C  In parentheses are the numbers indicated which identify the
C  structural elements (arrays) in the program.
C                                    ------------------------
C                                    I     cost q(i)  (3)   I
C    -------------------------     --------------------------
C    I       cost c   (1)    I     I    cost q0   (2)    I
C    -------------------------     -----------------------
C
C    -------------------------                                -----
C    I                       I                                I(5)I
C    I          (4)          I                                I   I
C    I                       I                                I R I
C    I      coefficients     I                                I H I
C    I           A           I                                I S I
C    I                       I                                I   I
C    I                       I                                I b I
C    I                       I                                I   I
C    -------------------------                                -----
C
C       -------------------------      --------------------     -------
C       I    coeff. T(i)   (7)  I      I  coeff. W(i)  (9)I     I(11) I
C    -------------------------  I   --------------------  I   ------  I
C    I                       I  I   I                  I  I   I(10)I  I
C    I           (6)         I  I   I       (8)        I  I   I    IR I
C    I                       I  I   I                  I  I   I  R IH I
C    I      coefficients     I  I   I   coefficients   I  I   I  H IS I
C    I           T0          I  I   I        W0        I  I   I  S I  I
C    I                       I  I   I                  I  I   I    Ih I
C    I                       I  I   I                  I  I   I h0 Ii)I
C    I                       I---   I                  I---   I    I---
C    -------------------------      --------------------      -----
C
C====================================================================
C
C  Usage notes
C  -----------
C
C  The program is written in FORTRAN 77 so any FORTRAN compiler should
C  be able to compile it. The program has been designed on an IBM/PC
C  (80486 processor, 8MB storage capacity) using the Lahey F77L-EM/32
C  FORTRAN compiler.
C
C  For generating uniformly distributed pseudorandom numbers in [0.0, 1.0]
C  the Lahey intrinsic functions RANDS(X) and RND() have been used.
C  RANDS requires a REAL argument, the seed for the generator,  and
C  returns a real (dummy) value. Its purpose is to initialize the generator.
C  RND() requires no argument and returns a pseudorandom number in [0,1].
C  If the code is compiled employing a different compiler, these two
C  functions are to be supplied by the user or replaced by calls to
C  an other random number generator. The single call to RANDS is in this
C  file at line 1228. All calls to RND are located in file RANDOM.FOR;
C  the lines where calls to RND occur are indicated in the header of that
C  file.
C
C  In the present version the limits for arrays appearing in the problem
C  are as follows: Rows < 2000, Columns < 3000 and Nonzeros < 10000.
C  For bigger problems simply change the PARAMETER statement below
C  accordingly. MAXVEC should be the maximum of NROWS and NCOLS.
C
C  The options as listed below in the description of the input-file
C  format are not yet completely implemented. All main options should be
C  available, with the exception of SIGDIG ( see below ).
C
C  For the case of colliding requirements some default measures are taken;
C  e.g. if the sparsity is too low resulting in a matrix containing a zero
C  column the sparsity requirement is overridden accordingly. In the
C  present version all arrays generated are without zero columns. This is
C  not too reasonable in the case of T; it would be sufficient to enforce
C  that A and T together have no zero column. The next version of GENSLP
C  will be modified accordingly.
C
C  As indicated above this is an experimental version. If you experience
C  any deviations from the specifications or encounter malfunctioning
C  please let us know. Suggestions for improving GENSLP are also
C  gratefully acknowledged.
C
C  Data flow:
C  ----------
C  The fileids of the input- and output-files of GENSLP are to be
C  specified in the first two records of a text-file with fileid
C  FILEDEF.GSL.
C  The input to this program is a text-file with a fixed structure
C  ( see description later on). It should contain the various parameters
C  specifying the problem to be generated.
C  The output of this program is another text-file with roughly the same
C  structure as the input file (see description later on). It
C  contains besides a few parameters the generated problem data.
C
C  Error Messages:
C  ---------------
C  All error messages are sent to the screen. For outputting them into a
C  file you have to use the DOS I/O redirection.
C
C  File structures:
C  ----------------
C
C  1. For specifying I/O fileids serves FILEDEF.GSL
C       rec. 1 :  input file name
C       rec. 2 :  output file name
C       ( comment lines may be placed anywhere; they should begin with
C          an asterisk '*' ).
C
C  2. Problem specification file ( INAME ) with fileid specified in
C     FILEDEF.GSL.
C
C     In the description below strings with quotation marks like 'STRING'
C     should appear in the input file as they are. The descriptions of the
C     records containing specification data always begin with a FORTRAN
C     format employed in reading the record.  A list of variables follows.
C     CHAR(i) means the character representing the number i, + means
C     concatenation.
C
C       rec. 1 : '$PROBLEM'
C
C       rec. 2 : '$NAME'               problem name:
C       rec. 3 :  (A80)   PRNAME       any string of up to 80 chars
C
C       rec. 4 : '$TYPE'               problem type:
C       rec. 5 :  (I3)    PRTYPE         0 = LP problem
C                                        1 = two stage random recourse
C                                        2 = two stage fixed recourse
C                                        3 = two stage complete recourse
C                                        4 = two stage simple recourse
C
C       rec. 6 : '$STRUCT'             problem structure:
C       rec. 7 :  (15I5)  PRSTRU(I)    for each matrix resp. vector:
C                                      ( alltogether 11 arrays, for their
C                                        ordering see the picture above )
C                                        0 = array not required
C                                        1 = array required
C                                       >1 = for q(i),T(i),W(i) and h(i):
C                                            numb. of terms ( = numb. random
C                                            variables ).
C
C       rec. 8 : '$DIMENS'             problem dimensions:
C       rec. 9 :  (15I5)  MM1,NN1,MM2,NN2,NRVARS
C                                       MM1:    numb. of first stage rows
C                                       NN1:    numb. of first stage cols
C                                       MM2:    numb. of second stage rows
C                                       NN2:    numb. of second stage cols
C                                       NRVARS: numb. of random variables
C
C       rec.10 : '$SIGDIG'             significant digits:
C       rec.11 :  (I3)    SIGDIG       numb. of digits in generated data
C
C       rec.12 : '$SEED'               random seed:
C       rec.13 :  (F20.0) MYSEED       seed for random number generator
C
C       rec.14 : '$DATA'               arrays description data:
C
C       records next, for each individual array in turn:
C
C   C:
C                '$$C'                 first-stage objective c:
C                '$$$PATTERN'          pattern of nonzero entries:
C                 (I3)     PATTER        0: zero array
C                                        1: any pattern
C                '$$$DENSITY'          array density:
C                 (E22.15) DENSI       density ( % )
C                '$$$MAXVAL'           magnitude of entries
C                 (E22.15) MAXVAL      upper bound on the magnitude
C                '$$$INTERVAL'         range of entries:
C                 (I3)     INTERV        1: (-MAXVAL , +MAXVAL)
C                                        2: (0 , +MAXVAL)
C                                        3: (-MAXVAL , 0)
C   Q0:
C                '$$Q0'                constant part of recourse objective q0:
C                '$$$PATTERN'          pattern of nonzero entries:
C                 (I3)     PATTER        0: zero array
C                                        1: any pattern
C                '$$$DENSITY'          array density:
C                 (E22.15) DENSI       density ( % )
C                '$$$MAXVAL'           magnitude of entries
C                 (E22.15) MAXVAL      upper bound on the magnitude
C                '$$$INTERVAL'         range of entries:
C                 (I3)     INTERV        1: (-MAXVAL , +MAXVAL)
C                                        2: (0 , +MAXVAL)
C                                        3: (-MAXVAL , 0)
C
C      if q stochastic then
C      for each q(i) (i=1,..,NRVARS):
C
C   Q(i):
C                '$$Q' + CHAR(i)       regression term q(i):
C                '$$$PATTERN'          pattern of nonzero entries:
C                 (I3)     PATTER      pattern is:
C                                       -4: same for all terms and the same
C                                           as the constant part pattern
C                                       -3: same for all terms and superset
C                                           of constant part pattern
C                                       -2: same for all terms and subset
C                                           of constant part pattern
C                                       -1: same for all terms
C                                        0: zero array
C                                        1: arbitrary for each term
C                '$$$DENSITY'          array density:
C                 (E22.15) DENSI       density ( % )
C                '$$$MAXVAL'           magnitude of entries
C                 (E22.15) MAXVAL      upper bound on the magnitude
C                '$$$INTERVAL'         range of entries:
C                 (I3)     INTERV        1: (-MAXVAL , +MAXVAL)
C                                        2: (0 , +MAXVAL)
C                                        3: (-MAXVAL , 0)
C   A:
C                '$$A'                 first-stage technology matrix A:
C                '$$$MATTYPE'          matrix type:
C                 (I5)     MATTYP        0: any
C                                        1: full rank
C                '$$$PATTERN'          pattern of nonzero entries:
C                 (I3)     PATTER        0: zero array
C                                        1: any pattern
C                '$$$DENSITY'          array density:
C                 (E22.15) DENSI       density ( % )
C                '$$$MAXVAL'           magnitude of entries
C                 (E22.15) MAXVAL      upper bound on the magnitude
C                '$$$INTERVAL'         range of entries:
C                 (I3)     INTERV        1: (-MAXVAL , +MAXVAL)
C                                        2: (0 , +MAXVAL)
C                                        3: (-MAXVAL , 0)
C   B:
C                '$$B'                 first-stage RHS b:
C                '$$$PATTERN'          pattern of nonzero entries:
C                 (I3)     PATTER        0: zero array
C                                        1: any pattern
C                '$$$DENSITY'          array density:
C                 (E22.15) DENSI       density ( % )
C                '$$$MAXVAL'           magnitude of entries
C                 (E22.15) MAXVAL      upper bound on the magnitude
C                '$$$INTERVAL'         range of entries:
C                 (I3)     INTERV        1: (-MAXVAL , +MAXVAL)
C                                        2: (0 , +MAXVAL)
C                                        3: (-MAXVAL , 0)
C   T0:
C                '$$T0'                constant part of second-stage
C                                      technology matrix T0:
C                '$$$MATTYPE'          matrix type:
C                 (I5)     MATTYP        0: any
C                                        1: full rank
C                '$$$PATTERN'          pattern of nonzero entries:
C                 (I3)     PATTER        0: zero array
C                                        1: any pattern
C                '$$$DENSITY'          array density:
C                 (E22.15) DENSI       density ( % )
C                '$$$MAXVAL'           magnitude of entries
C                 (E22.15) MAXVAL      upper bound on the magnitude
C                '$$$INTERVAL'         range of entries:
C                 (I3)     INTERV        1: (-MAXVAL , +MAXVAL)
C                                        2: (0 , +MAXVAL)
C                                        3: (-MAXVAL , 0)
C
C       if T stochastic then
C       for each T(i) (i=1,..,NRVARS):
C
C   T(i):
C                '$$T' + CHAR(i)       regression term T(i):
C                '$$$MATTYPE'          matrix type:
C                 (I5)     MATTYP        0: any
C                                        1: full rank
C                '$$$PATTERN'          pattern of nonzero entries:
C                 (I3)     PATTER      pattern is:
C                                       -4: same for all terms and the same
C                                           as the constant part pattern
C                                       -3: same for all terms and superset
C                                           of constant part pattern
C                                       -2: same for all terms and subset
C                                           of constant part pattern
C                                       -1: same for all terms
C                                        0: zero array
C                                        1: arbitrary for each term
C                '$$$DENSITY'          array density:
C                 (E22.15) DENSI       density ( % )
C                '$$$MAXVAL'           magnitude of entries
C                 (E22.15) MAXVAL      upper bound on the magnitude
C                '$$$INTERVAL'         range of entries:
C                 (I3)     INTERV        1: (-MAXVAL , +MAXVAL)
C                                        2: (0 , +MAXVAL)
C                                        3: (-MAXVAL , 0)
C   W0:
C                '$$W0'                constant part of recourse matrix W0:
C                '$$$MATTYPE'          matrix type:
C                 (I5)     MATTYP
C                                        4: complete fixed recourse
C                                        3: simple recourse
C                                        2: general fixed recourse
C                                        0: any
C                '$$$PATTERN'          pattern of nonzero entries:
C                 (I3)     PATTER        0: zero array
C                                        1: any pattern
C                '$$$DENSITY'          array density:
C                 (E22.15) DENSI       density ( % )
C                '$$$MAXVAL'           magnitude of entries
C                 (E22.15) MAXVAL      upper bound on the magnitude
C                '$$$INTERVAL'         range of entries:
C                 (I3)     INTERV        1: (-MAXVAL , +MAXVAL)
C                                        2: (0 , +MAXVAL)
C                                        3: (-MAXVAL , 0)
C
C       if W stochastic then
C       for each W(i) (i=1,..,NRVARS):
C
C   W(i):
C                '$$W' + CHAR(i)       regression term W(i):
C                '$$$MATTYPE'          matrix type:
C                 (I5)     MATTYP        0: any
C                                        1: full rank
C                '$$$PATTERN'          pattern of nonzero entries:
C                 (I3)     PATTER      pattern is:
C                                       -4: same for all terms and the same
C                                           as the constant part pattern
C                                       -3: same for all terms and superset
C                                           of constant part pattern
C                                       -2: same for all terms and subset
C                                           of constant part pattern
C                                       -1: same for all terms
C                                        0: zero array
C                                        1: arbitrary for each term
C                '$$$DENSITY'          array density:
C                 (E22.15) DENSI       density ( % )
C                '$$$MAXVAL'           magnitude of entries
C                 (E22.15) MAXVAL      upper bound on the magnitude
C                '$$$INTERVAL'         range of entries:
C                 (I3)     INTERV        1: (-MAXVAL , +MAXVAL)
C                                        2: (0 , +MAXVAL)
C                                        3: (-MAXVAL , 0)
C   H0:
C                '$$H0'                constant part of recourse RHS h0:
C                '$$$PATTERN'          pattern of nonzero entries:
C                 (I3)     PATTER        0: zero array
C                                        1: any pattern
C                '$$$DENSITY'          array density:
C                 (E22.15) DENSI       density ( % )
C                '$$$MAXVAL'           magnitude of entries
C                 (E22.15) MAXVAL      upper bound on the magnitude
C                '$$$INTERVAL'         range of entries:
C                 (I3)     INTERV        1: (-MAXVAL , +MAXVAL)
C                                        2: (0 , +MAXVAL)
C                                        3: (-MAXVAL , 0)
C
C       if h stochastic then
C       for each h(i) (i=1,..,NRVARS):
C
C   H(i):
C                '$$H' + CHAR(i)       regression term h(i)
C                '$$$PATTERN'          pattern of nonzero entries:
C                 (I3)     PATTER      pattern is:
C                                       -4: same for all terms and the same
C                                           as the constant part pattern
C                                       -3: same for all terms and superset
C                                           of constant part pattern
C                                       -2: same for all terms and subset
C                                           of constant part pattern
C                                       -1: same for all terms
C                                        0: zero array
C                                        1: arbitrary for each term
C                '$$$DENSITY'          array density:
C                 (E22.15) DENSI       density ( % )
C                '$$$MAXVAL'           magnitude of entries
C                 (E22.15) MAXVAL      upper bound on the magnitude
C                '$$$INTERVAL'         range of entries:
C                 (I3)     INTERV        1: (-MAXVAL , +MAXVAL)
C                                        2: (0 , +MAXVAL)
C                                        3: (-MAXVAL , 0)
C
C       type of restrictions
C
C                '$$RESTRICT1'         the first MM1 restrictions:
C                 (25I3)   ROWTP1(.)   row type:
C                                       -1: greater than or equal  (>=)
C                                        0: equal                  ( =)
C                                       +1: less or equal          (<=)
C
C                '$$RESTRICT2'         the first MM2 restrictions:
C                 (25I3)   ROWTP2(.)   row type:
C                                       -1: greater than or equal  (>=)
C                                        0: equal                  ( =)
C                                       +1: less or equal          (<=)
C
C       end of problem specification
C
C                '$END'
C
C  3. Generated problem file ( OUFIL ) with fileid specified in FILEDEF.GSL.
C
C     In the description below strings with quotation marks like 'STRING'
C     will appear in the output file as they are. FORTRAN format is
C     indicated for the individual records. Each of the generated arrays
C     is written according to the same format as follows (vectors are
C     treated as matrices with a single column). CHAR(i) means the character
C     representing the number i, + stands for concatenation.
C       rec. 1 :  dimensionalities
C       (3I10)    MM,NN,NONZ
C                          MM:         number of rows
C                          NN:         number of columns
C                          NONZ:       overall number of nonzeros
C       rec. next; for each column in turn
C            first rec. :  number of nonzeros in column
C            (3I10)   CNONZ:            number of nonzeros in the column
C            rec. next; for each nonzero entry in turn
C            (I10,F20.10)  ROWIND,ENTRY
C                             ROWIND:  row index
C                             ENTRY:   matrix entry
C
C     Description of the output-file structure follows.
C
C       rec. 1 :  '$PROBLEM'
C
C       rec. 2 :  '$NAME'
C       rec. 3 :  (A80)                string PRNAME of up to 80 chars
C
C       rec. 4 :  '$TYPE'
C       rec. 5 :   (I3)                  0 : LP
C                                        1 : random recourse
C                                        2 : fixed recourse
C                                        3 : complete recourse
C                                        4 : simple recourse
C
C       rec. 6 :  '$STRUCT'
C       rec. 7 :   (15I5)              for each matrix resp. vector:
C                                        0 : array not required
C                                        1 : array required
C                                       >1 : for q(i),T(i), W(i) and h(i):
C                                            number of terms.
C
C       rec. 8 :  '$DIMENS'
C       rec. 9 :   (15I5)  MM1,NN1,MM2,NN2,NRVARS
C                                       MM1:    number of first stage rows
C                                       NN1:    number of first stage cols
C                                       MM2:    number of second stage rows
C                                       NN2:    number of second stage cols
C                                       NRVARS: number of random variables
C
C       rec.10 :  '$SIGDIG'
C       rec.11 :   (I3)                 number of significant digits
C
C       rec.12 :  '$DATA'
C
C       records next, in turn for the various arrays:
C
C       rec.      '$$Q0'
C           recs. next
C                      either nothing (zero vector)
C                      or     data for cost vector q0:
C
C       if q stochastic then
C       for each q(i) (i=1,..,NRVARS):
C
C       rec.      '$$Q' + CHAR(i)       regression term q(i):
C           recs. next
C                      either nothing (zero vector)
C                      or     data for regression term q(i):
C
C       rec.      '$$RESTRICT1'
C           recs. next
C                  (8I10)               MM1-vector with restriction
C                                       type identifiers:
C                                       +1: <=; 0: =; -1: >=
C
C       rec.      '$$A'
C           recs. next
C                     either nothing (zero matrix)
C                     or     data for technology matrix A:
C
C       rec.      '$$B'
C           recs. next
C                     either nothing (zero vector)
C                     or     data for RHS b:
C
C       rec.      '$$C'
C           recs. next
C                     either nothing (zero vector)
C                     or     data for cost vector c; format see above.
C
C       rec.      '$$RESTRICT2'
C           recs. next
C                  (8I10)               MM2-vector with restriction
C                                       type identifiers:
C                                       +1: <=; 0: =; -1: >=
C
C       rec.      '$$T0'
C           recs. next
C                      either nothing (zero matrix)
C                      or     data for technology matrix T0:
C
C       if T stochastic then
C       for each T(i) (i=1,..,NRVARS):
C
C       rec.      '$$T' + CHAR(i)
C           recs. next
C                      either nothing (zero matrix)
C                      or     data for regression term T(i):
C
C       rec.      '$$W'
C           recs. next
C                     either nothing (zero matrix)
C                     or     data for recourse matrix W:
C
C       if W stochastic then
C       for each W(i) (i=1,..,NRVARS):
C
C       rec.      '$$W' + CHAR(i)
C           recs. next
C                      either nothing (zero matrix)
C                      or     data for regression term W(i):
C
C       rec.      '$$H0'
C           recs. next
C                      either nothing (zero vector)
C                      or     data for RHS h0:
C
C       if h stochastic then
C       for each h(i) (i=1,..,NRVARS):
C
C       rec.      '$$H' + CHAR(i)
C           recs. next
C                      either nothing (zero vector)
C                      or     data for regression term h(i):
C
C       end of output file
C
C                  '$END'
C
C
C
C  Data structure:
C  ---------------
C  a vector is treated as a matrix with 1 column
C
C         MM1          --  actual number of rows for stage 1
C         NN1          --  actual number of columns for stage 1
C         MM2          --  actual number of rows for stage 2
C         NN2          --  actual number of columns for stage 2
C
C         ABYCOL       --  vector of nonzero elements of a matrix;
C         ROWNOS       --  vector of row indices of the nonzeros;
C         COLPNT       --  vector of pointers to the columns in the
C                          matrix representation ABYCOL,ROWNOS.
C                          COLPNT(1) = 0, otherwise COLPNT(I)
C                          addresses the last element in the
C                          preceding column;
C                          COLPNT(NN+1) contains then the number
C                          of nonzero elements.
C
C  There are 4 work vectors used in GENMAT:
C         WORK1         --  equivalent to ABYCOL
C         WIND1         --  equivalent to ROWNOS
C         WNZR1         --  variable containing number of nonzeros
C                           in the vector
C         WORK2
C         WIND2              same structure as above
C         WNZR2
C         WORK3
C         WIND3              same structure as above
C         WNZR3
C         WIND4              same structure as above
C         WNZR4
C
C
C====================================================================
C
C Changing maximal dimensions of arrays should be performed here.
C
      INTEGER      NONZ,NCOLS,NCOLSP,NROWS,MAXVEC
C77   PARAMETER   (NONZ=10000,NCOLS=3000,NCOLSP=NCOLS+1,NROWS=2000)
C77   PARAMETER   (MAXVEC=3000)
      INTEGER      MAXNZ,MAXCO,MAXCOP,MAXRO,MAXVC
C
C Problem generation data
C     meaning:
C                  NONZ   :  Max number of nonzeros in matrix
C                  NCOLS  :  Max number of cols of the matrix
C                  NROWS  :  Max number of rows of the matrix
C
      INTEGER      NSTRU,NRV,NTOT
C77   PARAMETER   (NSTRU=11,NTOT=4*NRV+NSTRU)
C     Meaning:
C                  NSTRU  :  Number of array types
C                            (c,q0,qi,A,b,T0,Ti,W0,Wi,h0,hi)
C                  NRV    :  Max number of terms in q(i), T(i), W(i) or h(i).
C                  NTOT   :  Max totals of vectors and matrices.
C
C Data matrix
      INTEGER           MM1,NN1,MM2,NN2,NRVARS
C77   DOUBLE PRECISION  ABYCOL(NONZ)
C77   INTEGER           ROWNOS(NONZ)
C77   INTEGER           COLPNT(NCOLSP)
C-----FORTRAN-90--------------------------------------------------------
      DOUBLE PRECISION  ABYCOL( : )
      INTEGER           ROWNOS( : )
      INTEGER           COLPNT( : )
      ALLOCATABLE ::    ABYCOL,ROWNOS,COLPNT
C-----------------------------------------------------------------------
C Work vectors
C77   DOUBLE PRECISION  WORK1(MAXVEC),WORK2(MAXVEC),WORK3(MAXVEC)
C77   INTEGER           INDIC1(MAXVEC),INDIC2(MAXVEC),INDIC3(MAXVEC)
C-----FORTRAN-90--------------------------------------------------------
      DOUBLE PRECISION  WORK1( : ),WORK2( : ),WORK3( : )
      INTEGER           INDIC1( : ),INDIC2( : ),INDIC3( : ),INDIC4(:)
      ALLOCATABLE ::    WORK1,WORK2,WORK3,INDIC1,INDIC2,INDIC3,INDIC4
C-----------------------------------------------------------------------
      INTEGER           NONZR1,NONZR2,NONZR3
C Problem description
      CHARACTER*80      PRNAME
C77   INTEGER           PRTYPE,PRSTRU(NSTRU),SIGDIG
C77   INTEGER           ROWTP1(NROWS),ROWTP2(NROWS)
C-----FORTRAN-90--------------------------------------------------------
      INTEGER           PRTYPE,PRSTRU( : ),SIGDIG
      INTEGER           ROWTP1( : ),ROWTP2( : )
      ALLOCATABLE ::    PRSTRU,ROWTP1,ROWTP2
C-----------------------------------------------------------------------
      REAL              MYSEED,DUMMY
C Individual matrix descriptions
C77   INTEGER           PATT(NTOT)
C77   INTEGER           MATT(NTOT)
C77   INTEGER           INTV(NTOT)
C77   DOUBLE PRECISION  DENS(NTOT)
C77   DOUBLE PRECISION  MAXV(NTOT)
C-----FORTRAN-90--------------------------------------------------------
      INTEGER           PATT( : )
      INTEGER           MATT( : )
      INTEGER           INTV( : )
      DOUBLE PRECISION  DENS( : )
      DOUBLE PRECISION  MAXV( : )
      ALLOCATABLE ::    PATT,MATT,INTV,DENS,MAXV
C-----------------------------------------------------------------------
C Further variables for matrix generation routine
      INTEGER           ISTAT,NONZRS,TINDIC
      DOUBLE PRECISION  DETERM
C
C
C Input/output file data
      CHARACTER*12 INFIL,OUFIL
      INTEGER      IUNIT,OUNIT
C
C Local variables
      LOGICAL      IN,OUT
      INTEGER*2    IG,IE
      INTEGER      TOTMV,LCNT,MMWORK,NNWORK,PATTSV,JOINT,NZROW
      CHARACTER*80 LINE
      INTEGER      LINCNT,POSDLR,INSTAT,PPOS1,PPOS2,RECLEN,FIELDL,II
      INTEGER      PPOS
      CHARACTER    KEYW0(8)*7
      CHARACTER    KEYW1(11)*4
      CHARACTER    PARAM(5)*3
      CHARACTER*10 DFORM
      INTEGER      I,J,INDIC
C
      LOGICAL      SAVEMV
      INTEGER      NOS
C
C Functions used
      INTEGER      SUM, ARRPOS
      LOGICAL      ALLPOS,EXINEG
C
      DATA KEYW0  /'PROBLEM','NAME   ','TYPE   ','STRUCT ','DIMENS ',
     *             'SIGDIG ','SEED   ','DATA   '/
      DATA KEYW1  /'$$C ','$$Q0','$$Q ','$$A ','$$B ',
     *             '$$T0','$$T ','$$W0','$$W ','$$H0','$$H '/
      DATA PARAM  /'MAT','PAT','DEN','MAX','INT'/
C
      OPEN( UNIT = 1, FILE = 'GENSLP.DIM' )
      READ(1,1100) NROWS,NCOLS,NONZ,NRV
      NCOLSP  = NCOLS + 1
      MAXVEC = NCOLS
      IF ( NROWS .GT. NCOLS ) MAXVEC = NROWS
      NSTRU = 12
      NTOT = 4 * NRV + NSTRU
      CLOSE( 1 )
C-----FORTRAN-90--------------------------------------------------------
      ALLOCATE( ABYCOL(NONZ),    ROWNOS(NONZ),    COLPNT(NCOLSP),
     *          WORK1(MAXVEC),   WORK2(MAXVEC),   WORK3(MAXVEC),
     *          INDIC1(MAXVEC),  INDIC2(MAXVEC),  INDIC3(MAXVEC),
     *          INDIC4(MAXVEC),
     *          ROWTP1(NROWS),   ROWTP2(NROWS),   PRSTRU(NSTRU),
     *          PATT(NTOT),      MATT(NTOT),      INTV(NTOT),
     *          DENS(NTOT),      MAXV(NTOT)  )
C-----------------------------------------------------------------------
C
C  0. Initializatons, reading configuration file FILEDEF.GSL
C  ---------------------------------------------------------
      ISTAT=0
      MAXNZ=NONZ
      MAXCO=NCOLS
      MAXCOP=MAXCO+1
      MAXRO=NROWS
      MAXVC=MAXVEC
C
      RECLEN=80
      DO 1 I=1,NTOT
         PATT(I)=1
         MATT(I)=0
         INTV(I)=1
         DENS(I)=1.0D0
         MAXV(I)=1.0D1
    1 CONTINUE
      IUNIT = 1
      OUNIT = 2
cc    OPEN (IUNIT,FILE='GENSLP.FIL',STATUS='UNKNOWN')
cc    IN  = .FALSE.
cc    OUT = .FALSE.
C  Loop over all the lines in FILEDEF.GSL
c 5   CONTINUE
c     READ (IUNIT,'(A)',END=6) LINE
c     IF (LINE(1:1) .EQ. '*') THEN
C  Comment line encountered
c       GOTO 5
c                             ELSE
C  Name lines
c       IF      (.NOT. IN .AND. .NOT. OUT) THEN
c         INFIL = LINE(1:12)
c         IN = .TRUE.
c       ELSE IF (IN .AND. .NOT. OUT)      THEN
c         OUFIL = LINE(1:12)
c         OUT = .TRUE.
c       ELSE
c         GOTO 6
c       ENDIF
c       GOTO 5
c     ENDIF
c 6   CONTINUE
c     IF (.NOT. IN .OR. .NOT. OUT) THEN
c       WRITE (*,'(A)')
c    *        '  **** syntax error **** in file FILEDEF.GSL'
c       GOTO 500
c     ENDIF
c     CLOSE (IUNIT)
C
C  1. Read input file INFIL and check for syntax errors
C  ----------------------------------------------------
C
      OPEN (IUNIT,FILE='GENSLPN.INP',STATUS='UNKNOWN')
C
      LINCNT = 0
C
C  Process first input file lines concerning the problem structure
C  ---------------------------------------------------------------
C  Loop over the first one dollar keywords (at time 8)
      DO 10  I=1,8
C  Read next line
        READ (IUNIT,'(A)') LINE
        LINCNT = LINCNT+1
        POSDLR = INDEX(LINE,'$')
        IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
          CALL SXERR(LINCNT)
          GOTO 500
        ENDIF
        IF (LINE(POSDLR+1:POSDLR+7) .NE. KEYW0(I)) THEN
C  Wrong keyword
          CALL SXERR(LINCNT)
          GOTO 500
        ENDIF
C  Skip '$PROBLEM' or '$DATA'
        IF      (I .EQ. 1 .OR. I .EQ. 8) THEN
          GOTO 10
C  Extract problem name
        ELSE IF (I .EQ. 2) THEN
          READ (IUNIT,'(A)',IOSTAT=INSTAT) PRNAME
          LINCNT = LINCNT+1
          IF (INSTAT .NE. 0) THEN
            CALL IOERR(LINCNT)
            GOTO 500
          ENDIF
C  Extract problem type
        ELSE IF (I .EQ. 3) THEN
          READ (IUNIT,'(I3)',IOSTAT=INSTAT) PRTYPE
          LINCNT = LINCNT+1
          IF (INSTAT .NE. 0) THEN
            CALL IOERR(LINCNT)
            GOTO 500
          ENDIF
C  Extract problem structure
        ELSE IF (I .EQ. 4) THEN
          READ (IUNIT,'(15I5)',IOSTAT=INSTAT)
     *         (PRSTRU(II), II=1,NSTRU)
          LINCNT = LINCNT+1
          IF (INSTAT .NE. 0) THEN
            CALL IOERR(LINCNT)
            GOTO 500
          ENDIF
C  Now calculate total number of matrices in this problem
          TOTMV = SUM(PRSTRU,NSTRU)
C  Pre-inspect problem structure for plausibility:
C  test maximal number of vectors and matrices
          IF (TOTMV .GT. NTOT) THEN
            WRITE(*,'(A)') ' Dimension error...'
            GOTO 500
          ENDIF
C  Test for no negative elements in PRSTRU(.):
          IF (EXINEG(PRSTRU,NSTRU)) THEN
            CALL PLERR(KEYW0(I))
            GOTO 500
          ENDIF
C  Test existence of at least 1 structural element
          IF (TOTMV .EQ. 0) THEN
            CALL PLERR(KEYW0(I))
            GOTO 500
          ENDIF
C  Test for other structural elements beside cost vectors
cc        IF ((PRSTRU(1) .NE. 0 .OR. PRSTRU(2) .NE. 0 .OR.
cc   *        PRSTRU(3) .NE. 0) .AND.
cc   *        SUM(PRSTRU(4),NSTRU-3) .EQ. 0) THEN
cc          CALL PLERR(KEYW0(I))
cc          GOTO 500
cc        ENDIF
C  Extract problem dimensions
        ELSE IF (I .EQ. 5) THEN
          READ (IUNIT,'(15I5)',IOSTAT=INSTAT) MM1,NN1,MM2,NN2,NRVARS
          LINCNT = LINCNT+1
          IF (INSTAT .NE. 0) THEN
            CALL IOERR(LINCNT)
            GOTO 500
          ENDIF
C  Pre-inspect problem row dimensions
          IF (MM1 .LT. 0 .OR. MM1 .GT. NROWS) THEN
            WRITE(*,'(A)') 'Dimension error...'
            GOTO 500
          ENDIF
          IF (MM1 .EQ. 0) THEN
            IF (PRSTRU(4) .NE. 0 .OR. PRSTRU(5) .NE. 0) THEN
              CALL PLERR(KEYW0(I))
              GOTO 500
            ENDIF
          ENDIF
          IF (MM2 .LT. 0 .OR. MM2 .GT. NROWS) THEN
            CALL PLERR(KEYW0(I))
            GOTO 500
          ENDIF
cc        IF (MM2 .EQ. 0) THEN
cc          IF (.NOT. (SUM(PRSTRU(6),NSTRU-5) .EQ. 0)) THEN
cc            CALL PLERR(KEYW0(I))
cc            GOTO 500
cc          ENDIF
cc        ENDIF
C  Extract info for problem output format
        ELSE IF (I .EQ. 6) THEN
          READ (IUNIT,'(I3)',IOSTAT=INSTAT) SIGDIG
          LINCNT = LINCNT+1
          IF (INSTAT .NE. 0) THEN
            CALL IOERR(LINCNT)
            GOTO 500
          ENDIF
C  Extract seed for the random number generator
        ELSE IF (I .EQ. 7) THEN
          READ (IUNIT,'(E20.10)',IOSTAT=INSTAT) MYSEED
          LINCNT = LINCNT+1
          IF (INSTAT .NE. 0) THEN
            CALL IOERR(LINCNT)
            GOTO 500
          ENDIF
        ENDIF
  10  CONTINUE
C
C  Loop over all structure element descriptions
C  --------------------------------------------
C  Position where value is stored in MATT(.),PATT(.),etc.
      PPOS1 = 1
      PPOS2 = 1
      DO 20  I = 1,NSTRU-1
        IF (PRSTRU(I) .NE. 0) THEN
C
C  It is a simple structure element (c, q0, A, b, T0, W0, h0)
C
          IF (I .NE. 3 .AND. I .NE. 7 .AND.
     *        I .NE. 9 .AND. I .NE. 11     )    THEN
            READ (IUNIT,'(A)') LINE
            LINCNT = LINCNT+1
            POSDLR = INDEX(LINE,'$')
            IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
              CALL SXERR(LINCNT)
              GOTO 500
            ENDIF
            IF (LINE(POSDLR:POSDLR+3) .NE. KEYW1(I)) THEN
C  Wrong structure element identifier
              CALL SXERR(LINCNT)
              GOTO 500
            ENDIF
C           Only for a matrix read MATTYPE
            IF (I .EQ. 4 .OR. I .EQ. 6 .OR. I .EQ. 8) THEN
C  -- identifier '$$$MATTYPE'
              READ (IUNIT,'(A)') LINE
              LINCNT = LINCNT+1
              POSDLR = INDEX(LINE,'$')
              IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
              IF (LINE(POSDLR+3:POSDLR+5) .NE. PARAM(1)) THEN
C  Wrong identifier
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
C  -- extract numerical value
              READ (IUNIT,'(I3)',IOSTAT=INSTAT) MATT(PPOS2)
              LINCNT = LINCNT+1
              IF (INSTAT .NE. 0) THEN
                CALL IOERR(LINCNT)
                GOTO 500
              ENDIF
              PPOS2 = PPOS2 + 1
            ENDIF
C  -- identifier '$$$PATTERN'
            READ (IUNIT,'(A)') LINE
            LINCNT = LINCNT+1
            POSDLR = INDEX(LINE,'$')
            IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
              CALL SXERR(LINCNT)
              GOTO 500
            ENDIF
            IF (LINE(POSDLR+3:POSDLR+5) .NE. PARAM(2)) THEN
C  Wrong identifier
              CALL SXERR(LINCNT)
              GOTO 500
            ENDIF
C  -- extract numerical value
            READ (IUNIT,'(I3)',IOSTAT=INSTAT) PATT(PPOS1)
            LINCNT = LINCNT+1
            IF (INSTAT .NE. 0) THEN
              CALL IOERR(LINCNT)
              GOTO 500
            ENDIF
C  -- identifier '$$$DENSITY'
            READ (IUNIT,'(A)') LINE
            LINCNT = LINCNT+1
            POSDLR = INDEX(LINE,'$')
            IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
              CALL SXERR(LINCNT)
              GOTO 500
            ENDIF
            IF (LINE(POSDLR+3:POSDLR+5) .NE. PARAM(3)) THEN
C  Wrong identifier
              CALL SXERR(LINCNT)
              GOTO 500
            ENDIF
C  -- extract numerical value
            READ (IUNIT,'(E22.15)',IOSTAT=INSTAT) DENS(PPOS1)
            LINCNT = LINCNT+1
            IF (INSTAT .NE. 0) THEN
              CALL IOERR(LINCNT)
              GOTO 500
            ENDIF
C  -- identifier '$$$MAXVAL'
            READ (IUNIT,'(A)') LINE
            LINCNT = LINCNT+1
            POSDLR = INDEX(LINE,'$')
            IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
              CALL SXERR(LINCNT)
              GOTO 500
            ENDIF
            IF (LINE(POSDLR+3:POSDLR+5) .NE. PARAM(4)) THEN
C  Wrong identifier
              CALL SXERR(LINCNT)
              GOTO 500
            ENDIF
C  -- extract numerical value
            READ (IUNIT,'(E22.15)',IOSTAT=INSTAT) MAXV(PPOS1)
            LINCNT = LINCNT+1
            IF (INSTAT .NE. 0) THEN
              CALL IOERR(LINCNT)
              GOTO 500
            ENDIF
C  -- identifier '$$$INTERVAL'
            READ (IUNIT,'(A)') LINE
            LINCNT = LINCNT+1
            POSDLR = INDEX(LINE,'$')
            IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
              CALL SXERR(LINCNT)
              GOTO 500
            ENDIF
            IF (LINE(POSDLR+3:POSDLR+5) .NE. PARAM(5)) THEN
C  Wrong identifier
              CALL SXERR(LINCNT)
              GOTO 500
            ENDIF
C  -- extract numerical value
            READ (IUNIT,'(I3)',IOSTAT=INSTAT) INTV(PPOS1)
            LINCNT = LINCNT+1
            IF (INSTAT .NE. 0) THEN
              CALL IOERR(LINCNT)
              GOTO 500
            ENDIF
C
            PPOS1 = PPOS1 + 1
C
C  It is a multiple structure element (qi, Ti, Wi, hi)
C
          ELSE
            LCNT = PRSTRU(I)
C           WRITE (*,'(A,I5)') ' Anzahl i_s:',LCNT
            DO 30  J=1,LCNT
              READ (IUNIT,'(A)') LINE
              LINCNT = LINCNT+1
              POSDLR = INDEX(LINE,'$')
              IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
              IF (LINE(POSDLR:POSDLR+2) .NE. KEYW1(I)(1:3)) THEN
C  Wrong structure element identifier
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
C  Only for  a matrix read '$$$MATTYPE'
              IF (I .EQ. 7 .OR. I .EQ. 9) THEN
C  -- identifier '$$$MATTYPE'
                READ (IUNIT,'(A)') LINE
                LINCNT = LINCNT+1
                POSDLR = INDEX(LINE,'$')
                IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
                  CALL SXERR(LINCNT)
                  GOTO 500
                ENDIF
                IF (LINE(POSDLR+3:POSDLR+5) .NE. PARAM(1)) THEN
C  Wrong identifier
                  CALL SXERR(LINCNT)
                  GOTO 500
                ENDIF
C  -- extract numerical value
                READ (IUNIT,'(I3)',IOSTAT=INSTAT) MATT(PPOS2)
                LINCNT = LINCNT+1
                IF (INSTAT .NE. 0) THEN
                  CALL IOERR(LINCNT)
                  GOTO 500
                ENDIF
                PPOS2 = PPOS2 + 1
              ENDIF
C  -- identifier '$$$PATTERN'
              READ (IUNIT,'(A)') LINE
              LINCNT = LINCNT+1
              POSDLR = INDEX(LINE,'$')
              IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
              IF (LINE(POSDLR+3:POSDLR+5) .NE. PARAM(2)) THEN
C  Wrong identifier
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
C  -- extract numerical value
              READ (IUNIT,'(I3)',IOSTAT=INSTAT) PATT(PPOS1)
              LINCNT = LINCNT+1
              IF (INSTAT .NE. 0) THEN
                CALL IOERR(LINCNT)
                GOTO 500
              ENDIF
C  -- identifier '$$$DENSITY'
              READ (IUNIT,'(A)') LINE
              LINCNT = LINCNT+1
              POSDLR = INDEX(LINE,'$')
              IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
              IF (LINE(POSDLR+3:POSDLR+5) .NE. PARAM(3)) THEN
C  Wrong identifier
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
C  -- extract numerical value
              READ (IUNIT,'(E22.15)',IOSTAT=INSTAT) DENS(PPOS1)
              LINCNT = LINCNT+1
              IF (INSTAT .NE. 0) THEN
                CALL IOERR(LINCNT)
                GOTO 500
              ENDIF
C  -- identifier '$$$MAXVAL'
              READ (IUNIT,'(A)') LINE
              LINCNT = LINCNT+1
              POSDLR = INDEX(LINE,'$')
              IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
              IF (LINE(POSDLR+3:POSDLR+5) .NE. PARAM(4)) THEN
C  Wrong identifier
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
C  -- extract numerical value
              READ (IUNIT,'(E22.15)',IOSTAT=INSTAT) MAXV(PPOS1)
              LINCNT = LINCNT+1
              IF (INSTAT .NE. 0) THEN
                CALL IOERR(LINCNT)
                GOTO 500
              ENDIF
C  -- identifier '$$$INTERVAL'
              READ (IUNIT,'(A)') LINE
              LINCNT = LINCNT+1
              POSDLR = INDEX(LINE,'$')
              IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
              IF (LINE(POSDLR+3:POSDLR+5) .NE. PARAM(5)) THEN
C  Wrong identifier
                CALL SXERR(LINCNT)
                GOTO 500
              ENDIF
C  -- extract numerical value
              READ (IUNIT,'(I3)',IOSTAT=INSTAT) INTV(PPOS1)
              LINCNT = LINCNT+1
              IF (INSTAT .NE. 0) THEN
                CALL IOERR(LINCNT)
                GOTO 500
              ENDIF
C
              PPOS1 = PPOS1 + 1
   30       CONTINUE
          ENDIF
        ENDIF
  20  CONTINUE
C  Identifier $$RESTRICT1
      READ (IUNIT,'(A)') LINE
      LINCNT = LINCNT+1
      POSDLR = INDEX(LINE,'$')
      IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
        CALL SXERR(LINCNT)
        GOTO 500
      ENDIF
      IF (LINE(POSDLR:POSDLR+10) .NE. '$$RESTRICT1') THEN
C  Wrong keyword
        CALL SXERR(LINCNT)
        GOTO 500
      ENDIF
      READ (IUNIT,'(25I3)',IOSTAT=INSTAT)
     *        (ROWTP1(II), II=1,MM1)
      LINCNT = LINCNT+1
      IF (INSTAT .NE. 0) THEN
        CALL IOERR(LINCNT)
        GOTO 500
      ENDIF
C  Identifier $$RESTRICT2
      READ (IUNIT,'(A)') LINE
      LINCNT = LINCNT+1
      POSDLR = INDEX(LINE,'$')
      IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
        CALL SXERR(LINCNT)
        GOTO 500
      ENDIF
      IF (LINE(POSDLR:POSDLR+10) .NE. '$$RESTRICT2') THEN
C  Wrong keyword
        CALL SXERR(LINCNT)
        GOTO 500
      ENDIF
      READ (IUNIT,'(25I3)',IOSTAT=INSTAT)
     *        (ROWTP2(II), II=1,MM2)
      LINCNT = LINCNT+1
      IF (INSTAT .NE. 0) THEN
        CALL IOERR(LINCNT)
        GOTO 500
      ENDIF
C
C  Identifier $END
      READ (IUNIT,'(A)') LINE
      LINCNT = LINCNT+1
      POSDLR = INDEX(LINE,'$')
      IF (POSDLR .EQ. 0) THEN
C  Dollar sign is missing
        CALL SXERR(LINCNT)
        GOTO 500
      ENDIF
      IF (LINE(POSDLR+1:POSDLR+3) .NE. 'END') THEN
C  Wrong keyword
        CALL SXERR(LINCNT)
        GOTO 500
      ENDIF
C
      CLOSE(IUNIT)
C
      PPOS1=PPOS1-1
      PPOS2=PPOS2-1
C
CCC ***** Only for test purposes
C     WRITE (*,'(A)') ' $PROBLEM NAME'
C     WRITE (*,'(A)') PRNAME
C     WRITE (*,'(A)') ' $PROBLEM TYPE'
C     WRITE (*,'(I3)') PRTYPE
C     WRITE (*,'(A)') ' $PROBLEM STRUCT'
C     WRITE (*,'(15I5)') (PRSTRU(II), II=1,NSTRU)
C     WRITE (*,'(A)') ' $PROBLEM DIMENS'
C     WRITE (*,'(15I5)') MM1,NN1,MM2,NN2
C     WRITE (*,'(A)') ' $PROBLEM PRECISION'
C     WRITE (*,'(I3)') SIGDIG
C     WRITE (*,'(A)') ' $PROBLEM SEED'
C     WRITE (*,'(F20.0)') MYSEED
C     WRITE (*,'(A)') ' Matrix Type'
C     WRITE (*,'(15I5)')(MATT(II),II=1,PPOS2)
C     WRITE (*,'(A)') ' Matrix Pattern'
C     WRITE (*,'(15I5)')(PATT(II),II=1,PPOS1)
C     WRITE (*,'(A)') ' Matrix Interval'
C     WRITE (*,'(15I5)')(INTV(II),II=1,PPOS1)
C     WRITE (*,'(A)') ' Matrix DEnsity'
C     WRITE (*,'(3E22.15)')(DENS(II),II=1,PPOS1)
C     WRITE (*,'(A)') ' Matrix Maximal value'
C     WRITE (*,'(3E22.15)')(MAXV(II),II=1,PPOS1)
C     WRITE (*,'(A)') ' Restrictions 1:'
C     WRITE (*,'(15I5)') (ROWTP1(II), II=1,MM1)
C     WRITE (*,'(A)') ' Restrictions 2:'
C     WRITE (*,'(15I5)') (ROWTP2(II), II=1,MM2)
C     WRITE (*,'(A)') ' End 1 Test-Output'
C
C  2. Perform plausibility tests
C  -----------------------------

      IF (NN1 .GT. NCOLS .OR. NN2 .GT. NCOLS .OR.
     *    MM1 .GT. NROWS .OR. MM2 .GT. NROWS)      THEN
          WRITE(*,'(A)') 'Dimension too high...'
          STOP
      ENDIF

C     Hier sollte man berpfen auch mgliche zu grosse Dichte,
C     d.h. z.B. nn1*mm1*densi > nonz etc...
C
C .......... Nach dieser Sequenz sollten vernnftige Werte
C..........  angenommen werden knnen
C
C  3. Generate problem and write output file OUFIL
C  -----------------------------------------------
C
C------------- Lahey F77L-EM/32 intrinsic function ----------------
C
      DUMMY=RANDS(MYSEED)
C  Prepare variable output format for double precision numbers:
C  DFORM = '(NNEWW.DD)'
C  (DD=SIGDIG,WW=SIGDIG+7,NN=RECLEN/WW)
      DFORM = '(NNEWW.DD)'
      WRITE (DFORM(8:9),'(I2)') SIGDIG
      WRITE (DFORM(5:6),'(I2)') SIGDIG+7
      WRITE (DFORM(2:3),'(I2)') RECLEN/(SIGDIG+7)
C
      OPEN (OUNIT,FILE='GENSLPN.OUT',STATUS='UNKNOWN')
      WRITE (OUNIT,'(A)') '$PROBLEM'
      WRITE (OUNIT,'(A)') '$NAME'
      WRITE (OUNIT,'(A)') PRNAME
C
      WRITE (OUNIT,'(A)') '$TYPE'
      WRITE (OUNIT,'(I3)') PRTYPE
C
      WRITE (OUNIT,'(A)') '$STRUCT'
      WRITE (OUNIT,'(15I5)') (PRSTRU(II), II=1,NSTRU)
C
      WRITE (OUNIT,'(A)') '$DIMENS'
      WRITE (OUNIT,'(15I5)') MM1,NN1,MM2,NN2,NRVARS
C
      WRITE (OUNIT,'(A)') '$SIGDIG'
      WRITE (OUNIT,'(I3)') SIGDIG
C
      WRITE (OUNIT,'(A)') '$DATA'
C  PPOS points to the required info in PATT(.),INTV(.),
C  DENS(.),MAXV(.) in order to generate a matrix or vector
C  PPOS2 points to the required info in MATT(.).
      PPOS = 0
      PPOS2 = 0
C ---------------------
      JOINT = 0
      NZROW = 0
      PATTSV = 1
C --  Process q0-vector
      WRITE (OUNIT,'(A)') '$$Q0'
      PPOS = ARRPOS( 2, PRSTRU, NTOT )
      NNWORK = 0
      IF ( PPOS .EQ. 0 ) GOTO 300
      IF (NN2 .EQ. 0 .OR. PRSTRU(2) .EQ. 0 .OR.
     *    PATT(PPOS) .EQ. 0) GOTO 300
      PATTSV=PATT(PPOS)
      TINDIC=0
      NNWORK=NN2
      WRITE(*,'(A)')' Generating vector q ...'
      CALL GENMAT
     *           (ABYCOL,ROWNOS,COLPNT,NNWORK,1,
     *            WORK1,INDIC1,NONZR1,
     *            WORK2,INDIC2,NONZR2,
     *            WORK3,INDIC3,NONZR3,
     *            SIGDIG,0,DENS(PPOS),MAXV(PPOS),
     *            2,NONZRS,1,DETERM,ISTAT,
     *            MAXNZ,MAXCO,MAXCOP,MAXRO,MAXVC,TINDIC,
     *            INDIC4,JOINT,NZROW)
      WRITE(*,'(/)')
  300 CALL PRNMAT
     *  (ABYCOL,ROWNOS,COLPNT,NNWORK,1,SIGDIG,FIELDL,OUNIT,MAXNZ,MAXCOP)
C --  Process q1...qn vectors
      IF (PRSTRU(3) .GT. 0) THEN
        PPOS = ARRPOS( 2, PRSTRU, NTOT )
        DO 210  J=1,PRSTRU(3)
        WRITE (OUNIT,'(A)') '$$Q'// CHAR(J+ICHAR('0'))
        PPOS=PPOS+1
        PATTSV=PATT(PPOS)
        TINDIC=0
        NNWORK=NN2
        IF (PATTSV .EQ. -1 .AND. J .EQ. 1) TINDIC=1
        IF (NN2 .EQ. 0 .OR. PRSTRU(3) .EQ. 0 .OR.
     *                      PATTSV    .EQ. 0) NNWORK=0
        WRITE(*,'(A,I2,A)')' Generating vector q',J,' ...'
        CALL GENMAT
     *           (ABYCOL,ROWNOS,COLPNT,NNWORK,1,
     *            WORK1,INDIC1,NONZR1,
     *            WORK2,INDIC2,NONZR2,
     *            WORK3,INDIC3,NONZR3,
     *            SIGDIG,0,DENS(PPOS),MAXV(PPOS),
     *            2,NONZRS,PATTSV,DETERM,ISTAT,
     *            MAXNZ,MAXCO,MAXCOP,MAXRO,MAXVC,TINDIC,
     *            INDIC4,JOINT,NZROW)
        WRITE(*,'(/)')
        CALL PRNMAT
     * (ABYCOL,ROWNOS,COLPNT,NNWORK,1,SIGDIG,FIELDL,OUNIT,MAXNZ,MAXCOP)
 210    CONTINUE
      ENDIF
C --  Process A-matrix
      WRITE (OUNIT,'(A)') '$$A'
      NNWORK = 0
      PPOS = ARRPOS( 4, PRSTRU, NTOT )
      PPOS2 = 1
      IF ( PPOS .EQ. 0 ) GOTO 310
      IF (MM1 .EQ. 0 .OR. NN1 .EQ. 0 .OR. PRSTRU(4) .EQ. 0 .OR.
     *                    PATT(PPOS) .EQ. 0) GOTO 310
      MMWORK=MM1
      NNWORK=NN1
      TINDIC=0
      WRITE(*,'(A,I2)')' Generating matrix A ...'
      JOINT = 1
      NZROW = 1
      CALL GENMAT
     *           (ABYCOL,ROWNOS,COLPNT,MMWORK,NNWORK,
     *            WORK1,INDIC1,NONZR1,
     *            WORK2,INDIC2,NONZR2,
     *            WORK3,INDIC3,NONZR3,
     *            SIGDIG,MATT(PPOS2),DENS(PPOS),MAXV(PPOS),
     *            INTV(PPOS),NONZRS,PATT(PPOS),DETERM,ISTAT,
     *            MAXNZ,MAXCO,MAXCOP,MAXRO,MAXVC,TINDIC,
     *            INDIC4,JOINT,NZROW)
      WRITE(*,'(/)')
  310 CONTINUE
      JOINT = 0
      NZROW = 0
      CALL PRNMAT
     *  (ABYCOL,ROWNOS,COLPNT,MMWORK,NNWORK,SIGDIG,FIELDL,OUNIT,
     *   MAXNZ,MAXCOP)
C --  Process b-vector and c-vector
      WRITE (OUNIT,'(A)') '$$B'
      MMWORK = 0
      NNWORK = 0
      INDIC = -1
      PPOS = ARRPOS( 5, PRSTRU, NTOT )
      IF ( PPOS .EQ. 0 ) GOTO 320
      IF (MM1 .EQ. 0 .OR. PRSTRU(5) .EQ. 0 .OR.
     *                    PATT(PPOS) .EQ. 0) GOTO 320
      INDIC = 1
      MMWORK  = MM1
      NNWORK = NN1
      TINDIC=0
      IF (MM1 .EQ. 0 .OR. PRSTRU(5) .EQ. 0 .OR.
     *                    PATT(PPOS) .EQ. 0) MMWORK=0
      ISTAT=-1
      DO 100 II=1,MM1
  100 INDIC2(II)=ROWTP1(II)
      WRITE(*,'(A,I2)')' Generating vectors b and c ...'
        CALL GENMAT
     *           (ABYCOL,ROWNOS,COLPNT,MM1,NN1,
     *            WORK1,INDIC1,NONZR1,
     *            WORK2,INDIC2,NONZR2,
     *            WORK3,INDIC3,NONZR3,
     *            SIGDIG,0,DENS(PPOS),MAXV(PPOS),
     *            INTV(PPOS),NONZRS,PATT(PPOS),DETERM,ISTAT,
     *            MAXNZ,MAXCO,MAXCOP,MAXRO,MAXVC,TINDIC,
     *            INDIC4,JOINT,NZROW)
      ISTAT=0
      WRITE(*,'(/)')
      CALL COPVEC
     *           (ABYCOL,ROWNOS,COLPNT,MM1,1,
     *            WORK3,ISTAT,MAXNZ,MAXCOP,MAXRO)
  320 CALL PRNMAT
     *  (ABYCOL,ROWNOS,COLPNT,MMWORK,1,SIGDIG,FIELDL,OUNIT,MAXNZ,MAXCOP)
      IF ( INDIC .LT. 0 ) GOTO 330
C --  Process c-vector
C --------------------
C     MODIFICATION MADE TO ENSURE A BOUNDED OBJECTIVE FUNCTION
      WRITE (OUNIT,'(A)') '$$C'
      CALL COPVEC
     *           (ABYCOL,ROWNOS,COLPNT,NN1,1,
     *            WORK2,ISTAT,MAXNZ,MAXCOP,MAXRO)
  330 CALL PRNMAT
     *  (ABYCOL,ROWNOS,COLPNT,NNWORK,1,SIGDIG,FIELDL,OUNIT,MAXNZ,MAXCOP)
C --  Process T0-matrix
      WRITE (OUNIT,'(A)') '$$T0'
      PPOS = ARRPOS( 6, PRSTRU, NTOT )
      PPOS2=2
      MMWORK = 0
      IF ( PPOS .EQ. 0 ) GOTO 340
      IF (MM2 .EQ. 0 .OR. NN1 .EQ. 0 .OR. PRSTRU(6) .EQ. 0 .OR.
     *                    PATT(PPOS) .EQ. 0) GOTO 340
      PATTSV=PATT(PPOS)
      MMWORK=MM2
      NNWORK=NN1
      TINDIC=0
      WRITE(*,'(A,I2)')' Generating matrix T ...'
      JOINT = 2
        CALL GENMAT
     *           (ABYCOL,ROWNOS,COLPNT,MMWORK,NNWORK,
     *            WORK1,INDIC1,NONZR1,
     *            WORK2,INDIC2,NONZR2,
     *            WORK3,INDIC3,NONZR3,
     *            SIGDIG,MATT(PPOS2),DENS(PPOS),MAXV(PPOS),
     *            INTV(PPOS),NONZRS,1,DETERM,ISTAT,
     *            MAXNZ,MAXCO,MAXCOP,MAXRO,MAXVC,TINDIC,
     *            INDIC4,JOINT,NZROW)
      WRITE(*,'(/)')
  340 CONTINUE
      JOINT = 0
      CALL PRNMAT
     * (ABYCOL,ROWNOS,COLPNT,MMWORK,NNWORK,SIGDIG,FIELDL,OUNIT,
     *  MAXNZ,MAXCOP)
C --  Process T1...Tn matrices
      IF (PRSTRU(7) .GT. 0) THEN
        PPOS = ARRPOS( 6, PRSTRU, NTOT )
        PPOS2 = 2
        DO 220  J=1,PRSTRU(7)
        WRITE (OUNIT,'(A)') '$$T'// CHAR(J+ICHAR('0'))
        PPOS=PPOS+1
        PPOS2=PPOS2+1
        MMWORK=MM2
        NNWORK=NN1
        TINDIC=0
        PATTSV=PATT(PPOS)
        IF (PATTSV .EQ. -1 .AND. J .EQ. 1) TINDIC=1
        IF (MM2 .EQ. 0 .OR. NN1 .EQ. 0 .OR. PRSTRU(7) .EQ. 0 .OR.
     *                                      PATTSV .EQ. 0) MMWORK=0
        WRITE(*,'(A,I2,A)')' Generating matrix T',J,' ...'
        CALL GENMAT
     *           (ABYCOL,ROWNOS,COLPNT,MMWORK,NNWORK,
     *            WORK1,INDIC1,NONZR1,
     *            WORK2,INDIC2,NONZR2,
     *            WORK3,INDIC3,NONZR3,
     *            SIGDIG,MATT(PPOS2),DENS(PPOS),MAXV(PPOS),
     *            INTV(PPOS),NONZRS,PATTSV,DETERM,ISTAT,
     *            MAXNZ,MAXCO,MAXCOP,MAXRO,MAXVC,TINDIC,
     *            INDIC4,JOINT,NZROW)
      WRITE(*,'(/)')
      CALL PRNMAT
     *  (ABYCOL,ROWNOS,COLPNT,MMWORK,NNWORK,SIGDIG,FIELDL,OUNIT,
     *   MAXNZ,MAXCOP)
 220    CONTINUE
      ENDIF
C --  Process W-matrix
      WRITE (OUNIT,'(A)') '$$W'
      PPOS = ARRPOS( 8, PRSTRU, NTOT )
      PPOS2 = 2 + PRSTRU(7) + 1
      MMWORK = 0
      IF ( PPOS .EQ. 0 ) GOTO 350
      IF (MM2 .EQ. 0 .OR. NN2 .EQ. 0 .OR. PRSTRU(8) .EQ. 0 .OR.
     *    PATT(PPOS) .EQ. 0 .OR. MATT(PPOS) .EQ. 3 ) GOTO 350
      PATTSV=PATT(PPOS)
      MMWORK=MM2
      NNWORK=NN2
      TINDIC=0
      WRITE(*,'(A,I2,A)')' Generating matrix W ...'
      CALL GENMAT
     *           (ABYCOL,ROWNOS,COLPNT,MMWORK,NNWORK,
     *            WORK1,INDIC1,NONZR1,
     *            WORK2,INDIC2,NONZR2,
     *            WORK3,INDIC3,NONZR3,
     *            SIGDIG,MATT(PPOS2),DENS(PPOS),MAXV(PPOS),
     *            INTV(PPOS),NONZRS,1,DETERM,ISTAT,
     *            MAXNZ,MAXCO,MAXCOP,MAXRO,MAXVC,TINDIC,
     *            INDIC4,JOINT,NZROW)
      WRITE(*,'(/)')
  350 CALL PRNMAT
     *  (ABYCOL,ROWNOS,COLPNT,MMWORK,NNWORK,SIGDIG,FIELDL,OUNIT,
     *   MAXNZ,MAXCOP)
C --  Process W1...Wn matrices
      IF (PRSTRU(9) .GT. 0) THEN
        PPOS = ARRPOS( 8, PRSTRU, NTOT )
        PPOS2 = 2 + PRSTRU(7) + 1
        DO 235  J=1,PRSTRU(9)
        WRITE (OUNIT,'(A)') '$$W'// CHAR(J+ICHAR('0'))
        PPOS = PPOS + 1
        PPOS2 = PPOS2 + 1
        MMWORK=MM2
        NNWORK=NN2
        TINDIC=0
        PATTSV=PATT(PPOS)
        IF (PATTSV .EQ. -1 .AND. J .EQ. 1) TINDIC=1
        IF (MM2 .EQ. 0 .OR. NN2 .EQ. 0 .OR. PRSTRU(9) .EQ. 0 .OR.
     *                      PATTSV .EQ. 0) MMWORK=0
        WRITE(*,'(A,I2,A)')' Generating matrix W',J,' ...'
         CALL GENMAT
     *           (ABYCOL,ROWNOS,COLPNT,MMWORK,NNWORK,
     *            WORK1,INDIC1,NONZR1,
     *            WORK2,INDIC2,NONZR2,
     *            WORK3,INDIC3,NONZR3,
     *            SIGDIG,MATT(PPOS2),DENS(PPOS),MAXV(PPOS),
     *            INTV(PPOS),NONZRS,PATTSV,DETERM,ISTAT,
     *            MAXNZ,MAXCO,MAXCOP,MAXRO,MAXVC,TINDIC,
     *            INDIC4,JOINT,NZROW)
      WRITE(*,'(/)')
      CALL PRNMAT
     *  (ABYCOL,ROWNOS,COLPNT,MMWORK,NNWORK,SIGDIG,FIELDL,OUNIT,
     *   MAXNZ,MAXCOP)
 235    CONTINUE
      ENDIF
C --  Process h0-vector
      WRITE (OUNIT,'(A)') '$$H0'
      PPOS = ARRPOS( 10, PRSTRU, NTOT )
      MMWORK = 0
      IF ( PPOS .EQ. 0 ) GOTO 360
      IF (MM2 .EQ. 0 .OR. PRSTRU(10) .EQ. 0 .OR.
     *                    PATT(PPOS) .EQ. 0) GOTO 360
      PATTSV=PATT(PPOS)
      MMWORK=MM2
      TINDIC=0
      WRITE(*,'(A,I2,A)')' Generating vector h ...'
      CALL GENMAT
     *           (ABYCOL,ROWNOS,COLPNT,MMWORK,1,
     *            WORK1,INDIC1,NONZR1,
     *            WORK2,INDIC2,NONZR2,
     *            WORK3,INDIC3,NONZR3,
     *            SIGDIG,0,DENS(PPOS),MAXV(PPOS),
     *            INTV(PPOS),NONZRS,1,DETERM,ISTAT,
     *            MAXNZ,MAXCO,MAXCOP,MAXRO,MAXVC,TINDIC,
     *            INDIC4,JOINT,NZROW)
      WRITE(*,'(/)')
  360 CALL PRNMAT
     *   (ABYCOL,ROWNOS,COLPNT,MMWORK,1,SIGDIG,FIELDL,OUNIT,
     *    MAXNZ,MAXCOP)
C --  Process h1...hn vectors
      IF (PRSTRU(11) .GT. 0) THEN
        PPOS = ARRPOS( 10, PRSTRU, NTOT )
        DO 230  J=1,PRSTRU(11)
           WRITE (OUNIT,'(A)') '$$H'// CHAR(J+ICHAR('0'))
           PPOS=PPOS+1
           MMWORK=MM2
           TINDIC=0
           PATTSV=PATT(PPOS)
           IF (PATTSV .EQ. -1 .AND. J .EQ. 1) TINDIC=1
           IF (MM2 .EQ. 0 .OR. PRSTRU(11) .EQ. 0 .OR.
     *                         PATTSV .EQ. 0) MMWORK=0
           WRITE(*,'(A,I2,A)')' Generating vector h',J,' ...'
           IF ( PRSTRU(12) .GT. 0 ) THEN
              COLPNT( 1 ) = 0
              COLPNT( 2 ) = 1
              ROWNOS( 1 ) = J
              ABYCOL( 1 ) = 1.0D0
                                       ELSE
              CALL GENMAT
     *              (ABYCOL,ROWNOS,COLPNT,MMWORK,1,
     *               WORK1,INDIC1,NONZR1,
     *               WORK2,INDIC2,NONZR2,
     *               WORK3,INDIC3,NONZR3,
     *               SIGDIG,0,DENS(PPOS),MAXV(PPOS),
     *               INTV(PPOS),NONZRS,PATTSV,DETERM,ISTAT,
     *               MAXNZ,MAXCO,MAXCOP,MAXRO,MAXVC,TINDIC,
     *               INDIC4,JOINT,NZROW)
           ENDIF
           WRITE(*,'(/)')
           CALL PRNMAT
     *         (ABYCOL,ROWNOS,COLPNT,MMWORK,1,SIGDIG,FIELDL,OUNIT,
     *          MAXNZ,MAXCOP)
 230    CONTINUE
      ENDIF
C --  Process restriction type for the first MM1 restrictions
      IF (SUM(PRSTRU(4),2) .NE. 0) THEN
        WRITE (OUNIT,'(A)') '$$RESTRICT1'
        WRITE (OUNIT,'(8I10)') (ROWTP1(II), II=1,MM1)
      ENDIF
C --  Process restriction type for the second MM2 restrictions
      IF (SUM(PRSTRU(6),5) .NE. 0) THEN
        WRITE (OUNIT,'(A)') '$$RESTRICT2'
        WRITE (OUNIT,'(8I10)') (ROWTP2(II), II=1,MM2)
      ENDIF
      WRITE (OUNIT,'(A)') '$END'
      CLOSE (OUNIT)
  500 CONTINUE
C-----FORTRAN-90--------------------------------------------------------
      DEALLOCATE( ABYCOL,  ROWNOS,  COLPNT,
     *            WORK1,   WORK2,   WORK3,
     *            INDIC1,  INDIC2,  INDIC3,
     *            INDIC4,
     *            ROWTP1,  ROWTP2,  PRSTRU,
     *            PATT,    MATT,    INTV,
     *            DENS,    MAXV  )
C-----------------------------------------------------------------------
 1100 FORMAT(10I8)
      END
C
C
      INTEGER FUNCTION SUM(A,N)
C Sum the elements of a vector (integer values)
      INTEGER N,A(N),I,SUMW
      SUMW = 0
      DO 10  I=1,N
        SUMW=SUMW+A(I)
   10 CONTINUE
      SUM=SUMW
      END
C
C
      LOGICAL FUNCTION ALLPOS(A,N)
C Test if all elements of an integer vector are strict positive.
      INTEGER N,A(N),I
      ALLPOS = .TRUE.
      DO 10  I=1,N
        IF (A(I) .LE. 0) ALLPOS = .FALSE.
   10 CONTINUE
      END
C
C
      LOGICAL FUNCTION EXINEG(A,N)
C Test if a negative element exists in an integer vector.
      INTEGER N,A(N),I
      EXINEG = .FALSE.
      DO 10  I=1,N
        IF (A(I) .LT. 0) EXINEG = .TRUE.
   10 CONTINUE
      END
C
C
      SUBROUTINE SXERR(LINE)
C Syntax error
      INTEGER  LINE
      WRITE (*,'(A,I5)')
     *       '  **** syntax error **** in line',LINE
      END
C
C
      SUBROUTINE IOERR(LINE)
C Input/Output error
      INTEGER  LINE
      WRITE (*,'(A,I5)')
     *       '  **** i/o error **** in line',LINE
      END
C
C
      SUBROUTINE PLERR(SECTN)
C Plausibility error
      CHARACTER*7  SECTN
      WRITE (*,'(A)')
     *   '  **** plausibility error **** in section '//SECTN
      END
C
      INTEGER FUNCTION ARRPOS( POS, STRUC, DIMI )
C
      INTEGER POS,DIMI,STRUC(DIMI)
C
      INTEGER SUM,J
C
      SUM = 0
      DO 10 J=1,POS
   10 SUM = SUM + STRUC(J)
      ARRPOS = SUM
C
      END
C
      SUBROUTINE PRNMAT
     *           (ABYCOL,ROWNOS,COLPNT,MM,NN,SIGDIG,FIELDL,OUNI,
     *            MAXNZ,MAXCOP)
      INTEGER   MAXNZ,MAXCOP
      REAL*8    ABYCOL(MAXNZ)
      INTEGER   ROWNOS(MAXNZ),COLPNT(MAXCOP),MM,NN,SIGDIG,OUNI,FIELDL
      INTEGER   I,J,INX,COUNT
C     Format will be generated later!!!!!!!!!!!
      IF ( MM .EQ. 0 .OR. NN .EQ. 0) THEN
         I=0
         WRITE(OUNI,30)I,I,I
         RETURN
      ENDIF
      WRITE(OUNI,30) MM,NN,COLPNT(NN+1)
      COUNT=0
      DO 10 I=1,NN
         INX=COLPNT(I+1)-COLPNT(I)
         WRITE(OUNI,30) INX
         IF ( INX .EQ. 0 ) GOTO 10
         DO 20 J=1,INX
            COUNT=COUNT+1
            WRITE(OUNI,40) ROWNOS(COUNT),ABYCOL(COUNT)
   20    CONTINUE
   10 CONTINUE
   30 FORMAT(3I10)
   40 FORMAT(I10,F20.10)
      END
C
C
      SUBROUTINE COPVEC
     *           (ABYCOL,ROWNOS,COLPNT,MM,NN,
     *            WORK,ISTAT,MAXNZ,MAXCOP,MAXRO)
      INTEGER   MAXNZ,MAXCOP,MAXRO
      REAL*8    ABYCOL(MAXNZ)
      INTEGER   ROWNOS(MAXNZ),COLPNT(MAXCOP),MM,NN
      REAL*8    WORK(MAXRO)
      INTEGER   ISTAT
      INTEGER   I
      DO 10 I=1,MM
         ABYCOL(I)=WORK(I)
         ROWNOS(I)=I
   10 CONTINUE
      COLPNT(1)=0
      COLPNT(2)=MM
      END
C=======================================================================

