include 'fgraph.fi' C GENERAL MEMBRANE LAYOUT PLOT PROGRAM c For 1/4 to full layout DIMENSION FORH(400),X(400),Y(400),Z(400),JT(400,4),IFIX(400) 1 ,NP(400),MI(400),ISYM(400),R(1000),NSTART(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.2,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 Reflect node point about coord axes c isym=1 points on the x axis c isym=2 points on the y axis c isym=3 center of symmetry NB0=NB NN0=NN DO 31 I=1,NN0 NSTART(I)=NN+1 IF(ISYM(I).EQ.1) GO TO 22 IF(ISYM(I).EQ.3) GO TO 31 NN=NN+1 ifix(nn)=ifix(i) X(NN)=X(I) Y(NN)=-Y(I) Z(NN)=Z(I) IF(ISYM(I).EQ.2) GO TO 31 NN=NN+1 ifix(nn)=ifix(i) X(NN)=-X(I) Y(NN)=-Y(I) Z(NN)=Z(I) 22 NN=NN+1 ifix(nn)=ifix(i) X(NN)=-X(I) Y(NN)=Y(I) Z(NN)=Z(I) 31 CONTINUE DO 61 I=1,NB0 IP=NP(I) IM=MI(I) IPS=NSTART(IP)-1 IMS=NSTART(IM)-1 ISUM=ISYM(IP)+ISYM(IM) if(isum.eq.0) go to 62 isngl=0 if(isum.ge.4.or.isym(ip).eq.isym(im)) isngl=1 IF(isum.ge.4.OR.ISYM(IP).EQ.ISYM(IM)) GO TO 63 62 NB=NB+1 IPS=IPS+1 IMS=IMS+1 NP(NB)=IPS MI(NB)=IMS FORH(NB)=FORH(I) IF(isym(ip).eq.1.or.isym(ip).eq.3) GO TO 65 IF(isym(im).eq.1.or.isym(im).eq.3) GO TO 66 GO TO 64 65 NP(NB)=IP IPS=IPS-1 GO TO 64 66 MI(NB)=IM IMS=IMS-1 64 NB=NB+1 IPS=IPS+1 IMS=IMS+1 NP(NB)=IPS MI(NB)=IMS FORH(NB)=FORH(I) IF(isym(ip).eq.2) GO TO 165 IF(isym(im).eq.2) GO TO 166 if(isym(iP).eq.3) go to 465 if(isym(im).eq.3) go to 466 GO TO 63 465 np(nb)=ip ips=ips-1 go to 63 466 mi(nb)=im ims=ims-1 go to 63 165 ips=ips-1 NP(NB)=IPs GO TO 63 166 ims=ims-1 MI(NB)=IMs 63 NB=NB+1 100 IPS=IPS+1 IMS=IMS+1 NP(NB)=IPS MI(NB)=IMS FORH(NB)=FORH(I) if(isngl.eq.1.and.isym(ip).eq.3) go to 265 if(isngl.eq.1.and.isym(im).eq.3) go to 266 if(isngl.eq.1)go to 61 IF(isym(ip).eq.2.or.isym(ip).eq.3) GO TO 265 IF(isym(im).eq.2.or.isym(im).eq.3) GO TO 266 IF(isym(ip).eq.1.or.isym(ip).eq.3) GO TO 365 IF(isym(im).eq.1.or.isym(im).eq.3) GO TO 366 GO TO61 265 NP(NB)=IP GO TO 61 266 MI(NB)=IM go to 61 365 ips=ips-1 np(nb)=ips go to 61 366 ims=ims-1 mi(nb)=ims 61 CONTINUE DO 71 I=1,NN R(3*I-2)=X(I) R(3*I-1)=Y(I) R(3*I) =Z(I) 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 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(400),Y(400),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