1 // Copyright (C) 2007-2020 CEA/DEN, EDF R&D, OPEN CASCADE
3 // This library is free software; you can redistribute it and/or
4 // modify it under the terms of the GNU Lesser General Public
5 // License as published by the Free Software Foundation; either
6 // version 2.1 of the License, or (at your option) any later version.
8 // This library is distributed in the hope that it will be useful,
9 // but WITHOUT ANY WARRANTY; without even the implied warranty of
10 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 // Lesser General Public License for more details.
13 // You should have received a copy of the GNU Lesser General Public
14 // License along with this library; if not, write to the Free Software
15 // Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17 // See http://www.salome-platform.org/ or email : webmaster.salome@opencascade.com
25 #include "CalciumFortranInt.h"
27 #include <omniconfig.h> // to get SIZEOF_LONG
34 static void fstrtocstr(char *cstr, char *fstr,cal_int fstr_len)
37 for (iend = fstr_len-1; iend >= 0; iend--)
38 if (fstr[iend] != ' ') break;
39 for (i = 0; i <= iend; i++)
44 static void cstrtofstr(char *cstr, char *fstr,cal_int fstr_len)
48 if (len > fstr_len) len = fstr_len;
49 for (i = 0; i < len; i++)
55 static char * fstr1(char *nom,cal_int nnom)
57 char * cnom=(char*)malloc((nnom+1)*sizeof(char));
58 fstrtocstr(cnom,nom,nnom);
62 static void free_str1(char *nom)
68 #define POS_INFINITY 1
69 #define NEG_INFINITY 2
71 #define SIGNALING_NAN 4
73 int CheckFloat(float* value)
75 unsigned long L1 = *(unsigned long*)value;
76 unsigned long L2 = L1 & 0x7fffffff;
77 if (L2 < 0x7f800000) return (FLOAT_OK); // Short circuit for most values
78 if (L1 == 0x7f800000) return (POS_INFINITY);
79 else if (L1 == 0xff800000) return (NEG_INFINITY);
80 else if (L2 >= 0x7fc00000) return (QUIET_NAN);
81 else if ((L2 >= 0x7f800001) && (L2 <= 0x7fbfffff)) return (SIGNALING_NAN);
82 else return (FLOAT_OK);
85 /**********************************************/
86 /* INTERFACES DE DÉBUT ET DE FIN DE COUPLAGE */
87 /**********************************************/
89 void F_FUNC(cpcd,CPCD)(long *compo,STR_PSTR(nom),cal_int *info STR_PLEN(nom));
90 void F_FUNC(cpfin,CPFIN)(long *compo,cal_int *dep,cal_int *err);
92 void F_FUNC(cpcd,CPCD)(long *compo,STR_PSTR(nom),cal_int *info STR_PLEN(nom))
94 /* nom is OUT argument */
95 cp_cd((void *)*compo,STR_PTR(nom));
96 /* replace in place ??? */
97 cstrtofstr(STR_PTR(nom),STR_PTR(nom),STR_LEN(nom));
100 void F_FUNC(cpfin,CPFIN)(long *compo,cal_int *dep,cal_int *err)
102 *err=cp_fin((void *)*compo,(int)*dep);
105 /**************************************/
106 /* ERASE INTERFACE */
107 /**************************************/
108 void F_FUNC(cpfini,CPFINI)(long *compo,STR_PSTR(nom),cal_int *i, cal_int *err STR_PLEN(nom));
109 void F_FUNC(cpfint,CPFINT)(long *compo,STR_PSTR(nom),float *t, cal_int *err STR_PLEN(nom));
110 void F_FUNC(cpeffi,CPEFFI)(long *compo,STR_PSTR(nom),cal_int *i, cal_int *err STR_PLEN(nom));
111 void F_FUNC(cpefft,CPEFFT)(long *compo,STR_PSTR(nom),float *t, cal_int *err STR_PLEN(nom));
113 void F_FUNC(cpfini,CPFINI)(long *compo,STR_PSTR(nom),cal_int *i, cal_int *err STR_PLEN(nom))
115 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
116 *err=cp_fini((void *)*compo,cnom,*i);
120 void F_FUNC(cpfint,CPFINT)(long *compo,STR_PSTR(nom),float *t, cal_int *err STR_PLEN(nom))
122 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
123 *err=cp_fint((void *)*compo,cnom,*t);
127 void F_FUNC(cpeffi,CPEFFI)(long *compo,STR_PSTR(nom),cal_int *i, cal_int *err STR_PLEN(nom))
129 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
130 *err=cp_effi((void *)*compo,cnom,*i);
134 void F_FUNC(cpefft,CPEFFT)(long *compo,STR_PSTR(nom),float *t, cal_int *err STR_PLEN(nom))
136 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
137 *err=cp_efft((void *)*compo,cnom,*t);
141 /**************************************/
142 /* INTERFACES DE LECTURE */
143 /**************************************/
145 void F_FUNC(cplin,CPLIN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
146 cal_int *max,cal_int *n, int *tab,cal_int *err STR_PLEN(nom));
147 void F_FUNC(cpllg,CPLLG)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
148 cal_int *max,cal_int *n, long *tab,cal_int *err STR_PLEN(nom));
149 void F_FUNC(cplln,CPLLN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
150 cal_int *max,cal_int *n, long *tab,cal_int *err STR_PLEN(nom));
151 void F_FUNC(cplen,CPLEN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
152 cal_int *max,cal_int *n, cal_int *tab,cal_int *err STR_PLEN(nom));
153 void F_FUNC(cpllo,CPLLO)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
154 cal_int *max,cal_int *n, int *tab,cal_int *err STR_PLEN(nom));
155 void F_FUNC(cpldb,CPLDB)(long *compo,cal_int *dep,double *ti,double *tf,cal_int *iter,STR_PSTR(nom),
156 cal_int *max,cal_int *n, double *tab,cal_int *err STR_PLEN(nom));
157 void F_FUNC(cplre,CPLRE)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
158 cal_int *max,cal_int *n, float *tab,cal_int *err STR_PLEN(nom));
159 void F_FUNC(cplrd,CPLRD)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
160 cal_int *max,cal_int *n, double *tab,cal_int *err STR_PLEN(nom));
161 void F_FUNC(cplcp,CPLCP)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
162 cal_int *max,cal_int *n, float *tab,cal_int *err STR_PLEN(nom));
163 void F_FUNC(cplch,CPLCH)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
164 cal_int *max,cal_int *n, char *tab,cal_int *err STR_PLEN(nom) STR_PLEN(tab) );
167 void F_FUNC(cplin,CPLIN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
168 cal_int *max,cal_int *n, int *tab,cal_int *err STR_PLEN(nom))
170 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
173 #error "The macro SIZEOF_INT must be defined."
174 #elif SIZEOF_INT == 4
175 *err=cp_lin_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
177 fprintf(stderr,"End of CPLIN: %s : Can't use fortran INTEGER*4 because int C is not 32bits long on this machine.\n",
183 void F_FUNC(cpllg,CPLLG)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
184 cal_int *max,cal_int *n, long *tab,cal_int *err STR_PLEN(nom))
186 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
188 #error "The macro SIZEOF_LONG must be defined."
189 #elif SIZEOF_LONG == 8
190 *err=cp_llg_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
192 fprintf(stderr,"End of CPLLG: %s : Can't use fortran INTEGER*8 because long C is not 64bits long on this machine.\n",
198 void F_FUNC(cplln,CPLLN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
199 cal_int *max,cal_int *n, long *tab,cal_int *err STR_PLEN(nom))
201 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
203 #error "The macro SIZEOF_LONG must be defined."
204 #elif SIZEOF_LONG == 8
205 *err=cp_lln_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
207 fprintf(stderr,"End of CPLLN: %s : Can't use fortran INTEGER*8 because long C is not 64bits long on this machine.\n",
214 void F_FUNC(cplen,CPLEN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
215 cal_int *max,cal_int *n, cal_int *tab,cal_int *err STR_PLEN(nom))
217 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
218 *err=cp_len_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
223 void F_FUNC(cpllo,CPLLO)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
224 cal_int *max,cal_int *n, int *tab,cal_int *err STR_PLEN(nom))
226 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
227 *err=cp_llo_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
231 void F_FUNC(cpldb,CPLDB)(long *compo,cal_int *dep,double *ti,double *tf,cal_int *iter,STR_PSTR(nom),
232 cal_int *max,cal_int *n, double *tab,cal_int *err STR_PLEN(nom))
234 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
235 *err=cp_ldb_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
239 void F_FUNC(cplre,CPLRE)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
240 cal_int *max,cal_int *n, float *tab,cal_int *err STR_PLEN(nom))
242 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
243 *err=cp_lre_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
247 void F_FUNC(cplrd,CPLRD)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
248 cal_int *max,cal_int *n, double *tab,cal_int *err STR_PLEN(nom))
250 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
251 *err=cp_lrd_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,(float *)tab);
255 void F_FUNC(cplcp,CPLCP)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
256 cal_int *max,cal_int *n, float *tab,cal_int *err STR_PLEN(nom))
258 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
259 *err=cp_lcp_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
263 void F_FUNC(cplch,CPLCH)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
264 cal_int *max,cal_int *n, char *tab,cal_int *err STR_PLEN(nom) STR_PLEN(tab) )
266 char **tabChaine = NULL;
268 char* cnom = fstr1(STR_PTR(nom),STR_LEN(nom));
270 tabChaine = (char **) malloc(sizeof(char *) * (*max));
271 for (index = 0; index < *max; index++)
272 tabChaine[index] = (char *) malloc(sizeof(char) * (STR_LEN(tab)+1));
274 *err=cp_lch_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tabChaine,STR_LEN(tab));
278 for (index = 0; index < *n; index++)
280 strncpy(&tab[index * STR_LEN(tab)], tabChaine[index], strlen(tabChaine[index]));
281 if(STR_LEN(tab) > strlen(tabChaine[index]))
282 memset(&tab[index * STR_LEN(tab)+strlen(tabChaine[index])],' ',STR_LEN(tab)-strlen(tabChaine[index]));
286 if (tabChaine != (char **) NULL)
288 for (index = 0; index < *max; index++)
289 free(tabChaine[index]);
296 /***************************/
297 /* INTERFACES D'ECRITURE */
298 /***************************/
299 void F_FUNC(cpech,CPECH)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, char *tab,cal_int *err
300 STR_PLEN(nom) STR_PLEN(tab));
301 void F_FUNC(cpedb,CPEDB)(long *compo,cal_int *dep,double *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, double *tab,cal_int *err STR_PLEN(nom));
302 void F_FUNC(cpere,CPERE)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, float *tab,cal_int *err STR_PLEN(nom));
303 void F_FUNC(cperd,CPERD)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, double *tab,cal_int *err STR_PLEN(nom));
304 void F_FUNC(cpecp,CPECP)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, float *tab,cal_int *err STR_PLEN(nom));
305 void F_FUNC(cpein,CPEIN)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, int *tab,cal_int *err STR_PLEN(nom));
306 void F_FUNC(cpelg,CPELG)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, long *tab,cal_int *err STR_PLEN(nom));
307 void F_FUNC(cpeln,CPELN)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, long *tab,cal_int *err STR_PLEN(nom));
308 void F_FUNC(cpeen,CPEEN)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, cal_int *tab,cal_int *err STR_PLEN(nom));
309 void F_FUNC(cpelo,CPELO)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, int *tab,cal_int *err STR_PLEN(nom));
311 void F_FUNC(cpech,CPECH)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, char *tab,cal_int *err
312 STR_PLEN(nom) STR_PLEN(tab))
314 char ** tabChaine=NULL;
315 cal_int index=0,index2=0;
316 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
318 if(*dep == CP_TEMPS)tti=*ti;
320 tabChaine = (char **) malloc(sizeof(char *) * *n);
321 for (index = 0; index < *n; index++)
323 tabChaine[index] = (char *) malloc(sizeof(char) * (STR_LEN(tab) + 1));
324 strncpy(tabChaine[index],&tab[STR_LEN(tab) * index],STR_LEN(tab));
325 tabChaine[index][STR_LEN(tab)]='\0';
326 for (index2 = STR_LEN(tab) - 1; index2 >= 0; index2--)
328 if ( tabChaine[index][index2] == ' ' || tabChaine[index][index2] == '\0' )
329 tabChaine[index][index2]='\0';
333 *err=cp_ech_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tabChaine,STR_LEN(tab) );
335 if (tabChaine != (char **) NULL)
337 for (index = 0; index < *n; index++)
338 free(tabChaine[index]);
344 void F_FUNC(cpedb,CPEDB)(long *compo,cal_int *dep,double *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, double *tab,cal_int *err STR_PLEN(nom))
347 if(*dep == CP_TEMPS)tti=*ti;
348 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
349 *err=cp_edb_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
353 void F_FUNC(cpere,CPERE)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, float *tab,cal_int *err STR_PLEN(nom))
356 if(*dep == CP_TEMPS)tti=*ti;
357 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
358 *err=cp_ere_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
362 void F_FUNC(cperd,CPERD)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, double *tab,cal_int *err STR_PLEN(nom))
365 if(*dep == CP_TEMPS)tti=*ti;
366 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
367 *err=cp_erd_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,(float *)tab);
371 void F_FUNC(cpecp,CPECP)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, float *tab,cal_int *err STR_PLEN(nom))
374 if(*dep == CP_TEMPS)tti=*ti;
375 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
376 *err=cp_ecp_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
381 void F_FUNC(cpein,CPEIN)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, int *tab,cal_int *err STR_PLEN(nom))
384 if(*dep == CP_TEMPS)tti=*ti;
385 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
387 #error "The macro SIZEOF_INT must be defined."
388 #elif SIZEOF_INT == 4
389 *err=cp_ein_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
391 fprintf(stderr,"CPEIN: %s %f %d : Can't use fortran INTEGER*4 because int C is not 32bits long on this machine.\n",
397 void F_FUNC(cpelg,CPELG)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, long *tab,cal_int *err STR_PLEN(nom))
400 if(*dep == CP_TEMPS)tti=*ti;
401 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
403 #error "The macro SIZEOF_LONG must be defined."
404 #elif SIZEOF_LONG == 8
405 *err=cp_elg_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
407 fprintf(stderr,"CPELG: %s %f %d : Can't use fortran INTEGER*8 because long C is not 64bits long on this machine.\n",
413 void F_FUNC(cpeln,CPELN)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, long *tab,cal_int *err STR_PLEN(nom))
416 if(*dep == CP_TEMPS)tti=*ti;
417 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
419 #error "The macro SIZEOF_LONG must be defined."
420 #elif SIZEOF_LONG == 8
421 *err=cp_eln_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
423 fprintf(stderr,"CPELN: %s %f %d : Can't use fortran INTEGER*8 because long C is not 64bits long on this machine.\n",
430 void F_FUNC(cpeen,CPEEN)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, cal_int *tab,cal_int *err STR_PLEN(nom))
433 if(*dep == CP_TEMPS)tti=*ti;
434 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
435 *err=cp_een_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
439 void F_FUNC(cpelo,CPELO)(long *compo,cal_int *dep,float *ti,cal_int *iter,STR_PSTR(nom),cal_int *n, int *tab,cal_int *err STR_PLEN(nom))
442 if(*dep == CP_TEMPS)tti=*ti;
443 char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
444 *err=cp_elo_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);