PROGRAM INCO
      IMPLICIT REAL*4(A-H,O-Z)
      IMPLICIT INTEGER*2(I-N)
      CHARACTER*1 MOLNAM(60)
      CHARACTER*60 OBFILE
      CHARACTER*2 ATOMT
      DIMENSION IAA(4,500),IOLD(4,500),
     1XX(3),YY(3),A(3),P(3),E0(3),
     2IBACK(500),IBOND(500,4),
     3KATOM(500),X(500),Y(500),Z(500),ICON(500,4),Q(500)
      EQUIVALENCE(ICON,IBOND)
C     ****************************************************************
      WRITE(*,*)
      WRITE(*,*)'            CONVERSION OF PMODEL FILES '
      WRITE(*,*)
      WRITE(*,*)'            xxxx.XYZ  -->   xxxx.MOL'
      WRITE(*,*)
C     ******************************INPUT:****************************
      WRITE(*,*) 'FILE TO CONVERT (include .XYZ)'
      READ(*,'(A)') OBFILE
      WRITE(*,*)'MCM FILE ("1" ELSE "0") ?'
      READ(*,*)IMCM
      OPEN(5,FILE=OBFILE,STATUS='OLD')
      READ(5,888)MOLNAM
  888 FORMAT(60A1)
      WRITE(*,888)MOLNAM
      IF (IMCM.EQ.1) THEN
      I=0
1     READ(5,'(A2)')ATOMT
      i=i+1
      IF (ATOMT.NE.'XX'.AND.ATOMT.NE.'xx')THEN
      BACKSPACE(5)
      READ(5,666)ATOMT,KATOM(I),X(I),Y(I),Z(I),
     1(ICON(I,J),J=1,4),J,J,J,Q(I)
      IF (ATOMT.EQ.'C ')KATOM(I)=1
      IF (ATOMT.EQ.'H ')KATOM(I)=4
      IF (ATOMT.EQ.'N ')KATOM(I)=3
      IF (ATOMT.EQ.'O ')KATOM(I)=2
      IF (KATOM(I).EQ.0)WRITE(*,*)' UNKNOWN ATOM ',ATOMT
666   FORMAT(A2,I2,3F10.4,7I5,F8.4)
      GOTO 1
      ELSE
      GOTO 21
      ENDIF
      ENDIF
      I=1
   11 READ(5,*)KATOM(I),X(I),Y(I),Z(I),(ICON(I,J),J=1,4),Q(I)
      IF (KATOM(I).EQ.9999) GOTO 21
      I=I+1
      GOTO 11
   21 N=I-1
      CLOSE(5)
      write(*,*)'Input ok'
C     ***************************** OUTPUT:***************************
      NAT=N
      if (nat.gt.500) write(*,*)'To many atoms'
      if (nat.gt.500) goto 9999
      DO 14 I=1,500
14    IBACK(I)=0
      IBACK(1)=NAT+1
24    ICO=0
      DO 1111 L2=1,NAT
      IF (IBACK(L2).EQ.0)GOTO 1111
      DO 2222 K3=1,4
      L=L2
      K=K3
      IA=IBOND(L,K)
      IF (IA.NE.0)THEN
       ICO=1
       IBOND(L,K)=0
5555   IF (IBACK(IA).EQ.0)IBACK(IA)=L
       DO 33 KK=1,4
33     IF (IBOND(IA,KK).EQ.L)IBOND(IA,KK)=0
       DO 44 KK=1,4
       IF (IBOND(IA,KK).NE.0)THEN
        L=IA
        IA=IBOND(IA,KK)
        IBOND(L,KK)=0
        GOTO 5555
       ENDIF
44     CONTINUE
      ENDIF
2222  CONTINUE
1111  CONTINUE
      IF (ICO.EQ.1)GOTO 24
      PI=3.141592653589
      IBACK(NAT+1)=NAT+2
      X(NAT+1)=X(1)
      Y(NAT+1)=Y(1)
      Z(NAT+1)=Z(1)-1.0
      X(NAT+2)=X(1)+1.0
      Y(NAT+2)=Y(1)
      Z(NAT+2)=Z(1)-1.0
      IB=0
      DO 5 I=2,NAT
      IB=IB+1
      IAA(4,IB)=I
      IAA(3,IB)=IBACK(IAA(4,IB))
      IAA(2,IB)=IBACK(IAA(3,IB))
5     IAA(1,IB)=IBACK(IAA(2,IB))
C     BOND IAA(1) - IAA(2) -IAA(3) -> IAA(4) (IB) WAS DEFINED IN EACH CYCLE
      write(*,*)' BOND 1 - 2 - 3 -> (4) (IB) WAS DEFINED'
C
C     IF AN ATOM IA1 OF THE BOND IB IS NOT YET DEFINED, THE BOND IS PUSHED
C     TO THE BACK OF THE LIST OF BONDS:
      icontr=0
