C     COLUMN BUCKLING
      use imsl
      double precision D2(50,50),A(50,50),AII(50),EVAL(50)
     & ,EVEC(50,50),F(50),ALP(100,100),obj
     & ,XLB(50),XUB(50),BL(50),BU(50),XSOL(50),dsol(50)
      dimension itype(50)
C     INITIALIZE PARAMETERS/ARRAYS
C
      E = 29.0D06
      NSPACES=20
      NODES=NSPACES-1
      ALEN=120.
      PCR=1.987E7
      H=ALEN/FLOAT(NSPACES)
      H2=H*H
      DO 3 I=1,NODES
    3 AII(I)=1000.
c
      do 9997 iter=1,40
      DO 1 I=1,NODES
      DO 2 J=1,NODES
      A(I,J)=0.
    2 D2(I,J)=0.
      A(I,I)=1./(E*AII(I))
      IF(I.NE.1) D2(I,I-1)=1./H2
      IF(I.NE.NODES) D2(I,I+1)=1./H2
      D2(I,I  )=-2./H2
    1 CONTINUE
C      WRITE(60,*)((I,J,A(I,J),D2(i,j),J=1,NODES),I=1,NODES)
      CALL dGVCSP(NODES,D2,50,A,50,EVAL,EVEC,50)
      WRITE(60,*)NSPACES,EVAL(NODES),(I,EVEC(I,NODES)
     & ,I=1,NODES)
C
c
C
c     scale for displacements
C
      RATIOO=PCR/ABS(EVAL(NODES))
      do 88 i=1,NODES
  88  AII(i)=ratioo*AII(i)
c
      do 70 i=1,NODES
      F(I)=.5/SQRT(AII(I))
      ALP(1,I)=-(EVEC(I,NODES)**2)/(AII(I)**2)
      xlb(i)=-.1*AII(i)
  70  xub(i)=.1*AII(i)
      BL(1)=0.
      BU(1)=0.
      ITYPE(1)=3
      nrows=1
      LDA=100
c      write(60,*)' *** nrows',nrows
      write(60,*)((alp(i,j),j=1,nODES),i=1,nrows)
      CALL dDLPRS(NROWS,NODES,ALP,LDA,BL,BU,F,ITYPE,
     & xlb,xub,obj,xsol,dsol)
      write(60,61)obj,(i,xsol(i),AII(i),i=1,nODES)
  61  format(e20.8/ (i5,2e20.8))
      volume=0.
      do 71 i=1,nODES
      volume=volume+H*SQRT(AII(I))
   71 AII(i)=AII(i)+xsol(i)
      write(60,*) '*** volume', volume,nrows,iter
 9997 continue
      STOP
      END
