/***************************** LICENSE START ***********************************

 Copyright 2020- ECMWF and INPE. This software is distributed under the terms
 of the Apache License version 2.0. In applying this license, ECMWF does not
 waive the privileges and immunities granted to it by virtue of its status as
 an Intergovernmental Organization or submit itself to any jurisdiction.

 ***************************** LICENSE END *************************************/

#include "mars.h"

/* macro_api.h has no dependencies on mars.h */
#include "macro_api.h"

/* macro_api_internals.h hides Mars dependancies, it includes mars.h */
#include "macro_api_internals.h"

#include "VectorUtils.h"

/*=====================================

 Mars to external routines communication

 This file contains the implementation for:
 - the original Fortran interface routines ('MGET*'/'MSET*')
 - the second generation Fortran interface routines ('mfi_*')
   - except two routines implemented in file macro_api_f90.f90
   - internal Fortran interface routines ('mifi_*')
 - C/C++ interface functions ('mci_*')

=====================================*/

/* int mgetg_C( gribarg** g, int* c ); */

#ifdef FORTRAN_UPPERCASE
#define marscnt_ MARSCNT
#define marsarg_ MARSARG
#define marsret_ MARSRET
#define marsend_ MARSEND
#define marsout_ MARSOUT
#define gribnew_ GRIBNEW
#define gribcnt_ GRIBCNT
#define gribcopy_ GRIBCOPY
#define gribdata_ GRIBDATA
#define gribfile_ GRIBFILE
#define gribfree_ GRIBFREE
#define gribnext_ GRIBNEXT
#define gribsave_ GRIBSAVE
#define mfail_ MFAIL
#define mgetb_ MGETB
#define mgetg_ MGETG
#define mgeti_ MGETI
#define mgetm_ MGETM
#define mgetn2_ MGETN2
#define mgetn_ MGETN
#define mgets_ MGETS
#define mgetv_ MGETV
#define msetb_ MSETB
#define msetg_ MSETG
#define mseti_ MSETI
#define msetm_ MSETM
#define msetn2_ MSETN2
#define msetn_ MSETN
#define msets_ MSETS
#define msetv_ MSETV
#define mloadb_ MLOADB
#define mloadg_ MLOADG
#define mnewb_ MNEWB
#define mnewg_ MNEWG
#define mrewg_ MREWG
#endif


static int argc = 0;
static int argn = 0;
static arg* args = NULL;
static boolean sFirst = true;
static char* sName = NULL;
static char* sFile = NULL;


/* To avoid sending pointers back to the user program, we maintain a list of all
   gribarg pointers generated here and return indexes into our list instead.
*/

static fortint num_gribargs = 0;
static void** gribargs = NULL;


static fortint add_new_gribarg_pointer(void* new_gribarg_ptr)
{
    num_gribargs++;
    gribargs = realloc(gribargs, num_gribargs * sizeof(void*));
    gribargs[num_gribargs - 1] = new_gribarg_ptr;
    return num_gribargs - 1;
}

static void* get_gribarg_ptr_from_index(int index)
{
    return gribargs[index];
}


static fortint get_gribarg_index_from_ptr(void* ptr)
{
    fortint i;

    for (i = 0; i < num_gribargs; i++) {
        if (gribargs[i] == ptr)
            return i;
    }

    marslog(LOG_EXIT, "get_gribarg_index_from_ptr: pointer not found in list of %d pointers.", num_gribargs);
    return 0;
}


static void mout(int lvl, char* msg)
{
}

static void the_end(int code, void* data)
{
    printf("end is %d\n", code);
}

