Subroutine OVERALL for program GSAS2CIF

This subroutine is used to write overall parameters and results to the output CIF file. See the gsas2cif documentation for an explanation of this code.

link to documentation
      SUBROUTINE OVERALL(IUEXP,IUCIF,EXPRNAME,IFPWDR,HTYP,NHIST,
     1     NPWDHIST,MBW)

      INTEGER*4     IUEXP,IUCIF         !Unit nos.
      CHARACTER*8   EXPRNAME             !Experiment name
      LOGICAL*4     IFPWDR              ! true if there is one or more powder histogram present
      CHARACTER*4   HTYP(99)            !Histogram type flags
      INTEGER*4     NHIST               !The number of histograms in this experiment
      INTEGER*4     NPWDHIST            ! The number of powder histograms
      INTEGER*4     MBW                 !Matrix bandwidth               

!Local variables:

      CHARACTER*68  TEXT                !ISAM file read buffer
      CHARACTER*20  DAT1                !Mean value of |Shift/esd|
      CHARACTER*20  DAT2                !Maximum value of |shift/esd|

!Functions:

      INTEGER*4     READEXP             !ISAM file read routine
      CHARACTER*6   HSTKEY              !ISAM key builder

!Code:
                                                                 
      ISAM = READEXP(IUEXP,'  GNLS SHFTS',TEXT)
      IF ( ISAM.EQ.0 ) THEN
        DAT1 = TEXT(1:10)
        DAT2 = TEXT(11:20)
      ELSE
C if the Shifts are not present -- they are not defined, not unknown
        DAT1 = '.'
        DAT2 = '.'
      END IF
      CALL WRVAL(IUCIF,'_refine_ls_shift/su_max',DAT1)
      CALL WRVAL(IUCIF,'_refine_ls_shift/su_mean',DAT2)
      CALL WRVAL(IUCIF,'_computing_structure_refinement','GSAS')
      ISAM = READEXP(IUEXP,' REFN GDNFT ',TEXT)
C likewise for GOF, etc -- they are not defined, not unknown
      IF ( ISAM.EQ.0 ) THEN
        DAT1 = TEXT(33:37)
        READ (TEXT(18:28),'(F11.0)') GNFT
        WRITE (DAT2,'(F7.2)') SQRT(GNFT)
      ELSE
        DAT1 = '.'
        DAT2 = '.'
      END IF
      CALL WRVAL(IUCIF,'_refine_ls_number_parameters',DAT1)
      CALL WRVAL(IUCIF,'_refine_ls_goodness_of_fit_all',DAT2)
      ISAM = READEXP(IUEXP,' REFN RESTR ',TEXT)
      IF ( ISAM.NE.0 ) TEXT = '      0'
      CALL WRVAL(IUCIF,'_refine_ls_number_restraints',TEXT(1:7))

C things to consider computing 
      ! _refine_ls_number_reflns
      ! _refine_ls_goodness_of_fit_obs
      ! _refine_ls_R_factor_all
      ! _refine_ls_R_factor_obs
      ! _refine_ls_wR_factor_all
      ! _refine_ls_wR_factor_obs
      ! _refine_ls_restrained_S_all
      ! _refine_ls_restrained_S_obs


link to documentation
C include an overall profile r-factor, if there is more than one powder histogram
      IF ( IFPWDR .AND. NPWDHIST .GT. 1) THEN
        WRITE(IUCIF,'(/A/)') '# Overall powder R-factors'
        ISAM = READEXP(IUEXP,' REFN RPOWD ',TEXT)
        IF ( ISAM.EQ.0 ) THEN
          CALL WRVAL(IUCIF,'_pd_proc_ls_prof_R_factor',TEXT(11:20))
          CALL WRVAL(IUCIF,'_pd_proc_ls_prof_wR_factor',TEXT(1:10))
        ELSE
          CALL WRVAL(IUCIF,'_pd_proc_ls_prof_R_factor','.')
          CALL WRVAL(IUCIF,'_pd_proc_ls_prof_wR_factor','.')
        END IF
      END IF

      IF (MBW .EQ. 0) THEN
        CALL WRVAL(IUCIF,'_refine_ls_matrix_type','full')
      ELSE
        CALL WRVAL(IUCIF,'_refine_ls_matrix_type','userblocks')
      END IF
      RETURN
      END