c      main program
       parameter(nx=4,nx2=nx*2)
       dimension p(nx2)
c
c
       call initvrml
c
       call facebe
c
       call colorp(nx2,p)
c
       call coordbe
c
       call coordp(nx2,p)
c
       call coorden(nx)
       call faceen
c
       stop
       end
c      subroutine initvrml
       subroutine initvrml
       write(10,10)
   10  format("#VRML V2.0 utf8")
       return
       end
       subroutine colorp(nx,p)
       dimension p(1)
       r=1.0
       g=1.0
       b=1.0
       do 100 i=1,nx
       if(i.ne.nx) write(10,20) r,g,b
       if(i.eq.nx) write(10,30) r,g,b
   20  format(f3.1,1x,f3.1,1x,f3.1,",")
   30  format(f3.1,1x,f3.1,1x,f3.1)
  100  continue
       return
       end
       subroutine coordp(nx,p)
       dimension p(1)
       x=1.0
       y=1.0
       z=1.0
       xb=0.0
       yb=0.0
       dx=1.0
       dy=1.0
       do 100 i=1,nx
       i1=(i-1)/2
       i2=i-i1*2
       x=xb+dx*float(i1)
       y=yb+dy*float(i2-1)
       z=0.0
       if(i.ne.nx) write(10,20) x,y,z
       if(i.eq.nx) write(10,30) x,y,z
   20  format(f3.1,1x,f3.1,1x,f3.1,",")
   30  format(f3.1,1x,f3.1,1x,f3.1)
  100  continue
       return
       end
       subroutine facebe
       write(10,21)
   21  format("Shape {")
       write(10,22)
   22  format("geometry IndexedFaceSet {")
       write(10,23)
   23  format("color Color {")
       write(10,24)
   24  format("color [")
       return
       end
       subroutine coordbe
       write(10,21)
   21  format("]")
       write(10,22)
   22  format("}")
       write(10,23)
   23  format("coord Coordinate {")
       write(10,24)
   24  format("point [")
       return
       end
       subroutine coorden(nx)
       dimension ia(2000)
       write(10,21)
   21  format("]")
       write(10,22)
   22  format("}")
       write(10,23)
   23  format("colorPerVertex TRUE")
       write(10,24)
   24  format("coordIndex [")
c
       do 10 i=1,nx
       i1=1+5*(i-1)
       i2=2+5*(i-1)
       i3=3+5*(i-1)
       i4=4+5*(i-1)
       i5=5+5*(i-1)
       ia(i1)=0+2*(i-1)
       ia(i2)=1+2*(i-1)
       ia(i3)=3+2*(i-1)
       ia(i4)=2+2*(i-1)
       ia(i5)=-1
   10  continue
c
       na2=5*(nx-1)-1
       write(10,102) (ia(i),i=1,na2)
  102  format(4(4i2,i3),2i2,3i3,220i3,2i3,2i4,i3,
     1        449(4i4,i3),2i4,2i5,i3,3000(4i5,i3))
c
       return
       end
       subroutine faceen
       write(10,21)
   21  format("]")
       write(10,22)
   22  format("solid FALSE")
       write(10,23)
       write(10,23)
   23  format("}")
       return
       end