static void minit(void)
{
    int ac;
    char* av;
    request *r, *s;
    int i;

    if (!sFirst)
        return;

    sFirst = false;

    sFile = getenv("MREQUEST");
    sName = getenv("MNAME");

    ac = 1;
    av = strcache(sName ? sName : "external");

    marsinit(&ac, &av, 0, 0, 0);

    if (!sFile)
        marslog(LOG_EXIT, "Mars/Metview external environment not set");

    /* mars.outproc = mout; */

    argc = 0;
    argn = 0;
    s = r = read_request_file(sFile);
    while (s) {
        s = s->next;
        argc++;
    }

    /* empty file */
    fclose(fopen(sFile, "w"));

    if (argc == 0)
        return;

    args = NEW_ARRAY(arg, argc);
    i = 0;

    while (r) {
        const char* t = r->name;
        const char* v = get_value(r, "VALUE", 0);

        if (t == NULL)
            marslog(LOG_EXIT, "No data type");
        else if (EQ(t, "NUMBER")) {
            args[i].kind = 'N';
            args[i].u.dval = v ? atof(v) : 0.0;
        }
        else if (EQ(t, "STRING")) {
            args[i].kind = 'S';
            args[i].u.sval = strcache(v ? v : "");
        }
        else if (EQ(t, "GRIB")) {
            args[i].kind = 'G';
            args[i].u.rval = r;
        }
        else if (EQ(t, "BUFR")) {
            args[i].kind = 'B';
            args[i].u.rval = r;
        }
        else if (EQ(t, "IMAGE")) {
            args[i].kind = 'I';
            args[i].u.rval = r;
        }
        else if (EQ(t, "VECTOR")) {
            args[i].kind = 'V';
            args[i].u.rval = r;
        }
        else
            marslog(LOG_EXIT, "Unsupported type %s", t);

        r = r->next;
        i++;
    }

    /* install_exit_proc(the_end,NULL); */
}

static void mcheck(fortint* n, char kind, char* name)
{
    minit();

    if (*n == 0)
        *n = argn + 1;

    if (*n < 1 || *n > argc)
        marslog(LOG_EXIT,
                "Parameter %d is is out of range."
                " Only %d parameters where passed",
                *n, argc);
    if (args[*n - 1].kind != kind)
        marslog(LOG_EXIT, "Parameter %d is not of type %s", *n, name);

    argn = *n;
}


int write_vector_to_file(FILE* f, int size, double* values)
{
    size_t written;

    fprintf(f, "METVIEW_VECTOR");
    fprintf(f, "float64   ");                          /* hard-coded for now */
    fwrite(&size, sizeof(int), 1, f);                  /* write the number of values */
    written = fwrite(values, sizeof(double), size, f); /* write the values */
    fprintf(f, "METVIEW_VECTOR_END");

    if (written != size) {
        marslog(LOG_EXIT, "Tried to write %d elements - managed %d.", size, written);
    }

    return ferror(f);
}


static void getn(fortint n, double* d)
{
    mcheck(&n, 'N', "number");
    *d = args[n - 1].u.dval;
}

void mgetn_(fortfloat* f)
{
    double d;
    getn(0, &d);
    *f = d;
}

void mgetn2_(double* d)
{
    getn(0, d);
}

void mgetv_(fortint* s, fortfloat* v)
{
    fortint n = 0;
    int i, length;
    fortint size;
    request* r;
    double* vec;

    mcheck(&n, 'V', "vector"); /* ensure that next is a vector */
    r = args[n - 1].u.rval;

    read_vector_from_request(r, &vec, &length);
    size = (fortint)length;


    if (size > *s) {
        marslog(LOG_EROR, "MGETV: Fortran array too small, only %d first vector values returned", *s);
        size = *s;
    }

    /* convert to fortfloat */
    for (i = 0; i < size; ++i) {
        v[i] = (fortfloat)vec[i];
    }


    /* we are responsible for freeing the memory allocated by read_vector_from_request(). */

    if (vec)
        free(vec);

    *s = size;
}

void mgets_(char* s, fortint l_s)
{
    fortint n = 0;
    char* p;
    mcheck(&n, 'S', "string");
    p = args[n - 1].u.sval;
    n = strlen(p);
    memset(s, ' ', l_s);

    if (n > l_s) {
        marslog(LOG_EROR, "MGETS, string too small %d>%d",
                n, l_s);
        n = l_s;
    }

    strncpy(s, p, n);
}


static fieldset* getg(fortint n)
{
    mcheck(&n, 'G', "fieldset");
    /*-- we have to process one request at a time in case mgetg is called */
    /*-- more than once (in case there are several fieldset parameters)   */
    return request_to_fieldset(clone_one_request(args[n - 1].u.rval));
}


static int mgetg_C(gribarg** g, int* c)
{
    fieldset* v = getg(0);
    if (!v)
        return 1;

    *g = NEW_CLEAR(gribarg);
    *c = v->count;
    (*g)->v = v;
    return 0;
}

void mgetg_(fortint* g, fortint* c)
{
    fortint newga;
    gribarg* gc = NULL;
    int err = mgetg_C(&gc, (int*)c);
    if (err)
        marslog(LOG_EXIT, "MGETG, Cannot load grib file");


    newga = add_new_gribarg_pointer(gc);
    *g = newga;
}

