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.
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