void F90_FunctionBegin( int f, ... )
{
Va_list args;
int i;
int v;
int vars[20];
char * name;
int narg;
FILE *oldf;
name = varTable[ f ]->name;
narg = varTable[ f ]->maxi;
Va_start( args, f );
for( i = 0; i < narg; i++ )
vars[ i ] = va_arg( args, int );
va_end( args );
CommentFncBegin( f, vars );
F90_FunctionStart( f, vars );
NewLines(1);
/* bprintf(" USE %s_Precision\n", rootFileName );
bprintf(" USE %s_Parameters\n\n", rootFileName ); */
/* bprintf(" IMPLICIT NONE\n" ); */
FlushBuf();
for( i = 0; i < narg; i++ )
F90_Declare( vars[ i ] );
bprintf("\n");
FlushBuf();
MapFunctionComment( f, vars );
}
void MATLAB_ExternDeclare( int v )
{
if( varTable[ v ]->comment ) {
MATLAB_WriteComment( "%s - %s",
varTable[ v ]->name, varTable[ v ]->comment );
}
FlushBuf();
bprintf(" global %s;\n", varTable[ v ]->name );
FlushBuf();
}
void MATLAB_Declare( int v )
{
if( varTable[ v ]->comment ) {
MATLAB_WriteComment( "%s - %s",
varTable[ v ]->name, varTable[ v ]->comment );
}
FlushBuf();
bprintf(" %s\n", MATLAB_Decl(v) );
FlushBuf();
}
// store a new block into the buffer
bool CodeTorrent::StoreBlock(CodedBlockPtr in) {
int gen = in->gen;
if (nc->IsHelpful(rank_vec, m_helpful, in)) {
HAGGLE_DBG2("Block is helpful\n");
buf.push_back(CopyCodedBlock(in));
rank_vec[gen]++; // if helpful, raise the rank
rank_vec_in_buf[gen]++;
if (buf.size() >= buffer_size) { // if the buf goes above the threshold
FlushBuf();
}
} else {
HAGGLE_DBG("Block is not helpful\n");
return false; // if not helpful, return false
}
// if full-rank, this generation is complete
if (rank_vec[gen] == GetNumBlocksGen(gen)) {
IncrementGenCompleted();
}
return true;
}
void MATLAB_FunctionStart( int f, int *vars )
{
int i;
int v;
char * name;
int narg;
name = varTable[ f ]->name;
narg = varTable[ f ]->maxi;
bprintf("function " );
if( narg >= 1 ) {
v = vars[ narg-1 ];
bprintf("[ %s ] = ", varTable[ v ]->name );
}
bprintf(" %s_%s ( ", rootFileName, name );
for( i = 0; i < narg-1; i++ ) {
v = vars[ i ];
bprintf("%s ", varTable[ v ]->name );
if (i<narg-2) bprintf(", ");
}
bprintf(")\n");
FlushBuf();
}
void NewLines( int n )
{
for( ; n > 0; n-- )
bprintf("\n");
FlushBuf();
}
void F90_DeclareConstant( int v, char *val )
{
VARIABLE *var;
int ival;
char dummy_val[100]; /* used just to avoid strange behaviour of
sscanf when compiled with gcc */
strcpy(dummy_val,val);val = dummy_val;
var = varTable[ v ];
if( sscanf(val, "%d", &ival) == 1 )
if( ival == 0 ) var->maxi = 0;
else var->maxi = 1;
else
var->maxi = -1;
if( var->comment )
F90_WriteComment( "%s - %s", var->name, var->comment );
switch( var->type ) {
case CONST: bprintf(" %s, PARAMETER :: %s = %s \n",
F90_types[ var->baseType ], var->name, val );
break;
default:
printf( "Invalid constant %d", var->type );
break;
}
FlushBuf();
}
void F90_FunctionEnd( int f )
{
bprintf(" \nEND SUBROUTINE %s\n\n", varTable[ f ]->name );
FlushBuf();
CommentFunctionEnd( f );
}
nsresult
ISOControl::GetBufs(nsTArray<nsTArray<uint8_t>>* aOutputBufs)
{
uint32_t len = mOutBuffers.Length();
for (uint32_t i = 0; i < len; i++) {
mOutBuffers[i].SwapElements(*aOutputBufs->AppendElement());
}
return FlushBuf();
}
void MATLAB_FunctionBegin( int f, ... )
{
Va_list args;
int i;
int v;
int vars[20];
char * name;
int narg;
FILE *oldf;
char buf[200], bufname[200];
time_t t;
name = varTable[ f ]->name;
narg = varTable[ f ]->maxi;
/*Adi - each Matlab functin requires a separate file*/
sprintf( buf, "%s_%s.m", rootFileName, varTable[ f ]->name );
mex_funFile = fopen(buf, "w");
if( mex_funFile == 0 ) {
FatalError(3,"%s: Can't create file", buf );
}
UseFile( mex_funFile );
/*Adi*/
Va_start( args, f );
for( i = 0; i < narg; i++ )
vars[ i ] = va_arg( args, int );
va_end( args );
CommentFncBegin( f, vars );
WriteDelim();
WriteComment("");
WriteComment("Generated by KPP - symbolic chemistry Kinetics PreProcessor" );
WriteComment(" KPP is developed at CGRER labs University of Iowa by" );
WriteComment(" Valeriu Damian & Adrian Sandu" );
WriteComment("");
WriteComment("%-20s : %s", "File", buf );
strcpy( buf, (char*)ctime( &t ) );
buf[ (int)strlen(buf) - 1 ] = 0;
WriteComment("%-20s : %s", "Time", buf );
WriteComment("%-20s : %s", "Working directory", getcwd(buf, 200) );
WriteComment("%-20s : %s", "Equation file", eqFileName );
WriteComment("%-20s : %s", "Output root filename", rootFileName );
WriteComment("");
WriteDelim();
NewLines(1);
MATLAB_FunctionStart( f, vars );
NewLines(1);
FlushBuf();
MapFunctionComment( f, vars );
}
void F90_Declare( int v )
{
if( varTable[ v ]->comment ) {
F90_WriteComment( "%s - %s",
varTable[ v ]->name, varTable[ v ]->comment );
}
bprintf(" %s\n", F90_Decl(v) );
FlushBuf();
}
void MapFunctionComment( int f, int *vars )
{
FILE *oldf;
oldf = UseFile( mapFile );
FunctionStart( f, vars );
/*NewLines(1);
CommentFncBegin( f, vars );*/
FlushBuf();
UseFile( oldf );
}
void F90_FunctionPrototipe( int f, ... )
{
char * name;
int narg;
name = varTable[ f ]->name;
narg = varTable[ f ]->maxi;
bprintf(" EXTERNAL %s\n", name );
FlushBuf();
}
void MATLAB_FunctionEnd( int f )
{
bprintf(" \nreturn\n\n");
FlushBuf();
CommentFunctionEnd( f );
/*Adi*/
fclose(mex_funFile);
}
void MATLAB_WriteComment( char *fmt, ... )
{
Va_list args;
char buf[ MAX_LINE ];
va_start( args, fmt );
vsprintf( buf, fmt, args );
va_end( args );
fprintf( currentFile, "%c ", '%' );
bprintf( "%-65s\n", buf );
FlushBuf();
}
void MATLAB_Inline( char *fmt, ... )
{
Va_list args;
char buf[ 1000 ];
if( useLang != MATLAB_LANG ) return;
Va_start( args, fmt );
vsprintf( buf, fmt, args );
va_end( args );
bprintf( "%s\n", buf );
FlushBuf();
}
void F90_WriteVecData( VARIABLE * var, int min, int max, int split )
{
char buf[80];
char *p;
if( split )
sprintf( buf, "%6sdata( %s(i), i = %d, %d ) / &\n%5s",
" ", var->name, min, max, " " );
else
sprintf( buf, "%6sdata %s / &\n%5s",
" ", var->name, " " );
FlushThisBuf( buf );
bprintf( " / \n\n" );
FlushBuf();
}
void F90_WriteComment( char *fmt, ... )
{
Va_list args;
int n;
char buf[ MAX_LINE ];
Va_start( args, fmt );
vsprintf( buf, fmt, args );
va_end( args );
/* remove trailing spaces */
/* taken from http://www.cs.bath.ac.uk/~pjw/NOTES/ansi_c/ch10-idioms.pdf */
for (n= strlen(buf) - 1; n >= 0; n--)
if (buf[n] != ' ') break;
buf[n + 1]= '\0';
bprintf( "! %s\n", buf );
FlushBuf();
}
void IncludeFile( char * fname )
{
FILE *fp;
#define MAX_LINE 200
char line[ MAX_LINE ];
fp = fopen( fname, "r" );
if ( fp == 0 )
FatalError(3,"%s: Can't read file", fname );
FlushBuf();
while( !feof(fp) ) {
*line = '\0';
fgets( line, MAX_LINE, fp );
fputs( line, currentFile );
}
fclose( fp );
}
void F90_FunctionStart( int f, int *vars )
{
int i;
int v;
char * name;
int narg;
name = varTable[ f ]->name;
narg = varTable[ f ]->maxi;
bprintf("SUBROUTINE %s ( ", name );
for( i = 0; i < narg-1; i++ ) {
v = vars[ i ];
bprintf("%s, ", varTable[ v ]->name );
}
if( narg >= 1 ) {
v = vars[ narg-1 ];
bprintf("%s ", varTable[ v ]->name );
}
bprintf(")\n");
FlushBuf();
}
void F90_WriteAssign( char *ls, char *rs )
{
int start;
int linelg;
int i, j;
int ifound, jfound;
char c;
int first;
int crtident;
/* Max no of continuation lines in F90/F95 differs with compilers, but 39
should work for every compiler*/
int number_of_lines = 1, MAX_NO_OF_LINES = 36;
/* Operator Mapping: 0xaa = '*' | 0xab = '+' | 0xac = ','
0xad = '-' | 0xae ='.' | 0xaf = '/' */
/* char op_mult=0xaa, op_plus=0xab, op_minus=0xad, op_dot=0xae, op_div=0xaf; */
char op_mult='*', op_plus='+', op_minus='-', op_dot='.', op_div='/';
crtident = 2 + ident * 2;
bprintf("%*s%s = ", crtident, "", ls);
start = strlen( ls ) + 2;
linelg = 120 - crtident - start - 1; /* F90 max line length is 132 */
first = 1;
while( strlen(rs) > linelg ) {
ifound = 0; jfound = 0;
if ( number_of_lines >= MAX_NO_OF_LINES ) {
/* If a new line needs to be started.
Note: the approach below will create erroneous code if the +/- is within a subexpression, e.g. for
A*(B+C) one cannot start a new continuation line by splitting at the + sign */
for( j=linelg; j>5; j-- ) /* split row here if +, -, or comma */
if ( ( rs[j] == op_plus )||( rs[j] == op_minus )||( rs[j]==',' ) ) {
jfound = 1; i=j; break;
}
}
if ( ( number_of_lines < MAX_NO_OF_LINES )||( !jfound ) ) {
for( i=linelg; i>10; i-- ) /* split row here if operator or comma */
if ( ( rs[i] & 0x80 )||( rs[i]==',' ) ) {
ifound = 1; break;
}
if( i <= 10 ) {
printf("\n Warning: double-check continuation lines for:\n %s = %s\n",ls,rs);
i = linelg;
}
}
while ( rs[i-1] & 0x80 ) i--; /* put all operators on the next row */
while ( rs[i] == ',' ) i++; /* put commas on the current row */
c = rs[i];
rs[i] = 0;
if ( first ) { /* first line in a split row */
bprintf("%s", rs );
linelg++;
first = 0;
} else {/* continuation line in a split row - but not last line*/
bprintf("&\n %*s&%s", start, "", rs );
if ( jfound ) {
bprintf("\n%*s%s = %s", crtident, "", ls, ls);
number_of_lines = 1;
}
}
rs[i] = c;
rs += i; /* jump to the first not-yet-written character */
number_of_lines++;
}
if ( number_of_lines > MAX_NO_OF_LINES ) {
printf("\n Warning: %d continuation lines for %s = ...",number_of_lines,ls);
}
if ( first ) bprintf("%s\n", rs ); /* non-split row */
else bprintf("&\n %*s&%s\n", start, "", rs ); /* last line in a split row */
FlushBuf();
}
void F90_DeclareDataOld( int v, int * values, int n )
{
int i, j;
int nlines, min, max;
int split;
VARIABLE *var;
int * ival;
double * dval;
char **cval;
int maxCols = MAX_COLS;
char dsbuf[55];
var = varTable[ v ];
ival = (int*) values;
dval = (double*) values;
cval = (char**) values;
nlines = 1;
min = max = 1;
split = 0;
switch( var->type ) {
case VELM: if( n <= 0 ) break;
for( i = 0; i < n; i++ ) {
switch( var->baseType ) {
case INT: bprintf( "%3d", ival[i] ); maxCols=12; break;
case DOUBLE:
case REAL:bprintf( "%5lg", dval[i] ); maxCols=8; break;
case STRING:bprintf( "'%s'", cval[i] ); maxCols=5; break;
case DOUBLESTRING:
strncpy( dsbuf, cval[i], 54 ); dsbuf[54]='\0';
bprintf( "'%48s'", dsbuf ); maxCols=1; break;
}
if( ( (i+1) % 12 == 0 ) && ( nlines > MAX_LINES ) ) {
split = 1; nlines = 1;
F90_WriteVecData( var, min, max, split );
min = max + 1;
}
else {
if( i < n-1 ) bprintf( "," );
if( (i+1) % maxCols == 0 ) {
bprintf( "\n%5s", " " );
nlines++;
}
}
max ++;
}
F90_WriteVecData( var, min, max-1, split );
break;
case ELM: bprintf( "%6sdata %s / ", " ", var->name );
switch( var->baseType ) {
case INT: bprintf( "%d", *ival ); break;
case DOUBLE:
case REAL:bprintf( "%lg", *dval ); break;
case STRING:bprintf( "'%s'", *cval ); break;
case DOUBLESTRING:
strncpy( dsbuf, *cval, 54 ); dsbuf[54]='\0';
bprintf( "'%s'", dsbuf ); maxCols=1; break;
/* bprintf( "'%50s'", *cval ); break; */
}
bprintf( " / \n" );
FlushBuf();
break;
default:
printf( "\n Function not defined !\n" );
break;
}
}
VOID
Thread (
IN PVOID Context
)
{
PDEVICE_OBJECT DeviceObject;
PDEVICE_EXTENSION deviceExtension;
PLIST_ENTRY request;
PIRP Irp;
PIO_STACK_LOCATION currentIrpStack;
PIO_STACK_LOCATION nextIrpStack;
DWORD dwStartSec;
DWORD dwLength;
PVOID pBuffer;
NTSTATUS status;
DWORD dwRetVal;
BOOL bReadSys;
PBLK_MOVER_PARAM pParam;
DIOC_REGISTERS *pRegs;
PREAD_WRITE_BUFFER pReadWriteBuffer;
KIRQL Irql;
// PAGED_CODE();
ASSERT(Context != NULL);
DeviceObject = (PDEVICE_OBJECT) Context;
deviceExtension = (PDEVICE_EXTENSION) DeviceObject->DeviceExtension;
KeSetPriorityThread(KeGetCurrentThread(),HIGH_PRIORITY);//LOW_REALTIME_PRIORITY);// HIGH_PRIORITY);
while(TRUE)
{
KeWaitForSingleObject(
&deviceExtension->request_event,
Executive,
KernelMode,
FALSE,
NULL
);
ASSERT(KeGetCurrentIrql() == PASSIVE_LEVEL);
if (deviceExtension->terminate_thread)
{
PsTerminateSystemThread(STATUS_SUCCESS);
}
while (request = ExInterlockedRemoveHeadList(
&deviceExtension->list_head,
&deviceExtension->list_lock
))
{
Irp = CONTAINING_RECORD(request, IRP, Tail.Overlay.ListEntry);
currentIrpStack = IoGetCurrentIrpStackLocation(Irp);
nextIrpStack = IoGetNextIrpStackLocation(Irp);
ASSERT(KeGetCurrentIrql() == PASSIVE_LEVEL);
switch (currentIrpStack->MajorFunction)
{
case IRP_MJ_READ:
case IRP_MJ_WRITE:
pBuffer = MmGetSystemAddressForMdlSafe(Irp->MdlAddress,NormalPagePriority);
dwLength = currentIrpStack->Parameters.Read.Length/SECTOR_SIZE;
dwStartSec = (DWORD)(currentIrpStack->Parameters.Read.ByteOffset.QuadPart/SECTOR_SIZE);
status = BlkMoverRelocateReadWrite(DeviceObject,currentIrpStack->MajorFunction,dwStartSec,dwLength,pBuffer);
//ASSERT(status == STATUS_SUCCESS);
Irp->IoStatus.Status = status;
Irp->IoStatus.Information = dwLength*SECTOR_SIZE;
break;
case IRP_MJ_DEVICE_CONTROL:
switch (currentIrpStack->Parameters.DeviceIoControl.IoControlCode)
{
case IOCTL_YG_BLOCK_MOVER_FLUSH_BUFFER:
pRegs = (DIOC_REGISTERS *)Irp->AssociatedIrp.SystemBuffer;
pRegs->reg_EAX = TRUE;
status = FlushBuf(g_pMoverData->DeviceObject);
Irp->IoStatus.Status = status;
Irp->IoStatus.Information = sizeof(DIOC_REGISTERS);
break;
case IOCTL_YG_BLOCK_MOVING_GROUP_CURRENT:
pRegs = (DIOC_REGISTERS *)Irp->AssociatedIrp.SystemBuffer;
g_MovingGroup.bFront = pRegs->reg_EAX;
g_MovingGroup.dwSStart = pRegs->reg_EBX;
g_MovingGroup.dwTStart = pRegs->reg_ECX;
g_MovingGroup.dwSize = pRegs->reg_EDX;
g_MovingGroup.dwMovedSize = 0;
g_dwMovedRecNum = pRegs->reg_EDI;
g_pMoverData->bWorking = TRUE;
pRegs->reg_EAX = TRUE;
Irp->IoStatus.Status = STATUS_SUCCESS;
Irp->IoStatus.Information = sizeof(DIOC_REGISTERS);
break;
case IOCTL_YG_GET_MOVED_SECTORS:
pRegs = (DIOC_REGISTERS *)Irp->AssociatedIrp.SystemBuffer;
pRegs->reg_EAX = g_dwMovedSecs;
Irp->IoStatus.Status = STATUS_SUCCESS;
Irp->IoStatus.Information = sizeof(DIOC_REGISTERS);
break;
case IOCTL_YG_READ:
pReadWriteBuffer = (PREAD_WRITE_BUFFER)Irp->AssociatedIrp.SystemBuffer;
dwLength = pReadWriteBuffer->dwLength;
pBuffer = MmGetSystemAddressForMdlSafe(Irp->MdlAddress,NormalPagePriority);
dwStartSec = pReadWriteBuffer->dwStartSec;
if (pReadWriteBuffer->dwMovedRecNum == YGBLK_READ_WRITE)
{
status = BlkMoverRelocateReadWrite(DeviceObject,IRP_MJ_READ,dwStartSec,dwLength,pBuffer);
}
else
{
status = SyncReadWriteSec(DeviceObject,dwStartSec,dwLength ,pBuffer ,IRP_MJ_READ);
}
MmUnlockPages(Irp->MdlAddress);
IoFreeMdl(Irp->MdlAddress);
Irp->MdlAddress = NULL;
Irp->IoStatus.Status = STATUS_SUCCESS;
Irp->IoStatus.Information = sizeof(READ_WRITE_BUFFER);
break;
case IOCTL_YG_WRITE:
pReadWriteBuffer = (PREAD_WRITE_BUFFER)Irp->AssociatedIrp.SystemBuffer;
dwLength = pReadWriteBuffer->dwLength;
pBuffer = MmGetSystemAddressForMdlSafe(Irp->MdlAddress,NormalPagePriority);
dwStartSec = pReadWriteBuffer->dwStartSec;
if (pReadWriteBuffer->dwMovedRecNum == YGBLK_READ_WRITE)
{
status = BlkMoverRelocateReadWrite(DeviceObject,IRP_MJ_WRITE,dwStartSec,dwLength,pBuffer);
}
else
{
status = SyncReadWriteSec(DeviceObject,dwStartSec,dwLength ,pBuffer ,IRP_MJ_WRITE);
}
MmUnlockPages(Irp->MdlAddress);
IoFreeMdl(Irp->MdlAddress);
Irp->MdlAddress = NULL;
if (pReadWriteBuffer->dwMovedRecNum != YGBLK_READ_WRITE)
{
if(!pReadWriteBuffer->bSys && g_dwDataRecNum)
{
//g_dwMovedRecNum = pReadWriteBuffer->dwMovedRecNum;
g_MovingGroup.dwMovedSize += dwLength;
}
if(g_bReLocate && pReadWriteBuffer->bSys)
g_dwRePointer = pReadWriteBuffer->dwStartSec + dwLength;
}
Irp->IoStatus.Status = STATUS_SUCCESS;
Irp->IoStatus.Information = sizeof(READ_WRITE_BUFFER);
break;
default:
Irp->IoStatus.Status = STATUS_DRIVER_INTERNAL_ERROR;
Irp->IoStatus.Information = 0;
}
break;
default:
DbgPrint("BlkMover:Thread default conditions.");
Irp->IoStatus.Status = STATUS_DRIVER_INTERNAL_ERROR;
Irp->IoStatus.Information = 0;
}
IoCompleteRequest(Irp,
(CCHAR) (NT_SUCCESS(Irp->IoStatus.Status) ?
IO_DISK_INCREMENT : IO_NO_INCREMENT));
}
}
}
char * F90_DeclareData( int v, void * values, int n)
{
int i, j;
int nlines;
int split;
static char buf[120];
VARIABLE *var;
int * ival;
double * dval;
char ** cval;
char *baseType;
char maxi[20];
char maxj[20];
int maxCols = MAX_COLS;
char dsbuf[200];
int i_from, i_to;
int isplit;
int splitsize;
int maxi_mod;
int maxi_div;
char mynumber[30];
var = varTable[ v ];
ival = (int*) values;
dval = (double *) values;
cval = (char **) values;
nlines = 1;
split = 0;
var -> maxi = max( n, 1 );
baseType = F90_types[ var->baseType ];
*buf = 0;
switch( var->type ) {
case ELM:
bprintf( " %s :: %s = ", baseType, var->name );
switch ( var->baseType ) {
case INT: bprintf( "%d", *ival ); break;
case DOUBLE: bprintf( "%f", *dval); break;
case REAL: bprintf( "%lg", *dval ); break;
case STRING: bprintf( "'%3s'", *cval ); break;
}
break;
case VELM:
/* define maxCols here already and choose suitable splitsize */
switch( var -> baseType ) {
case INT: maxCols =12; break;
case DOUBLE: maxCols = 5; break;
case REAL: maxCols = 5; break;
case STRING: maxCols = 3; break;
case DOUBLESTRING: maxCols = 1; break;
}
splitsize = 30 * maxCols; /* elements = lines * columns */
maxi_mod = var->maxi % splitsize;
maxi_div = var->maxi / splitsize;
/* correction if var->maxi is a multiple of splitsize */
if ( (maxi_div>0) && (maxi_mod==0) ) {
maxi_mod = splitsize;
maxi_div--;
}
for ( isplit=0; isplit <= maxi_div; isplit++ ) {
if( var->maxi > 0 ) sprintf( maxi, "%d", var->maxi );
else sprintf( maxi, "%s", varTable[ -var->maxi ]->name );
if( (var->maxi == 0) ||
((var->maxi < 0) && (varTable[ -var->maxi ]->maxi == 0)) )
strcat( maxi, "+1");
bprintf( " %s, " , baseType);
if( n>0 ) bprintf( "PARAMETER, " ); /* if values are assigned now */
if ( maxi_div==0 ) { /* define array in one piece */
bprintf( "DIMENSION(%s) :: %s",
maxi, var->name) ;
} else {/* define partial arrays */
if ( isplit==maxi_div ) { /* last part has size maxi_mod */
bprintf( "DIMENSION(%d) :: %s_%d",
maxi_mod, var->name, isplit) ;
} else { /* all other parts have size splitsize */
bprintf( "DIMENSION(%d) :: %s_%d",
splitsize, var->name, isplit) ;
}
}
if( n<=0 ) break;
/* now list values */
bprintf( " = (/ &\n " );
/* if the array is defined in one piece, then the for loop will
go from 0 to n. Otherwise, there will be partial arrays from
i_from to i_to which are of size splitsize except for the
last one which is usually smaller and contains the rest */
i_from = isplit * splitsize;
i_to = min(i_from+splitsize,n);
for ( i=i_from; i < i_to; i++ ) {
switch( var -> baseType ) {
case INT:
bprintf( "%3d", ival[i] ); break;
case DOUBLE:
/* bprintf( "%4f", dval[i] ); maxCols = 5; break; */
sprintf(mynumber, "%12.6e_dp",dval[i]);
/* mynumber[ strlen(mynumber)-4 ] = 'd'; */
bprintf( " %s", mynumber ); break;
case REAL:
bprintf( "%12.6e", dval[i] ); break;
case STRING:
bprintf( "'%-15s'", cval[i] ); break;
case DOUBLESTRING:
/* strncpy( dsbuf, cval[i], 54 ); dsbuf[54]='\0'; */
/* bprintf( "'%48s'", dsbuf ); break; */
bprintf( "'%-100.100s'", cval[i] ); break;
}
if( i < i_to-1 ) {
bprintf( "," );
if( (i+1) % maxCols == 0 ) {
bprintf( " &\n " );
nlines++;
}
}
}
bprintf( " /)\n" );
/* mz_rs added FlushBuf, otherwise MAX_OUTBUF would have to be very large */
FlushBuf();
}
/* combine the partial arrays */
if ( maxi_div != 0 ) {
bprintf( " %s, PARAMETER, DIMENSION(%s) :: %s = (/&\n ",
baseType, maxi, var->name) ;
for ( isplit=0; isplit <= maxi_div; isplit++ ) {
bprintf( "%s_%d", var->name, isplit) ;
if( isplit < maxi_div ) { /* more parts will follow */
bprintf( ", " );
/* line break after 5 variables */
if( (isplit+1) % 5 == 0 ) bprintf( "&\n " );
} else { /* after last part */
bprintf( " /)\n" );
}
}
}
break;
case MELM: if( var->maxi > 0 ) sprintf( maxi, "%d", var->maxi );
else sprintf( maxi, "%s", varTable[ -var->maxi ]->name );
if( (var->maxi == 0) ||
((var->maxi < 0) && (varTable[ -var->maxi ]->maxi == 0)) )
strcat( maxi, "+1");
if( var->maxj > 0 ) sprintf( maxj, "%d", var->maxj );
else sprintf( maxj, "%s", varTable[ -var->maxj ]->name );
if( (var->maxj == 0) ||
((var->maxj < 0 ) && (varTable[ -var->maxj ]->maxi == 0)) )
strcat( maxj, "+1");
sprintf( buf, "%s, DIMENSION(%s,%s) :: %s\n", /* changed here */
baseType, maxi, maxj,var->name );
break;
default:
printf( "Can not declare type %d", var->type );
break;
}
return buf;
}