static fieldset* geti(fortint n)
{
    mcheck(&n, 'I', "image");
    return request_to_fieldset(args[n - 1].u.rval);
}


void mfail_(char* msg, fortint l_msg);

void mnewb_()
{
    mfail_("MNEWB is not yet implemeted", 0);
}
void mgetb_()
{
    mfail_("MGETB is not yet implemeted", 0);
}
void msetb_()
{
    mfail_("MSETB is not yet implemeted", 0);
}
void mloadb_()
{
    mfail_("MLOADB is not yet implemeted", 0);
}
void msaveb_()
{
    mfail_("MSAVEB is not yet implemeted", 0);
}
void mgetm_()
{
    mfail_("MGETM is not yet implemeted", 0);
}
void msetm_()
{
    mfail_("MSETM is not yet implemeted", 0);
}

void mgeti_(fortint* g, fortint* c)
{
    fortint newga;
    fieldset* v = geti(0);
    gribarg* a = NEW_CLEAR(gribarg);
    if (!v) {
        marslog(LOG_EXIT, "MGETI, Cannot load image file");
    }
    else {
        *c = v->count;
        a->v = v;
        newga = add_new_gribarg_pointer(a);
        *g = newga;
    }
}

void mloadg_(fortint* g, char* p, fortint* c)
{
    gribarg* a = (gribarg*)(get_gribarg_ptr_from_index(*g));
    fieldset* v = a->v;
    int i = a->cnt++;
    long int msg_len = (*c) * sizeof(fortint);

    minit();

    if (i < 0 || i >= v->count)
        marslog(LOG_EXIT, "MLOADG, No more fields");


    if ((*c) * sizeof(fortint) < v->fields[i]->length)
        marslog(LOG_EXIT, "MLOADG, Buffer too small %d words (should be %d words)",
                *c, (v->fields[i]->length + (sizeof(fortint) - 1)) / sizeof(fortint));

    if (a->f == NULL || a->file != v->fields[i]->file->fname) {
        if (a->f)
            fclose(a->f);
        strfree(a->file);
        a->file = strcache(v->fields[i]->file->fname);
        a->f = fopen(a->file, "r");
        if (a->f == NULL)
            marslog(LOG_EXIT | LOG_PERR, "MLOADG, cannot open %s", a->file);
    }

    if (fseek(a->f, v->fields[i]->offset, 0) < 0)
        marslog(LOG_EXIT | LOG_PERR, "MLOADG, cannot position to grib");

    if (_readany(a->f, p, &msg_len))
        marslog(LOG_EXIT | LOG_PERR, "MLOADG, cannot read grib");

    v->fields[i]->length = msg_len;
}

void mnewg_(fortint* g)
{
    fortint newga;
    gribarg* a;
    minit();
    a = NEW_CLEAR(gribarg);
    newga = add_new_gribarg_pointer(a);
    *g = newga;
}

void mrewg_(fortint* g) /*-- mrewg: rewind fieldset (warning: no checks done!) --*/
{
    gribarg* a = (gribarg*)(get_gribarg_ptr_from_index(*g));
    a->cnt = 0;
}

/* here *c gives the length of GRIB msg in Fortran integers */
void msaveg_(fortint* g, char* p, fortint* c)
{
    fortint c2bytes = (*c) * sizeof(fortint);
    msavebyteg_(g, p, &c2bytes);
}

/* here *c gives the length of GRIB msg in bytes (chars) */
void msavebyteg_(fortint* g, char* p, fortint* c)
{
    gribarg* a = (gribarg*)(get_gribarg_ptr_from_index(*g));
    fortint j, length, pad;
    char x;
    minit();

    if (a->f == NULL) {
        a->file = strcache(marstmp());
        a->f = fopen(a->file, "w");
        if (a->f == NULL)
            marslog(LOG_EXIT | LOG_PERR, "MSAVEG: Cannot open %s", a->file);
    }

    length = *c;
    pad = ((length + 119) / 120) * 120 - length;

    if (fwrite(p, 1, length, a->f) != length)
        marslog(LOG_EXIT | LOG_PERR, "MSAVEG: Error while writing to disk");

    x = 0;
    for (j = 0; j < pad; j++)
        if (fwrite(&x, 1, 1, a->f) != 1)
            marslog(LOG_EXIT | LOG_PERR, "MSAVEG: Error while writing to disk");
}

