static void R_FEL( uint rep, char dummy2 ) {
//=================================
for(;;) {
if( IOCB->typ == PT_NOTYPE ) {
IOCB->flags |= IOF_FMTDONE;
}
if( IOCB->typ == PT_NOTYPE ) break;
FmtPrepOp();
R_ChkType( PT_LOG_1, PT_LOG_4 );
if( IOCB->flags & IOF_OUTPT ) {
R_FOLog();
R_ChkRecLen();
} else {
R_FILog();
}
FmtIOType();
if( --rep == 0 ) break;
}
IOCB->flags |= IOF_FMTREP;
IOCB->fmtptr = (fmt_desc PGM *)((fmt1 PGM *)IOCB->fmtptr + 1);
}
void R_FOG( void ) {
//===============
int width;
int dec;
int exp;
int logval;
char *buf;
ftnfile *fcb;
char ch;
extended value;
extended absvalue;
width = IOCB->fmtptr->fmt3.fld1;
dec = IOCB->fmtptr->fmt3.fld2;
exp = IOCB->fmtptr->fmt3.fld3;
fcb = IOCB->fileinfo;
buf = &fcb->buffer[ fcb->col ];
if( IOCB->typ <= PT_LOG_4 ) {
R_FOLog();
} else if( IOCB->typ <= PT_INT_4 ) {
OutInt( width, 1 );
} else {
if( GetRealRtn( &value, width ) ) {
absvalue = value;
if( value < 0.0 ) {
absvalue = -value;
}
/* round to "dec" digits */
absvalue = absvalue + .5 * pow( 10, -dec );
if( ( IOCB->typ == PT_REAL_4 ) || ( IOCB->typ == PT_CPLX_8 ) ) {
logval = Div10S( absvalue );
} else if((IOCB->typ == PT_REAL_8) || (IOCB->typ == PT_CPLX_16)) {
logval = Div10L( absvalue );
} else {
logval = Div10X( absvalue );
}
// use E format if less than 0.1 unless value is zero
// use E format if there are more digits than the width
if( (( absvalue < 0.1 ) || ( logval >= dec )) &&
( value != 0.0 ) ) {
ch = 'E';
if( exp == 0 ) { // if Gw.d
#if defined( _M_IX86 ) || defined( __AXP__ ) || defined( __PPC__ )
if( ( ( absvalue <= P1d_99 ) || ( absvalue >= P1d100 ) ) &&
( absvalue != 0.0 ) ) {
ch = NULLCHAR; // no exponent letter
exp = 3;
} else {
#endif
exp = 2;
#if defined( _M_IX86 ) || defined( __AXP__ ) || defined( __PPC__ )
}
#endif
}
R_F2E( value, buf, width, dec, (IOCB->flags & IOF_PLUS) != 0,
IOCB->scale, exp, ch );
fcb->col += width;
} else {
if( exp == 0 ) { // if Gw.d
exp = 4;
} else {
exp += 2;
}
width -= exp;
if( width > 0 ) {
dec -= ( logval + 1 );
if( ( dec <= width ) && ( dec >= 0 ) ) {
R_F2F( value, buf, width, dec,
( IOCB->flags & IOF_PLUS ) != 0, 0 );
fcb->col += width;
if( *buf == '*' ) {
// fill remaining field
SendChar( '*', exp );
} else {
SendChar( ' ', exp );
}
} else {
SendChar( '*', width + exp );
}
} else {
SendChar( '*', width + exp );
}
}
} else { // undefined chars will be filled in for value
fcb->col += width;
}
}
}
