Sources Esope | Cast3M

simplx
C SIMPLX    SOURCE    CHAT      05/01/13    03:18:54     5004
      SUBROUTINE SIMPLX(A,M,N,MP,NP,M1,M2,M3,ICASE,IZROV,IPOSV,
     >                                         EPS,L1,L2,L3,MMAX)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                     C
C     METHODE DU SIMPLEX : CALCUL EFFECTIF APPELER PAR SIMPLE         C
C                                                                     C
C     FORTRAN APPELLANT SIMP1,SIMP2 ET SIMP3                          C
C                                                                     C
C     P.PEGON 31/8/92                                                 C
C                                                                     C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION A(MP,NP),IZROV(N),IPOSV(M),L1(MMAX),L2(MMAX),L3(MMAX)
C
      NL1=N
      DO 11 K=1,N
        L1(K)=K
        IZROV(K)=K
 11   CONTINUE
C
      NL2=M
      DO 12 I=1,M
        L2(I)=I
        IPOSV(I)=N+I
 12   CONTINUE
C
      DO 13 I=1,M2
        L3(I)=1
 13   CONTINUE
C
      IR=0
      IF(M2+M3.EQ.0)GOTO 30
C
      IR=1
      DO 15 K=1,N+1
        Q1=0.D0
        DO 14 I=M1+1,M
          Q1=Q1+A(I+1,K)
  14    CONTINUE
        A(M+2,K)=-Q1
  15  CONTINUE
C
  10  CALL SIMP1(A,MP,NP,M+1,L1,NL1,0,KP,BMAX)
C
      IF(BMAX.LE.EPS.AND.A(M+2,1).LT.-EPS)THEN
        ICASE=-1
        RETURN
C
      ELSEIF(BMAX.LE.EPS.AND.A(M+2,1).LE.EPS)THEN
        M12=M1+M2+1
C
        IF(M12.LE.M)THEN
          DO 16 IP=M12,M
            IF(IPOSV(IP).EQ.IP+N)THEN
              CALL SIMP1(A,MP,NP,IP,L1,NL1,1,KP,BMAX)
              IF(BMAX.GT.0.D0)GOTO 1
            ENDIF
  16      CONTINUE
        ENDIF
C
        IR=0
        M12=M12-1
        IF(M1+1.GT.M12)GOTO 30
        DO 18 I=M1+1,M12
          IF(L3(I-M1).EQ.1)THEN
            DO 17 K=1,N+1
              A(I+1,K)=-A(I+1,K)
 17         CONTINUE
          ENDIF
 18     CONTINUE
        GOTO 30
C
      ENDIF
C
      CALL SIMP2(A,M,N,MP,NP,L2,NL2,IP,KP,Q1,EPS)
      IF(IP.EQ.0)THEN
        ICASE=-1
        RETURN
      ENDIF
C
 1    CALL SIMP3(A,MP,NP,M+1,N,IP,KP)
      IF(IPOSV(IP).GE.N+M1+M2+1)THEN
        DO 19 K=1,NL1
          IF(L1(K).EQ.KP)GOTO 2
 19     CONTINUE
 2      NL1=NL1-1
        DO 21 IS=K,NL1
          L1(IS)=L1(IS+1)
 21     CONTINUE
      ELSE
        IF(IPOSV(IP).LT.N+M1+1)GOTO 20
        KH=IPOSV(IP)-M1-N
        IF(L3(KH).EQ.0)GOTO 20
        L3(KH)=0
      ENDIF
C
      A(M+2,KP+1)=A(M+2,KP+1)+1.D0
      DO 22 I=1,M+2
        A(I,KP+1)=-A(I,KP+1)
 22   CONTINUE
C
 20   IS=IZROV(KP)
      IZROV(KP)=IPOSV(IP)
      IPOSV(IP)=IS
C
      IF(IR.NE.0)GOTO 10
C
 30   CALL SIMP1(A,MP,NP,0,L1,NL1,0,KP,BMAX)
      IF(BMAX.LE.0.D0)THEN
        ICASE=0
        RETURN
      ENDIF
C
      CALL SIMP2(A,M,N,MP,NP,L2,NL2,IP,KP,Q1,EPS)
      IF(IP.EQ.0)THEN
        ICASE=1
        RETURN
      ENDIF
C
      CALL SIMP3(A,MP,NP,M,N,IP,KP)
      GOTO 20
C
      END