void msetg_(fortint* g)
{
    gribarg* a = (gribarg*)(get_gribarg_ptr_from_index(*g));
    FILE* f;

    minit();

    if (a->f)
        fclose(a->f);
    a->f = NULL;

    f = fopen(sFile, "a+");
    fprintf(f, "GRIB,TEMPORARY=1,PATH='%s'\n",
            a->file);
    fclose(f);
}

void mseti_(fortint* g)
{
    gribarg* a = (gribarg*)(get_gribarg_ptr_from_index(*g));
    FILE* f;

    minit();

    if (a->f)
        fclose(a->f);
    a->f = NULL;

    f = fopen(sFile, "a+");
    fprintf(f, "IMAGE,TEMPORARY=1,PATH='%s'\n",
            a->file);
    fclose(f);
}

void msets_(char* s, fortint l_s)
{
    FILE* f;
    int space = 0;
    minit();
    f = fopen(sFile, "a+");
    fprintf(f, "STRING,VALUE=\"");

    space = 0;

    while (*s && l_s--) {
        if (*s == '"' || *s == '\\')
            fputc('\\', f);
        if (*s == ' ')
            space++;
        else {
            while (space-- > 0)
                fputc(' ', f);
            fputc(*s, f);
        }
        s++;
    }
    fprintf(f, "\"\n");
    fclose(f);
}

void msetn2_(double* d)
{
    FILE* f;
    minit();
    f = fopen(sFile, "a+");
    fprintf(f, "NUMBER,VALUE=%g\n", *d);
    fclose(f);
}

void msetn_(fortfloat* f)
{
    double d = *f;
    msetn2_(&d);
}

void msetv_(fortint* s, fortfloat* v)
{
    FILE* f;
    fortint i;

    minit();

    f = fopen(sFile, "a+");

    fprintf(f, "VECTOR,SIZE=%d,VALUES=", *s);
    if (*s > 0) {
        for (i = 0; i < *s; ++i) {
            fprintf(f, "%g", (double)v[i]);
            if ((i + 1) < *s)
                fprintf(f, "/");
        }
    }
    else {
        fprintf(f, "0");
    }
    fprintf(f, "\n");

    fclose(f);
}

void mfail_(char* msg, fortint l_msg)
{
    char buf[512]; /* no '\0' in Fortran strings! */
    size_t len = l_msg < 512 ? l_msg : 511;
    strncpy(buf, msg, len);
    buf[len] = '\0'; /* make sure we have terminating null */

    minit();

    marslog(LOG_EXIT, "%s", buf);
}

void margs_(fortint* cnt, char* types, fortint l_types)
{
    int i, n;

    minit();
    *cnt = argc;

    memset(types, 0, l_types);
    n = argc;

    if (n > l_types) {
        marslog(LOG_EROR, "MARGS, string to small %d>%d",
                n, l_types);
        n = l_types;
    }

    for (i = 0; i < n; i++)
        types[i] = args[i].kind;
}


/* Versions with no underscore */
void mgetn(fortfloat* f)
{
    mgetn_(f);
}
void mgetn2(double* d)
{
    mgetn2_(d);
}
void msetn2(double* d)
{
    msetn2_(d);
}
void msetn(fortfloat* f)
{
    msetn_(f);
}

void mgets(char* s, fortint l_s)
{
    mgets_(s, l_s);
}
void msets(char* s, fortint l_s)
{
    msets_(s, l_s);
}

void mgetg(fortint* g, fortint* c)
{
    mgetg_(g, c);
}
void mloadg(fortint* g, char* p, fortint* c)
{
    mloadg_(g, p, c);
}
void mnewg(fortint* g)
{
    mnewg_(g);
}
void mrewg(fortint* g)
{
    mrewg_(g);
}
void msaveg(fortint* g, char* p, fortint* c)
{
    msaveg_(g, p, c);
}
void msavebyteg(fortint* g, char* p, fortint* c)
{
    msavebyteg_(g, p, c);
}
void msetg(fortint* g)
{
    msetg_(g);
}

void mgetv(fortint* s, fortfloat* v)
{
    mgetv_(s, v);
}
void msetv(fortint* s, fortfloat* v)
{
    msetv_(s, v);
}

