*DECK DPINIT SUBROUTINE DPINIT (MRELAS, NVARS, COSTS, BL, BU, IND, PRIMAL, + INFO, AMAT, CSC, COSTSC, COLNRM, XLAMDA, ANORM, RHS, RHSNRM, + IBASIS, IBB, IMAT, LOPT) C***BEGIN PROLOGUE DPINIT C***SUBSIDIARY C***PURPOSE Subsidiary to DSPLP C***LIBRARY SLATEC C***TYPE DOUBLE PRECISION (SPINIT-S, DPINIT-D) C***AUTHOR (UNKNOWN) C***DESCRIPTION C C THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO C DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. C C USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. C /REAL (12 BLANKS)/DOUBLE PRECISION/,/SCOPY/DCOPY/ C REVISED 810519-0900 C REVISED YYMMDD-HHMM C C INITIALIZATION SUBROUTINE FOR DSPLP(*) PACKAGE. C C***SEE ALSO DSPLP C***ROUTINES CALLED DASUM, DCOPY, DPNNZR C***REVISION HISTORY (YYMMDD) C 811215 DATE WRITTEN C 890531 Changed all specific intrinsics to generic. (WRB) C 890605 Removed unreferenced labels. (WRB) C 891009 Removed unreferenced variable. (WRB) C 891214 Prologue converted to Version 4.0 format. (BAB) C 900328 Added TYPE section. (WRB) C***END PROLOGUE DPINIT DOUBLE PRECISION AIJ,AMAT(*),ANORM,BL(*),BU(*),CMAX, * COLNRM(*),COSTS(*),COSTSC,CSC(*),CSUM,ONE,PRIMAL(*), * RHS(*),RHSNRM,SCALR,TESTSC,XLAMDA,ZERO DOUBLE PRECISION DASUM INTEGER IBASIS(*),IBB(*),IMAT(*),IND(*) LOGICAL CONTIN,USRBAS,COLSCP,CSTSCP,MINPRB,LOPT(8) C C***FIRST EXECUTABLE STATEMENT DPINIT ZERO=0.D0 ONE=1.D0 CONTIN=LOPT(1) USRBAS=LOPT(2) COLSCP=LOPT(5) CSTSCP=LOPT(6) MINPRB=LOPT(7) C C SCALE DATA. NORMALIZE BOUNDS. FORM COLUMN CHECK SUMS. GO TO 30001 C C INITIALIZE ACTIVE BASIS MATRIX. 20002 CONTINUE GO TO 30002 20003 RETURN C C PROCEDURE (SCALE DATA. NORMALIZE BOUNDS. FORM COLUMN CHECK SUMS) C C DO COLUMN SCALING IF NOT PROVIDED BY THE USER. 30001 IF (.NOT.(.NOT. COLSCP)) GO TO 20004 J=1 N20007=NVARS GO TO 20008 20007 J=J+1 20008 IF ((N20007-J).LT.0) GO TO 20009 CMAX=ZERO I=0 20011 CALL DPNNZR(I,AIJ,IPLACE,AMAT,IMAT,J) IF (.NOT.(I.EQ.0)) GO TO 20013 GO TO 20012 20013 CONTINUE CMAX=MAX(CMAX,ABS(AIJ)) GO TO 20011 20012 IF (.NOT.(CMAX.EQ.ZERO)) GO TO 20016 CSC(J)=ONE GO TO 20017 20016 CSC(J)=ONE/CMAX 20017 CONTINUE GO TO 20007 20009 CONTINUE C C FORM CHECK SUMS OF COLUMNS. COMPUTE MATRIX NORM OF SCALED MATRIX. 20004 ANORM = ZERO J=1 N20019=NVARS GO TO 20020 20019 J=J+1 20020 IF ((N20019-J).LT.0) GO TO 20021 PRIMAL(J)=ZERO CSUM = ZERO I=0 20023 CALL DPNNZR(I,AIJ,IPLACE,AMAT,IMAT,J) IF (.NOT.(I.LE.0)) GO TO 20025 GO TO 20024 20025 CONTINUE PRIMAL(J)=PRIMAL(J)+AIJ CSUM = CSUM+ABS(AIJ) GO TO 20023 20024 IF (IND(J).EQ.2) CSC(J)=-CSC(J) PRIMAL(J)=PRIMAL(J)*CSC(J) COLNRM(J)=ABS(CSC(J)*CSUM) ANORM = MAX(ANORM,COLNRM(J)) GO TO 20019 C C IF THE USER HAS NOT PROVIDED COST VECTOR SCALING THEN SCALE IT C USING THE MAX. NORM OF THE TRANSFORMED COST VECTOR, IF NONZERO. 20021 TESTSC=ZERO J=1 N20028=NVARS GO TO 20029 20028 J=J+1 20029 IF ((N20028-J).LT.0) GO TO 20030 TESTSC=MAX(TESTSC,ABS(CSC(J)*COSTS(J))) GO TO 20028 20030 IF (.NOT.(.NOT.CSTSCP)) GO TO 20032 IF (.NOT.(TESTSC.GT.ZERO)) GO TO 20035 COSTSC=ONE/TESTSC GO TO 20036 20035 COSTSC=ONE 20036 CONTINUE CONTINUE 20032 XLAMDA=(COSTSC+COSTSC)*TESTSC IF (XLAMDA.EQ.ZERO) XLAMDA=ONE C C IF MAXIMIZATION PROBLEM, THEN CHANGE SIGN OF COSTSC AND LAMDA C =WEIGHT FOR PENALTY-FEASIBILITY METHOD. IF (.NOT.(.NOT.MINPRB)) GO TO 20038 COSTSC=-COSTSC 20038 GO TO 20002 C:CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C PROCEDURE (INITIALIZE RHS(*),IBASIS(*), AND IBB(*)) C C INITIALLY SET RIGHT-HAND SIDE VECTOR TO ZERO. 30002 CALL DCOPY(MRELAS,ZERO,0,RHS,1) C C TRANSLATE RHS ACCORDING TO CLASSIFICATION OF INDEPENDENT VARIABLES J=1 N20041=NVARS GO TO 20042 20041 J=J+1 20042 IF ((N20041-J).LT.0) GO TO 20043 IF (.NOT.(IND(J).EQ.1)) GO TO 20045 SCALR=-BL(J) GO TO 20046 20045 IF (.NOT.(IND(J).EQ.2)) GO TO 10001 SCALR=-BU(J) GO TO 20046 10001 IF (.NOT.(IND(J).EQ.3)) GO TO 10002 SCALR=-BL(J) GO TO 20046 10002 IF (.NOT.(IND(J).EQ.4)) GO TO 10003 SCALR=ZERO 10003 CONTINUE 20046 CONTINUE IF (.NOT.(SCALR.NE.ZERO)) GO TO 20048 I=0 20051 CALL DPNNZR(I,AIJ,IPLACE,AMAT,IMAT,J) IF (.NOT.(I.LE.0)) GO TO 20053 GO TO 20052 20053 CONTINUE RHS(I)=SCALR*AIJ+RHS(I) GO TO 20051 20052 CONTINUE 20048 CONTINUE GO TO 20041 C C TRANSLATE RHS ACCORDING TO CLASSIFICATION OF DEPENDENT VARIABLES. 20043 I=NVARS+1 N20056=NVARS+MRELAS GO TO 20057 20056 I=I+1 20057 IF ((N20056-I).LT.0) GO TO 20058 IF (.NOT.(IND(I).EQ.1)) GO TO 20060 SCALR=BL(I) GO TO 20061 20060 IF (.NOT.(IND(I).EQ.2)) GO TO 10004 SCALR=BU(I) GO TO 20061 10004 IF (.NOT.(IND(I).EQ.3)) GO TO 10005 SCALR=BL(I) GO TO 20061 10005 IF (.NOT.(IND(I).EQ.4)) GO TO 10006 SCALR=ZERO 10006 CONTINUE 20061 CONTINUE RHS(I-NVARS)=RHS(I-NVARS)+SCALR GO TO 20056 20058 RHSNRM=DASUM(MRELAS,RHS,1) C C IF THIS IS NOT A CONTINUATION OR THE USER HAS NOT PROVIDED THE C INITIAL BASIS, THEN THE INITIAL BASIS IS COMPRISED OF THE C DEPENDENT VARIABLES. IF (.NOT.(.NOT.(CONTIN .OR. USRBAS))) GO TO 20063 J=1 N20066=MRELAS GO TO 20067 20066 J=J+1 20067 IF ((N20066-J).LT.0) GO TO 20068 IBASIS(J)=NVARS+J GO TO 20066 20068 CONTINUE C C DEFINE THE ARRAY IBB(*) 20063 J=1 N20070=NVARS+MRELAS GO TO 20071 20070 J=J+1 20071 IF ((N20070-J).LT.0) GO TO 20072 IBB(J)=1 GO TO 20070 20072 J=1 N20074=MRELAS GO TO 20075 20074 J=J+1 20075 IF ((N20074-J).LT.0) GO TO 20076 IBB(IBASIS(J))=-1 GO TO 20074 C C DEFINE THE REST OF IBASIS(*) 20076 IP=MRELAS J=1 N20078=NVARS+MRELAS GO TO 20079 20078 J=J+1 20079 IF ((N20078-J).LT.0) GO TO 20080 IF (.NOT.(IBB(J).GT.0)) GO TO 20082 IP=IP+1 IBASIS(IP)=J 20082 GO TO 20078 20080 GO TO 20003 END