C CIF2INS PROGRAM TO CONVERT DENZO'S IMPORT.CIF FILE OF KAPPA-CCD C THIS PROGRAM CREATES .CEL, .INS & .HKL FILES FROM IMPORT.CIF OF CCD C DATED: 05-AUG-00 C********************************************************************** INTEGER H,K,L,NDUM,NATOM(20),NA,INTCR INTEGER NZ,NLATT,NS,NATOMS,KF REAL FO,S,A,B,C,AL,BE,GA,EA,EB,EC,EAL,EBE,EGA,FF,MA,WL,ZCAL REAL RAD,COSA,COSB,COSG,VOLUME,ATVOL CHARACTER FILE*8, FILE1*12, FILE2*12, FILE3*12,FILE4*12 CHARACTER WORD1*14,WORD2*17,WORD3*21,WORD4*30,FORM10*60 CHARACTER*1 CELLA(40), FORMULA(60), FORM1(40),FORM2(40),SYMM(20) CHARACTER CDATE*9, CTIME*8, METHOD*1 CHARACTER*1 SYS(20),SYSTEM WRITE(*,*)'This program creates .INS file for SHELX programs' WRITE(*,*)'from the IMPORT.CIF file of KappaCCD.' WRITE(*,*)'You can rename the IMPORT.CIF as NAME.ccd' WRITE(*,*)' This program was written by:' WRITE(*,*)' Dr. A.Chandrasekaran,' WRITE(*,*)'Chemistry, UMass, Amherst, USA. Dated: 05-AUG-2000.' WRITE(*,*)' ' WRITE(*,*)'Warning!!! NAME.cel, NAME.ins & NAME.hkl files will', 1' be overwritten!!!' WRITE(*,*)' ' WRITE(*,'(A,$)')' Please give the job NAME [<8 characters]: ' READ(*,*)FILE FILE1='IMPORT.CIF' OPEN(UNIT=1,FILE=FILE1,STATUS='OLD',ERR=10) GOTO 11 10 FILE1=TRIM(FILE)//'.CCD' WRITE(*,101)TRIM(FILE1) 101 FORMAT(' File [IMPORT.CIF] not found! Looking for [',A12,'] ...') OPEN(UNIT=1,FILE=FILE1,STATUS='OLD',ERR=9) GOTO 11 9 STOP 'NO INPUT FILE FOUND! QUITING!' C GOTO 1 11 CONTINUE WRITE(*,102)TRIM(FILE1) 102 FORMAT(' File [',A12, '] found! Will use this as input file',/) FILE2=TRIM(FILE)//'.CEL' OPEN(UNIT=2,FILE=FILE2,STATUS='NEW',ERR=12) GOTO 13 12 WRITE(*,*)TRIM(FILE2),' file already exists! Overwriting' CLOSE(2) OPEN(UNIT=2,FILE=FILE2,STATUS='UNKNOWN') 13 CONTINUE WRITE(2,*)'1.0 6.0 0.71073' OPEN(UNIT=10,FILE="DUMMY.FILE",STATUS='UNKNOWN') C********************************************************************** C READING THE CELL, ESD, FORMULA AS CHARACTERS. SEPARATING AND C WRITING IN DUMMY.FILE TEMPORARILY TO READ AS NUMBERS LATER. C READING THE CRYSTAL SYSTEM INFORMATION 1080 READ(1,'(A30,20A1)')WORD4,SYS IF (WORD4.NE.'_symmetry_space_group_name_H-M') GOTO 1080 DO 1081 NSYS=1,20 IF (SYS(NSYS).EQ.CHAR(39)) THEN SYSTEM=SYS(NSYS+1) GOTO 1082 ELSE ENDIF 1081 CONTINUE 1082 CONTINUE REWIND 1 C********************************************************************** C ***** LOOKING FOR FORMULA AND SPLITTING NUMBERS ***** J=1 KF=1 30 READ(1,'(A21,60A1)')WORD3,(FORMULA(I),I=1,60) IF (WORD3.NE.'_chemical_formula_sum') GOTO 30 DO 70 I=1,60 IF (FORMULA(I).EQ.CHAR(39)) THEN DO 71 N=I+1,60 IF(FORMULA(N).EQ.CHAR(39)) GOTO 75 IF(FORMULA(N).EQ.' ') THEN IF(FORM1(J-1).EQ.' ') THEN FORM1(J)='1' J=J+1 ELSE ENDIF FORM1(J)=FORMULA(N) FORM2(KF)=FORMULA(N) NJ=NJ+1 NK=NK+1 J=J+1 KF=KF+1 GOTO 71 ELSE ENDIF DO 72 L=1,10 IF (FORMULA(N).EQ.CHAR(47+L)) THEN FORM1(J)=FORMULA(N) J=J+1 GOTO 71 ELSE ENDIF 72 CONTINUE FORM2(KF)=FORMULA(N) KF=KF+1 71 CONTINUE ELSE ENDIF 70 CONTINUE 75 CONTINUE NFORMJ=J C CHANGING ELEMENT SYMBOLS TO CAPITALS (ONLY SHELX86 NEEDS SO) DO 76 L=1,KF NS=IACHAR(FORM2(L)) IF(NS.GT.96.AND.NS.LT.123) FORM2(L)=CHAR(NS-32) 76 CONTINUE REWIND 1 C ***** LOOKING FOR THE FIRST CELL LENGTH AND ESD ***** 20 READ(1,'(A14,40A1)')WORD1,(CELLA(I),I=1,40) IF (WORD1.NE.'_cell_length_a') GOTO 20 DO 40 I=1,40 40 IF(CELLA(I).EQ.'(') WRITE(10,*) (CELLA(J),J=1,I-1) DO 41 I=1,40 IF(CELLA(I).EQ.'(') NDUM=I+1 41 IF(CELLA(I).EQ.')') WRITE(10,*) (CELLA(J),J=NDUM,I-1) C ***** READING THE REMAINING TWO LENGTHS AND ESDS ***** DO 60 N=1,2 READ(1,'(A14,40A1)')WORD1,(CELLA(I),I=1,40) DO 50 I=1,40 50 IF(CELLA(I).EQ.'(') WRITE(10,*) (CELLA(J),J=1,I-1) DO 60 I=1,40 IF(CELLA(I).EQ.'(') NDUM=I+1 IF(CELLA(I).EQ.')') WRITE(10,*) (CELLA(J),J=NDUM,I-1) 60 CONTINUE C ***** READING THE THREE ANGLES AND ESDS ***** DO 65 N=1,3 READ(1,'(A17,40A1)')WORD2,(CELLA(I),I=1,40) DO 51 I=1,40 51 IF(CELLA(I).EQ.'(') WRITE(10,*) (CELLA(J),J=1,I-1) DO 61 I=1,40 IF(CELLA(I).EQ.'(') NDUM=I+1 IF(CELLA(I).EQ.')') WRITE(10,*) (CELLA(J),J=NDUM,I-1) 61 CONTINUE DO 62 L=1,40 IF(CELLA(L).EQ.'(') GOTO 65 62 CONTINUE WRITE(10,*) (CELLA(J),J=1,40) WRITE(10,*)'0' 65 CONTINUE C WRITING THE FORMULA MATTER IN THE END OF DUMMY FILE WRITE(10,*)NJ+1,NK+1 C WRITE(10,*)(FORM2(L),L=1,KF) WRITE(10,*)(FORM1(L),L=1,NFORMJ) REWIND 10 C********************************************************************** C ***** READING FROM DUMMY.FILE AND WRITING TO .CEL FILE ***** C OPEN(UNIT=10,FILE="DUMMY.FILE",STATUS='OLD') READ(10,*)A,EA,B,EB,C,EC,AL,EAL,BE,EBE,GA,EGA,NA INTCR=0 WRITE(2,301)A,B,C,AL,BE,GA,INTCR 301 FORMAT(1X,6F10.5,I2) EA=EA/100000.0 EB=EB/100000.0 EC=EC/100000.0 EAL=EAL/10000.0 EBE=EBE/10000.0 EGA=EGA/10000.0 WRITE(2,301)EA,EB,EC,EAL,EBE,EGA WRITE(2,302)NA 302 FORMAT(20I4) WRITE(2,*)(FORM2(L),L=1,KF) READ(10,*,ERR=80)(NATOM(I),I=1,NA) 80 CONTINUE IF (NATOM(NA).LT.1.OR.NA.GT.100) NATOM(NA)=1 WRITE(2,302)(NATOM(N),N=1,NA) CLOSE (UNIT=10, STATUS='DELETE') REWIND 2 C********************************************************************** C ***** MAKING THE .INS FILE (COMMANDS PART) ***** FILE4=TRIM(FILE)//'.INS' OPEN(UNIT=4,FILE=FILE4,STATUS='UNKNOWN') READ(2,*)FF,MA,WL READ(2,*)A,B,C,AL,BE,GA,INTCR READ(2,*)EA,EB,EC,EAL,EBE,EGA READ(2,*)NA READ(2,*)FORM10 READ(2,*)(NATOM(I),I=1,NA) CLOSE (UNIT=2) RAD=1.0/57.29577951 COSA=cos(AL*RAD) COSB=cos(BE*RAD) COSG=cos(GA*RAD) VOLUME=1.0-(COSA**2)-(COSB**2)-(COSG**2)+2.0*COSA*COSB*COSG VOLUME=sqrt(VOLUME) VOLUME=VOLUME*A*B*C DO 490 N=1,NA IF(N.NE.2) NATOMS=NATOMS+NATOM(N) 490 CONTINUE ZCAL=VOLUME/NATOMS/19 CALL DATE(CDATE) CALL TIME(CTIME) WRITE(4,501)CDATE,CTIME 501 FORMAT('TITL This was created by CIF2INS program of ACS on ', 1A9,' at ',A8) WRITE(4,502)FILE 502 FORMAT('TITL ',A8) WRITE(4,503)WL,A,B,C,AL,BE,GA 503 FORMAT('CELL ',F7.5,3F10.5,3F9.4) WRITE(*,*)' ' WRITE(*,*)'Lattice Choices: ', 1'P=1,I=2,R=3,F=4,A=5,B=6,C=7; (Negative for NON-CENTRIC!!):' WRITE(*,'(A27,4X,A1)')' Suggested Lattice Type is:',SYSTEM WRITE(*,'(A,$)')' Select a Lattice Type: ' READ(*,*)NLATT WRITE(*,*)' ' WRITE(*,*)'The given formula is ',FORMULA WRITE(*,*)'Calculated molecules(Z) in the unit cell are: ',ZCAL ATVOL=VOLUME/NATOMS/ZCAL WRITE(*,*)'The calculated atomic volume is',ATVOL WRITE(*,*)'Expected range is 15-23; close to 19 is most common.' WRITE(*,*)'If needed, change the formula in CIF file and reRUN.' WRITE(*,*)' ' WRITE(*,'(A,$)')' Please input the number of molecules(Z) in the 1 cell: ' READ(*,*)NZ WRITE(4,504)NZ,EA,EB,EC,EAL,EBE,EGA 504 FORMAT('ZERR ',I3,4X,3F10.5,3F9.4) WRITE(4,505)NLATT 505 FORMAT('LATT ',I2) IF(AL.NE.90.AND.BE.NE.90) GOTO 600 IF(AL.NE.90.AND.GA.NE.90) GOTO 600 IF(BE.NE.90.AND.GA.NE.90) GOTO 600 601 WRITE(*,'(A,$)')' Please give the SYMMETRY operator (Q/q Ends):' READ(*,'(20A1)')(SYMM(I),I=1,20) IF(SYMM(1).EQ.'Q'.OR.SYMM(1).EQ.'q') GOTO 600 IF(SYMM(1).EQ.' '.OR.SYMM(1).EQ.CHAR(13)) GOTO 601 DO 605 J=1,20 NS=IACHAR(SYMM(J)) IF(NS.GT.96.AND.NS.LT.123) SYMM(J)=CHAR(NS-32) 605 CONTINUE WRITE(4,506)SYMM 506 FORMAT('SYMM ',20A1) GOTO 601 600 CONTINUE WRITE(4,507)(FORM2(L),L=1,KF-1) 507 FORMAT('SFAC ',40A1) WRITE(4,508)(NATOM(I)*NZ,I=1,NA) 508 FORMAT('UNIT ',18I4) WRITE(*,*)' ' WRITE(*,*)'Please select a method for STRUCTURE SOLUTION:' WRITE(*,'(A,$)')' [D=Direct, P=Patterson (Heavy Atom) Method]: ' READ(*,'(A1)')METHOD IF (METHOD.EQ.'P'.OR.METHOD.EQ.'p') THEN WRITE(4,509) 509 FORMAT('PATT') ELSE WRITE(4,510) 510 FORMAT('TREF 100') ENDIF WRITE(4,511) 511 FORMAT('HKLF -4') C********************************************************************** C ***** MAKING THE .HKL FILE &.INS FILE ***** FILE3=TRIM(FILE)//'.HKL' OPEN(UNIT=3,FILE=FILE3,STATUS='UNKNOWN') 100 READ(1,160,END=200,ERR=100)H,K,L,FO,S 160 FORMAT(I4,2I5,2F9.2) IF(H.EQ.0.AND.K.EQ.0.AND.L.EQ.0) GOTO 100 WRITE(3,170)H,K,L,FO,S WRITE(4,170)H,K,L,FO,S 170 FORMAT(3I4,2F8.2) GOTO 100 200 CONTINUE WRITE(3,180) 180 FORMAT(/) CLOSE (UNIT=1) CLOSE (UNIT=3) CLOSE (UNIT=4) STOP ' DONE' END