void mgeti(fortint* g, fortint* c)
{
    mgeti_(g, c);
}
void mseti(fortint* g)
{
    mseti_(g);
}

void mfail(char* msg, fortint l_msg)
{
    mfail_(msg, l_msg);
}

void margs(fortint* cnt, char* types, fortint l_types)
{
    margs_(cnt, types, l_types);
}

void mnewb(void)
{
    mnewb_();
}
void mgetb(void)
{
    mgetb_();
}
void msetb(void)
{
    msetb_();
}
void mloadb(void)
{
    mloadb_();
}
void msaveb(void)
{
    msaveb_();
}

void mgetm(void)
{
    mgetm_();
}
void msetm(void)
{
    msetm_();
}


/*=====================================

 Macro to external C/C++ routines communication: 'mci_*'

=====================================*/


double
mci_get_number()
{
    double d;
    mgetn2_(&d);
    return d;
}
void mci_return_number(double d)
{
    msetn2_(&d);
}

/*----------------------------------------------------------==
**
**  WARNING: Memory for the string is reused for each call to this function!!!
*/
const char*
mci_get_string()
{
    static char* strbuf = 0;
    static int sbuflen = 0;
    fortint n = 0;
    char* p;

    mcheck(&n, 'S', "string");
    p = args[n - 1].u.sval;
    n = strlen(p);

    if ((n + 1) > sbuflen) {
        free(strbuf);
        sbuflen = n + 1;
        strbuf = (char*)malloc(sbuflen);
    }

    if (strbuf) {
        strcpy(strbuf, p);
    }

    return strbuf;
}
void mci_return_string(const char* s)
{
    msets_((char*)s, strlen(s));
}

/*----------------------------------------------------------==
**
**  NOTE: Memory for the vector is allocated here,
**        but freeing it is up to the calling pgm!!!
*/
void mci_get_vector(double** vec, int* length)
{
    fortint n = 0;
    int size, i;
    request* r;
    const char* c;
    const char* path;
    double* v;
    FILE* f;
    char buf[20] = "";
    int read;

    mcheck(&n, 'V', "vector"); /* ensure that next is a vector */
    r = args[n - 1].u.rval;

    read_vector_from_request(r, vec, length);
}

void mci_return_vector(double* vec, int length)
{
    FILE* f;
    int i;
    char* path;
    FILE* fv;

    minit();

    f = fopen(sFile, "a+"); /* append to the return request file */

    path = marstmp();
    fv = fopen(path, "w");

    if (fv) {
        write_vector_to_file(fv, length, vec);
        fprintf(f, "VECTOR,TEMPORARY=1,PATH='%s'\n", path);
    }

    fprintf(f, "\n");

    fclose(f); /* close the return request file */
}

/*----------------------------------------------------------==
**
**  NOTE: Memory for the fieldset ptr is allocated here,
**        but freeing it is up to the calling pgm!!!
*/
void* mci_get_fieldset(int* field_count)
{
    gribarg* ga = (gribarg*)malloc(sizeof(gribarg));
    if (mgetg_C(&ga, field_count) != 0) {
        field_count = 0;
        if (ga) {
            free(ga);
        }
        marslog(LOG_EROR, "mci_get_fieldset: next parameter is not a fieldset!");
        return NULL;
    }

    add_new_gribarg_pointer(ga);

    return (void*)ga;
}

#ifdef MV_ALLOW_DEPRECATED_MCI_NAMES
void* mci_get_grib_id_ptr(int* field_count)
{
    marslog(LOG_WARN, "'mci_get_grib_id_ptr' is deprecated, use 'mci_get_fieldset'");
    return mci_get_fieldset(field_count);
}
#endif

