1 /* This file is part of MED.
2 *
3 * COPYRIGHT (C) 1999 - 2019 EDF R&D, CEA/DEN
4 * MED is free software: you can redistribute it and/or modify
5 * it under the terms of the GNU Lesser General Public License as published by
6 * the Free Software Foundation, either version 3 of the License, or
7 * (at your option) any later version.
8 *
9 * MED is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU Lesser General Public License for more details.
13 *
14 * You should have received a copy of the GNU Lesser General Public License
15 * along with MED. If not, see <http://www.gnu.org/licenses/>.
16 */
17
18
19 #include <med.h>
20 #include <med_config.h>
21 #include <med_outils.h>
22 #include <string.h>
23 #include <stdlib.h>
24
25 /*
26 * - Nom de la fonction : MEDchampEcr
27 * - Description : ecriture d'un Champ Résultat
28 * - Parametres :
29 * - fid (IN) : ID du fichier HDF courant
30 * - maa (IN) : le nom du maillage sur lequel s'applique le champ (eventuellement distant)
31 * - cha (IN) : le nom du champ
32 * - val (IN) : valeurs du champ à stocker
33 * - interlace(IN) : entrelacement utilisé en mémoire {MED_FULL_INTERLACE,MED_NO_INTERLACE}
34 * - nbelem (IN) : nombre d'éléments (prend en compte le nbre
35 * de points de Gauss (c'est demandé à l'utilisateur ds la doc)
36 mais pas le nbre de composantes)
37 * - locname (IN) : clé utilisée pour la définition de la localisation
38 des points de GAUSS (MED_NOGAUSS si aucun, MED_GAUSS_ELNO si les points de Gauss
39 * portent sur les noeuds de l'element). La localisation doit exister
40 * avant l'appel à MEDchampEcr.
41 * - numco (IN) : n° de la composante à stocker (MED_ALL si toutes)
42 * - profil (IN) : nom du profil utilisé (MED_NOPFL si inutilisé)
43 * - pflmod (IN) : Indique comment lire les informations en mémoire { MED_COMPACT, MED_GLOBAL }.
44 * - type_ent (IN) : entité concerné par le champ {MED_NOEUD,MED_ARETE,MED_FACE,MED_MAILLE}
45 * - type_geo (IN) : type géométrique de l'entité concerné {MED_POINT,MED_SEG2 ......}
46 * - numdt (IN) : n° du pas de temps (MED_NOPDT si aucun)
47 * - dt_unit (IN) : chaine de taille MED_NOMP indiquant l'unité du champ
48 * - dt (IN) : valeur du pas de temps
49 * - numo (IN) : n° d'ordre utilisé MED_NONOR si inutile
50 * - Resultat : 0 en cas de succes, -1 sinon
51 */
52
MEDchampEcr231(int dummy,...)53 void MEDchampEcr231(int dummy,...) {
54
55
56 med_idt fid ;
57 char * maa ;
58 char * cha ;
59 unsigned char * val ;
60 med_mode_switch interlace ;
61 med_int nbelem ;
62 char * locname ;
63 med_int numco ;
64 char * profil ;
65 med_mode_profil pflmod ;
66 med_entite_maillage type_ent ;
67 med_geometrie_element type_geo ;
68 med_int numdt ;
69 char * dt_unit ;
70 med_float dt ;
71 med_int numo ;
72 med_err * fret ;
73
74 med_err ret=-1;
75 med_idt gid=0,datagroup1=0,datagroup2=0,datagroup3=0,attr=0,gid_loc=0;
76 med_int ncomp=0, chtype=0, i=0, ngauss=0, pfluse=0;
77 char nomdatagroup1[2*MED_TAILLE_NOM_ENTITE+2]="";
78 char nomdatagroup2[2*MED_MAX_PARA+1]="";
79 /* char maaNoBlc [MED_TAILLE_NOM+1]=""; */
80 char pflname [MED_TAILLE_NOM+1]="";
81 char locname_i [MED_TAILLE_NOM+1]="";
82 char maillage[MED_TAILLE_NOM+1]="";
83 char tmp1[MED_TAILLE_NOM_ENTITE+1]="";
84 med_size dimd[1],psize=0,lsize=0;
85 med_int *pfltabtmp=0;
86 med_size *pfltab=0;
87 char chemin[MED_TAILLE_CHA+MED_TAILLE_NOM+1]="";
88 char chemin_loc[MED_TAILLE_GAUSS+MED_TAILLE_NOM+1]="";
89 med_geometrie_element type_geo_g;
90 med_int type_geo_g_int=0;
91 med_mode_acces MED_MODE_ACCES;
92
93 va_list params;
94 va_start(params,dummy);
95
96 fid = va_arg(params,med_idt);
97 maa = va_arg(params,char *);
98 cha = va_arg(params,char *);
99 val = va_arg(params, unsigned char *);
100 interlace = va_arg(params,med_mode_switch);
101 nbelem = va_arg(params,med_int);
102 locname = va_arg(params,char *);
103 numco = va_arg(params,med_int);
104 profil = va_arg(params,char *);
105 pflmod = va_arg(params,med_mode_profil);
106 type_ent = va_arg(params,med_entite_maillage);
107 type_geo = va_arg(params,med_geometrie_element);
108 numdt = va_arg(params,med_int);
109 dt_unit = va_arg(params,char *);
110 dt = va_arg(params,med_float);
111 numo = va_arg(params,med_int);
112 fret = va_arg(params,med_err *);
113
114 /*
115 * On inhibe le gestionnaire d'erreur HDF 5
116 */
117 _MEDmodeErreurVerrouiller();
118 if (MEDcheckVersion(fid) < 0) {*fret=-1;return;}
119
120
121 if ( (MED_MODE_ACCES = _MEDmodeAcces(fid) ) == MED_UNDEF_MODE_ACCES ) {
122 MESSAGE("Impossible de déterminer le mode d'acces au fichier ");
123 goto ERROR;
124 }
125
126 if ( MED_MODE_ACCES == MED_LECTURE) {
127 MESSAGE("Impossible d'écrire un champ en mode MED_LECTURE : ");
128 goto ERROR;
129 };
130
131
132 /*
133 * Si le Data Group CHA n'existe pas => erreur
134 */
135 strcpy(chemin,MED_CHA);
136 strcat(chemin,cha);
137 if ((gid = _MEDdatagroupOuvrir(fid,chemin)) < 0)
138 goto ERROR;
139
140 /* Lecture de l'attribut MED_NOM_NCO */
141 if (_MEDattrEntierLire(gid,MED_NOM_NCO,&ncomp) < 0)
142 goto ERROR;
143
144 /* Lecture de l'attribut MED_NOM_TYP */
145 if ( _MEDattrEntierLire(gid,MED_NOM_TYP,&chtype) < 0)
146 goto ERROR;
147
148
149
150 /*
151 * Creation/Ouverture du datagroup de niveau 1 <type_ent>[.<type_geo>]
152 */
153 if ( type_ent == MED_NOEUD_MAILLE ) {
154 SSCRUTE("L'écriture aux noeuds des éléments n'est pas disponible.");
155 goto ERROR;
156 }
157
158 if (_MEDnomEntite(nomdatagroup1,type_ent) < 0)
159 goto ERROR;
160
161 if ( type_ent != MED_NOEUD ) {
162 if ( _MEDnomGeometrie(tmp1,type_geo) < 0)
163 goto ERROR;
164 strcat(nomdatagroup1,".");
165 strcat(nomdatagroup1,tmp1);
166 }
167 datagroup1 = 0;
168 if ( (datagroup1 = _MEDdatagroupOuvrir(gid,nomdatagroup1)) < 0)
169 if ((datagroup1 = _MEDdatagroupCreer(gid,nomdatagroup1)) < 0)
170 goto ERROR;
171
172
173 /*
174 * Creation/Ouverture du datagroup de niveau 2 <numdt>.<numoo>
175 */
176
177 sprintf(nomdatagroup2,"%*li%*li",MED_MAX_PARA,(long ) numdt,MED_MAX_PARA,(long ) numo);
178
179 datagroup2 = 0;
180 if ( (datagroup2 = _MEDdatagroupOuvrir(datagroup1,nomdatagroup2)) < 0 )
181 if ((datagroup2 = _MEDdatagroupCreer(datagroup1,nomdatagroup2)) < 0 )
182 goto ERROR;
183
184 /*Cree ou ouvre l'attribut MED_NOM_NDT pour écriture */
185 if ( _MEDattrEntierEcrire(datagroup2,MED_NOM_NDT,&numdt) < 0)
186 goto ERROR;
187
188 /*Cree ou ouvre l'attribut MED_NOM_PDT pour écriture */
189 if ( _MEDattrFloatEcrire(datagroup2,MED_NOM_PDT,&dt) < 0)
190 goto ERROR;
191
192 /*Cree ou ouvre l'attribut MED_NOM_NOR pour écriture */
193 if (_MEDattrEntierEcrire(datagroup2,MED_NOM_NOR,&numo) < 0)
194 goto ERROR;
195
196 /*Cree ou ouvre l'attribut MED_NOM_UNI pour écriture */
197 if ( numdt == MED_NOPDT ) {
198 if ( _MEDattrStringEcrire(datagroup2,MED_NOM_UNI,MED_TAILLE_PNOM,MED_PNOM_BLANC) < 0)
199 goto ERROR;
200 } else
201 if ( _MEDattrStringEcrire(datagroup2,MED_NOM_UNI,MED_TAILLE_PNOM,dt_unit) < 0)
202 goto ERROR;
203
204
205 /*
206 * Si c'est la première référence à un maillage, initialise l'attribut MED_MAA à ce maillage
207 */
208 if ((attr = _MEDattrOuvrir(datagroup2,MED_NOM_MAI)) < 0 ) {
209 if (_MEDattrStringEcrire(datagroup2,MED_NOM_MAI,MED_TAILLE_NOM,maa) < 0)
210 goto ERROR;
211 } else {
212 if ( _MEDattrFermer(attr) < 0) goto ERROR;
213 }
214
215
216
217 /*
218 * Cree ou ouvre le datagroup de niveau 3 <maa>
219 */
220 /* if (_MEDcstring(maa,maaNoBlc) <0) { */
221 /* MESSAGE("Erreur à la convertion du nom du maillage : "); */
222 /* SSCRUTE(maaNoBlc); */
223 /* goto ERROR; */
224 /* } */
225 NOFINALBLANK(maa,ERROR)
226
227 datagroup3 = 0;
228 if (((datagroup3 = _MEDdatagroupOuvrir(datagroup2,maa)) > 0)
229 && ( MED_MODE_ACCES == MED_LECTURE_AJOUT )) {
230 MESSAGE("Impossible de créer une reference à un maillage existant en mode MED_LECTURE_AJOUT :");
231 goto ERROR;
232 } else
233 if (datagroup3 < 0)
234 if ((datagroup3 = _MEDdatagroupCreer(datagroup2,maa)) < 0)
235 goto ERROR;
236
237 /*Cree ou ouvre l'attribut MED_NOM_NBR */
238 if ( _MEDattrEntierEcrire(datagroup3,MED_NOM_NBR,&nbelem) < 0)
239 goto ERROR;
240
241 /*Cree ou ouvre l'attribut MED_NOM_PFL */
242 pfluse = 0;
243 if ( strlen(profil) == 0) /* idem MED_NOPFL*/
244 /* Ecriture de MED_NOPFLi car MED_NOM_PFL est forcément de taille MED_TAILLE_NOM*/
245 strncpy(pflname,MED_NOPFLi,MED_TAILLE_NOM+1);
246 else {
247 strncpy(pflname,profil,MED_TAILLE_NOM);
248 pflname[MED_TAILLE_NOM]='\0';
249 pfluse = 1;
250 }
251 if ( _MEDattrStringEcrire(datagroup3,MED_NOM_PFL,MED_TAILLE_NOM,pflname) < 0){
252 MESSAGE("Erreur d'écriture de l'attribut pflname : ");
253 SSCRUTE(chemin); goto ERROR;
254 }
255
256 /* Lit le nombre de points de gauss et vérifie */
257 /* que la localisation porte sur le meme type géométrique */
258
259 if ( strlen(locname) == 0 ) {
260 /* Ecriture de MED_NOGAUSSi car MED_NOM_GAUSS est forcément de taille MED_TAILLE_NOM*/
261 strcpy(locname_i,MED_NOGAUSSi);
262 ngauss = MED_NOPG ;
263 } else if (! strcmp(locname,MED_GAUSS_ELNO)) {
264 /* Les points de Gauss sont définis sur les noeuds de l'element (mot cle) */
265 /* le nombre de points de Gauss est egal au nombre de noeuds de l'element */
266 ngauss = type_geo % 100;
267 strcpy(locname_i,locname);
268
269 } else {
270 strcpy(locname_i,locname);
271
272 strcpy(chemin_loc,MED_GAUSS);
273 strcat(chemin_loc,locname_i);
274
275 if ((gid_loc = _MEDdatagroupOuvrir(fid,chemin_loc)) < 0) {
276 MESSAGE("Ouverture du datagroup : ");
277 SSCRUTE(chemin_loc); goto ERROR;
278 }
279
280 if (_MEDattrEntierLire(gid_loc,MED_NOM_NBR,&ngauss) < 0) {
281 MESSAGE("Erreur à la lecture de l'attribut MED_NOM_NBR : ");
282 ISCRUTE(ngauss);goto ERROR;
283 };
284
285
286 if (_MEDattrEntierLire(gid_loc,MED_NOM_GEO,&type_geo_g_int) < 0) {
287 MESSAGE("Erreur à la lecture de l'attribut MED_NOM_GEO : ");
288 ISCRUTE(type_geo_g_int);goto ERROR;
289 };
290 type_geo_g = type_geo_g_int;
291
292 if ( type_geo_g != type_geo ) {
293 MESSAGE("Erreur, la localisation ne porte pas sur le meme type géométrique : ");
294 SSCRUTE(locname);ISCRUTE_int(type_geo);ISCRUTE_int(type_geo_g);goto ERROR;
295 };
296
297 }
298
299 /* Cree ou ouvre l'attribut MED_NOM_GAU */
300 /* Ecriture de la localisation des pts de gauss */
301 if ( _MEDattrStringEcrire(datagroup3,MED_NOM_GAU,MED_TAILLE_NOM,locname_i) < 0) {
302 MESSAGE("Erreur d'écriture de l'attribut MED_NOM_GAU : ");
303 SSCRUTE(locname); goto ERROR;
304 }
305
306 /* Cree ou ouvre l'attribut MED_NOM_NGA */
307 /* Ecriture de l'attribut portant le nombre de points de gauss */
308 if ( _MEDattrEntierEcrire(datagroup3,MED_NOM_NGA,&ngauss) < 0) {
309 MESSAGE("Erreur d'écriture de l'attribut MED_NOM_NGA : ");
310 ISCRUTE(ngauss); goto ERROR;
311 }
312
313 /*Determination de la taille dimd[0] du dataset à stocker*/
314 dimd[0] = nbelem*ncomp;
315
316 /* Gestion des profils*/
317 if ( pfluse ) {
318
319 if ( ( i = MEDnValProfil(fid,pflname) ) < 0 ) {
320 MESSAGE("Erreur à la lecture du nombre de valeurs sur le profil : ");
321 SSCRUTE(pflname);
322 goto ERROR;
323 } else
324 psize = i;
325
326 pfltabtmp = (med_int *) malloc (sizeof(med_int)*psize);
327 pfltab = (med_size *) malloc (sizeof(med_size)*psize);
328 if (MEDprofilLire(fid,pfltabtmp,pflname) < 0) {
329 MESSAGE("Erreur à la lecture du profil : ");
330 SSCRUTE(pflname);goto ERROR;
331 };
332 for (i=0;i<psize;i++)
333 pfltab[i] = (med_size) pfltabtmp[i];
334
335 }
336 else
337 psize = MED_NOPF;
338
339
340 /*
341 * Ecriture du champ
342 */
343
344 switch(chtype)
345 {
346 case MED_FLOAT64 :
347 if ( _MEDdatasetNumEcrire(datagroup3,MED_NOM_CO,MED_FLOAT64,interlace,
348 ncomp,numco,psize,pflmod,0,pfltab,ngauss,dimd,val) < 0) {
349 MESSAGE("Impossible d'ecrire le dataset : ");
350 SSCRUTE(MED_NOM_CO);ISCRUTE((int)(dimd[0])); goto ERROR;
351 }
352 break;
353
354 case MED_INT32 :
355 #if defined(HAVE_F77INT64)
356 if ( _MEDdatasetNumEcrire(datagroup3,MED_NOM_CO,MED_INT64,interlace,
357 ncomp,numco,psize,pflmod,0,pfltab,ngauss,dimd,val) < 0) {
358 MESSAGE("Impossible d'ecrire le dataset : ");
359 SSCRUTE(MED_NOM_CO);ISCRUTE((int)(dimd[0])); goto ERROR;
360 }
361 #else
362 if ( _MEDdatasetNumEcrire(datagroup3,MED_NOM_CO,MED_INT32,interlace,
363 ncomp,numco,psize,pflmod,0,pfltab,ngauss,dimd,val) < 0){
364 MESSAGE("Impossible d'ecrire le dataset : ");
365 SSCRUTE(MED_NOM_CO);ISCRUTE((int)(dimd[0])); goto ERROR;
366 }
367 #endif
368 break;
369
370 case MED_INT64 :
371 #if defined(HAVE_F77INT64)
372 if ( _MEDdatasetNumEcrire(datagroup3,MED_NOM_CO,MED_INT64,interlace,
373 ncomp,numco,psize,pflmod,0,pfltab,ngauss,dimd,val) < 0){
374 MESSAGE("Impossible d'ecrire le dataset : ");
375 SSCRUTE(MED_NOM_CO);ISCRUTE(dimd); goto ERROR;
376 }
377 #else
378 MESSAGE("Impossible d'ecrire le dataset de type MED_INT64 sur une plateforme autre que IRIX64 et OSF1 !");
379 goto ERROR;
380 #endif
381 break;
382
383 default :
384 goto ERROR;
385 }
386
387 /*
388 * On ferme tout
389 */
390
391 ret = 0;
392
393 ERROR:
394
395 if ( pfluse ) { free(pfltab); free(pfltabtmp);}
396
397 if (datagroup3>0) if (_MEDdatagroupFermer(datagroup3) < 0) {
398 MESSAGE("Impossible de fermer le datagroup : ");
399 ISCRUTE_int(datagroup3); ret = -1;
400 }
401
402 if (datagroup2>0) if (_MEDdatagroupFermer(datagroup2) < 0) {
403 MESSAGE("Impossible de fermer le datagroup : ");
404 ISCRUTE_int(datagroup2); ret = -1;
405 }
406
407 if (datagroup1>0) if (_MEDdatagroupFermer(datagroup1) < 0) {
408 MESSAGE("Impossible de fermer le datagroup : ");
409 ISCRUTE_int(datagroup1); ret = -1;
410 }
411
412 if (gid>0) if (_MEDdatagroupFermer(gid) < 0) {
413 MESSAGE("Impossible de fermer le datagroup : ");
414 ISCRUTE_id(gid); ret = -1;
415 }
416
417 if (gid_loc>0) if (_MEDdatagroupFermer(gid_loc) < 0) {
418 MESSAGE("Impossible de fermer le datagroup : ");
419 ISCRUTE_id(gid_loc); ret = -1;
420 }
421
422 va_end(params);
423 *fret = ret;
424 return;
425 }
426
427