From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Ganlib/src/clecst.c | 119 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 119 insertions(+) create mode 100644 Ganlib/src/clecst.c (limited to 'Ganlib/src/clecst.c') diff --git a/Ganlib/src/clecst.c b/Ganlib/src/clecst.c new file mode 100644 index 0000000..d1823f6 --- /dev/null +++ b/Ganlib/src/clecst.c @@ -0,0 +1,119 @@ + +/*****************************************/ +/* CLE-2000 API */ +/* AUTHOR OF FORTRAN VERSION: R. Roy */ +/* AUTHOR: A. Hebert ; 15/05/09 */ +/*****************************************/ + +#include +#include "cle2000.h" +#define index_f(A, B) (strstr(A, B) == NULL ? 0 : strstr(A, B) - A + 1) + +int_32 clecst(char *cparm, int_32 *ityp, int_32 *nitma, float_32 *flott, char *text, double_64 *dflot) +{ + static char *ctypes[] = {"_I", "_R", "_S", "_D", "_L"}; + static char *cinteg[] = {"$Version", "$XLangLvl", "$c0", "$Date", "$Time", "$True", "$False"}; + static int_32 dinteg[] = { 2,77,299792458,20000101,0,1,-1 }; + static char *cfloat[] = {"$Pi", "$E", "$Euler", "$c0", "$Na", "$u", "$eV", "$h"}; + static double_64 dfloat[] = {3.141592653589793, 2.718281828459045, .577215664901533, 299792458., + 6.02214199e23, 1.66053873e-27, 1.602176462e-19, 6.62606876e-34}; + static char *cstrin[] = {"$Code", "$Release", "$XLang", "$Date", "$Time", "$Bang", "$GetIn", + "$GetOut"}; + static char *dstrin[] = {"CLE2000", "3", "Fortran", "20000101", "000000", "!", ">>", + "<<"}; + +/* CLE-2000 CONSTANTS: R.ROY (11/1999) */ + +/* *CLECST* WILL ATTEMPT TO FIND VALUES FOR */ +/* A CLE-2000 CONSTANT. */ + +/* INPUT: *CPARM * IS THE TENTATIVE CONSTANT NAME */ + +/* OUTPUT: *ITYP * IS THE CONSTANT TYPE (1:INTEGER) */ +/* (2:REAL) */ +/* (3:CHARACTER STRING) */ +/* (4:DOUBLE) */ +/* (5:LOGICAL) */ +/* *NITMA * IS AN INTEGER VALUE */ +/* (= LENGTH OF STRING IF *ITYP* .EQ.3) */ +/* (= -1 FOR .F. +1 FOR .T. IF *ITYP* .EQ.5) */ +/* *FLOTT * IS AN REAL VALUE */ +/* *TEXT * IS AN CHARACTER STRING */ +/* *DFLOT * IS AN DOUBLE PRECISION VALUE */ + +/* NOTE: *CLECST* = 0, IF WE FOUND THE PARAMETER *CPARM* */ + +/* THIS FUNCTION DEPEND ON THE APPLICATION */ +/* THE EXAMPLE GIVEN HERE SHOULD HELP THE DEVELOPER */ +/* TO WRITE ITS OWN APPLICATION-BASED CONSTANT LIST. */ + +/* PHYSICAL CONSTANTS GIVEN HERE WERE TAKEN FROM: */ +/* http://physics.nist.gov/cuu/Constants/ */ + +/* EXAMPLE: HERE *ITYP* IS IMPOSED AT THE END OF *CPARM* */ +/* (1:INTEGER) => END: _I */ +/* (2:REAL ) => END: _R */ +/* (3:STRING ) => END: _S */ +/* (4:DOUBLE ) => END: _D */ +/* (5:LOGICAL) => END: _L */ +/* ALL FLOATING (_R, _D ) ARE KEPT IN DOUBLE */ +/* AND CONVERTED INTO THE APPROPRIATE MODE. */ + + int_32 iloop1, ret_val = 1; + char cparin[13]; + +/* IDENTITY WHICH TYPE: _I ,_R, _D, _S, _L */ + int_32 indlec = 0; + for (iloop1 = 0; iloop1 < 5; ++iloop1) { + int_32 idftyp = index_f(cparm, ctypes[iloop1]); + if (idftyp != 0) { + indlec = iloop1 + 1; + strncpy(cparin, cparm, idftyp-1); cparin[idftyp-1] = '\0'; + } + } + + if (indlec == 1 || indlec == 5) { +/* LOOK FOR INTEGER VARIABLES */ + for (iloop1 = 0; iloop1 < 7; ++iloop1) { + if (strcmp(cparin, cinteg[iloop1]) == 0) { +/* FOUND: RETURN => TYPE=1, INTEGER */ +/* => TYPE=5, LOGICAL */ + *ityp = indlec; + *nitma = dinteg[iloop1]; + ret_val = 0; + goto L666; + } + } + } else if (indlec == 3) { +/* LOOK FOR STRING VARIABLES */ + for (iloop1 = 0; iloop1 < 8; ++iloop1) { + if (strcmp(cparin, cstrin[iloop1]) == 0) { +/* FOUND: RETURN => TYPE=3, STRING AND ITS LENGTH */ + *ityp = 3; + strcpy(text, dstrin[iloop1]); + *nitma = strlen(dstrin[iloop1]); + ret_val = 0; + goto L666; + } + } + } else if (indlec != 0) { +/* LOOK FOR FLOATING VARIABLES */ + for (iloop1 = 0; iloop1 < 8; ++iloop1) { + if (strcmp(cparin, cfloat[iloop1]) == 0) { + if (indlec == 2) { +/* FOUND: RETURN => TYPE=2, REAL */ + *flott = (float_32) dfloat[iloop1]; + } else { +/* FOUND: RETURN => TYPE=4, DOUBLE */ + *dflot = dfloat[iloop1]; + } + *ityp = indlec; + ret_val = 0; + goto L666; + } + } + } + +L666: + return ret_val; +} /* clecst */ -- cgit v1.2.3