/*
**  NOTE: Memory for the grib handle is allocated here,
**        but freeing it is up to the calling pgm!!!
*/
grib_handle*
mci_load_one_grib(void* fieldset_ptr)
{
    gribarg* ga = (gribarg*)fieldset_ptr;
    char* grib_msg = NULL;
    field* cur_msg = NULL;
    long int msg_len = 0;
    grib_handle* gh;
    fieldset* fs;
    int fi;
    FILE* f;

    if (!ga) /* ensure fieldset exists */
    {
        marslog(LOG_EROR, "mci_load_one_grib: fieldset_ptr is NULL");
        return NULL;
    }

    fs = ga->v;
    fi = ga->cnt++; /*-- field index for the next field (in the fieldset) --*/

    minit(); /* ensure input request stuff is initialised */

    if (fi < 0 || fi >= fs->count) /* ensure a field exists */
    {
        marslog(LOG_EROR, "mci_load_one_grib: no more fields");
        return NULL;
    }

    cur_msg = fs->fields[fi];
    msg_len = cur_msg->length; /* get msg length and allocate memory */

    grib_msg = (char*)malloc(msg_len * sizeof(char));

    f = fopen(cur_msg->file->fname, "r"); /* ensure file exists */
    if (!f)
        marslog(LOG_EXIT | LOG_PERR, "mci_load_one_grib: unable to open GRIB file");

    if (fseek(f, cur_msg->offset, 0) < 0) /* skip to the current field */
        marslog(LOG_EXIT | LOG_PERR, "mci_load_one_grib: cannot position to GRIB file");

    if (_readany(f, grib_msg, &msg_len)) /* read current field */
        marslog(LOG_EXIT | LOG_PERR, "mci_load_one_grib: cannot read GRIB file");

    fclose(f); /* close fieldset file */

    /*-- grib handle to be returned, must be free'd by the calling pgm --*/
    gh = grib_handle_new_from_message_copy(NULL, grib_msg, msg_len);

    free(grib_msg);

    return gh;
}

void mci_rewind_fieldset(void* fieldset)
{
    fortint index;
    index = get_gribarg_index_from_ptr(fieldset);
    mrewg_(&index);
}

#ifdef MV_ALLOW_DEPRECATED_MCI_NAMES
void mci_rewind_grib(void* fieldset_ptr)
{
    marslog(LOG_WARN, "'mci_rewind_grib' is deprecated, use 'mci_rewind_fieldset'");
    mci_rewind_fieldset(fieldset_ptr);
}
#endif

/*
**  NOTE: Memory for the grib id ptr is allocated here,
**        but freeing it is up to the calling pgm!!!
*/
void* mci_new_fieldset()
{
    /*gribarg* a = (gribarg*)malloc( sizeof(gribarg) );*/
    fortint a;
    mnewg_(&a);
    gribarg* ga = (gribarg*)get_gribarg_ptr_from_index(a);
    return (void*)ga;
}

#ifdef MV_ALLOW_DEPRECATED_MCI_NAMES
void* mci_new_grib_id_ptr()
{
    marslog(LOG_WARN, "'mci_new_grib_id_ptr' is deprecated, use 'mci_new_fieldset'");
    return mci_new_fieldset();
}
#endif

void mci_save_grib(void* fieldset_ptr, grib_handle* gh)
{
    /* writes a GRIB msg into fieldset created by 'mci_new_fieldset' */
    const void* buffer = NULL;
    size_t size = 0;
    int err = 0;
    fortint sizeint = 0;

    /* get the coded message in a buffer */
    err = grib_get_message(gh, &buffer, &size);
    if (err)
        marslog(LOG_EXIT | LOG_PERR, "mci_save_grib: error in 'grib_get_message': %d!", err);

    fortint index = get_gribarg_index_from_ptr(fieldset_ptr);

    sizeint = size; /* we need to pass it as a fortint */
    msavebyteg_(&index, (char*)buffer, (fortint*)&sizeint);
}

void mci_return_fieldset(void* fieldset)
{
    fortint index = get_gribarg_index_from_ptr(fieldset);
    msetg_(&index); /* append return request with output fieldset params */
}

#ifdef MV_ALLOW_DEPRECATED_MCI_NAMES
void mci_return_grib(void* grib_id_ptr)
{
    marslog(LOG_WARN, "'mci_return_grib' is deprecated, use 'mci_return_fieldset'");
    mci_return_fieldset(grib_id_ptr);
}
#endif


/*----------------------------------------------------------*/

int mci_arg_count()
{
    minit();
    return argc; /* return argument count */
}

const char*
mci_args()
{
#define cBufMax 64

    static int tbuflen = 0;
    static char typesbuf[cBufMax];
    int i;

    if (tbuflen == 0) {
        minit();

        tbuflen = argc > cBufMax ? cBufMax - 1 : argc;

        for (i = 0; i < tbuflen; i++)
            typesbuf[i] = args[i].kind; /* add a corresponding letter to output string */

        typesbuf[tbuflen] = '\0'; /* terminate output string */
    }

    return typesbuf; /* return the string of argument type letters */
}

