      SUBROUTINE ARSME(M, M1, M2, ME, ND, RT, NI, NS, X, R, RL,         ARS   10
     * IBV, LO, E, U, D)
C PURPOSE
C   TO SOLVE A MULTIPLE-RESOURCE NETWORK SCHEDULING PROBLEM -PREEMPTIVE
C   CASE BY THE REVISED SIMPLEX METHOD WITH THE PRODUCT FORM OF THE
C   INVERSE. *ACTIVITIES-ON-ARCS* NETWORK REPRESENTATION IS USED.
C   THIS IS THE PRIMARY SUBROUTINE AND IT COORDINATES THE SPECIAL
C   PURPOSE SUBROUTINES GEN,KFIND,PRISET,ORDSNE.
C   THE SUBROUTINE USES A LINE-PRINTER AS PROGRAMMING UNIT 2 AND
C   MAGNETIC TAPES AS PROGRAMMING UNIT 3.
C   THE MAGNETIC TAPES ARE USED ONLY IF THE INVERSE EXCEEDS THE
C   DIMENSION LIMIT OF VECTOR E.
C DESCRIPTION OF PARAMETERS
C   M    NUMBER OF ACTIVITIES
C   M1   DIMENSION LIMIT OF VECTORS IBV,U,D AND X, EQUAL TO M+1
C   M2   DIMENSION LIMIT OF VECTOR NS, EQUAL TO M+M+1
C   ME   DIMENSION LIMIT OF VECTOR E
C   ND   NUMBER OF NODES
C   RT   NUMBER OF RESOURCE TYPES
C   NI   DECLARED LIMIT OF THE NUMBER OF ITERATIONS ( ABOUT 2*M )
C   NS   NETWORK STRUCTURE VECTOR CONTAINING THE CONSECUTIVE ACTIVITIES
C        AS ORDERED PAIRS OF NODES.
C        NO INITIAL VALUE IS REQUIRED FOR ELEMENT NS(M2).
C   X    VECTOR OF ACTIVITY DURATIONS
C   R    MATRIX OF RESOURCE REQUIREMENTS
C   RL   VECTOR OF RESOURCE LIMITS
C   E    VECTOR OF THE INVERSE
C   U,D  VECTORS USED FOR FINDING VECTORS INTRODUCED INTO AND
C        ELIMINATED FROM THE BASIS RESPECTIVELY
C   LO   VECTOR OF THE INDICES OF VECTORS ELIMINATED FROM THE BASIS IN
C        SUCCESIVE ITERATIONS
C   IBV  VECTOR OF INDICES OF THE BASIC VECTORS
C   AS INPUT DATA PROVIDE M,M1,M2,ME,ND,RT,NI,NS,X,R,RL.
      INTEGER RT, RT1
      LOGICAL PRE, PROC
      DIMENSION NS(M2), IBV(M1), LO(NI), E(ME), U(M1), D(M1),
     * X(M1), R(M,RT), RL(RT)
C FOR SOME COMPILERS OF FORTRAN THE DIMENSION LIMIT OF A MATRIX MUST
C BE GREATER THAN 1, THEN IF RT IS TO BE EQUAL TO 1, MAKE RT=2 AND
C RL(2)=0
      PROC = .FALSE.
      PRE = .TRUE.
      RT1 = RT
      IF (RL(RT).EQ.0.) RT1 = RT - 1
      LG = 0
      IT = 0
      JK = 0
      IH2 = 0
      IH = 1
      JP = 1
      ND = ND - 1
      NS(M2) = NS(M2-1) + 1
      IH1 = ME/M1
      RR = 0.
      DO 10 I=1,M
        RR = RR + X(I)
   10 CONTINUE
      X(M1) = -RR
