      PROGRAM THMINP 
C *** THMINP is a program to write an input file for THMA11 from
C *** the information contained in the NRCVAX derived .CD file.
C *** Written by Paul Boyle, University of New Brunswick
C
C ** Declare variables used in this program.
C
      CHARACTER*12 FILE1, FILE2
      REAL CELL(100),ATOMS(100),DIS,TEMP,CONSLV
      INTEGER N1,N2,CONL3(13),CONL4A(5),CONL4B(5)
C
C ** Specify .CD file to be used.
C
      PRINT *,'Enter name of .CD file in single quotes.'
      READ *,FILE1
C
C ** Specify the name of the input file to be written.
C
      PRINT *,'Enter name of THMA11 input file in single quotes.'
      READ *,FILE2
C
C
C ** Specify the atoms to be included in calculation.
C
      PRINT *,'Enter range of atoms to be included; must be contigious'
      READ *,N1,N2
      PRINT *,'Enter value for DIS (max. bond length in struc.)'
      READ *,DIS
C
C ** Calculate NTOT and set default values for control lines.
C
      NTOT=N2-N1+1
      DO 5 I=1,13
        CONL3(I)=0
5     CONTINUE
C
      CONL3(1)=NTOT
      CONL3(4)=8
      CONL3(6)=-1
      CONL3(8)=NTOT
      CONL3(10)=-1
      CONL3(11)=2
      CONL3(12)=1
C
      DO 7 I=1,5
        CONL4A(I)=0
        CONL4B(I)=0
7     CONTINUE
C
      TEMP=296.0
      CONSLV=0.01
      IFMX=2
      IFMB=1
      ETA=0.0
      NUORB=6
C
C ** OPEN units 1 and 2 for the .CD and THMA11.INP files respectively.
C
      OPEN(UNIT=1,FILE=FILE1,ACCESS='DIRECT',STATUS='OLD',RECL=400)
      OPEN(UNIT=2,FILE=FILE2,STATUS='UNKNOWN')
C
C ** Intialize array used for reading the cell paramters.
      DO 10 I=1,100
        CELL(I)=0.0
        ATOMS(I)=0.0
10    CONTINUE
C
C
C ** Read cell parameters from .CD file.
C
      READ (UNIT=1,REC=1) (CELL(I), I=1,100)
C
      WRITE(2,100) 'TITLE, EDIT THIS FILE'
      WRITE(2,200) (CELL(I),I=28,30),(CELL(I),I=37,39),IFMX,IFMB,ETA,DIS
      WRITE(2,300) (CONL3(I),I=1,13)
      WRITE(2,401) TEMP,(CONL4A(I),I=1,5)
      WRITE(2,402) (CONL4B(I),I=1,5),CONSLV
C
C **  Read in atom x,y,z and ADP parameters.
C
      DO 30 J=1,NTOT
        READ (UNIT=1,REC=7+J+N1) (ATOMS(I), I=1,100)
        WRITE(2,501) (ATOMS(K),K=7,9),ATOMS(1),DUM,ATOMS(31)
        WRITE(2,502) (ATOMS(I), I=10,15),NUORB
C
C **  Read in ADP sigma's
C
30    CONTINUE 
      DO 40 J=1,NTOT
        READ (UNIT=1,REC=7+J+N1) (ATOMS(I), I=1,100)
        WRITE(2,503) (ATOMS(I), I=20,25),ATOMS(1)
40    CONTINUE
C
C ** FORMAT statements
C
100   FORMAT(A80)
200   FORMAT(3F8.4,3F8.3,2I5,2F6.3)
300   FORMAT(13I5)
401   FORMAT(F7.2,5I5)
402   FORMAT(5I5,F6.4)
501   FORMAT(3F8.5,14X,A4,4X,2F5.1)
502   FORMAT(6F10.6,I1)
503   FORMAT(6F10.5,A4)

      CLOSE(1)
      CLOSE(2)
      END