void mci_fail(const char* msg)
{
    mfail_((char*)msg, strlen(msg)); /* issue error msg and exit! */
}

/*-------------------------------------     m f i _     ---------------------------------*/

/*-------------------------------------------------------- mfi-number
 */
void mfi_get_number_(fortfloat* d)
{
    *d = mci_get_number();
}

void mfi_return_number_(fortfloat* d)
{
    mci_return_number(*d);
}

/*-------------------------------------------------------- mfi-string
 */
void mfi_get_string_(char* s, fortint s_len)
{
    int i = 0;
    const char* c_str = mci_get_string(); /* get a C string + memory! */

    strncpy(s, c_str, s_len); /* use strncpy for safety */

    /* Fortran strings do not use the terminating null
     * character, so we need to remove it and fill the
     * rest with spaces (if 's' longer than 'str'), i.e.
     * we need to convert the C string to a Fortran string:
     */
    if (strlen(c_str) < s_len) /* append spaces... */
    {
        for (i = s_len; i > strlen(c_str); --i)
            s[i - 1] = ' ';
    }
    else if (strlen(c_str) > s_len) /* ...unless a string overflow */
    {
        marslog(LOG_EROR, "mfi_get_string: string too long: %d chars", strlen(c_str));
        marslog(LOG_EROR, "mfi_get_string: got only the first %d chars", s_len);
    }
}

void mfi_return_string_(char* s, fortint s_len)
{
    /* Fortran string 's' does not contain the terminating
     * null character, so we need to add it, i.e.
     * we need to convert the Fortran string to a C string:
     */
    char* str = (char*)malloc(s_len + 1); /* temporary only */
    strncpy(str, s, s_len);               /* need to use 'strncpy' */
    str[s_len] = '\0';                    /* add the terminator */

    mci_return_string(str); /* return as a C string */

    free(str); /* not needed anymore */
}

/*-------------------------------------------------------- mfi-vector
 */
void mfi_get_vector_(double* vec, int* length)
{
    double* v;
    int l, i;

    mci_get_vector(&v, &l); /* also allocates memory for 'v' */

    if (l > *length) /* check that 'vec' is long enough */
    {
        marslog(LOG_EROR, "mfi_get_vector: vector too long: it has %d elems", l);
        marslog(LOG_EROR, "mfi_get_vector: got only the first %d elements", *length);
        l = *length;
    }

    for (i = 0; i < l; ++i)
        vec[i] = v[i]; /* copy values to Fortran array */
    *length = l;

    free(v); /* free the allocated memory */
}

void mfi_return_vector_(double* vec, int* length)
{
    mci_return_vector(vec, *length);
}

/*-------------------------------------------------------- mfi-fieldset
 */


/* To avoid sending pointers back to the user program, we maintain a list of all
   fieldset_id pointers generated here and return indexes into our list instead.
*/

static int num_fieldsets = 0;
static void** fieldsets = NULL;

static int add_new_mfi_fieldset_pointer(void* new_fieldset_id)
{
    num_fieldsets++;
    fieldsets = realloc(fieldsets, num_fieldsets * sizeof(void*));
    fieldsets[num_fieldsets - 1] = new_fieldset_id;
    return num_fieldsets - 1;
}

static void* get_fieldset_id_ptr_from_index(fortint index)
{
    return fieldsets[index];
}


void mfi_get_fieldset_(fortint* fieldset_id, fortint* field_count)
{
    int fc = 0;
    void* new_id_ptr = mci_get_fieldset(&fc);
    int new_id = add_new_mfi_fieldset_pointer(new_id_ptr);
    *fieldset_id = new_id;
    *field_count = fc;
}

void mfi_rewind_fieldset_(fortint* fieldset_id_index)
{
    mci_rewind_fieldset(get_fieldset_id_ptr_from_index(*fieldset_id_index));
}


void mfi_new_fieldset_(fortint* fieldset_id)
{
    void* new_id_ptr = mci_new_fieldset();
    *fieldset_id = add_new_mfi_fieldset_pointer(new_id_ptr);
}

void mfi_return_fieldset_(fortint* fieldset_id_index)
{
    mci_return_fieldset(get_fieldset_id_ptr_from_index(*fieldset_id_index));
}


/*-------------------------------------------------------- mfi-misc
 */

