Subroutine FESD for program GSAS2CIF

This subroutine is used to format numbers for CIF in a variation of crystallographic notation. Note that if the uncertainty value is negative, the uncertainty is not printed, but rather, the uncertainty determines the number of significant digits. See the gsas2cif documentation for an explanation of this code. 
link to documentation
      SUBROUTINE FESD(value,esd,string,ln)

C------------------------------------------------------------------------
C format a value & esd as a string in crystallographic notation
C Use a negative esd to indicate the level of significance: 
C  value 123.456, error=0.01 ==> 123.46(1)
C  value 123.456, error=-.01 ==> 123.46
C------------------------------------------------------------------------
      REAL          VALUE,ESD           
      CHARACTER*(*) STRING              
      INTEGER*4     LN                  !if <0 input then fixed field
      INTEGER*4     IDEC,IFLD           
      CHARACTER*20  FMTSTR              
      LOGICAL*4     IFXD                
                                  
      IFXD = .FALSE.                                  
      IF ( LN.LT.0 ) IFXD = .TRUE.
      IF (VALUE .eq. 0 .and. esd .eq. 0) then
        IDEC = 1
        IFLD = 5
      ELSE IF (VALUE .eq. 0) then
        IDEC = max(0.,1.545-LOG10(ABS(ESD)))
        IFLD = 4+IDEC
      ELSE IF (esd .eq. 0) then
        IDEC = 5
        IFLD = max(1.,LOG10(abs(VALUE)))+3+IDEC
      ELSE
        IDEC = max(0.,1.545-LOG10(MAX(0.000001*ABS(VALUE),ABS(ESD))))
        IFLD = max(1.,LOG10(MAX(abs(ESD),abs(VALUE))))+3+IDEC
      END IF
      IF (esd .le. 0) then
        ISIGW = 0
      ELSE
        ISIG = NINT(ESD * (10.0**IDEC))
        ISIGW = 1. + LOG10(1.*ISIG)
      END IF
C remove insignificant figures to the left of the decimal
      if (ISIGW .gt. 2) THEN
        xmult = 10.**(isigw-2)
        value = xmult*NINT(value/xmult)
        isig = xmult*NINT(isig/xmult)
      END IF
      IF ( ISIGW .eq. 0 ) THEN
        WRITE(FMTSTR,'(A,I2,A,I1,A)') '(F',IFLD,'.',IDEC,')'
        WRITE (string,FMTSTR) VALUE
        ln = lench(string)
C remove trailing zeros
        IF ( .NOT.IFXD ) THEN
          DO WHILE (string(ln:ln) .eq. '0' 
     1      .AND. STRING(LN-1:LN-1).NE.'.' )
            string(ln:ln) = ' '
            ln = ln - 1
          END DO
        END IF
      ELSE IF (IDEC .gt. 0) THEN
        WRITE(FMTSTR,'(A,I2,A,I1,A,I2,A)') '(F',IFLD,'.',IDEC,
     1    ',1H(,I',ISIGW,',1H))'
        WRITE (string,FMTSTR) VALUE,ISIG
        ln = lench(string)
      ELSE
        WRITE(FMTSTR,'(A,I2,A,I2,A)') '(I',IFLD,',1H(,I',ISIGW,',1H))'
        WRITE (string,FMTSTR) NINT(VALUE),ISIG
        ln = lench(string)
      END IF
      RETURN
      END