[Wien] from struct to cif files

[Florent Boucher]

Dear Souraya,
this is just a very simple program that we made. I allows to read the 
struct file create a very very simple cif file.
You can try it if you want.
Regards
Florent

      PROGRAM convstruct
      implicit none
      double precision    a,b,c,alpha,beta,gamma,POS,a0,sigma
      INTEGER   nat,MULT,jatom,J,N,i
      CHARACTER*80     fin,fout                                         
      CHARACTER*10    lat,rep
      CHARACTER*15    SG
      CHARACTER*4     NAME,symb
      CHARACTER*79      title
      CHARACTER*1       car     
      PARAMETER (N = 40,a0=0.529177d0,sigma=1.0d-6)
      dimension    POS(3,N),MULT(N),NAME(N)
                                                
      write (*,*) 'Conversion of WIEN struct file into cif file'
      write (*,*) 'The output will be struct.cif'
      write (*,*) 'Name of input file ?'
      read (*,*) fin
      write (*,*) 'Space group?'
      read (*,*) SG
      open (20,FILE=fin,STATUS='unknown')
      read (20,1000) title,lat,nat
      read (20,1001) a,b,c,alpha,beta,gamma
      do jatom = 1,nat                                              
         READ(20,1002) (POS(J,JATOM),J=1,3),MULT(JATOM) 
         do i = 2,MULT(JATOM)
          read(20,*)               
         enddo
         read(20,1003)NAME(jatom)
      enddo 
      close (20)
      open (21,FILE='struct.cif',STATUS='unknown')
      car=char(13)
      write(21,4000)car,a*A0,car,b*A0,car,c*A0,car,alpha,car,beta,
     c              car,gamma,car
      write(21,4001)"'"//SG//"'",car
      write(21,4002)(car,i=1,6)
      do jatom = 1,nat
         symb=name(jatom)
         if (symb(2:2).eq.' ') symb(2:4)=symb(3:4)//' '
         write(21,4003)symb,name(jatom)(1:2),(POS(J,JATOM),J=1,3),car
      enddo
      close (21)
 1000 FORMAT(A79,/,A4,24X,I2,/)
 1001 FORMAT(6F10.6)
 1002 FORMAT(12X,F10.8,3X,F10.8,3X,F10.8,/,15X,I2)                   
 1003 FORMAT(A4,/,/,/)
 4000 FORMAT('data_111111',A1/
     c       '_cell_length_a',F9.4,A1/
     c       '_cell_length_b',F9.4,A1/
     c       '_cell_length_c',F9.4,A1/
     c       '_cell_angle_alpha',F9.3,A1/
     c       '_cell_angle_beta',F9.3,A1/
     c       '_cell_angle_gamma',F9.3,A1)
 4001 FORMAT('_symmetry_space_group_name_H-M ',A17,A1)
 4002 FORMAT('loop_',A1/
     c        '_atom_site_label',A1/
     c        '_atom_site_type_symbol',A1/
     c        '_atom_site_fract_x',A1/
     c        '_atom_site_fract_y',A1/
     c         '_atom_site_fract_z',A1)
 4003 FORMAT(A4,A4,3F12.7,A1)
      END

-- 
 -------------------------------------------------------------------------
| Florent BOUCHER                    |                                    |
| Institut des Matériaux Jean Rouxel | Mailto:Florent.Boucher at cnrs-imn.fr |
| 2, rue de la Houssinière           | Phone: (33) 2 40 37 39 24          |
| BP 32229                           | Fax:   (33) 2 40 37 39 95          |
| 44322 NANTES CEDEX 3 (FRANCE)      | http://www.cnrs-imn.fr             |
 -------------------------------------------------------------------------