PROGRAM PUCK
C**** JACS,97,1354(1975)
      DIMENSION X(200),Y(200),Z(200),XC(200),YC(200),ZC(200),XR(15),YR(1
     &5),ZR(15),EN(3),EM(3),EL(3),XP(15),YP(15),ZP(15),QC(10),QS(10),Q(1
     &0),PHI(10),TLE(10),NAME(200),IAT(20,15),AF(200),IN(2),NRA(20)
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')
      OPEN(UNIT=1,FILE='PUCIN',STATUS='UNKNOWN')
      OPEN(UNIT=3,FILE='PUCPRT',STATUS='UNKNOWN')
      READ(1,1)TLE
      WRITE(3,5)TLE
      WRITE(3,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(3,6)
      DO 27 I=1,NAT
27    WRITE(3,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(3,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(3,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(3,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(3,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(3,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(3,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(3,12)N,Q(N),PHI(N)
      IF(IE.NE.1)GO TO 140
      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(3,13)Q(N2)
      BQ=SQRT(BQ)
      TH=ACOS(Q(N2)/BQ)/FACT
      WRITE(3,14)BQ,TH
140   CONTINUE
      GO TO 150
145   WRITE(3,2)IN(1)
      CLOSE(1)
      CLOSE(3)
150   STOP
      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(3,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(3,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