C     RADIAL TENT INPUT
      DIMENSION HT(20), H0(20), ZZ(20,20)
      READ(50,1) NRINGS, NSEGS,V,RAD
      READ(50,2) (HT(I),I=1,NRINGS)
      READ(50,2) (H0(I),I=1,NRINGS)
      write(60,1) NRINGS, NSEGS,V,RAD
      write(60,2) (HT(I),I=1,NRINGS)
      write(60,2) (H0(I),I=1,NRINGS)
      THETA=3.14159/(4.*FLOAT(NSEGS))
      NSG=NSEGS+1
    1 FORMAT(2I5,2F10.3)
    2 FORMAT(6F10.3)
      DO 10 I=1,NSG
      TH=FLOAT(I-1)*THETA
      ZZ(NRINGS,I)=RAD
   10 ZZ(1,I)=50./COS(TH)
      write(*,*) 'Do you want to change the square base? 
     1 (yes,no=1,0)'
      read(*,*) iyes
      if(iyes.ne.1) go to 20
C      write(*,*) (zz(1,i),i=1,nsg)
      read(50,*)(zz(1,i),i=1,nsg)
   20 CALL TENT(NRINGS,NSEGS,V,HT,H0,ZZ)
      STOP
      END
C
      SUBROUTINE TENT(NRINGS,NSEGS,V,HT,H0,ZZ)
C     RADIAL TENT PROGRAM
      DIMENSION HT(1),H0(1),ZZ(20,20)
      DIMENSION NP(100),MI(100),R(300),FOR(300)
      DIMENSION IFIX(110),ISYM(100),JT(100,100)
C
C     HT=RING HEIGHT
C     HO=REFERENCE RADIAL FORCE
C     V=VERTICAL FORCE COMPONENT
C     ZZ(RING LEVEL,SEGMENT)=RADIAL COORDINATES
C
      THETA=3.14159/(4.*FLOAT(NSEGS))
      CTN=COS(THETA)/SIN(THETA)
      SI=SIN(THETA)
      NRING2=NRINGS-2
      NR1=NRINGS-1
      NSEG1=NSEGS+1
      NSG=NSEGS+1
      DO 10 I=2,NR1
      DO 10 J=1,NSEG1
   10 ZZ(I,J)=ZZ(1,J)*float(nrings-i)/float(NRINGS)
      WRITE(60,9)((ZZ(I,J),J=1,NSG),I=1,NRINGS)
      NIT=10
      DO 100 ITER=1,NIT
      DO 100 I1=1,NRING2
      I=NRINGS-I1
      HZ=H0(I)
      R0=ZZ(I,1)
      DO 1 J=1,nsg
      ZU=HT(I+1)
      ZI=HT(I)
      ZD=HT(I-1)
      HU=-(ZI-ZU)
      HD=ZI-ZD
      RU=ZZ(I+1,J)
      RD=ZZ(I-1,J)
      IF(J.EQ.1) RL=ZZ(I,J+1)
      IF(J.EQ.NSG) RR=ZZ(I,J-1)
      IF(J.NE.1) RL=ZZ(I,J-1)
      IF(J.NE.NSG) RR=ZZ(I,J+1)
      RI=ZZ(I,J)
      A=V*(1./HD+1./HU)
      B=R0*HZ*(1./RR+1./RL)/SI-V*(RD/HD+RU/HU)
      C=-2.*R0*HZ*CTN
      write(60,9) a,b,c
      RNEW=(-B+SQRT(B*B-4.*A*C))/(2.*A)
      RATIO=RNEW/ZZ(I,J)
      ZZ(I,J)=RNEW
    1 WRITE(60,9) RATIO,RNEW
    9 FORMAT(5E20.8)
  100 CONTINUE
      WRITE(60,9)((ZZ(I,J),J=1,NSG),I=1,NRINGS)
      NN=0
      NB=0
      DO 200 I=1,NRINGS
      DO 200 J=1,NSG
      ANG=FLOAT(J-1)*THETA
      NN=NN+1
      ISYM(nn)=0
      R(3*NN-2)=ZZ(I,J)*SIN(ANG)
      R(3*NN-1)=-ZZ(I,J)*COS(ANG)+50.
      R(3*NN)  =HT(I)
      if(nn.eq.1) isym(nn)=3
      if(nn.ne.1.and .j.eq.1) isym(nn)=2
      if(nn.ne.1.and.j.eq.nsg) isym(nn)=4
      if(isym(nn).eq.0.and .i.eq.1) isym(nn)=1
      IF(NN.EQ.1) GO TO 200
      IF(J.EQ.1) GO TO 201
      NB=NB+1
      NP(NB)=NN
      MI(NB)=NN-1
  201 IF(I.EQ.1) GO TO 200
      NB=NB+1
      NP(NB)=NN
      MI(NB)=NN-NSG
  200 CONTINUE
      WRITE(150,150)NB,NN
  150 FORMAT(2I5)
      WRITE(150,151) (NP(I),MI(I),FOR(I),I=1,NB)
  151 FORMAT(2I5,E20.8)
      WRITE(150,152)(R(3*I-2),R(3*I-1),R(3*I), IFIX(I),ISYM(I),
     1 (JT(I,J),J=1,8),I=1,NN)
  152 format(3f10.3,2i2,8i5)
c      call splot(np,mi,nn,nb,r,for,0)
c      call splot(np,mi,nn,nb,r,for,1)
c      call splot(np,mi,nn,nb,r,for,2)
      RETURN
      END