Subroutine CPTMPLTE for program GSAS2CIF

This subroutine is used to insert the contents of a CIF template file into a CIF file. See the gsas2cif documentation for an explanation of this code.

link to documentation
      SUBROUTINE CPTMPLTE(IUCIF,TEMPLATE1,TEMPLATE2,LOCALCOPY)
C Copy Template File 
C This subroutine opens the file referenced by LOCALCOPY and copies
C the contents, line by line to the output CIF file (IUCIF).
C
C If this file does not exist, a master template file named TEMPLATE1
C is opened and a file named LOCALCOPY is created. If that does not exist
C or is blank,  a master template file named TEMPLATE2 is opened.
C
C The master template file is then copied to are copied both to the 
C output CIF file (IUCIF) and the LOCALCOPY file.
C
C The master template file will be read from the current default data
C data directory, if it exists, otherwise it is read from the GSAS
C data directory.
                                              
      INTEGER*4     IUCIF               !Unit no. for cif file
      CHARACTER*(*) TEMPLATE1           !Name of template file #1
      CHARACTER*(*) TEMPLATE2           !Name of template file #2
      CHARACTER*(*) LOCALCOPY           !Name of local copy of template file

!LOCAL VARIABLES:
      INTEGER*4     IUIN                !Unit no. for input file
      INTEGER*4     IUCP                !Unit no. for output localcopy file (if needed)
      INTEGER*4     IFLAG               !Open error flag
      INTEGER*4     ILONG               !# of too long lines
      INTEGER*4     L

      CHARACTER*100 LINE                !temp variable 
      CHARACTER*255 FULLNAME            !full path for template file
      CHARACTER*255 GSAS                !location of GSAS files
      LOGICAL*4     DATAFLAG            !set to true after the data_ line is read

!FUNCTION DEFINITIONS:

      INTEGER*4     GSGETENV            !get a environment variable
      INTEGER*4     LENCH               !length of a character string


      IUCP = 0
      CALL GETUNIT(IUIN)


link to documentation
C first try to open the LOCALCOPY, if it exists
      OPEN(UNIT=IUIN,FILE=LOCALCOPY,
     1  IOSTAT=IFLAG,                                           !error flag
     1  STATUS='OLD',FORM='FORMATTED')
      IF (IFLAG .EQ. 0) THEN
        PRINT '(2A)',' Copying from file ',LOCALCOPY
      END IF


link to documentation
      IF (IFLAG .NE. 0 .AND. TEMPLATE1 .NE. ' ') THEN
C     open failed, open the 1st template
C       look first for a template in the current directory
        OPEN(UNIT=IUIN,FILE=TEMPLATE1,
     1    IOSTAT=IFLAG,                                           !error flag
     1    STATUS='OLD',FORM='FORMATTED')
        IF ( IFLAG.EQ.0 ) THEN
          PRINT '(2A)',' Reading from current directory, file ',
     1      TEMPLATE1(:LENCH(TEMPLATE1))
          CALL GETUNIT(IUCP)
          OPEN(UNIT=IUCP,FILE=LOCALCOPY,STATUS='NEW',
     1      FORM='FORMATTED')
          PRINT '(2A)',' Creating file ',LOCALCOPY
        ELSE
C       not found, look in the GSAS data directory
          IFLAG = GSGETENV('gsas    ',GSAS)
          IF ( IFLAG.EQ.0 ) STOP
     1      'ERROR - Environment variable GSAS is undefined'
          FULLNAME = GSAS(1:INDEX(GSAS,' ')-1)//'/data/'//TEMPLATE1
          OPEN(UNIT=IUIN,FILE=FULLNAME,
     1      IOSTAT=IFLAG,
     1      STATUS='OLD',FORM='FORMATTED')
          IF ( IFLAG.NE.0 ) THEN
            PRINT '(3A)',' File ',TEMPLATE1(:LENCH(TEMPLATE1)),
     1        ' not found in current or GSAS data directory'
            PRINT '(4A)',' will try generic template'
          ELSE
            PRINT '(2A)',' Reading from GSAS data directory, file ',
     1        TEMPLATE1(:LENCH(TEMPLATE1))
            CALL GETUNIT(IUCP)
            OPEN(UNIT=IUCP,FILE=LOCALCOPY,STATUS='NEW',
     1        FORM='FORMATTED')
            PRINT '(2A)',' Creating file ',LOCALCOPY
          END IF
        END IF
      END IF


link to documentation
      IF (IFLAG .NE. 0) THEN
C     open failed, open the 2nd template
C       look first for a template in the current directory
        OPEN(UNIT=IUIN,FILE=TEMPLATE2,
     1    IOSTAT=IFLAG,                                           !error flag
     1    STATUS='OLD',FORM='FORMATTED')
        IF ( IFLAG.EQ.0 ) THEN
          PRINT '(2A)',' Reading from current directory, file ',
     1      TEMPLATE2(:LENCH(TEMPLATE2))
        ELSE
C       not found, look in the GSAS data directory
          IFLAG = GSGETENV('gsas    ',GSAS)
          IF ( IFLAG.EQ.0 ) STOP
     1      'ERROR - Environment variable GSAS is undefined'
          FULLNAME = GSAS(1:INDEX(GSAS,' ')-1)//'/data/'//TEMPLATE2
          OPEN(UNIT=IUIN,FILE=FULLNAME,
     1      IOSTAT=IFLAG,
     1      STATUS='OLD',FORM='FORMATTED')
          IF ( IFLAG.NE.0 ) THEN
            PRINT '(2A)',' Error: could not find file ',
     1        TEMPLATE2(:LENCH(TEMPLATE2))
            PRINT '(4A)','  This file is missing from GSAS',
     1        ' data directory, ',GSAS(1:INDEX(GSAS,' ')-1),
     1        '/data/'
            STOP 'ERROR - missing template file'
          END IF
          PRINT '(2A)',' Reading from GSAS data directory, file ',
     1      TEMPLATE2(:LENCH(TEMPLATE2))
        END IF
        CALL GETUNIT(IUCP)
        OPEN(UNIT=IUCP,FILE=LOCALCOPY,STATUS='NEW',FORM='FORMATTED')
        PRINT '(2A)',' Creating file ',LOCALCOPY
      END IF


link to documentation
C got the input file, now read from it 
      ILONG = 0
      DATAFLAG = .FALSE.
      READ (IUIN,'(A)',IOSTAT=IFLAG) LINE
      DO WHILE (IFLAG .EQ. 0)
        L = LENCH(LINE)                                          ! is the line too long?
        IF (L .GT. 80) THEN
          L = 80
          ILONG = ILONG + 1
        END IF
C don't copy lines that preceed the data_ token
        IF (DATAFLAG) WRITE (IUCIF,'(A)') LINE(:L)
        IF (IUCP .NE. 0) WRITE (IUCP,'(A)') LINE(:L)
C Did this line contain a data_ block name?
        IF (.NOT. DATAFLAG) THEN
          I = 1
          DO WHILE (LINE(I:I) .EQ. ' ' .AND. I .LT. L)
            I = I + 1
          END DO
          CALL UPCASE(LINE)
          IF (LINE(I:I+4) .EQ. 'DATA_') DATAFLAG = .TRUE.
        END IF
        READ (IUIN,'(A)',IOSTAT=IFLAG) LINE
      END DO 

      IF (ILONG .GT. 0) PRINT '(A,I5,A)',' Warning:',ILONG,
     1  ' lines longer than 80 characters were truncated'
      IF (IUCP .NE. 0) CLOSE(IUCP)
      CLOSE(IUIN)
      RETURN
      END