C CHECK IF THE RESOURCE REQUIREMENTS FOR ANY TYPE OF RESOURCE ARE
C EQUAL TO EACH OTHER. IF SO, CALCULATE IP IT IS THE MAXIMUM NUMBER
C OF ACTIVITIES WHICH MAY BE PERFORMED SIMULTANEOUSLY.
      IP = 99999
      DO 30 J=1,RT1
        P = R(1,J)
        DO 20 I=2,M
          IF (P.NE.R(I,J)) GO TO 40
   20   CONTINUE
        IF (P.LT.0.000001) GO TO 30
        I = (RL(J)+.00001)/P
        IF (IP.GT.I) IP = I
   30 CONTINUE
      IF (IP.NE.99999) PROC = .TRUE.
   40 D(M1) = 0.
C CALCULATE VECTOR U
      DO 50 I=1,M
        U(I) = 0.
   50 CONTINUE
      U(M1) = 1.
      MF = IH*M1
      IF (LG.EQ.0) GO TO 80
      LG = -1
      JK = IT
      JP = IH2 + 1
      GO TO 80
   60 LG = 1
      JK = IH2
   70 IF (JK.LT.IH1) GO TO 130
      BACKSPACE 3
      BACKSPACE 3
      READ (3) E
      MF = IH1*M1
      JP = JP - IH1
   80 J = JK
   90 IF (J.LT.JP) GO TO 110
      MF = MF - M1
      TH = 0.
      DO 100 I=1,M1
        MQ = MF + I
        TH = TH + U(I)*E(MQ)
  100 CONTINUE
      MQ = LO(J)
      U(MQ) = TH
      J = J - 1
      GO TO 90
  110 IF (LG) 60, 130, 120
  120 JK = JK - IH1
      GO TO 70
C FIND K, I.E. THE INDEX OF THE NEW OPTIMAL BASIC VECTOR
  130 CALL GEN(PROC, PRE, .FALSE., M, M1, M2, ND, K, J, RT, RT1,
     * IP, NS, IBV, LO, U, D, R, RL)
C CHECK THE SOLUTION OPTIMALITY CRITERION
      IF (D(M1).LE.(-0.00001)) GO TO 230
C PRINT THE RESULTS OF ARSME
      X(M1) = -X(M1)
      WRITE (2,99999) X(M1)
      CALL ORDSNE(.TRUE., M, IBV, X)
      DO 140 I=2,M
        X(I) = X(I) + X(I-1)
  140 CONTINUE
      J = 1
      K = 44
  150 IF (M.LT.K) K = M
      I = 1
      JK = 1
      IF (J.GT.1) JK = K - 43
      DO 160 I=JK,K
        LO(I) = I
  160 CONTINUE
      WRITE (2,99986)
      JK = J
      IF (J.GT.4) JK = 4
      GO TO (180, 190, 200, 210), JK
  170 WRITE (2,99987)
      IF (K.EQ.M) RETURN
      J = J + 1
      K = K + 44
      GO TO 150
  180 IF (M.GE.10) WRITE (2,99997) (LO(I),I=10,K,2)
      JK = 8
      IF (K.LT.8) JK = K
      WRITE (2,99996) (LO(I),I=1,K,2)
      WRITE (2,99995) (LO(I),I=2,JK,2)
      WRITE (2,99988)
      GO TO 220
  190 IF (M.GE.46) WRITE (2,99994) (LO(I),I=46,K,2)
      WRITE (2,99993) (LO(I),I=45,K,2)
      WRITE (2,99988)
      GO TO 220
  200 IF (M.GE.90) WRITE (2,99992) (LO(I),I=90,K,2)
      WRITE (2,99991) (LO(I),I=89,K,2)
      WRITE (2,99988)
      GO TO 220
  210 IF (M.GE.134) WRITE (2,99990) (LO(I),I=134,K,2)
      WRITE (2,99989) (LO(I),I=133,K,2)
      WRITE (2,99988)
  220 CALL GEN(PROC, .TRUE., .TRUE., M, M1, M2, ND, K, J, RT, RT1,
     * IP, NS, IBV, LO, U, X, R, RL)
      GO TO 170
  230 TH = 10.E70
      IF (.NOT.PRE) GO TO 250
