	PROGRAM RFINEOTP
C ROUTINE TO WRITE AN ORTEP INPUT CARD DECK FROM THE 'RFINE90' BINARY FILE
      DIMENSION RECELL(6),LABEL(3),G(3,3),RMAT(3,3,24),TRANS(3,24),CELLP
     1(3,4),IPARA(1000),FCURVE(9,20),SCALE(10),ANOM(2,20),TAG(2,150)
     2,ISOT(150),ISCAT(2,150),OCCA(150),OCCUP(150),SITE(150)
     3,XYZ(3,150),BETA(6,150),XXP(3),XP(3),IR(3,3),EXTIN(7)
     4,CR(10,150),DR(10,150)
	CHARACTER*80 FILNAM
      DATA ISC1,IPUN/10,11/
C
C GET FILE NAMES AND OPEN FILES
C
	TYPE 990
990	FORMAT(/' RFINE to ORTEP File Conversion'//
	1'$Type RFINE Binary File Name?  ')
	ACCEPT 991,FILNAM
991	FORMAT(A)
	OPEN(UNIT=10,NAME=FILNAM,TYPE='OLD',READONLY,FORM='UNFORMATTED')
	TYPE 992
992	FORMAT('$Type ORTEP File Name?  ')
	ACCEPT 991,FILNAM
	OPEN(UNIT=11,NAME=FILNAM,TYPE='NEW',CARRIAGECONTROL='LIST')
      REWIND ISC1
      READ(ISC1) KCYL,LABEL,RECELL,G,VOL,NSYM,NATOM,NSCAT,JCELL,MRANK,NP
     1ARA,NSF,DMIN,DMAX,DELMAX,ICENT,(((RMAT(I,J,K),I=1,3),J=1,3),K=1,NS
     2YM),((TRANS(I,J),I=1,3),J=1,NSYM),((CELLP(I,J),I=1,3),J=1,JCELL),(
     3IPARA(I),I=1,NPARA),((FCURVE(I,J),I=1,9),J=1,NSCAT),(SCALE(I),I=1,
     4NSF),IREJ,FOMAX,FOMIN,RHOMN,RHOMX
	READ(ISC1)((ANOM(J,I),J=1,2),I=1,NSCAT)
     5,IEXT,EXTIN,((TAG(J,I),J=1,2),ISOT(I),(ISCAT(J,I),J=1,2),OCCA(I),O
     6CCUP(I),SITE(I),(XYZ(J,I),J=1,3),(BETA(J,I),J=1,6)
     7,(CR(J,I),J=1,10),(DR(J,I),J=1,15),I=1,NATOM)
      WRITE(IPUN,2)RECELL
    2 FORMAT(3F9.8,3F9.7)
      TYPE 3,RECELL
    3 FORMAT(' RECIPROCAL CELL DATA  '3F9.8,3F9.7//' SYMMETRY OPERATIONS
     1'//)
C        PREPARE SYMMETRY CARDS
      ISENT=0
      DO 150 I=1,JCELL
      DO 100 J=1,3
  100 XP(J)=CELLP(J,I)
      DO 150 J=1,NSYM
      DO 110 K=1,3
      XXP(K)=XP(K)+TRANS(K,J)
      DO 110 L=1,3
  110 IR(K,L)=RMAT(L,K,J)
      K=2-ICENT
  120 IF(I.EQ.JCELL.AND.J.EQ.NSYM.AND.K.EQ.1)ISENT=1
      WRITE(IPUN,4)ISENT,(XXP(L),(IR(M,L),M=1,3),L=1,3)
      TYPE 5   ,ISENT,(XXP(L),(IR(M,L),M=1,3),L=1,3)
    4 FORMAT(I1,F14.7,3I3,2(F15.7,3I3))
    5 FORMAT(1X,I1,F14.7,3I3,2(F15.7,3I3))
      K=K-1
      IF(K)150,150,130
  130 DO 140 L=1,3
      XXP(L)=-XXP(L)
      DO 140 M=1,3
  140 IR(M,L)=-IR(M,L)
      GO TO 120
  150 CONTINUE
C        PUNCH ATOM CARDS
      TYPE 10
   10 FORMAT(///' ATOM CARDS'//)
      DO 180 I=1,NATOM
C        COORDINATES FIRST
      WRITE(IPUN,6)(TAG(J,I),J=1,2),(XYZ(J,I),J=1,3)
      TYPE 7,(TAG(J,I),J=1,2),(XYZ(J,I),J=1,3)
    6 FORMAT(2A3,21X,3F9.6)
    7 FORMAT(1X,2A3,21X,3F9.6)
      IF(ISOT(I))170,160,170
  160 WRITE(IPUN,8)BETA(1,I)
      TYPE 9,BETA(1,I)
    8 FORMAT(1X,F8.4,53X,1H6)
    9 FORMAT(2X,F8.4,53X,1H6)
      GO TO 180
C        ANISOTROPIC ATOM
  170 WRITE(IPUN,12)(BETA(J,I),J=1,6)
      TYPE 11,(BETA(J,I),J=1,6)
   12 FORMAT(1X,F8.6,5F9.6)
   11 FORMAT(2X,F8.6,5F9.6)
  180 CONTINUE
C        INCLUDE A DUMMY ATOM AT THE ORIGIN
      WRITE(IPUN,14)
   14 FORMAT(4HORGN/1H1)
      TYPE 15
   15 FORMAT(5H ORGN/2H 1)
      STOP
      END
