PROGRAM CONPUC2 DIMENSION Q(20),PHI(20) OPEN(UNIT=1,FILE='PUCIN',STATUS='OLD') OPEN(UNIT=2,FILE='PUCPRT',STATUS='UNKNOWM') CALL PUCKER(Q,PHI,AAZ,NR) CLOSE(1) CLOSE(2) STOP END SUBROUTINE PUCKER(Q,PHI,AAZ,NRAT) DIMENSION X(200),Y(200),Z(200),XC(200),YC(200),ZC(200),XR(25),YR(2 &5),ZR(25),EN(3),EM(3),EL(3),XP(25),YP(25),ZP(25),QC(15),QS(15),Q(2 &0),PHI(20),TLE(10),NAME(200),IAT(40,25),AF(200),IN(2),NRA(50) READ(1,1)TLE WRITE(2,5)TLE WRITE(2,3)TLE NORS=0 NAT=0 ICART = 0 K=1 20 CALL FREFOR(AF,IN) INT=IN(2)+2 GO TO(145,26,25,21,22,23),INT 21 IF(AF(1).LT.0) GO TO 16 IF(AF(1).EQ.1) K=0 ICART=AF(1) GO TO 20 16 K=0 GO TO 20 22 A=AF(1) B=AF(2) C=AF(3) GAL=AF(4) GBE=AF(5) GGA=AF(6) GO TO 20 23 NORS=NORS+1 M=AF(1) NRA(NORS)=AF(1) DO 24 J=1,M 24 IAT(NORS,J)=AF(J+1) GO TO 20 25 NAT=NAT+1 NAME(NAT)=IN(1) X(NAT)=AF(K+1) Y(NAT)=AF(K+2) Z(NAT)=AF(K+3) GO TO 20 26 FACT=0.01745329 IF(ICART.EQ.2)GO TO 40 WRITE(2,6) DO 27 I=1,NAT 27 WRITE(2,4)I,NAME(I),X(I),Y(I),Z(I) IF(ICART.NE.1)GO TO 40 DO 30 I=1,NAT XC(I)=X(I) YC(I)=Y(I) 30 ZC(I)=Z(I) GO TO 60 40 IF(ICART.EQ.0)GO TO 45 WRITE(2,15) XF=0.0 YF=0.0 ZF=0.0 DO 41 I=1,NAT X(I)=-X(I) Y(I)=-Y(I) Z(I)=-Z(I) XF=XF+X(I) YF=YF+Y(I) 41 ZF=ZF+Z(I) NX=1-XF/NAT NY=1-YF/NAT NZ=1-ZF/NAT DO 43 I=1,NAT X(I)=X(I)+NX Y(I)=Y(I)+NY Z(I)=Z(I)+NZ 43 WRITE(2,4)I,NAME(I),X(I),Y(I),Z(I) 45 AL=GAL*FACT BE=GBE*FACT GA=GGA*FACT PA=COS(BE)*COS(GA) R=(COS(AL)-PA)/SIN(GA) QA=SQRT(1.-COS(BE)**2-R**2) CAB=B*COS(GA) CAC=C*COS(BE) CBB=B*SIN(GA) CBC=C*R CCC=C*QA DO 50 I=1,NAT XC(I)=X(I)*A+Y(I)*CAB+Z(I)*CAC YC(I)=Y(I)*CBB+Z(I)*CBC 50 ZC(I)=Z(I)*CCC 60 DO 140 I=1,NORS NRAT=NRA(I) WRITE(2,8)NRAT 65 DO 70 J=1,NRAT IF(NRAT.EQ.NAT)IAT(I,J)=J XR(J)=XC(IAT(I,J)) YR(J)=YC(IAT(I,J)) 70 ZR(J)=ZC(IAT(I,J)) BX=0.0 BY=0.0 BZ=0.0 DO 80 J=1,NRAT BX=BX+XR(J) BY=BY+YR(J) 80 BZ=BZ+ZR(J) BX=BX/NRAT BY=BY/NRAT BZ=BZ/NRAT XD=0.0 YD=0.0 ZD=0.0 XDD=0.0 YDD=0.0 ZDD=0.0 DO 90 J=1,NRAT XR(J)=XR(J)-BX YR(J)=YR(J)-BY ZR(J)=ZR(J)-BZ SINF=SIN(6.283185*(J-1)/NRAT) COSF=COS(6.283185*(J-1)/NRAT) XD=XD+XR(J)*SINF YD=YD+YR(J)*SINF ZD=ZD+ZR(J)*SINF XDD=XDD+XR(J)*COSF YDD=YDD+YR(J)*COSF 90 ZDD=ZDD+ZR(J)*COSF A=YD*ZDD-ZD*YDD B=ZD*XDD-XD*ZDD C=XD*YDD-YD*XDD R=SQRT(A**2+B**2+C**2) EN(1)=A/R EN(2)=B/R EN(3)=C/R D=EN(1)*XR(1)+EN(2)*YR(1)+EN(3)*ZR(1) XO=XR(1)-EN(1)*D YO=YR(1)-EN(2)*D ZO=ZR(1)-EN(3)*D R=SQRT(XO**2+YO**2+ZO**2) EM(1)=XO/R EM(2)=YO/R EM(3)=ZO/R EL(1) =EM(2)*EN(3)-EM(3)*EN(2) EL(2)=EM(3)*EN(1)-EM(1)*EN(3) EL(3)=EM(1)*EN(2)-EM(2)*EN(1) A=0.0 B=0.0 IE=0 WRITE(2,9) DO 100 J=1,NRAT XP(J)=EL(1)*XR(J)+EL(2)*YR(J)+EL(3)*ZR(J) YP(J)=EM(1)*XR(J)+EM(2)*YR(J)+EM(3)*ZR(J) ZP(J)=EN(1)*XR(J)+EN(2)*YR(J)+EN(3)*ZR(J) 100 WRITE(2,7)NAME(IAT(I,J)),XC(IAT(I,J)),YC(IAT(I,J)),ZC(IAT(I,J)),XP &(J),YP(J),ZP(J) M=(NRAT-1)/2 WRITE(2,11) DO 120 N=2,M QS(N)=0.0 QC(N)=0.0 DO 110 J=1,NRAT QC(N)=QC(N)+ZP(J)*COS(6.283185*N*(J-1)/NRAT) 110 QS(N)=QS(N)+ZP(J)*SIN(6.283185*N*(J-1)/NRAT) IF(NRAT/2.GT.M)IE=1 QC(N)=QC(N)*SQRT(2./NRAT) QS(N)=-QS(N)*SQRT(2./NRAT) Q(N)=SQRT(QC(N)**2+QS(N)**2) SNTH=QS(N)/Q(N) CSTH=QC(N)/Q(N) IF(CSTH.LT.0)GO TO 115 PHI(N)=ASIN(SNTH)/FACT IF(PHI(N).LT.0)PHI(N)=PHI(N)+360.0 GO TO 120 115 PHI(N)=ACOS(CSTH)/FACT IF(SNTH.LT.0)PHI(N)=360.0-PHI(N) 120 WRITE(2,12)N,Q(N),PHI(N) IF(IE.NE.1)GO TO 135 BQ=0.0 N2=NRAT/2 Q(N2)=0.0 DO 130 J=1,NRAT Q(N2)=(-1)**(J-1)*ZP(J)+Q(N2) 130 BQ=BQ+ZP(J)**2 Q(N2)=Q(N2)*SQRT(1./NRAT) WRITE(2,13)Q(N2) BQ=SQRT(BQ) TH=ACOS(Q(N2)/BQ)/FACT WRITE(2,14)BQ,TH 135 AAZ=0 IF(IE.EQ.1)AAZ=Q(N2) CALL CONFOR(Q,PHI,AAZ,NRAT) 140 CONTINUE GO TO 150 145 WRITE(2,2)IN(1) 1 FORMAT(4X,10A4) 2 FORMAT(1X,' BAD DATA'/' UNSUITABLE ',A4,' RECORD') 3 FORMAT(1X,' INPUT DATA'//' TITL ',10A4) 4 FORMAT(I3,3X,A4,3F10.4) 5 FORMAT(1X,'PUCKERING ANALYSIS OF ',10A4) 6 FORMAT(1X,'ATOM COORDINATES') 7 FORMAT(1X,A4,5X,3F13.4,5X,3F13.4) 8 FORMAT(//,I5,' MEMBERED RING') 9 FORMAT(1X,'CARTESIAN AND PUCKERING COORDINATES') 10 FORMAT(1X,'CELL CONSTANTS',6F10.4) 11 FORMAT(1X,'PUCKERING PARAMETERS') 12 FORMAT(1X,'M =',I3,' Q(M) =',F7.4,' PHI(M) =',F8.4) 13 FORMAT(1X,'Q(N/2) =',F7.4) 14 FORMAT(1X,'PUCKERING AMPLITUDE =',F7.4,' THETA =',F8.4) 15 FORMAT(1X,'ENANTIOMORPHIC COORDINATES') 150 RETURN END SUBROUTINE FREFOR(A,IN) DIMENSION IR(76),IH(14),A(200),IN(2),JZ(8) DATA IH(1)/1H0/,IH(2)/1H1/,IH(3)/1H2/,IH(4)/1H3/,IH(5)/1H4/ DATA IH(6)/1H5/IH(7)/1H6/,IH(8)/1H7/,IH(9)/1H8/,IH(10)/1H9/ DATA IH(11)/1H./,IH(12)/1H-/,IH(13)/1H+/,IH(14)/1H=/ DATA JZ(1)/4H /,JZ(2)/4HFVAR/,JZ(3)/4HWGHT/,JZ(4)/4HAFIX/ DATA JZ(5)/4HCOOR/,JZ(6)/4HCELL/,JZ(7)/4HRING/,JZ(8)/4HEND / 1 FORMAT(A4,76A1) 2 FORMAT(1H ,A4,76A1) 3 READ(1,1)I,IR IN(1)=I WRITE(2,2)I,IR IN(2)=1 DO 5 J=1,4 IF(I.EQ.JZ(J))GO TO 3 5 CONTINUE IF(I.EQ.JZ(8)) GO TO 40 DO 15 J=5,7 IF(I.EQ.JZ(J))IN(2)=J-3 15 CONTINUE N=0 GO TO 25 6 W=1. 7 V=0. NB=0 Y=1. U=10. Z=1. GO TO 10 8 Z=Y*Z V=U*ABS(V)+Z*X NB=1 IF(V)9,10,9 9 V=SIGN(V,W) W=V 10 N=N+1 K=6 IF(76-N)27,11,11 11 X=0. DO 12 M=1,10 IF(IR(N).EQ.IH(M))GO TO 8 12 X=X+1. GO TO 14 13 IF(IR(N).EQ.IH(K+9)) GO TO 27 14 K=K-1 IF(K-2)27,13,13 17 U=1. Y=0.1 GO TO 10 21 READ(1,1)M,IR WRITE(2,2)M,IR N=0 IF(JZ(1).EQ.M)GO TO 6 C ERROR MESSAGE RETURN. IN(2)=-1 23 IN(2)=-1 GO TO 35 25 DO 26 J=1,200 26 A(J)=0. NA=0 GO TO 6 27 IF(K-2)28,17,28 28 NA=NA+NB IF(200-NA)23,29,29 29 IF(-NA)30,31,31 30 A(NA)=V+A(NA) 31 IF(K-5)33,21,35 32 CONTINUE 33 IF(K-3)6,34,6 34 W=-1. GO TO 7 40 IN(2)=0 C END OF FILE 35 RETURN END SUBROUTINE CONFOR(Q,PHI,AAZ,NR) C *************************************************************** C THIS PROGRAM EXPRESSES ANY CONFORMATION AS A LINEAR COMBINATION C OF PRIMITIVE FORMS- AS DEFINED BY THE CREMER-POPLE EQUATIONS. C THE PROGRAM IS ONLY FOR 18 -MEMBERED RINGS OR LESS. C *************************************************************** DIMENSION Q(20),PHI(20),XA(20),XB(20),XXA(20),XXB(20) N=(NR-1)/2 WRITE(2,111) WRITE(2,109) WRITE(2,503) WRITE(2,103)(M,Q(M),PHI(M),M=2,N) C C *********************************************** C DISTINGUISH BETWEEN ODD AND EVEN MEMBERED RINGS C *********************************************** C IF(NR/2.GT.N)THEN IC=NR/2 Q(IC)=AAZ WRITE(2,104)IC,Q(IC) R=Q(IC) IF(NR.LE.8)CALL EVEN(Q,PHI,N,NR,R) IF(NR.GT.8)CALL LARGE(Q,PHI,N,NR,R) ELSE CALL ODD(Q,PHI,N,NR) ENDIF 111 FORMAT(///,5X,'CONFORMATIONAL ANALYSIS') 103 FORMAT(5X,I2,4X,F5.3,4X,F7.2) 109 FORMAT(//,5X,'PUCKERING PARAMETERS') 104 FORMAT(//,5X,'Q(',I1,')=',F6.3) 503 FORMAT(//,6X,'M',4X,'Q(M)',7X,'PHI(M)') RETURN END SUBROUTINE MINI(N,KK,KM,NR,PHI) C C *********************************************************** C THIS SUBROUTINE FINDS THE PHI VALUES OF THE PRIMITIVE FORMS C CLOSEST TO THE RING C *********************************************************** C REAL KK(50),KM YM=380 DO 1000 I=1,N Y=ABS(((KK(I)*180)/(2*NR))-PHI) IF(Y.LT.YM)GO TO 1010 GOTO 1000 1010 YM=Y KM=KK(I) 1000 CONTINUE RETURN END SUBROUTINE SOLVE(Q,KMIN,LMIN,N,NR,PHI,XA,XB) C C **************************************************** C THIS FINDS THE COEFFICIENTS IN THE LINEAR EXPRESSION C **************************************************** C DIMENSION Q(20),PHI(20),XA(20),XB(20),A(20),B(20),W(20),RHI(20) REAL KMIN(50),LMIN(50) C C THE EQUATIONS IN THE LINEAR COMBINATION ARE NOW SOLVED 150 PI=3.14159265 DO 201 M=2,N A(M)=((KMIN(M)*PI)/(2*NR)) B(M)=((LMIN(M)*PI)/(2*NR)) W(M)=(SIN(A(M)))*(COS(B(M)))-(COS(A(M)))*(SIN(B(M))) C THE COEFFICIENTS IN THE EXPRESSION ARE NOW SOLVED FACT=0.01745329 RHI(M)=PHI(M)*(FACT) XA(M)=(1/W(M))*((-Q(M))*(COS(RHI(M)))*(SIN(B(M)))+Q(M)*(SIN(RHI(M) &))*(COS(B(M)))) XB(M)=(1/W(M))*(Q(M)*(COS(RHI(M)))*(SIN(A(M)))-Q(M)*(SIN(RHI(M)))* &(COS(A(M)))) 201 CONTINUE RETURN END SUBROUTINE WRITES(N,XA,XB,V,KMIN,LMIN,XXA,XXB,VV) C C **************************************************** C THIS NORMALISES COEFFICIENTS AND WRITES THEM TO FILE C **************************************************** C DIMENSION XA(20),XB(20),XXA(20),XXB(20) REAL KMIN(50),LMIN(50) TOTL=0 DO 250 M=2,N TOTL=TOTL+XA(M)+XB(M) 250 CONTINUE TOTL=TOTL+V WRITE(2,110) WRITE(2,504) WRITE(2,105)(M,XA(M),XB(M),M=2,N) WRITE(2,111) WRITE(2,505) WRITE(2,506) WRITE(2,507) DO 300 M=2,N XXA(M)=XA(M)/(TOTL) XXB(M)=XB(M)/(TOTL) WRITE(2,106)M,XXA(M),KMIN(M) WRITE(2,107)XXB(M),LMIN(M) 300 CONTINUE VV=V/(TOTL) 105 FORMAT(5X,I2,8X,F5.3,8X,F5.3) 106 FORMAT(5X,I2,8X,F5.3,8X,F4.1) 107 FORMAT(15X,F5.3,8X,F4.1) 110 FORMAT(//,5X,'COEFFICIENTS OF PRIMITIVE FORMS') 111 FORMAT(//,5X,'NORMALISED COEFFICIENTS') 504 FORMAT(//,6X,'M',7X,'COSFORM',5X,'SINFORM') 505 FORMAT(//,6X,'M',5X,'COEFFICIENT',3X,'ANGULAR VALUE') 506 FORMAT(12X,'OF PRIMITIVE',2X,'OF PRIMITIVE') 507 FORMAT(12X,'FORM',11X,'FORM') RETURN END SUBROUTINE EVEN(Q,PHI,N,NR,R) C C ********************************************** C THIS GENERATES THE PRIMITIVE FORMS FOR 6 AND 8 C MEMBERED RINGS C ********************************************** C DIMENSION Q(20),PHI(20),XA(20),XB(20),XXA(20),XXB(20),TF1(6),TF2(6 &),TF3(6),UF1(15),UF2(15),UF3(15),UF4(15),UF5(15),YXZ(15),QX(8),QXA &(8) REAL K(50),L(50),KMIN(50),LMIN(50) CHARACTER NAME(6),NAMEX(15)*3 C C ********************************************* C THIS FINDS THE CROWN FORM CLOSEST TO THE RING C ********************************************* C IF (R.LE.0)THEN AA=-1.0 ELSE AA=1.0 ENDIF V=ABS(R) C C ****************************************************************** C THIS DETERMINES THE ANGULAR VALUES OF PRIMITIVE FORMS OF 6-M RINGS C ****************************************************************** C IF(NR.EQ.6)THEN DO 86 M=2,N DO 85 I=1,7 K(I)=4*(I-1) L(I)=4*(I-1)+2 85 CONTINUE NX=7 CALL MINI(NX,K,KMIN(M),NR,PHI(M)) CALL MINI(NX,L,LMIN(M),NR,PHI(M)) 86 CONTINUE CALL SOLVE(Q,KMIN,LMIN,N,NR,PHI,XA,XB) CALL WRITES(N,XA,XB,V,KMIN,LMIN,XXA,XXB,VV) WRITE(2,108)NR/2,VV,AA C C ************************************************** C THIS FINDS OUT IF THE 6-M RING IS A CLASSICAL FORM C DATA FOR 6-M CLASSICAL FORMS C ********************************************** C DATA NAME /'B','T','C','E','S','H'/ DATA TF1 /1.0,0.0,0.0,0.586,0.0,0.0/ DATA TF2 /0.0,1.0,0.0,0.0,0.707,0.551/ DATA TF3 /0.0,0.0,1.0,0.414,0.293,0.449/ DO 7000 I=1,6 YXX=ABS(TF1(I)-XXA(2))+ABS(TF2(I)-XXB(2))+ABS(TF3(I)-VV) IF(YXX.LE.0.2.AND.YXX.GT.0.1)WRITE(2,7031)NAME(I) IF(YXX.LE.0.1)WRITE(2,7030)NAME(I) 7000 CONTINUE 7030 FORMAT(/,5X,'WARNING:THIS IS A',A4,' FORM') 7031 FORMAT(/,5X,'WARNING:THIS IS VERY SIMILAR TO A ',A4,' FORM') C C ******************************************* C THE PRIMITIVE FORMS OF EIGHT MEMBERED RINGS C ******************************************* C ELSE DO 141 M=2,N C C ********************************************************* C PRIMITIVE FORMS ARE AT DIFFERENT PHI VALUES FOR M=2 AND 3 C ********************************************************* C 90 IF(M.EQ.2)THEN DO 120 I=1,3 K(I)=16*(I-1) L(I)=16*(I-1)+8 120 CONTINUE MY=3 CALL MINI(MY,K,KMIN(M),NR,PHI(M)) CALL MINI(MY,L,LMIN(M),NR,PHI(M)) ELSE DO 140 I=1,5 K(I)=8*(I-1) L(I)=8*(I-1)+4 140 CONTINUE NI=5 CALL MINI(NI,K,KMIN(M),NR,PHI(M)) CALL MINI(NI,L,LMIN(M),NR,PHI(M)) ENDIF 141 CONTINUE CALL SOLVE(Q,KMIN,LMIN,N,NR,PHI,XA,XB) CALL WRITES(N,XA,XB,V,KMIN,LMIN,XXA,XXB,VV) WRITE(2,108)NR/2,VV,AA C C THIS FINDS OUT IF A 8-M RING IS A CLASSICAL FORM C C ************************************************ C DATA FOR CLASSICAL FORMS C ************************************************ C DATA NAMEX /'BB ','BB ','CR ','TC ','TC ','C ','B ','S ','S ' &,'CC ','CC ','TCC','BC ','BC ','TBC'/ DATA UF1 /1.0,0.0,0.0,0.0,0.0,0.0,0.5,0.707,0.293,0.352,0.0,0.234 &,0.530,0.0,0.229/ DATA UF2 /0.0,1.0,0.0,0.0,0.0,0.0,0.5,0.293,0.707,0.0,0.352,0.234 &,0.0,0.530,0.229/ DATA UF3 /0.0,0.0,0.0,1.0,0.0,0.5,0.0,0.0,0.0,0.0,0.0,0.0,0.298,0 &.0,0.213/ DATA UF4 /0.0,0.0,0.0,0.0,1.0,0.5,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.2 &98,0.213/ DATA UF5 /0.0,0.0,1.0,0.0,0.0,0.0,0.0,0.0,0.0,0.648,0.648,0.533,0 &.172,0.172,0.116/ DO 7500 I=1,15 YXZ(I)= ABS(XXA(2)-UF1(I))+ ABS(XXB(2)-UF2(I))+ ABS(XXA(3)-UF3(I) &)+ ABS(XXB(3)-UF4(I)) + ABS(VV-UF5(I)) 7500 CONTINUE DO 7501 I=1,12 IF(YXZ(I).LE.0.2.AND.YXZ(I).GT.0.1)WRITE(2,7514)NAMEX(I) IF(YXZ(I).LE.0.1)WRITE(2,7513)NAMEX(I) 7501 CONTINUE DO 9669 I=2,N RZ=ABS(PHI(I)-360) IF(RZ.LT.5)PHI(I)=360-PHI(I) 9669 CONTINUE IF(YXZ(13).LE.0.2.OR.YXZ(14).LE.0.2)THEN DO 3010 J=1,8 ANG=(8*180*(J-1))/16 ANGA=180+(8*180*(J-1))/16 ANGL=180 + (4*180*(J-1))/16 RL= ABS(PHI(2)-ANG) IF(ANG.GE.360.AND.ANG.LT.720)RL= ABS(PHI(2)+360-ANG) IF(ANG.GE.720)RL= ABS(PHI(2)+720-ANG) RLA= ABS(PHI(2)-ANGA) IF(ANGA.GE.360.AND.ANGA.LT.720)RLA= ABS(PHI(2)+360-ANGA) IF(ANGA.GE.720)RLA= ABS(PHI(2)+720-ANGA) RLL= ABS(PHI(3)-ANGL) IF(ANGL.GE.360)RLL= ABS(PHI(3)+360-ANGL) QX(J)=RL+RLL QXA(J)=RLA+RLL 3010 CONTINUE QXX=10.03 QXXA=10.03 DO 3000 J=1,8 IF(QX(J).LE.10.AND.AA.EQ.-1.0)QXX=QX(J) IF(QXA(J).LE.10.AND.AA.EQ.1.0)QXXA=QXA(J) 3000 CONTINUE IF(QXX.LE.10.AND.YXZ(13).LE.0.1.OR.QXX.LE.10.AND.YXZ(14).LE.0.1)WR &ITE(2,7513)NAMEX(13) IF(QXXA.LE.10.AND.YXZ(13).GT.0.1.OR.QXXA.LE.10.AND.YXZ(14).GT.0.1) &WRITE(2,7514)NAMEX(13) ELSEIF(YXZ(15).LE.0.2)THEN DO 3002 J=1,8 ANG= (4*180)/16 +(8*180*(J-1))/16 ANGA=180+ 4*180/16 + (8*180*(J-1))/16 ANGL=180 + 2*180/16 + (4*180*(J-1))/16 RL= ABS(PHI(2)-ANG) IF(ANG.GE.360.AND.ANG.LT.720)RL= ABS(PHI(2)+360-ANG) IF(ANG.GE.720)RL= ABS(PHI(2)+720-ANG) RLA= ABS(PHI(2)-ANGA) IF(ANGA.GE.360.AND.ANGA.LT.720)RLA= ABS(PHI(2)+360-ANGA) IF(ANGA.GE.720)RLA= ABS(PHI(2)+720-ANGA) RLL= ABS(PHI(3)-ANGL) IF(ANGL.GE.360)RLL= ABS(PHI(3)+360-ANGL) QX(J)=RL+RLL QXA(J)=RLA+RLL 3002 CONTINUE QXX=10.03 QXXA=10.03 DO 3005 J=1,8 IF(QX(J).LE.10.AND.AA.EQ.-1.0)QXX=QX(J) IF(QXA(J).LE.10.AND.AA.EQ.1.0)QXXA=QXA(J) 3005 CONTINUE IF(QXX.LE.10.AND.YXZ(15).LE.0.1)WRITE(2,7513)NAMEX(15) IF(QXXA.LE.10.AND.YXZ(15).GT.0.1)WRITE(2,7514)NAMEX(15) IF(QXXA.LE.10.AND.YXZ(15).LE.0.1)WRITE(2,7513)NAMEX(15) IF(QXX.LE.10.AND.YXZ(15).GT.0.1)WRITE(2,7514)NAMEX(15) ELSE CONTINUE ENDIF 7513 FORMAT(/,5X,'WARNING: THIS IS A',A4,' FORM') 7514 FORMAT(/,5X,'WARNING:THIS IS VERY SIMILAR TO A',A4,' FORM') 7552 ENDIF 108 FORMAT(5X,I2,8X,F5.3,8X,F4.1) RETURN END SUBROUTINE ODD(Q,PHI,N,NR) C C ****************************************************** C THIS FINDS THE PRIMITIVE FORMS OF ODD MEMBERED RINGS C **************************************************** C DIMENSION Q(20),PHI(20),XA(20),XB(20),XXA(20),XXB(20),SF1(2),SF2(2 &),XF1(9),XF2(9),XF3(9),XF4(9),XN1(16),XN2(16),XN3(16),XN4(16),XN5( &16),XN6(16),YZZ(16),QY(14),QX(19),QXA(14),QYA(14),QX1(18),QX2(18), &QX3(18),QX4(18) REAL K(50),L(50),KMIN(50),LMIN(50) CHARACTER NAME(2),NAMEX(9)*2,NAMX(16)*4 DO 45 M=2,N NRR=2*NR+1 IF(NR.EQ.9.AND.M.EQ.3)THEN NUM=7 DO 4040 I=1,7 K(I)=6*(I-1) L(I)=6*(I-1)+3 4040 CONTINUE CALL MINI(NUM,K,KMIN(M),NR,PHI(M)) CALL MINI(NUM,L,LMIN(M),NR,PHI(M)) ELSEIF(NR.EQ.15.AND.M.EQ.5)THEN NUM=7 DO 4031 I=1,7 K(I)=10*(I-1) L(I)=10*(I-1)+5 4031 CONTINUE CALL MINI(NUM,K,KMIN(M),NR,PHI(M)) CALL MINI(NUM,L,LMIN(M),NR,PHI(M)) ELSEIF(NR.EQ.15.AND.M.EQ.3.OR.NR.EQ.15.AND.M.EQ.6)THEN NUM=11 DO 4033 I=1,11 K(I)=6*(I-1) L(I)=6*(I-1)+3 4033 CONTINUE CALL MINI(NUM,K,KMIN(M),NR,PHI(M)) CALL MINI(NUM,L,LMIN(M),NR,PHI(M)) ELSE DO 40 I=1,NRR K(I)=2*(I-1) L(I)=2*(I-1)+1 40 CONTINUE CALL MINI(NRR,K,KMIN(M),NR,PHI(M)) CALL MINI(NRR,L,LMIN(M),NR,PHI(M)) ENDIF 45 CONTINUE V=0 CALL SOLVE(Q,KMIN,LMIN,N,NR,PHI,XA,XB) CALL WRITES(N,XA,XB,V,KMIN,LMIN,XXA,XXB,VV) C C ********************************************* C THIS DETERMINES IF A RING IS A CLASSICAL FORM C ********************************************* C IF(NR.GT.9)GO TO 4994 IF(NR.EQ.5)THEN C C **************************** C DATA FOR 5-M CLASSICAL FORMS C **************************** C DATA NAME /'E','T'/ DATA SF1 /1.0,0.0/ DATA SF2 /0.0,1.0/ DO 9000 I=1,2 YX = ABS(SF1(I)-XXA(2))+ABS(SF2(I)-XXB(2)) IF(YX.LE.0.1)WRITE(2,9200)NAME(I) IF(YX.GT.0.1.AND.YX.LE.0.2)WRITE(2,9201)NAME(I) 9000 CONTINUE 9200 FORMAT(/,5X,'WARNING:THIS IS A',A4,' FORM') 9201 FORMAT(/,5X,'WARNING:THIS IS VERY SIMILAR TO A',A4,' FORM') ELSEIF(NR.EQ.7)THEN C C **************************** C DATA FOR 7-M CLASSICAL FORMS C **************************** C DATA NAMEX /'B ','TB','C ','TC','BS','S ','TS','H ','T '/ DATA XF1 /1.00,0.0,0.0,0.0,0.783,0.5,0.0,0.417,0.0/ DATA XF2 /0.0,1.0,0.0,0.0,0.0,0.0,0.444,0.0,0.46/ DATA XF3 /0.0,0.0,1.0,0.0,0.217,0.5,0.0,0.583,0.0/ DATA XF4 /0.0,0.0,0.0,1.0,0.0,0.0,0.555,0.0,0.54/ DO 4000 I=1,9 YZZ(I)= ABS(XXA(2)-XF1(I))+ ABS(XXB(2)-XF2(I))+ ABS(XXA(3)-XF3(I)) &+ABS(XXB(3)-XF4(I)) 4000 CONTINUE DO 9669 I=2,N RZ=ABS(PHI(I)-360) IF(RZ.LT.5)PHI(I)=360-PHI(I) 9669 CONTINUE IF (YZZ(5).LE.0.2)THEN DO 4041 J=1,14 ANGA=180+(6*180*(J-1))/14 ANGL=(2*180*(J-1))/14 RLA= ABS(PHI(2)-ANGA) IF(ANGA.GE.360.AND.ANGA.LT.720)RLA= ABS(PHI(2)+360-ANGA) IF(ANGA.GE.720.AND.ANGA.LT.1080)RLA= ABS(PHI(2)+720-ANGA) IF(ANGA.GE.1080)RLA= ABS(PHI(2)+1080-ANGA) RLL= ABS(PHI(3)-ANGL) QX(J)=RLA+RLL 4041 CONTINUE QXX=10.03 DO 4944 J=1,14 IF(QX(J).LE.10)QXX=QX(J) 4944 CONTINUE IF(QXX.LE.10.AND.YZZ(5).LE.0.1)WRITE(2,4091) IF(QXX.LE.10.AND.YZZ(5).GT.0.1)WRITE(2,4092) ELSEIF(YZZ(6).LE.0.2.OR.YZZ(8).LE.0.2)THEN 4020 DO 4021 J=1,14 ANG=(6*180*(J-1))/14 ANGA=180+(6*180*(J-1))/14 ANGL=(2*180*(J-1))/14 RL= ABS(PHI(2)-ANG) IF(ANG.GE.360.AND.ANG.LT.720)RL= ABS(PHI(2)+360-ANG) IF(ANG.GE.720)RL= ABS(PHI(2)+720-ANG) RLA= ABS(PHI(2)-ANGA) IF(ANGA.GE.360.AND.ANGA.LT.720)RLA= ABS(PHI(2)+360-ANGA) IF(ANGA.GE.720.AND.ANGA.LT.1080)RLA= ABS(PHI(2)+720-ANGA) IF(ANGA.GE.1080)RLA= ABS(PHI(2)+1080-ANGA) RLL= ABS(PHI(3)-ANGL) QX(J)=RL+RLL QXA(J)=RLA+RLL 4021 CONTINUE QXX=10.03 QXXA=10.03 DO 4998 J=1,14 IF(QX(J).LE.10)QXX=QX(J) IF(QXA(J).LE.10)QXXA=QXA(J) 4998 CONTINUE IF(QXX.LE.10.AND.YZZ(6).LE.0.1)WRITE(2,4071) IF(QXX.LE.10.AND.YZZ(6).GT.0.1.AND.YZZ(6).LE.0.2)WRITE(2,4072) IF(QXXA.LE.10.AND.YZZ(8).LE.0.1)WRITE(2,4081) IF(QXXA.LE.10.AND.YZZ(8).GT.0.1.AND.YZZ(8).LE.0.2)WRITE(2,4082) GO TO 5001 ELSEIF(YZZ(7).LE.0.2.OR.YZZ(9).LE.0.2)THEN DO 5005 J=1,14 ANGM=((3*180)/14) + ((6*180*(J-1))/14) ANGMA=180+((3*180)/14) + ((6*180*(J-1))/14) ANGLM= (180/14) + ((2*180*(J-1))/14) RM= ABS(PHI(2)-ANGM) IF(ANGM.GE.360.AND.ANGM.LT.720)RM= ABS(PHI(2)+360-ANGM) IF(ANGM.GE.720)RM= ABS(PHI(2)+720-ANGM) RMA= ABS(PHI(2)-ANGMA) IF(ANGMA.GE.360.AND.ANGMA.LT.720)RMA= ABS(PHI(2)+360-ANGMA) IF(ANGMA.GE.720.AND.ANGMA.LT.1080)RMA= ABS(PHI(2)+720-ANGMA) IF(ANGMA.GE.1080)RMA= ABS(PHI(2)+1080-ANGMA) RMM= ABS(PHI(3)-ANGLM) QY(J)= RM + RMM QYA(J)= RMA + RMM 5005 CONTINUE QYY=10.03 QYYA=10.03 DO 4999 J=1,14 IF(QY(J).LE.10)QYY= QY(J) IF(QYA(J).LE.10)QYYA= QYA(J) 4999 CONTINUE IF(QYY.LE.10.AND.YZZ(7).LE.0.1)WRITE(2,5010) IF(QYY.LE.10.AND.YZZ(7).GT.0.1.AND.YZZ(7).LE.0.2)WRITE(2,5011) IF(QYYA.LE.10.AND.YZZ(9).LE.0.1)WRITE(2,5012) IF(QYYA.LE.10.AND.YZZ(9).GT.0.1.AND.YZZ(9).LE.0.2)WRITE(2,5013) ELSE DO 4919 I=1,9 IF(YZZ(I).LE.0.1)WRITE(2,4902)NAMEX(I) IF(YZZ(I).GT.0.1.AND.YZZ(I).LE.0.2)WRITE(2,4903)NAMEX(I) 4919 CONTINUE ENDIF 4071 FORMAT(/,5X,'WARNING:THIS IS A S FORM') 4072 FORMAT(/,5X,'WARNING:THIS IS VERY SIMILAR TO A S FORM') 4081 FORMAT(/,5X,'WARNING:THIS IS AN H FORM') 4082 FORMAT(/,5X,'WARNING:THIS IS VERY SIMILAR TO A H FORM') 4091 FORMAT(/,5X,'WARNING:THIS IS AN BS FORM') 4092 FORMAT(/,5X,'WARNING:THIS IS VERY SIMILAR TO A BS FORM') 5010 FORMAT(/,5X,'WARNING:THIS IS A TS FORM') 5011 FORMAT(/,5X,'WARNING:THIS IS VERY SIMILAR TO A TS FORM') 5012 FORMAT(/,5X,'WARNING:THIS IS A T FORM') 5013 FORMAT(/,5X,'WARNING:THIS IS VERY SIMILAR TO A T FORM') 4902 FORMAT(/,5X,'WARNING:THIS IS A',A4,' FORM') 4903 FORMAT(/,5X,'WARNING:THIS IS VERY SIMILAR TO A ',A4,' FORM') ELSE C **************************** C DATA FOR 9-M CLASSICAL FORMS C **************************** C DATA NAMX /'BB','TBB','BC ','TBC','CC','TCC','BC"','TBC"','B','CC &"','TB','TCC"','C','CB','TC','TCB'/ DATA XN1 /1.00,0.0,0.0,0.0,0.0,0.0,0.308,0.0,0.582,0.401,0.0,0.0 &,0.280,0.601,0.0,0.0/ DATA XN2 /0.0,1.00,0.0,0.0,0.0,0.0,0.0,0.317,0.0,0.0,0.584,0.397 &,0.0,0.,0.340,0.498/ DATA XN3 /0.0,0.0,1.0,0.0,0.379,0.0,0.563,0.0,0.168,0.189,0.0,0. &0,0.617,0.245,0.0,0.0/ DATA XN4 /0.0,0.0,0.0,1.0,0.0,0.379,0.0,0.564,0.0,0.0,0.168,0.19 &2,0.0,0.0,0.515,0.319/ DATA XN5 /0.0,0.0,0.0,0.0,0.621,0.0,0.129,0.0,0.250,0.410,0.0,0.0 &0,0.104,0.154,0.0,0.0/ DATA XN6 /0.0,0.0,0.0,0.0,0.0,0.621,0.0,0.119,0.0,0.0,0.248,0.411 &,0.0,0.0,0.145,0.183/ DO 4101 I=1,16 YZZ(I)= ABS(XXA(2)-XN1(I))+ ABS(XXB(2)-XN2(I))+ ABS(XXA(3)-XN3(I)) &+ABS(XXB(3)-XN4(I))+ABS(XXA(4)-XN5(I))+ABS(XXB(4)-XN6(I)) 4101 CONTINUE DO 9666 I=2,N RH=ABS(PHI(I)-360) IF(RH.LT.5)PHI(I)=360-PHI(I) 9666 CONTINUE IF(YZZ(5).LE.0.2)THEN DO 5111 J=1,18 ANG=180+(6*180*(J-1))/18 ANGL=(2*180*(J-1))/18 RL= ABS(PHI(3)-ANG) IF(ANG.GE.360.AND.ANG.LT.720)RL= ABS(PHI(3)+360-ANG) IF(ANG.GE.720.AND.ANG.LT.1080)RL= ABS(PHI(3)+720-ANG) IF(ANG.GE.1080)RL= ABS(PHI(3)+1080-ANG) RLL= ABS(PHI(4)-ANGL) QX(J)=RL+RLL 5111 CONTINUE QXX=10.03 DO 5998 J=1,18 IF(QX(J).LE.10)QXX=QX(J) 5998 CONTINUE IF(QXX.LE.10.AND.YZZ(5).GT.0.1)WRITE(2,7010)NAMX(5) IF(QXX.LE.10.AND.YZZ(5).LE.0.1)WRITE(2,7011)NAMX(5) ELSEIF(YZZ(6).LE.0.2)THEN DO 5112 J=1,18 ANG=180+ 3*180/18+(6*180*(J-1))/18 ANGL=180/18+(2*180*(J-1))/18 RL= ABS(PHI(3)-ANG) IF(ANG.GE.360.AND.ANG.LT.720)RL= ABS(PHI(3)+360-ANG) IF(ANG.GE.720.AND.ANG.LT.1080)RL= ABS(PHI(3)+720-ANG) IF(ANG.GE.1080)RL= ABS(PHI(3)+1080-ANG) RLL= ABS(PHI(4)-ANGL) QX(J)=RL+RLL 5112 CONTINUE QXX=10.03 DO 5997 J=1,18 IF(QX(J).LE.10)QXX=QX(J) 5997 CONTINUE IF(QXX.LE.10.AND.YZZ(6).GT.0.1)WRITE(2,7010)NAMX(6) IF(QXX.LE.10.AND.YZZ(6).LE.0.1)WRITE(2,7011)NAMX(6) C ELSEIF(YZZ(7).LE.0.2.OR.YZZ(9).LE.0.2.OR.YZZ(10).LE.0.2.OR.YZZ(13) &.LE.0.2.OR.YZZ(14).LE.0.2)THEN DO 5113 J=1,18 ANG= 180 + (10*180*(J-1))/18 ANGL=180 + (6*180*(J-1))/18 ANGM= (2*180*(J-1))/18 RL= ABS(PHI(2)-ANG) IF(ANG.GE.360.AND.ANG.LT.720)RL= ABS(PHI(2)+360-ANG) IF(ANG.GE.720.AND.ANG.LT.1080)RL= ABS(PHI(2)+720-ANG) IF(ANG.GE.1080.AND.ANG.LT.1440)RL= ABS(PHI(2)+1080-ANG) IF(ANG.GE.1440.AND.ANG.LT.1800)RL= ABS(PHI(2)+1440-ANG) IF(ANG.GE.1800)RL= ABS(PHI(2)+1800-ANG) RLL= ABS(PHI(3)-ANGL) IF(ANGL.GE.360.AND.ANGL.LT.720)RLL= ABS(PHI(3)+360-ANGL) IF(ANGL.GE.720.AND.ANGL.LT.1080)RLL= ABS(PHI(3)+720-ANGL) IF(ANGL.GE.1080)RLL= ABS(PHI(3)+1080-ANGL) RLM= ABS(PHI(4)-ANGM) IF(ANGM.GE.360)RLM= ABS(PHI(4)+360-ANGM) QX(J)=RL+RLL+RLM 5113 CONTINUE QXX=15.03 DO 5996 J=1,18 IF(QX(J).LE.15)QXX=QX(J) 5996 CONTINUE IF(QXX.LE.15.AND.YZZ(7).GT.0.1.AND.YZZ(7).LE.0.2)WRITE(2,7010)NAMX &(7) IF(QXX.LE.15.AND.YZZ(7).LE.0.1)WRITE(2,7011)NAMX(7) DO 5115 J=1,18 ANG= (10*180*(J-1))/18 ANGL=180+(6*180*(J-1))/18 ANGM=(2*180*(J-1))/18 RL= ABS(PHI(2)-ANG) IF(ANG.GE.360.AND.ANG.LT.720)RL= ABS(PHI(2)+360-ANG) IF(ANG.GE.720.AND.ANG.LT.1080)RL= ABS(PHI(2)+720-ANG) IF(ANG.GE.1080.AND.ANG.LT.1440)RL= ABS(PHI(2)+1080-ANG) IF(ANG.GE.1440.AND.ANG.LT.1800)RL= ABS(PHI(2)+1440-ANG) IF(ANG.GE.1800)RL= ABS(PHI(2)+1800-ANG) RLL= ABS(PHI(3)-ANGL) IF(ANGL.GE.360.AND.ANGL.LT.720)RLL= ABS(PHI(3)+360-ANGL) IF(ANGL.GE.720.AND.ANGL.LT.1080)RLL= ABS(PHI(3)+720-ANGL) IF(ANGL.GE.1080)RLL= ABS(PHI(3)+1080-ANGL) RLM= ABS(PHI(4)-ANGM) IF(ANGM.GE.360)RLM= ABS(PHI(4)+360-ANGM) QX1(J)=RL+RLL+RLM 5115 CONTINUE QXX1=15.03 DO 5994 J=1,18 IF(QX1(J).LE.15)QXX1=QX1(J) 5994 CONTINUE IF(QXX1.LE.15.AND.YZZ(9).GT.0.1.AND.YZZ(9).LE.0.2)WRITE(2,7010)NAM &X(9) IF(QXX1.LE.15.AND.YZZ(9).LE.0.1)WRITE(2,7011)NAMX(9) IF(QXX1.LE.15.AND.YZZ(10).GT.0.1.AND.YZZ(10).LE.0.2)WRITE(2,7010)N &AMX(10) IF(QXX1.LE.15.AND.YZZ(10).LE.0.1)WRITE(2,7011)NAMX(10) C DO 5117 J=1,18 ANG= 180+(10*180*(J-1))/18 ANGL=(6*180*(J-1))/18 ANGM=(2*180*(J-1))/18 RL= ABS(PHI(2)-ANG) IF(ANG.GE.360.AND.ANG.LT.720)RL= ABS(PHI(2)+360-ANG) IF(ANG.GE.720.AND.ANG.LT.1080)RL= ABS(PHI(2)+720-ANG) IF(ANG.GE.1080.AND.ANG.LT.1440)RL= ABS(PHI(2)+1080-ANG) IF(ANG.GE.1440.AND.ANG.LT.1800)RL= ABS(PHI(2)+1440-ANG) IF(ANG.GE.1800)RL= ABS(PHI(2)+1800-ANG) RLL= ABS(PHI(3)-ANGL) IF(ANGL.GE.360.AND.ANGL.LT.720)RLL= ABS(PHI(3)+360-ANGL) IF(ANGL.GE.720.AND.ANGL.LT.1080)RLL= ABS(PHI(3)+720-ANGL) IF(ANGL.GE.1080)RLL= ABS(PHI(3)+1080-ANGL) RLM= ABS(PHI(4)-ANGM) IF(ANGM.GE.360)RLM= ABS(PHI(4)+360-ANGM) QX2(J)=RL+RLL+RLM 5117 CONTINUE QXX2=15.03 DO 5992 J=1,18 IF(QX2(J).LE.15)QXX2=QX2(J) 5992 CONTINUE IF(QXX2.LE.15.AND.YZZ(13).GT.0.1.AND.YZZ(13).LE.0.2)WRITE(2,7010)N &AMX(13) IF(QXX2.LE.15.AND.YZZ(13).LE.0.1)WRITE(2,7011)NAMX(13) IF(QXX2.LE.15.AND.YZZ(14).GT.0.1.AND.YZZ(14).LE.0.2)WRITE(2,7010)N &AMX(14) IF(QXX2.LE.15.AND.YZZ(14).LE.0.1)WRITE(2,7011)NAMX(14) ELSEIF(YZZ(8).LE.0.2.OR.YZZ(11).LE.0.2.OR.YZZ(12).LE.0.2.OR.YZZ(15 &).LE.0.2.OR.YZZ(16).LE.0.2)THEN DO 5114 J=1,18 ANG= 180 + 5*180/18+(10*180*(J-1))/18 ANGL= 180 + 3*180/18+(6*180*(J-1))/18 ANGM=180/18+ (2*180*(J-1))/18 RL= ABS(PHI(2)-ANG) IF(ANG.GE.360.AND.ANG.LT.720)RL= ABS(PHI(2)+360-ANG) IF(ANG.GE.720.AND.ANG.LT.1080)RL= ABS(PHI(2)+720-ANG) IF(ANG.GE.1080.AND.ANG.LT.1440)RL= ABS(PHI(2)+1080-ANG) IF(ANG.GE.1440.AND.ANG.LT.1800)RL= ABS(PHI(2)+1440-ANG) IF(ANG.GE.1800)RL= ABS(PHI(2)+1800-ANG) RLL= ABS(PHI(3)-ANGL) IF(ANGL.GE.360.AND.ANGL.LT.720)RLL= ABS(PHI(3)+360-ANGL) IF(ANGL.GE.720.AND.ANGL.LT.1080)RLL= ABS(PHI(3)+720-ANGL) IF(ANGL.GE.1080)RLL= ABS(PHI(3)+1080-ANGL) RLM= ABS(PHI(4)-ANGM) IF(ANGM.GE.360)RLM= ABS(PHI(4)+360-ANGM) QX(J)=RL+RLL+RLM 5114 CONTINUE QXX=15.03 DO 5995 J=1,18 IF(QX(J).LE.15)QXX=QX(J) 5995 CONTINUE IF(QXX.LE.15.AND.YZZ(8).GT.0.1.AND.YZZ(8).LE.0.2)WRITE(2,7010)NAMX &(8) IF(QXX.LE.15.AND.YZZ(8).LE.0.1)WRITE(2,7011)NAMX(8) DO 5116 J=1,18 ANG= 5*180/18+(10*180*(J-1))/18 ANGL=180+ 3*180/18+(6*180*(J-1))/18 ANGM=180/18+(2*180*(J-1))/18 RL= ABS(PHI(2)-ANG) IF(ANG.GE.360.AND.ANG.LT.720)RL= ABS(PHI(2)+360-ANG) IF(ANG.GE.720.AND.ANG.LT.1080)RL= ABS(PHI(2)+720-ANG) IF(ANG.GE.1080.AND.ANG.LT.1440)RL= ABS(PHI(2)+1080-ANG) IF(ANG.GE.1440.AND.ANG.LT.1800)RL= ABS(PHI(2)+1440-ANG) IF(ANG.GE.1800)RL= ABS(PHI(2)+1800-ANG) RLL= ABS(PHI(3)-ANGL) IF(ANGL.GE.360.AND.ANGL.LT.720)RLL= ABS(PHI(3)+360-ANGL) IF(ANGL.GE.720.AND.ANGL.LT.1080)RLL= ABS(PHI(3)+720-ANGL) IF(ANGL.GE.1080)RLL= ABS(PHI(3)+1080-ANGL) RLM= ABS(PHI(4)-ANGM) IF(ANGM.GE.360)RLM= ABS(PHI(4)+360-ANGM) QX3(J)=RL+RLL+RLM 5116 CONTINUE QXX3=15.03 DO 5993 J=1,18 IF(QX3(J).LE.15)QXX3=QX3(J) 5993 CONTINUE IF(QXX3.LE.15.AND.YZZ(11).GT.0.1.AND.YZZ(11).LE.0.2)WRITE(2,7010)N &AMX(11) IF(QXX3.LE.15.AND.YZZ(11).LE.0.1)WRITE(2,7011)NAMX(11) IF(QXX3.LE.15.AND.YZZ(12).GT.0.1.AND.YZZ(12).LE.0.2)WRITE(2,7010)N &AMX(12) IF(QXX3.LE.15.AND.YZZ(12).LE.0.1)WRITE(2,7011)NAMX(12) DO 5118 J=1,18 ANG= 5*180/18+180+(10*180*(J-1))/18 ANGL= 3*180/18+(6*180*(J-1))/18 ANGM=180/18+(2*180*(J-1))/18 RL= ABS(PHI(2)-ANG) IF(ANG.GE.360.AND.ANG.LT.720)RL= ABS(PHI(2)+360-ANG) IF(ANG.GE.720.AND.ANG.LT.1080)RL= ABS(PHI(2)+720-ANG) IF(ANG.GE.1080.AND.ANG.LT.1440)RL= ABS(PHI(2)+1080-ANG) IF(ANG.GE.1440.AND.ANG.LT.1800)RL= ABS(PHI(2)+1440-ANG) IF(ANG.GE.1800)RL= ABS(PHI(2)+1800-ANG) RLL= ABS(PHI(3)-ANGL) IF(ANGL.GE.360.AND.ANGL.LT.720)RLL= ABS(PHI(3)+360-ANGL) IF(ANGL.GE.720.AND.ANGL.LT.1080)RLL= ABS(PHI(3)+720-ANGL) IF(ANGL.GE.1080)RLL= ABS(PHI(3)+1080-ANGL) RLM= ABS(PHI(4)-ANGM) IF(ANGM.GE.360)RLM= ABS(PHI(4)+360-ANGM) QX4(J)=RL+RLL+RLM 5118 CONTINUE QXX4=15.03 DO 5991 J=1,18 IF(QX4(J).LE.15)QXX4=QX4(J) 5991 CONTINUE IF(QXX4.LE.15.AND.YZZ(15).GT.0.1.AND.YZZ(15).LE.0.2)WRITE(2,7010)N &AMX(15) IF(QXX4.LE.15.AND.YZZ(15).LE.0.1)WRITE(2,7011)NAMX(15) IF(QXX4.LE.15.AND.YZZ(16).GT.0.1.AND.YZZ(16).LE.0.2)WRITE(2,7010)N &AMX(16) IF(QXX4.LE.15.AND.YZZ(16).LE.0.1)WRITE(2,7011)NAMX(16) ELSE DO 5000 I=1,4 IF(YZZ(I).LE.0.2.AND.YZZ(I).GT.0.1)WRITE(2,7010)NAMX(I) IF(YZZ(I).LE.0.1)WRITE(2,7011)NAMX(I) 5000 CONTINUE ENDIF 7011 FORMAT(/,5X,'WARNING:THIS IS A ',A4,' FORM') 7010 FORMAT(/,5X,'WARNING:THIS IS VERY SIMILAR TO A ',A4,' FORM') 5001 ENDIF 4994 RETURN END SUBROUTINE LARGE(Q,PHI,N,NR,R) C C ******************************************************** C THIS SUBROUTINE FINDS THE PRIMITIVE FORMS OF EVEN RINGS C WITH MORE THAN 10 RING ATOMS C ******************************************************** DIMENSION Q(20),PHI(20),XA(20),XB(20),XXA(20),XXB(20) REAL K(50),L(50),KMIN(50),LMIN(50) C IF (R.LE.0)THEN AA=-1.0 ELSE AA=1.0 ENDIF V=ABS(R) C IF(NR.EQ.10)THEN DO 286 M=2,N DO 285 I=1,11 K(I)=4*(I-1) L(I)=4*(I-1)+2 285 CONTINUE NXN=11 CALL MINI(NXN,K,KMIN(M),NR,PHI(M)) CALL MINI(NXN,L,LMIN(M),NR,PHI(M)) 286 CONTINUE CALL SOLVE(Q,KMIN,LMIN,N,NR,PHI,XA,XB) CALL WRITES(N,XA,XB,V,KMIN,LMIN,XXA,XXB,VV) WRITE(2,118)NR/2,VV,AA 118 FORMAT(5X,I2,8X,F5.3,8X,F4.1) ELSEIF(NR.EQ.12)THEN DO 296 M=2,N IF(M.EQ.3)THEN DO 300 I=1,3 K(I)=24*(I-1) L(I)=24*(I-1)+12 300 CONTINUE NZX=3 ELSE DO 295 I=1,13 K(I)=8*(I-1) L(I)=8*(I-1)+4 295 CONTINUE NZX=13 ENDIF CALL MINI(NZX,K,KMIN(M),NR,PHI(M)) CALL MINI(NZX,L,LMIN(M),NR,PHI(M)) 296 CONTINUE CALL SOLVE(Q,KMIN,LMIN,N,NR,PHI,XA,XB) CALL WRITES(N,XA,XB,V,KMIN,LMIN,XXA,XXB,VV) WRITE(2,117)NR/2,VV,AA 117 FORMAT(5X,I2,8X,F5.3,8X,F4.1) ELSEIF(NR.EQ.14)THEN DO 302 M=2,N DO 303 I=1,15 K(I)=4*(I-1) L(I)=4*(I-1)+2 303 CONTINUE NXC=15 CALL MINI(NXC,K,KMIN(M),NR,PHI(M)) CALL MINI(NXC,L,LMIN(M),NR,PHI(M)) 302 CONTINUE CALL SOLVE(Q,KMIN,LMIN,N,NR,PHI,XA,XB) CALL WRITES(N,XA,XB,V,KMIN,LMIN,XXA,XXB,VV) WRITE(2,111)NR/2,VV,AA 111 FORMAT(5X,I2,8X,F5.3,8X,F4.1) ELSEIF(NR.EQ.16)THEN DO 309 M=2,N IF(M.EQ.2.OR.M.EQ.6)THEN DO 393 I=1,5 K(I)=16*(I-1) L(I)=16*(I-1)+8 393 CONTINUE NXC=5 ELSEIF(M.EQ.4)THEN DO 373 I=1,3 K(I)=32*(I-1) L(I)=32*(I-1)+16 373 CONTINUE NXC=3 ELSE DO 383 I=1,9 K(I)=8*(I-1) L(I)=8*(I-1)+4 383 CONTINUE NXC=9 ENDIF CALL MINI(NXC,K,KMIN(M),NR,PHI(M)) CALL MINI(NXC,L,LMIN(M),NR,PHI(M)) 309 CONTINUE CALL SOLVE(Q,KMIN,LMIN,N,NR,PHI,XA,XB) CALL WRITES(N,XA,XB,V,KMIN,LMIN,XXA,XXB,VV) WRITE(2,151)NR/2,VV,AA 151 FORMAT(5X,I2,8X,F5.3,8X,F4.1) ELSE DO 509 M=2,N IF(M.EQ.3.OR.M.EQ.6)THEN DO 593 I=1,7 K(I)=12*(I-1) L(I)=12*(I-1)+6 593 CONTINUE NYC=7 ELSE DO 573 I=1,19 K(I)=4*(I-1) L(I)=4*(I-1)+2 573 CONTINUE NYC=19 ENDIF CALL MINI(NYC,K,KMIN(M),NR,PHI(M)) CALL MINI(NYC,L,LMIN(M),NR,PHI(M)) 509 CONTINUE CALL SOLVE(Q,KMIN,LMIN,N,NR,PHI,XA,XB) CALL WRITES(N,XA,XB,V,KMIN,LMIN,XXA,XXB,VV) WRITE(2,551)NR/2,VV,AA 551 FORMAT(5X,I2,8X,F5.3,8X,F4.1) ENDIF RETURN END