C FIND LO(1), I.E. THE INDEX OF THE VECTOR ELIMINATED FROM THE BASIS
C IN THE FIRST ITERATION
      PRE = .FALSE.
      IT = 1
      JK = 1
      DO 240 I=1,M
        IF (D(I).EQ.0.0 .OR. TH.LE.X(I)) GO TO 240
        TH = X(I)
        L = I
  240 CONTINUE
      LO(1) = L
      GO TO 380
  250 IF (LG.EQ.0) GO TO 280
      LG = -1
      REWIND 3
      JP = 1 - IH1
      JK = IH1
  260 IF (JK.GT.IH2) GO TO 330
  270 JP = JP + IH1
      READ (3) E
  280 MF = -M1
      J = JP
  290 IF (J.GT.JK) GO TO 310
      MF = MF + M1
C CALCULATE VECTOR D
      L = LO(J)
      RR = D(L)
      DO 300 I=1,M
        MQ = MF + I
        D(I) = D(I) + RR*E(MQ)
  300 CONTINUE
      D(L) = D(L) - RR
      J = J + 1
      GO TO 290
  310 IF (LG) 320, 340, 340
  320 JK = JK + IH1
      GO TO 260
  330 JK = IH2 + IH
      LG = 1
      GO TO 270
C INCREASE THE NUMBER OF ITERATIONS IN THE ITERATION COUNTER
  340 IT = IT + 1
      IF (IT.GT.NI) WRITE (2,99998)
      IF (IT.GT.NI) STOP
      IH = IH + 1
      IF (IH.LE.IH1) GO TO 360
      IF (LG.NE.0) GO TO 350
      REWIND 3
      WRITE (3) E
      LG = -1
  350 IH = 1
      IH2 = IH2 + IH1
  360 IF (LG.EQ.0) JK = IH
C FIND LO(IT), I.E. THE INDEX OF THE VECTOR ELIMINATED FROM THE
C BASIS I ITERATION IT.
      DO 370 I=1,M
        IF (D(I).LE.0.) GO TO 370
        RR = X(I)/D(I)
        IF (TH.LE.RR) GO TO 370
        TH = RR
        L = I
  370 CONTINUE
      LO(IT) = L
C CALCULATE VECTORS E AND X
  380 MF = IH*M1 - M1
      MQ = MF + L
      RR = 1./D(L)
      E(MQ) = RR
      TH = X(L)
      X(L) = TH*RR
      DO 390 I=1,M1
        IF (I.EQ.L) GO TO 390
        MQ = MF + I
        G = -D(I)*RR
        E(MQ) = G
        X(I) = X(I) + G*TH
  390 CONTINUE
      IF (LG.EQ.0) GO TO 400
      IF (IH.GT.1) BACKSPACE 3
      WRITE (3) E
C MEMORIZE THE INDEX OF THE VECTOR INTRODUCED INTO THE BASIS
  400 IBV(L) = K
      GO TO 40
