Salome HOME
Merge from V6_main_20120808 08Aug12
[modules/kernel.git] / src / DSC / DSC_User / Datastream / Calcium / calciumf.c
1 // Copyright (C) 2007-2012  CEA/DEN, EDF R&D, OPEN CASCADE
2 //
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.
7 //
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.
12 //
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
16 //
17 // See http://www.salome-platform.org/ or email : webmaster.salome@opencascade.com
18 //
19
20 #include <string.h>
21 #include <stdlib.h>
22 #include "fortoc.h"
23 #include "calcium.h"
24 #include "calciumf.h"
25 #include "CalciumFortranInt.h"
26 #include <stdio.h>
27
28 #ifdef __cplusplus
29 extern "C" {
30 #endif
31
32
33 static void fstrtocstr(char *cstr, char *fstr,cal_int fstr_len)
34 {
35   cal_int i,iend;
36   for (iend = fstr_len-1; iend >= 0; iend--)
37     if (fstr[iend] != ' ') break;
38   for (i = 0; i <= iend; i++)
39     cstr[i] = fstr[i];
40   cstr[i] = '\0';
41 }
42
43 static void cstrtofstr(char *cstr, char *fstr,cal_int fstr_len)
44 {
45   cal_int i, len;
46   len = strlen(cstr);
47   if (len > fstr_len) len = fstr_len;
48   for (i = 0; i < len; i++)
49     fstr[i] = cstr[i];
50   while (i < fstr_len)
51     fstr[i++] = ' ';
52 }
53
54 static char * fstr1(char *nom,cal_int nnom)
55 {
56   char * cnom=(char*)malloc((nnom+1)*sizeof(char));
57   fstrtocstr(cnom,nom,nnom);
58   return cnom;
59 }
60
61 static void free_str1(char *nom)
62 {
63   free(nom);
64 }
65
66 #define FLOAT_OK              0
67 #define POS_INFINITY          1
68 #define NEG_INFINITY          2
69 #define QUIET_NAN             3
70 #define SIGNALING_NAN         4
71
72 int CheckFloat(float* value)
73 {
74    unsigned long L1 = *(unsigned long*)value;
75    unsigned long L2 = L1 & 0x7fffffff;
76    if (L2 < 0x7f800000) return (FLOAT_OK); // Short circuit for most values
77    if (L1 == 0x7f800000) return (POS_INFINITY);
78    else if (L1 == 0xff800000) return (NEG_INFINITY);
79    else if (L2 >= 0x7fc00000) return (QUIET_NAN);
80    else if ((L2 >= 0x7f800001) && (L2 <= 0x7fbfffff)) return (SIGNALING_NAN);
81    else return (FLOAT_OK);
82 }
83
84 /**********************************************/
85 /*  INTERFACES DE DÉBUT ET DE FIN DE COUPLAGE */
86 /**********************************************/
87
88 void F_FUNC(cpcd,CPCD)(long *compo,STR_PSTR(nom),cal_int *info STR_PLEN(nom));
89 void F_FUNC(cpfin,CPFIN)(long *compo,cal_int *dep,cal_int *err);
90
91 void F_FUNC(cpcd,CPCD)(long *compo,STR_PSTR(nom),cal_int *info STR_PLEN(nom))
92 {
93   /* nom is OUT argument */
94   cp_cd((void *)*compo,STR_PTR(nom));
95   /* replace in place ??? */
96   cstrtofstr(STR_PTR(nom),STR_PTR(nom),STR_LEN(nom));
97 }
98
99 void F_FUNC(cpfin,CPFIN)(long *compo,cal_int *dep,cal_int *err)
100 {
101   *err=cp_fin((void *)*compo,(int)*dep);
102 }
103
104 /**************************************/
105 /* ERASE INTERFACE                    */
106 /**************************************/
107 void F_FUNC(cpfini,CPFINI)(long *compo,STR_PSTR(nom),cal_int *i, cal_int *err STR_PLEN(nom));
108 void F_FUNC(cpfint,CPFINT)(long *compo,STR_PSTR(nom),float *t, cal_int *err STR_PLEN(nom));
109 void F_FUNC(cpeffi,CPEFFI)(long *compo,STR_PSTR(nom),cal_int *i, cal_int *err STR_PLEN(nom));
110 void F_FUNC(cpefft,CPEFFT)(long *compo,STR_PSTR(nom),float *t, cal_int *err STR_PLEN(nom));
111
112 void F_FUNC(cpfini,CPFINI)(long *compo,STR_PSTR(nom),cal_int *i, cal_int *err STR_PLEN(nom))
113 {
114   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
115   *err=cp_fini((void *)*compo,cnom,*i);
116   free_str1(cnom);
117 }
118
119 void F_FUNC(cpfint,CPFINT)(long *compo,STR_PSTR(nom),float *t, cal_int *err STR_PLEN(nom))
120 {
121   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
122   *err=cp_fint((void *)*compo,cnom,*t);
123   free_str1(cnom);
124 }
125
126 void F_FUNC(cpeffi,CPEFFI)(long *compo,STR_PSTR(nom),cal_int *i, cal_int *err STR_PLEN(nom))
127 {
128   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
129   *err=cp_effi((void *)*compo,cnom,*i);
130   free_str1(cnom);
131 }
132
133 void F_FUNC(cpefft,CPEFFT)(long *compo,STR_PSTR(nom),float *t, cal_int *err STR_PLEN(nom))
134 {
135   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
136   *err=cp_efft((void *)*compo,cnom,*t);
137   free_str1(cnom);
138 }
139
140 /**************************************/
141 /* INTERFACES DE LECTURE              */
142 /**************************************/
143
144 void F_FUNC(cplin,CPLIN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
145                          cal_int *max,cal_int *n, int *tab,cal_int *err STR_PLEN(nom));
146 void F_FUNC(cpllg,CPLLG)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
147             cal_int *max,cal_int *n, long *tab,cal_int *err STR_PLEN(nom));
148 void F_FUNC(cplln,CPLLN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
149             cal_int *max,cal_int *n, long *tab,cal_int *err STR_PLEN(nom));
150 void F_FUNC(cplen,CPLEN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
151             cal_int *max,cal_int *n, cal_int *tab,cal_int *err STR_PLEN(nom));
152 void F_FUNC(cpllo,CPLLO)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
153             cal_int *max,cal_int *n, int *tab,cal_int *err STR_PLEN(nom));
154 void F_FUNC(cpldb,CPLDB)(long *compo,cal_int *dep,double *ti,double *tf,cal_int *iter,STR_PSTR(nom),
155             cal_int *max,cal_int *n, double *tab,cal_int *err STR_PLEN(nom));
156 void F_FUNC(cplre,CPLRE)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
157             cal_int *max,cal_int *n, float *tab,cal_int *err STR_PLEN(nom));
158 void F_FUNC(cplcp,CPLCP)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
159             cal_int *max,cal_int *n, float *tab,cal_int *err STR_PLEN(nom));
160 void F_FUNC(cplch,CPLCH)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
161             cal_int *max,cal_int *n, char *tab,cal_int *err STR_PLEN(nom) STR_PLEN(tab) );
162
163
164 void F_FUNC(cplin,CPLIN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
165                          cal_int *max,cal_int *n, int *tab,cal_int *err STR_PLEN(nom))
166 {
167   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
168
169 #if   !SIZEOF_INT
170 #error "The macro SIZEOF_INT must be defined."
171 #elif SIZEOF_INT == 4
172   *err=cp_lin_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
173 #else
174   fprintf(stderr,"End of CPLIN: %s : Can't use fortran INTEGER*4 because int C is not 32bits long on this machine.\n",
175           cnom);
176 #endif
177   free_str1(cnom);
178 }
179
180 void F_FUNC(cpllg,CPLLG)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
181             cal_int *max,cal_int *n, long *tab,cal_int *err STR_PLEN(nom))
182 {
183   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
184 #if   !SIZEOF_LONG
185 #error "The macro SIZEOF_LONG must be defined."
186 #elif SIZEOF_LONG == 8
187   *err=cp_llg_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
188 #else
189   fprintf(stderr,"End of CPLLG: %s : Can't use fortran INTEGER*8 because long C is not 64bits long on this machine.\n",
190           cnom);
191 #endif
192   free_str1(cnom);
193 }
194
195 void F_FUNC(cplln,CPLLN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
196                                     cal_int *max,cal_int *n, long *tab,cal_int *err STR_PLEN(nom))
197 {
198  char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
199 #if   !SIZEOF_LONG
200 #error "The macro SIZEOF_LONG must be defined."
201 #elif SIZEOF_LONG == 8
202   *err=cp_lln_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
203 #else
204   fprintf(stderr,"End of CPLLN: %s : Can't use fortran INTEGER*8 because long C is not 64bits long on this machine.\n",
205           cnom);
206 #endif
207   free_str1(cnom);
208 }
209
210
211 void F_FUNC(cplen,CPLEN)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
212             cal_int *max,cal_int *n, cal_int *tab,cal_int *err STR_PLEN(nom))
213 {
214   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
215   *err=cp_len_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
216   free_str1(cnom);
217 }
218
219
220 void F_FUNC(cpllo,CPLLO)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
221             cal_int *max,cal_int *n, int *tab,cal_int *err STR_PLEN(nom))
222 {
223   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
224   *err=cp_llo_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
225   free_str1(cnom);
226 }
227
228 void F_FUNC(cpldb,CPLDB)(long *compo,cal_int *dep,double *ti,double *tf,cal_int *iter,STR_PSTR(nom),
229             cal_int *max,cal_int *n, double *tab,cal_int *err STR_PLEN(nom))
230 {
231   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
232   *err=cp_ldb_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
233   free_str1(cnom);
234 }
235
236 void F_FUNC(cplre,CPLRE)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
237             cal_int *max,cal_int *n, float *tab,cal_int *err STR_PLEN(nom))
238 {
239   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
240   *err=cp_lre_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
241   free_str1(cnom);
242 }
243
244 void F_FUNC(cplcp,CPLCP)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
245             cal_int *max,cal_int *n, float *tab,cal_int *err STR_PLEN(nom))
246 {
247   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
248   *err=cp_lcp_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tab);
249   free_str1(cnom);
250 }
251
252 void F_FUNC(cplch,CPLCH)(long *compo,cal_int *dep,float *ti,float *tf,cal_int *iter,STR_PSTR(nom),
253             cal_int *max,cal_int *n, char *tab,cal_int *err STR_PLEN(nom) STR_PLEN(tab) )
254 {
255   char **tabChaine = NULL;
256   cal_int    index = 0;
257   char*      cnom = fstr1(STR_PTR(nom),STR_LEN(nom));
258
259   tabChaine = (char **) malloc(sizeof(char *) * (*max));
260   for (index = 0; index < *max; index++)
261     tabChaine[index] = (char *) malloc(sizeof(char) * (STR_LEN(tab)+1));
262
263   *err=cp_lch_fort_((void *)*compo,*dep,ti,tf,iter,cnom,*max,n,tabChaine,STR_LEN(tab));
264
265   if (*err == CPOK )
266     {
267       for (index = 0; index < *n; index++)
268         {
269           strncpy(&tab[index * STR_LEN(tab)], tabChaine[index], strlen(tabChaine[index]));
270           if(STR_LEN(tab) > strlen(tabChaine[index]))
271             memset(&tab[index * STR_LEN(tab)+strlen(tabChaine[index])],' ',STR_LEN(tab)-strlen(tabChaine[index]));
272         }
273     }
274
275   if (tabChaine != (char **) NULL)
276     {
277       for (index = 0; index < *max; index++)
278         free(tabChaine[index]);
279       free(tabChaine);
280     }
281   free_str1(cnom);
282 }
283
284
285 /***************************/
286 /*  INTERFACES D'ECRITURE  */
287 /***************************/
288 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
289                          STR_PLEN(nom) STR_PLEN(tab));
290 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));
291 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));
292 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));
293 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));
294 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));
295 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));
296 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));
297 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));
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 {
302   char ** tabChaine=NULL;
303   cal_int     index=0,index2=0;
304   char*   cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
305   float tti=0.;
306   if(*dep == CP_TEMPS)tti=*ti;
307
308   tabChaine = (char **) malloc(sizeof(char *) * *n);
309   for (index = 0; index < *n; index++)
310     {
311       tabChaine[index] = (char *) malloc(sizeof(char) * (STR_LEN(tab) + 1));
312       strncpy(tabChaine[index],&tab[STR_LEN(tab) * index],STR_LEN(tab));
313       tabChaine[index][STR_LEN(tab)]='\0';
314       for (index2 = STR_LEN(tab) - 1; index2 >= 0; index2--)
315         {
316           if ( tabChaine[index][index2] == ' ' || tabChaine[index][index2] == '\0' )
317             tabChaine[index][index2]='\0';
318         }
319     }
320
321   *err=cp_ech_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tabChaine,STR_LEN(tab) );
322
323   if (tabChaine != (char **) NULL)
324     {
325       for (index = 0; index < *n; index++)
326         free(tabChaine[index]);
327       free(tabChaine);
328     }
329   free_str1(cnom);
330 }
331
332 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))
333 {
334   double tti=0.;
335   if(*dep == CP_TEMPS)tti=*ti;
336   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
337   *err=cp_edb_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
338   free_str1(cnom);
339 }
340
341 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))
342 {
343   float tti=0.;
344   if(*dep == CP_TEMPS)tti=*ti;
345   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
346   *err=cp_ere_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
347   free_str1(cnom);
348 }
349
350 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))
351 {
352   float tti=0.;
353   if(*dep == CP_TEMPS)tti=*ti;
354   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
355   *err=cp_ecp_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
356   free_str1(cnom);
357 }
358
359
360 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))
361 {
362   float tti=0.;
363   if(*dep == CP_TEMPS)tti=*ti;
364   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
365 #if   !SIZEOF_INT
366 #error "The macro SIZEOF_INT must be defined."
367 #elif SIZEOF_INT == 4
368   *err=cp_ein_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
369 #else
370   fprintf(stderr,"CPEIN: %s %f %d : Can't use fortran INTEGER*4 because int C is not 32bits long on this machine.\n",
371           cnom, *ti,*iter);
372 #endif
373   free_str1(cnom);
374 }
375
376 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))
377 {
378   float tti=0.;
379   if(*dep == CP_TEMPS)tti=*ti;
380   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
381 #if   !SIZEOF_LONG
382 #error "The macro SIZEOF_LONG must be defined."
383 #elif SIZEOF_LONG == 8
384   *err=cp_elg_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
385 #else
386   fprintf(stderr,"CPELG: %s %f %d : Can't use fortran INTEGER*8 because long C is not 64bits long on this machine.\n",
387           cnom, *ti,*iter);
388 #endif
389   free_str1(cnom);
390 }
391
392 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))
393 {
394   float tti=0.;
395   if(*dep == CP_TEMPS)tti=*ti;
396   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
397 #if   !SIZEOF_LONG
398 #error "The macro SIZEOF_LONG must be defined."
399 #elif SIZEOF_LONG == 8
400   *err=cp_eln_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
401 #else
402   fprintf(stderr,"CPELN: %s %f %d : Can't use fortran INTEGER*8 because long C is not 64bits long on this machine.\n",
403           cnom, *ti,*iter);
404 #endif
405   free_str1(cnom);
406 }
407
408
409 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))
410 {
411   float tti=0.;
412   if(*dep == CP_TEMPS)tti=*ti;
413   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
414   *err=cp_een_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
415   free_str1(cnom);
416 }
417
418 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))
419 {
420   float tti=0.;
421   if(*dep == CP_TEMPS)tti=*ti;
422   char* cnom=fstr1(STR_PTR(nom),STR_LEN(nom));
423   *err=cp_elo_fort_((void *)*compo,*dep,tti,*iter,cnom,*n,tab);
424   free_str1(cnom);
425 }
426
427
428 #ifdef __cplusplus
429 }
430 #endif
431