PROGRAM COORD C THIS PROGRAM READS .XYZ FILE (CARTESIAN COORDINATES OF A MOLECUL C IN THE PMODEL FORMAT) AND MAKES THE UMATIN INPUT FILES FOR THE C VCD PROGRAMS IMPLICIT REAL*4 (A-H,O-Z) IMPLICIT INTEGER*2 (I-N) CHARACTER*1 MOLNAM(80) CHARACTER*2 ATOMT CHARACTER*5 PGROUP DIMENSION ATOMT(500),RAD(14),KATOM(500) 1,X(500),Y(500),Z(500) COMMON /ICOORD/IDUM(500,4),ICON(500,4), 1ISTRE,IBEND,ITOR,IST(500),JST(500),IBD(500),JBD(500), 2KBD(500),NITOR(500),NLTOR(500),JTOR(500),KTOR(500), 3IBUF(500,4),JBUF(500,4),N,IBOND(500) DATA RAD0/0.05/,RAD/ 0.83,0.8,0.8,0.4,1.2,0.83,0.83,0.83, 11.5,0.75,1.5,1.5,1.5,0.05/ C **************************************************************** WRITE(6,*) WRITE(6,*)' VCD PROGRAM PACKAGE INPUT FILE GENERATION ' C PETR BOUR, UOCHB CSAV 9-1992 WRITE(6,*)' PC version ' WRITE(6,*) WRITE(6,*)' FILE XYZ --> FILE UMAT' WRITE(6,*) C ******************************INPUT:**************************** WRITE(6,*) 'FILE XYZ = THE INPUT FILE, PMODEL FORMAT' OPEN(5,FILE='FILE.XYZ',STATUS='OLD') READ(5,888)MOLNAM 888 FORMAT(80A1) WRITE(6,888)MOLNAM I=1 11 READ(5,*)KATOM(I),X(I),Y(I),Z(I) IF (KATOM(I).EQ.9999) GOTO 2100 ATOMT(I)='XX' IF (KATOM(I).EQ.1)ATOMT(I)=' C' IF (KATOM(I).EQ.2)ATOMT(I)=' O' IF (KATOM(I).EQ.3)ATOMT(I)=' N' IF (KATOM(I).EQ.4)ATOMT(I)=' H' IF (KATOM(I).EQ.5)ATOMT(I)=' S' IF (KATOM(I).EQ.6)ATOMT(I)=' C' IF (KATOM(I).EQ.7)ATOMT(I)=' C' IF (KATOM(I).EQ.8)ATOMT(I)=' C' IF (KATOM(I).EQ.9)ATOMT(I)=' P' IF (KATOM(I).EQ.10)ATOMT(I)=' F' IF (KATOM(I).EQ.11)ATOMT(I)='Cl' IF (KATOM(I).EQ.12)ATOMT(I)='Br' I=I+1 GOTO 11 2100 N=I-1 CLOSE(5) WRITE(6,*)'INPUT OK' C ************************* BOND GENERATION: ********************* DO 4 I=1,N DO 5 J=1,4 5 ICON(I,J)=0 4 IBOND(I)=0 DO 1 I=1,N DO 2 J=I+1,N R9=(X(J)-X(I))*(X(J)-X(I))+ 1 (Y(J)-Y(I))*(Y(J)-Y(I))+ 2 (Z(J)-Z(I))*(Z(J)-Z(I)) R91= ( RAD(KATOM(I))+ RAD(KATOM(J)) ) 1 *( RAD(KATOM(I))+ RAD(KATOM(J)) ) IF (R9.LE.R91) THEN IBOND(I)=IBOND(I)+1 IBOND(J)=IBOND(J)+1 ICON(I,IBOND(I))=J ICON(J,IBOND(J))=I ENDIF 2 CONTINUE 1 CONTINUE C ENDIF C ************************** COORDINATE DEFINITION: ************** CALL INCO(I) C ************************************************************ WRITE(6,*) ISTRE,' OF STRETCHES' WRITE(6,*) IBEND,' OF VALENCE BENDS' WRITE(6,*) ITOR,' OF TORSIONS' WRITE(6,*)' -------------------------' NTOT=ISTRE+IBEND+ITOR WRITE(6,*)NTOT,' - TOTAL ; 3N-6 = ',3*N-6 IF(NTOT.NE.3*N-6)THEN WRITE(6,*)' ** NUMBER OF FOUND COORDINATES IS NOT 3N-6 !! **' WRITE(6,*)' ** Manual redefinition required **' ENDIF WRITE(6,*) C **************************** OUTPUT: *********************** WRITE(6,*)'FILE.UMA - IS THE OUPTUT FILE' IPNCH=-1 PGROUP='C1 ' OPEN(7,FILE='FILE.UMA',STATUS='UNKNOWN') WRITE(7,888)MOLNAM WRITE(7,888)MOLNAM NFCS=((3*N-6)*((3*N-6)+1))/2 WRITE(7,222)N,3*N-6,NFCS,IPNCH,PGROUP 222 FORMAT(4I6,A5) DO 100 I=1,N 100 WRITE(7,333)X(I),Y(I),Z(I),I,KATOM(I),ATOMT(I) 333 FORMAT(3F12.6,2I4,A2) I1=1 A1=1.0 I0=0 DO 101 I=1,ISTRE 101 WRITE(7,444)I1,IST(I),JST(I),I0,I0,I0,I0,A1 1,ATOMT(IST(I)),IST(I), 2ATOMT(JST(I)),JST(I) 444 FORMAT(7I4,F12.6,' STRETCH ',A2,I3,' - ',A2,I3) I2=2 DO 102 I=1,IBEND 102 WRITE(7,555)I2,IBD(I),JBD(I),KBD(I),I0,I0,I0,A1, 1ATOMT(IBD(I)),IBD(I),ATOMT(JBD(I)),JBD(I), 2ATOMT(KBD(I)),KBD(I) 555 FORMAT(7I4,F12.6,' BEND ',A2,I3, 1' - ',A2,I3,' - ',A2,I3) I4=4 DO 103 I=1,ITOR WRITE(7,666)I4,NITOR(I),JTOR(I),KTOR(I),NLTOR(I), 1I0,I0,A1, 2ATOMT(JTOR(I)),JTOR(I),ATOMT(KTOR(I)),KTOR(I) WRITE(7,666)(IBUF(I,J),J=1,NITOR(I)) 103 WRITE(7,666)(JBUF(I,J),J=1,NLTOR(I)) 666 FORMAT(7I4,F12.6,' TORSION ',A2,I3,' - ',A2,I3) WRITE(7,*)' 0' A=1.0e0 DO 771 I=1,3*N-6 771 WRITE(7,777)I,A 777 FORMAT(' 1',/,I3,F5.1) CLOSE(7) WRITE(6,*)' PROGRAM TERMINATED' END SUBROUTINE INCO(IN) IMPLICIT REAL*4(A-H,O-Z) IMPLICIT INTEGER*2(I-N) DIMENSION IAA(4,500),ICON(500,4),IDT(500),IDB(500) COMMON /ICOORD/IDUM(500,4),IBOND(500,4), 1ISTRE,IBEND,ITOR,IST(500),JST(500),IBD(500),JBD(500), 2KBD(500),NITOR(500),NLTOR(500),JTOR(500),KTOR(500), 3IBUF(500,4),JBUF(500,4),N,IE(500) COMMON /IB/IBM2,IBM1,IB0,IBACK(500) NAT=N DO 1 I=1,N DO 1 J=1,4 1 ICON(I,J)=IBOND(I,J) DO 2 I=N,N+2 DO 2 J=1,4 IBOND(I,J)=0 2 ICON(I,J)=0 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 CONTINUE IF (IBACK(IA).EQ.0)IBACK(IA)=L DO 33 KK=1,4 IF (IBOND(IA,KK).EQ.L)IBOND(IA,KK)=0 33 CONTINUE 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 IBACK(NAT+1)=NAT+2 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)) WRITE(6,999) 999 FORMAT(1X,' 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 PU C TO THE BACK OF THE LIST OF BONDS: icontr=0 47 IC=0 IB0=IB 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(6,*)'INFINITE LOOP' goto 9999 endif IF (IC.EQ.1)GOTO 47 WRITE(6,*)' BONDS ARRANGED' ISTRE=0 IBEND=0 ITOR=0 DO 3 I=1,N IDB(I)=0 3 IDT(I)=0 DO 54 IB=1,IB0 ISTRE=ISTRE+1 IST(ISTRE)=IAA(4,IB) JST(ISTRE)=IAA(3,IB) IBEND=IBEND+1 IBD(IBEND)=IAA(4,IB) JBD(IBEND)=IAA(3,IB) KBD(IBEND)=IAA(2,IB) IDB(IBD(IBEND))=KBD(IBEND) IF (KBD(IBEND).GT.NAT) THEN IW=0 DO 55 I=1,4 IR=ICON(JBD(IBEND),I) IF (IR.EQ.IBD(IBEND))GOTO 55 IF (IR.NE.0) IW=IR 55 CONTINUE IF (IW.EQ.0)IBEND=IBEND-1 IF (IW.NE.0)THEN KBD(IBEND)=IW IDB(IBD(IBEND))=IW IF (IDB(IW).EQ.IBD(IBEND))IBEND=IBEND-1 ENDIF ENDIF ITOR=ITOR+1 NITOR(ITOR)=1 NLTOR(ITOR)=1 JTOR(ITOR)=IAA(2,IB) KTOR(ITOR)=IAA(3,IB) IBUF(ITOR,1)=IAA(1,IB) JBUF(ITOR,1)=IAA(4,IB) IDT(JBUF(ITOR,1))=IBUF(ITOR,1) IF (IBUF(ITOR,1).EQ.NAT+1)THEN IW=0 DO 56 I=1,4 IR=ICON(JTOR(ITOR),I) IF (IR.EQ.KTOR(ITOR))GOTO 56 IF (IR.NE.0) IW=IR 56 CONTINUE IF (IW.EQ.0)ITOR=ITOR-1 IF (IW.NE.0)THEN IDT(JBUF(ITOR,1))=IW IBUF(ITOR,1)=IW ENDIF IF ((IW.EQ.0).AND.(IE(KTOR(ITOR+1)).GT.2)) THEN DO 59 I=1,IE(KTOR(ITOR+1)) IT=ICON(KTOR(ITOR+1),I) IF (IT.EQ.JTOR(ITOR+1).OR.IT.EQ.JBUF(ITOR+1,1))GOTO 59 IF (IDB(IT).NE.JBUF(ITOR+1,1))THEN IBEND=IBEND+1 IBD(IBEND)=IT JBD(IBEND)=KTOR(ITOR+1) KBD(IBEND)=JBUF(ITOR+1,1) IDB(JBUF(ITOR+1,1))=IT ENDIF GOTO 60 59 CONTINUE ENDIF 60 CONTINUE ENDIF IF (IBUF(ITOR,1).EQ.NAT+2)THEN K=KTOR(ITOR) IW=0 DO 57 I=1,4 IR=ICON(KTOR(ITOR),I) IF (IR.EQ.JBUF(ITOR,1))GOTO 57 IF (IR.NE.0) IW=IR 57 CONTINUE IF (IW.EQ.0)ITOR=ITOR-1 IF (IW.EQ.0)GOTO 54 IC=0 DO 58 I=1,4 IR=ICON(JBUF(ITOR,1),I) IF (IR.EQ.KTOR(ITOR)) GOTO 58 IF (IR.NE.0)IC=IR 58 CONTINUE IF ((IDT(IW).LE.N).AND.(IDT(IC).GE.1))IC=0 IF (IC.EQ.0)ITOR=ITOR-1 IF (IC.EQ.0)GOTO 54 JTOR(ITOR)=KTOR(ITOR) KTOR(ITOR)=JBUF(ITOR,1) JBUF(ITOR,1)=IC IBUF(ITOR,1)=IW IDT(IW)=IC ENDIF 54 CONTINUE RETURN 9999 STOP END