99999 FORMAT (//////35H   AUTOMATIC REVISED SIMPLEX METHOD///
     * 17H OPTIMAL SOLUTION//33H MINIMAL SCHEDULE LENGTH   TMIN =,
     * F12.5///)
99998 FORMAT (/////37H NUMBER OF ITERATIONS GREATER THAN NI///)
99997 FORMAT (30X, 1H*, 17X, 18I4)
99996 FORMAT (30X, 2H* , I2, 21I4)
99995 FORMAT (1H+, 31X, 4I4)
99994 FORMAT (30X, 2H* , 22I4)
99993 FORMAT (30X, 2H* , I2, 21I4)
99992 FORMAT (30X, 2H* , 5I4, 1X, 17I4)
99991 FORMAT (30X, 2H* , I2, 5I4, 1X, 16I4)
99990 FORMAT (30X, 3H*  , 22I4)
99989 FORMAT (30X, 1H*, 22I4)
99988 FORMAT (30X, 1H*/1X, 120(1H-)/30X, 1H*)
99987 FORMAT (30X, 1H*/1X, 120(1H-)//)
99986 FORMAT (1X, 120(1H-)/30X, 1H*/30X, 1H*, 40X, 10HACTIVITIES/
     * 30X, 1H*/13X, 4HTIME, 13X, 2H* , 89(1H-)/11X, 9HINTERVALS,
     * 10X, 1H*)
      END
      SUBROUTINE GEN(PROC, PRE, PRI, M, M1, M2, ND, K, KW, RT, RT1,     GEN   10
     * IP, NS, IBV, LO, U, D, R, RL)
C PURPOSE
C   SUBROUTINE GEN GENERATES ALL RESOURCE FEASIBLE SETS.
C DESCRIPTION OF PARAMETERS
C   PROC LOGICAL VARIABLE. IF PROC IS .TRUE. RESOURCE CONSTRAINTS ARE
C        NOT CHECKED, AND SETS WITH THE NUMBER OF ELEMENTS LESS THAN OR
C        EQUAL TO IP ARE GENERATED. IP IS DETERMINED IN SUBROUT. ARSME
C   PRE  LOGICAL VARIABLE. PRE IS .TRUE. IN THE FIRST ITERATION
C   PRI  LOGICAL VARIABLE. IF PRI IS .TRUE. SUBROUTINE GEN CALLS
C        SUBROUTINE PRISET TO PRINT RESULTS OF ARSME
C   DA   LOGICAL VARIABLE. DA IS .TRUE. IF THE MAIN SET IS RESOURCE
C        FEASIBLE
C   KAS  VECTOR CONTAINING THE NUMBERS OF ACTIVITIES IN THE MAIN SET
C        CURRENTLY BEING CONSIDERED.
C   KAR  VECTOR OF THOSE INDICES OF KAS ELEMENTS WHICH COMPOSE THE
C        SUBSET CURRENTLY BEING CONSIDERED.
C   IC   NUMBER OF ELEMENTS OF THE MAIN SET CURRENTLY BEING CONSIDERED
C   NR   NUMBER OF ELEMENTS OF THE SUBSET CURRENTLY BEING CONSIDERED
C   LI   SET COUNTER
      INTEGER RT, RT1
      LOGICAL PRE, PRI, DA, PROC
      DIMENSION NS(M2), IBV(M1), LO(M), U(M1), D(M1), R(M,RT),
     * RL(RT), KAS(100), KAR(100), KA(100), RC(100)
      JS = 1
      LI = 1
      DO 300 KG=1,ND
C GENERATE A MAIN SET
        IC = 0
        DO 10 ID=1,M2,2
          IF (NS(ID).GE.KG) GO TO 20
          IF (NS(ID+1).LE.KG) GO TO 10
          IC = IC + 1
          KAS(IC) = (ID+1)/2
          KAR(IC) = IC
   10   CONTINUE
C NOTE-- DO LOOP IS NEVER EXITED HERE.
   20   II = IC
        J = ID
        DO 30 ID=J,M2,2
          IF (NS(ID).NE.KG) GO TO 40
          IC = IC + 1
          KAS(IC) = (ID+1)/2
          KAR(IC) = IC
   30   CONTINUE
   40   IF (PROC) GO TO 120
C CHECK THE RESOURCE FEASIBILITY OF THE MAIN SET
        NP = 99999
        DA = .TRUE.
        DO 90 J=1,RT1
          G = 0.
          DO 50 I=1,IC
            MQ = KAS(I)
            H = R(MQ,J)
            G = G + H
            RC(I) = H
   50     CONTINUE
          IF (G.LE.RL(J)) GO TO 90
          DA = .FALSE.
C ORDER ACTIVITIES IN THE MAIN SET
          IF (II.GT.1) CALL ORDSNE(.FALSE., II, KAS, RC)
          IF ((IC-II).GT.1) CALL ORDSNE(.FALSE., IC-II, KAS(II+1),
     *     RC(II+1))
          G = 0.
          DO 60 I=1,IC
            G = G + RC(I)
            IF (G.GT.RL(J)) GO TO 70
   60     CONTINUE
C NOTE-- DO LOOP IS NEVER EXITED HERE.
   70     IF (NP.LE.I) GO TO 90
          NP = I
          IF (RT1.EQ.1) GO TO 90
          DO 80 I=1,IC
            KA(I) = KAS(I)
   80     CONTINUE
   90   CONTINUE
        IF (DA) GO TO 120
        IF (RT1.EQ.1) GO TO 110
        DO 100 I=1,IC
          KAS(I) = KA(I)
  100   CONTINUE
C GENERATE SUBSETS
  110   NR = IC
        IF (NP.LE.(II+1)) GO TO 250
  120   NR = II
  130   NR = NR + 1
  140   IF (PROC) GO TO 270
        IF (DA) GO TO 180
C CHECK RESOURCE FEASIBILITY OF THE SUBSET
        NP = 99999
        DO 170 J=1,RT1
          G = 0.
          DO 150 I=1,NR
            MQ = KAR(I)
            MQ = KAS(MQ)
            G = G + R(MQ,J)
            IF (G.GT.RL(J)) GO TO 160
  150     CONTINUE
          GO TO 170
  160     IF (NP.GT.I) NP = I
  170   CONTINUE
        IF (NR.GE.NP) GO TO 250
C GO TO SIMPLEX PROCEDURE
  180   IF (PRI) GO TO 260
        CALL KFIND(PRE, M1, NR, K, LI, KAS, KAR, IBV, U, D)
C INCREASE THE NUMBER OF SETS IN THE SET COUNTER
  190   LI = LI + 1
        IF (KAR(NR).LT.IC) GO TO 130
C GENERATE THE PRIMARY SUBSET
  200   NR = NR - 1
        IF (NR.EQ.0) GO TO 300
  210   KAR(NR) = KAR(NR) + 1
        IF (KAR(NR).EQ.IC) GO TO 140
        MQ = NR + 1
        MP = NR + IC - KAR(NR)
        IF (PROC) GO TO 290
  220   DO 230 I=MQ,MP
          KAR(I) = KAR(I-1) + 1
  230   CONTINUE
  240   IF (KAR(NR).LE.II) NR = II - KAR(NR) + NR + 1
        GO TO 140
C GENERATE THE NEW PRIMARY SUBSET BECAUSE OF RESOURCE INFEASIBILITY
C OF THE LAST-GENERATED SET
  250   IF (KAR(NP).EQ.IC) GO TO 200
        NR = NP
        GO TO 210
C CHECK IF THE SET COMPRISE THE OPTIMAL SOLUTION
  260   IF (LI.NE.IBV(JS)) GO TO 190
        CALL PRISET(M, NR, KW, JS, K, KAR, KAS, LO, D)
        JS = JS + 1
        IF (JS.EQ.M1) RETURN
        GO TO 190
C GENERATE THE SETS IN THE CASE OF EQUAL RESOURCE REQUIREMENTS
  270   IF (NR.LE.IP) GO TO 180
        NR = IP
        IF (KAR(NR).LE.II) GO TO 280
        GO TO 210
  280   KAR(NR) = II + 1
        GO TO 180
  290   IF (MP.GT.IP) MP = IP
        IF (MP.LT.MQ) GO TO 240
        GO TO 220
  300 CONTINUE
      RETURN
      END
      SUBROUTINE KFIND(PRE, M1, NR, K, LI, KAS, KAR, IBV, U, D)         KFI   10
C PURPOSE
C   SUBROUTINE KFIND CHECKS TO DETERMINE IF THE INTRODUCTION OF THE
C   CURRENTLY CONSIDERED SET ( VECTOR ) INTO THE BASIS IS MORE
C   PROFITABLE THAN THE INTRODUCTION OF THE PREVIOUSLY GENERATED SETS.
      LOGICAL PRE
      DIMENSION U(M1), D(M1), IBV(M1), KAS(100), KAR(100)
      IF (.NOT.(PRE .AND. (NR.EQ.1))) GO TO 10
C CALCULATE THE INITIAL VALUES OF VECTOR IBV
      MQ = KAR(1)
      MQ = KAS(MQ)
      IBV(MQ) = LI
C CALCULATE VALUE G OF THE CRITERION FOR INTRODUCING A VECTOR INTO
C THE BASIS
   10 G = 0.
      DO 20 I=1,NR
        MQ = KAR(I)
        MQ = KAS(MQ)
        G = G + U(MQ)
   20 CONTINUE
      RR = 1 - NR
      G = G + U(M1)*RR
      IF (D(M1).LE.G) RETURN
C MEMORIZE THE VECTOR FOR WHICH G IS AT MINIMUM
      D(M1) = G
      K = LI
      MQ = M1 - 1
      DO 30 I=1,MQ
        D(I) = 0.
   30 CONTINUE
      DO 40 I=1,NR
        MQ = KAR(I)
        MQ = KAS(MQ)
        D(MQ) = 1.
   40 CONTINUE
      RETURN
      END
      SUBROUTINE PRISET(M, NR, J, JS, K, KAR, KAS, LO, X)               PRI   10
C PURPOSE
C   SUBROUTINE PRISET PRINTS THE SET OF ACTIVITIES COMPOSING THE
C   OPTIMAL SOLUTION AND THE TIME-INTERVALS OF ITS PERFORMANCE.
      DIMENSION KAR(100), KAS(100), LO(M), X(M)
      DO 10 I=1,M
        LO(I) = 0
   10 CONTINUE
      DO 20 I=1,NR
        MQ = KAR(I)
        MQ = KAS(MQ)
        MP = J*44
        MR = MP - 44
        IF (MQ.LE.MR .OR. MQ.GT.MP) GO TO 20
        LO(MQ) = 1
   20 CONTINUE
      C = 0.
      IF (JS.EQ.1) WRITE (2,99999) C, X(JS), (LO(I),I=1,K)
      MQ = JS - 1
      IF (JS.NE.1) WRITE (2,99999) X(MQ), X(JS), (LO(I),I=1,K)
      RETURN
99999 FORMAT (1X, F12.5, 3H  -, F12.5, 4H  * , 44I2)
      END
      SUBROUTINE ORDSNE(PRI, IC, KAS, RC)                               ORD   10
C PURPOSE
C   IF PRI IS .TRUE. SUBROUTINE ORDSNE ORDERS ELEMENTS OF VECTOR KAS
C   IN INCREASING ORDER OF THEIR VALUES AND VECTOR RC CORRESPONDINGLY.
C   IF PRI IS .FALSE. SUBROUTINE ORDSNE ORDERS ELEMENTS OF VECTOR RC
C   IN DECREASING ORDER OF THEIR VALUES AND VECTOR KAS CORRESPONDINGLY.
      LOGICAL PRI
      DIMENSION RC(IC), KAS(IC)
      ID = -IC/2
   10 IF (ID.GE.0) RETURN
      MQ = ID + IC
      DO 40 J=1,MQ
        I = J
   20   IF (I.LT.1) GO TO 40
        JJ = I - ID
        IF (PRI) GO TO 50
        IF (RC(I).GE.RC(JJ)) GO TO 40
   30   G = RC(I)
        RC(I) = RC(JJ)
        RC(JJ) = G
        II = KAS(I)
        KAS(I) = KAS(JJ)
        KAS(JJ) = II
        I = I + ID
        GO TO 20
   40 CONTINUE
      ID = ID/2
      GO TO 10
   50 IF (KAS(I).LE.KAS(JJ)) GO TO 40
      GO TO 30
      END
