33000 CONTINUE
RETURN
910
WRITE(*,1910) NAQ(I),NAQ(J)
1910 FORMAT(2(1X,I3),/,'!! TABLE 1 IS NOT COMPLETE !!'/
$'
!! OR WRONG COMPONENT WAS ENTERED !!')
STOP
END
C------------------------------------------------------------------C
C------------------------------------------------------------------C
SUBROUTINE SIMPL (IP1,M,IOP1,IP,N1,K,IR)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
COMMON /MASS1/ A,G,NUM,X(40)
COMMON /ENTER/ ISIM,ISIMIN
DIMENSION A(10,40),G(40),NUM(40)
C
IP1 - BEGINING J, M - FINISH J, IOP1- BEGINING I, IP -FINISH I
C......LOOKING FOR A NEW PHASE FOR INCLUDING INTO BASIS.........
ISIM=0
1111
DEL=0.D0
IK=0
K=0
DO 1001 J=IP1,M
P=0.
DO 1002 I=1,IP
P=P+G(I)*A(I,J)
1002
CONTINUE
DELTA=G(J)-P
IF(DELTA.GE.DEL) GO TO 1001
DEL=DELTA
K=J
ISIM=1
1001
CONTINUE
IF(K.EQ.0) GO TO 1000
C......LOOKING FOR PLACE IN THE BASIS TO BE SUBSTITUTED...........
BMIN=1D+20
DO 1005 I=IOP1,IP
IF(A(I,K).LE.0.) GO TO 1005
BTEK=A(I,N1)/A(I,K)
IF(BTEK.GE.BMIN) GO TO 1005
BMIN=BTEK
IR=I
1005
CONTINUE
DO 1007 I=1,IP
A(I,IR)=A(I,K)
1007
CONTINUE
27
Previous Page