47    IC=0
      DO 45 I=2,IB-1
      DO 46 J=1,I-1
46    IF (IAA(3,I).EQ.IAA(4,J).OR.IAA(3,I).EQ.1)GOTO 45
      IC=1
      DO 51 J=1,4
      I0=IAA(J,I)
      IAA(J,I)=IAA(J,I+1)
51    IAA(J,I+1)=I0
45    CONTINUE
      icontr=icontr+1
      if (icontr.gt.5000) then
       write(*,*)'Infinite loop'
       goto 9999
      endif
      IF (IC.EQ.1)GOTO 47
      DO 53 I=1,4
      DO 53 J=1,500
53    IOLD(I,J)=IAA(I,J)
C     THE ATOMS ARE RENAMED TO ACHIEVE AN INCREASING ORDER FOR IAA(4,I):
      DO 48 I=1,IB
      IA0=IAA(4,I)
      IAA(4,I)=I+1
      DO 49 J=I+1,IB
      DO 52 K=3,4
      IF (IAA(K,J).EQ.IA0)THEN
       IAA(K,J)=I+1
       GOTO 52
      ENDIF
      IF (IAA(K,J).EQ.I+1)THEN
       IAA(K,J)=IA0
      ENDIF
52    CONTINUE
49    CONTINUE
48    CONTINUE
      WRITE(*,*)'OUTPUT FILE (include .MOL): '
      READ(6,'(A)')OBFILE
      OPEN(7,FILE=OBFILE,STATUS='NEW')
      WRITE(7,222)IB
222   FORMAT(I4)
      WRITE(7,333)KATOM(1),Q(1)
333   FORMAT(I4,F10.5)
      DO 6 I=1,IB
      L0=IOLD(4,I)
      L1=IOLD(3,I)
      L2=IOLD(2,I)
      L3=IOLD(1,I)
        A(1)=X(L2)-X(L3)
        A(2)=Y(L2)-Y(L3)
        A(3)=Z(L2)-Z(L3)
        P(1)=X(L0)-X(L1)
        P(2)=Y(L0)-Y(L1)
        P(3)=Z(L0)-Z(L1)
        E0(1)=X(L1)-X(L2)
        E0(2)=Y(L1)-Y(L2)
        E0(3)=Z(L1)-Z(L2)
        SSE0E0=E0(1)*E0(1)+E0(2)*E0(2)+E0(3)*E0(3)
        DO 8 KK=1,3
8       E0(KK)=E0(KK)/SQRT(SSE0E0)
        SSPP=P(1)*P(1)+P(2)*P(2)+P(3)*P(3)
        AD=SQRT(SSPP)
        SSAE0=A(1)*E0(1)+A(2)*E0(2)+A(3)*E0(3)
        SSPE0=P(1)*E0(1)+P(2)*E0(2)+P(3)*E0(3)
        DO 9 KK=1,3
        XX(KK)=A(KK)-E0(KK)*SSAE0
9       YY(KK)=P(KK)-E0(KK)*SSPE0
        SSXXXX=XX(1)*XX(1)+XX(2)*XX(2)+XX(3)*XX(3)
        SSYYYY=YY(1)*YY(1)+YY(2)*YY(2)+YY(3)*YY(3)
        SSXXYY=XX(1)*YY(1)+XX(2)*YY(2)+XX(3)*YY(3)
        APX=XX(2)*YY(3)-XX(3)*YY(2)
        APY=XX(3)*YY(1)-XX(1)*YY(3)
        APZ=XX(1)*YY(2)-XX(2)*YY(1)
        SSE0AP=APX*E0(1)+APY*E0(2)+APZ*E0(3)
        SIGN=1.0
        IF (SSE0AP.NE.0.0)SIGN=-SSE0AP/ABS(SSE0AP)
        CB=0.0
        IF (AD.NE.0.0)CB=-SSPE0/AD
        CA=0.0
        IF (SSXXXX.NE.0.0.AND.SSYYYY.NE.0.0)
     1CA=-SSXXYY/SQRT(SSXXXX)/SQRT(SSYYYY)
        BANGLE=0.0
         ANGLE=0.0
        IF (CB.EQ.-1.0)BANGLE=PI
        IF (ABS(CB).LT.1.0)BANGLE=ACOS(CB)
        IF (CA.LE.-1.0) ANGLE=PI
C on the previous line should be " .EQ.", but computer error must be considered
        IF (ABS(CA).LT.1.0) ANGLE=ACOS(CA)
         ANGLE=180* ANGLE/PI
        BANGLE=180*BANGLE/PI
        ANGLE=SIGN*ANGLE
      WRITE(7,111)IAA(3,I),IAA(4,I),KATOM(L0),AD,BANGLE,ANGLE,Q(L0)
111   FORMAT(3I4,4F11.5)
6     CONTINUE
      WRITE(7,*)' 0'
      CLOSE(7)
C
      WRITE(*,*)'CONVERSION COMPLETED'
9999  END