include 'fgraph.fi'
C     GENERAL MEMBRANE LAYOUT PLOT PROGRAM
c     Mapping 1/8 to 1/4
      DIMENSION FORH(400),X(400),Y(400),Z(400),JT(400,4),IFIX(400)
     1 ,NP(400),MI(400),ISYM(400),R(1000),New(1000)
      READ(50,1)NB,NN
      WRITE(6,1)NB,NN
    1 FORMAT(2I5)
      READ(50,222)(NP(I),MI(I),FORH(I),I=1,NB)
  222 FORMAT(2I5,E20.8)
      WRITE(6,2)(FORH(I),NP(I),MI(I),I=1,NB)
    2 FORMAT(f10.3,2I5)
      READ(50,3)(X(I),Y(I),Z(I),IFIX(I),ISYM(I),(JT(I,J),J=1,4),I=1,
     1 NN)
      WRITE(6,3)(X(I),Y(I),Z(I),IFIX(I),ISYM(I),(JT(I,J),J=1,4),I=1,
     1 NN)
    3 FORMAT(3f10.3,2I2,4I5)
c     ISYM = 4 implies a node on the diagonal
C      WRITE(*,*) 'ENTER THE Y OFFSET'
C      READ(*,*)YSHIFT
C      WRITE(*,*)YSHIFT
      YSHIFT=50.
c
c     THIS IS A SPECIAL CASE
      NB0=NB
      NN0=NN
      DO 31 I=1,NN0
      IF(ISYM(I).EQ.4) GO TO 31
      NN=NN+1
      new(i)=nn
      X(NN)=-y(I)+YSHIFT
      Y(NN)=-x(I)+YSHIFT
      Z(NN)=Z(I)
   31 CONTINUE
      DO 61 I=1,NB0
      IP=NP(I)
      IM=MI(I)
      if(isym(ip).eq.4.and.isym(im).eq.4)go to 61
  62  NB=NB+1
      NP(NB)=IP
      if(isym(ip).ne.4)np(nb)=new(ip)
      MI(NB)=IM
      if(isym(im).ne.4)mi(nb)=new(im)
   61 CONTINUE
      DO 71 I=1,NN
      R(3*I-2)=X(I)
      y(i)=y(i)-YSHIFT
      R(3*I-1)=Y(I)
      R(3*I)  =Z(I)
      Isym(I)=0
      IF(X(I).EQ.0.) Isym(I)=2
      IF(Y(I).EQ.0.) ISYM(I)=1
      IF(X(I).EQ.0..AND.Y(I).EQ.0.) ISYM(I)=3
   71 WRITE(6,72)I, R(3*I-2),R(3*I-1),R(3*I)
      WRITE(150,1)NB,NN
      WRITE(150,222)(NP(I),MI(I),forh(i),I=1,NB)
      WRITE(150,3)(X(I),Y(I),Z(I),IFIX(I),ISYM(I),(JT(I,J),J=1,4),I=1,
     1 NN)
   72 FORMAT(I5,3E20.8)
      CALL SPLOT(NP,MI,NN,NB,R,forh,0)
      STOP
      END
c 
      SUBROUTINE PLOT(NB, NN, X, Y, NP, MI,for,iwrite)
      INCLUDE 'FGRAPH.FD'
      DIMENSION  NP(1), MI(1), X(1), Y(1),for(1)
      INTEGER*2 DUMMY,xk,yk,xm,ym,lx,ly
      RECORD /XYCOORD/ XY