void mfi_args_(fortint* c, char* a, fortint s_len)
{
    /* about Fortran strings: see mfi_get_string_ and mfi_return_string_ */

    int i = 0;
    const char* c_str = mci_args(); /* get args as C string   */
    *c = mci_arg_count();           /* equal to strlen(c_str) */

    strncpy(a, c_str, s_len); /* copy to Fortran string */

    if (strlen(c_str) < s_len) /* remove '\0' and add trailing spaces... */
    {
        for (i = s_len; i > strlen(c_str); --i)
            a[i - 1] = ' ';
    }
    else if (strlen(c_str) > s_len) /* ...unless a string overflow */
    {
        marslog(LOG_EROR, "mfi_args: string too long: %d chars", strlen(c_str));
        marslog(LOG_EROR, "mfi_args: got only the first %d chars", s_len);
    }
}

void mfi_fail_(char* msg, fortint s_len)
{
    char* str = (char*)malloc(s_len + 1); /* temporary only */
    strncpy(str, msg, s_len);             /* need to use 'strncpy' */
    str[s_len] = '\0';                    /* add the terminator */

    mci_fail(str); /* issue msg and exit !! */

    free(str); /* thus we never get here */
}

/*----------- mifi = M(acro) I(nternal) F(ortran) I(nterface) ------------*/

/*
 *  'mifi_get_msg_length_' is called from Fortran code of 'mfi_load_one_grib'
 */
void mifi_get_msg_length_(fortint* fieldset_id_index, fortint* msg_len)
{
    int current;
    void* fieldset_id = get_fieldset_id_ptr_from_index(*fieldset_id_index);
    gribarg* ga = (gribarg*)(fieldset_id);
    if (!ga) /* ensure fieldset exists */
    {
        marslog(LOG_EROR, "mfi_load_one_grib: fieldset_id is NULL");
        return;
    }

    current = ga->cnt;
    if (current < 0 || current >= ga->v->count) /* ensure a field exists */
    {
        marslog(LOG_EROR, "mfi_load_one_grib: no more fields");
        return;
    }

    *msg_len = ga->v->fields[current]->length; /* get length from inside the struct */
    return;
}

/*
 *  'mifi_load_one_grib_to_memory_' is called from Fortran code of 'mfi_load_one_grib'
 */
void mifi_load_one_grib_to_memory_(fortint* fieldset_id_index, char* grib_in_memory)
{
    void* fieldset_id = get_fieldset_id_ptr_from_index(*fieldset_id_index);
    gribarg* ga = (gribarg*)(fieldset_id);
    field* cur_msg = NULL;
    long int msg_len = 0;
    grib_handle* gh;
    fieldset* fs;
    int fi;
    FILE* f;

    if (!ga) /* ensure fieldset exists */
    {
        marslog(LOG_EROR, "mfi_load_one_grib: fieldset_id is NULL");
        return;
    }

    fs = ga->v;     /* fieldset pointer */
    fi = ga->cnt++; /* index for the next field within the fieldset */

    minit(); /* ensure input request stuff is initialised */

    if (fi < 0 || fi >= fs->count) /* ensure a field exists */
    {
        marslog(LOG_EROR, "mfi_load_one_grib: no more fields");
        return;
    }

    cur_msg = fs->fields[fi];
    msg_len = cur_msg->length; /* get msg length and allocate memory */

    f = fopen(cur_msg->file->fname, "r"); /* ensure file exists */
    if (!f)
        marslog(LOG_EXIT | LOG_PERR, "mfi_load_one_grib: unable to open GRIB file");

    if (fseek(f, cur_msg->offset, 0) < 0) /* skip to the current field */
        marslog(LOG_EXIT | LOG_PERR, "mfi_load_one_grib: cannot position to GRIB file");

    if (_readany(f, grib_in_memory, &msg_len)) /* read current field */
        marslog(LOG_EXIT | LOG_PERR, "mfi_load_one_grib: cannot read GRIB file");

    fclose(f); /* close fieldset file */
}


/*
 *  'mifi_save_one_grib_to_file_' is called from Fortran code of 'mfi_save_grib'
 */
void mifi_save_one_grib_to_file_(fortint* fieldset_id_index, char* grib_data, fortint* bytecount)
{
    void* fieldset_id = get_fieldset_id_ptr_from_index(*fieldset_id_index);
    fortint ga_index = get_gribarg_index_from_ptr(fieldset_id);

    msavebyteg_(&ga_index, grib_data, bytecount);
}