c     record /rccoord/ curpos
      character*6  text
      character*15 text1
      CHARACTER*64 FONTPATH
      CHARACTER*20 LIST
      FONTPATH='\f32\lib\courb.fon'
      LIST="t'courb'"//'h10w10b'
      DUMMY = SETVIDEOMODE( $VRES16COLOR)
      DUMMY=REGISTERFONTS(FONTPATH)
      DUMMY=SETFONT(LIST)
      AMAXX=639-20
      AMAYY=479-20
      XMIN=X(1)
      XMAX=X(1)
      YMIN=Y(1)
      YMAX=Y(1)
      DO 2 I=1,NN
      XI=X(I)
      YI=Y(I)
      IF(XMIN.GT.XI) XMIN=XI
      IF(XMAX.LT.XI) XMAX=XI
      IF(YMIN.GT.YI) YMIN=YI
   2  IF(YMAX.LT.YI) YMAX=YI
      SCALE = AMAX1((XMAX-XMIN)/AMAXX,(YMAX-YMIN)/AMAYY)
      XSHIFT = (XMAX+XMIN)/2.0 - 639/2*SCALE
      YSHIFT = (YMAX+YMIN)/2.0 - 479/2*SCALE
      DO 3 I=1,NB
      K=NP(I)
      M=MI(I)
      XK=(X(K)-XSHIFT)/SCALE
      YK=(Y(K)-YSHIFT)/SCALE
      XM=(X(M)-XSHIFT)/SCALE
      YM=(Y(M)-YSHIFT)/SCALE
      YK = 479-YK
      YM = 479-YM
      LX=((XK+XM)/2)
      LY=((YK+YM)/2)
      CALL MOVETO  ( XK, YK,  XY)
      DUMMY = LINETO  ( XM, YM)
      if(iwrite.ne.2) go to 998
      call  moveto(lx,ly,xy)
      write(text, '(i3)') i
      call outgtext (text)
  998 if(iwrite.eq.0.or.iwrite.eq.2) go to 3
      call moveto(lx,ly,xy)
      write(text1,'(f7.0)') for(i)
      call outgtext (text1)
   3  CONTINUE
      if(iwrite.ne.2) go to 996
      do 997 i=1,nn
      lx=(x(i)-xshift)/scale
      yk=(y(i)-yshift)/scale
      ly=(479-yk)
      call  moveto(lx,ly,xy)
      write(text, '(i3)') i
      call outgtext (text)
  997 continue
  996 continue
      RETURN
      END

      SUBROUTINE SPLOT ( NP,NM,NN,NB,R,for,iwrite)
      INCLUDE 'FGRAPH.FD'
      DIMENSION  NP(1),NM(1),RXY(1000),ROT(3,3),for(1)
      DIMENSION ANGL(3),NT(3),A(3,3),R1(3,3,3)
      INTEGER*2 DUMMY
      DIMENSION R(1),X(200),Y(200),RZ(1000)
      WRITE(*,1)
    1 FORMAT(' YOU ARE ABOUT TO ENTER A GRAPHICS '
     1 'DISPLAY MODE'/' THE KEYBOARD COMMANDS ARE'//
     1 '     +1...POSITIVE ROTATION ABOUT X AXIS'/
     1 '     -1...NEGATIVE ROTATION ABOUT X AXIS'/
     1 '     +2...POSITIVE ROTATION ABOUT Y AXIS'/
     1 '     -2...NEGATIVE ROTATION ABOUT Y AXIS'/
     1 '     +3...POSITIVE ROTATION ABOUT Z AXIS'/
     1 '     -3...NEGATIVE ROTATION ABOUT Z AXIS'/
     1 '      0...EXIT')
      READ(*,*)
      DO 616 I=1,3
      DO 617 J=1,3
      DO 617 K=1,3
  617 R1(I,J,K)=0.
  616 R1(I,I,I)=1.
      THX=0.
      THY=00.
      THZ=00.
      DTH=10.
  70  PI=3.14159
      DO 604 I=1,3 
      DO 603 J=1,3 
  603 ROT(J,I)=0. 
  604 ROT(I,I)=1. 
      ANGL(1)=THX
      ANGL(2)=THY
      ANGL(3)=THZ
      NT(1)=1
        NT(2)=2
      NT(3)=3
      I=0 
  302 I=I+1 
      IF(ANGL(I))606,605,606 
  606 L=NT(I) 
      GO TO 612 
  618 DO 607 J=1,3 
      DO 607 JA=1,3 
      A(J,JA)=0. 
      DO 607 JB=1,3 
  607 A(J,JA)=A(J,JA)+R1(L,J,JB)*ROT(JB,JA) 
      DO 608 K=1,3 
      DO 608 J=1,3 
  608 ROT(K,J)=A(K,J) 
  605 IF(I-3) 302,303,303 
  303 DO 805 I=1,NN
      RZ(I)=0.
      DO 806 K=1,3
  806 RZ(I)=RZ(I)+ROT(3,K)*R(3*I-3+K)
      DO 805 J=1,2
      RXY(2*I-2+J)=0.
      DO 805 K=1,3
  805 RXY(2*I-2+J)=RXY(2*I-2+J)+ROT(J,K)*R(3*I-3+K)
      GO TO 59
  612 ANG=ANGL(I)*PI/180. 
      IF(L-2)613,614,615 
  613 R1(1,2,2)=COS(ANG) 
      R1(1,2,3)=SIN(ANG) 
      R1(1,3,3)=R1(1,2,2) 
      R1(1,3,2)=-R1(1,2,3) 
      GO TO 618 
  614 R1(2,1,1)=COS(ANG) 
      R1(2,1,3)=-SIN(ANG) 
      R1(2,3,1)=-R1(2,1,3) 
      R1(2,3,3)=R1(2,1,1) 
      GO TO 618 
  615 R1(3,1,1)=COS(ANG) 
      R1(3,1,2)=SIN(ANG) 
      R1(3,2,1)=-R1(3,1,2) 
      R1(3,2,2)=R1(3,1,1) 
      GO TO 618 
   59 DO 24 I=1,NN
      X(I)=RXY(2*I-1)
   24 Y(I)=RXY(2*I)
      CALL PLOT(NB,NN,X,Y,NP,NM,for,iwrite)
      READ(*,*) IVAL
      IF(IVAL.EQ.+1) GO TO 2000
      IF(IVAL.EQ.-1) GO TO 3000
      IF(IVAL.EQ. 2) GO TO 4000
      IF(IVAL.EQ.-2) GO TO 5000
      IF(IVAL.EQ. 3) GO TO 6000
      IF(IVAL.EQ.-3) GO TO 7000
      IF(IVAL.EQ. 0) GO TO 8000
 2000 THX=THX+DTH
      GO TO 70
 3000 THX=THX-DTH
      GO TO 70
 4000 THY=THY+DTH
      GO TO 70
 5000 THY=THY-DTH
      GO TO 70
 6000 THZ=THZ+DTH
      GO TO 70
 7000 THZ=THZ-DTH
      GO TO 70
 8000 CALL UNREGISTERFONTS()
      DUMMY = SETVIDEOMODE( $DEFAULTMODE )
      RETURN
      END