29 integer ret,fid,user_interlace,user_mode
32 character*32 maa1,maa2,maa3
33 character*13 lien_maa2
36 character*16 comp1(2), unit1(2)
37 character*16 dtunit1, nounit
42 real*8 refcoo1(12), gscoo1_1(12), wg1_1(6)
48 real*8 gscoo1_2(6), wg1_2(3)
53 integer ngauss1_3,nval1_3
59 character*16 comp2(3), unit2(3)
61 integer valr2(5*3), valr2p(3*3)
65 character*16 comp3(2), unit3(2)
67 integer valr3(5*4*2), valr3p(3*4*2)
70 character*32 nomprofil1
71 integer profil1(2) , profil2(3)
73 parameter(user_interlace = med_full_interlace)
74 parameter(user_mode = med_compact )
75 parameter( a=0.446948490915965d0, b=0.091576213509771d0 )
76 parameter( p1=0.11169079483905d0, p2=0.0549758718227661d0 )
78 parameter( maa1 =
"maa1", maa2 =
"maa2", maa3 =
"maa3" )
79 parameter( lien_maa2=
"./testfoo.med" )
81 parameter( nomcha1 =
"champ reel" )
82 parameter( ncomp1 = 2 )
83 parameter( dtunit1 =
" ")
84 parameter( nounit =
" ")
86 parameter( gauss1_1 =
"Model n1" )
87 parameter( ngauss1_1 = 6 )
89 parameter( gauss1_2 =
"Model n2" )
90 parameter( ngauss1_2 = 3 )
92 parameter( ngauss1_3 = 6 )
93 parameter( nval1_3 = 6 )
95 parameter( nomcha2=
"champ entier")
96 parameter( ncomp2 = 3, nval2= 5 )
98 parameter( nomcha3=
"champ entier 3")
99 parameter( ncomp3 = 2, nval3= 5*4 )
101 parameter( nomprofil1 =
"PROFIL(champ(1))" )
105 data comp1 /
"comp1",
"comp2"/
106 data unit1 /
"unit1",
"unit2"/
109 data refcoo1 / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0,
110 1 0.0,-1.0, 0.0,0.0 /
111 data valr1_1 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
112 1 20.0,21.0, 22.0,23.0/
114 data valr1_2 / 0.0,1.0, 2.0,3.0, 10.0,11.0,
115 1 12.0,13.0, 20.0,21.0, 22.0,23.0 /
116 data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 /
118 data valr1_3 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
119 1 20.0,21.0, 22.0,23.0 /
120 data valr1_3p / 2.0,3.0, 10.0,11.0 /
122 data comp2 /
"comp1",
"comp2",
"comp3"/
123 data unit2 /
"unit1",
"unit2",
"unit3"/
124 data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 /
125 data valr2p / 0,1,2, 20,21,22, 40,41,42 /
127 data comp3 /
"comp1",
"comp2"/
128 data unit3 /
"unit1",
"unit2"/
129 data valr3 / 0,1, 10,11, 20,21, 30,31,
130 1 40,41, 50,51, 60,61, 70,71,
131 1 80,81, 90,91, 100,101, 110,111,
132 1 120,121, 130,131, 140,141, 150,151,
133 1 160,161, 170,171, 180,181, 190,191 /
134 data valr3p / 0,1, 10,11, 20,21, 30,31,
135 1 80,81, 90,91, 100,101, 110,111,
136 1 160,161, 170,171, 180,181, 190,191 /
166 gscoo1_2(1) = -2.0d0/3
167 gscoo1_2(2) = 1.0d0/3
168 gscoo1_2(3) = -2.0d0/3
169 gscoo1_2(4) = -2.0d0/3
170 gscoo1_2(5) = 1.0d0/3
171 gscoo1_2(6) = -2.0d0/3
178 call efouvr(fid,
'test10.med',med_lecture_ecriture, ret)
179 if (ret .ne. 0 )
then
180 print *,
'Erreur à l''ouverture du fichier : ',
'test10.med'
185 call efmaac(fid,maa1,3,med_non_structure,
186 1
"Maillage vide",ret)
187 if (ret .ne. 0 )
then
188 print *,
'Erreur à la création du maillage : ', maa1
193 call efmaac(fid,maa3,3,med_non_structure,
194 1
"Maillage vide",ret)
195 if (ret .ne. 0 )
then
196 print *,
'Erreur à la création du maillage : ', maa3
202 call efchac(fid,nomcha1,
med_float64,comp1,unit1,ncomp1,ret)
203 if (ret .ne. 0 )
then
204 print *,
'Erreur à la création du champ : ', nomcha1
209 call efchac(fid,nomcha2,
med_int32,comp2,unit2,ncomp2,ret)
210 if (ret .ne. 0 )
then
211 print *,
'Erreur à la création du champ : ', nomcha2
216 call efliee(fid,lien_maa2,maa2,ret)
217 if (ret .ne. 0 )
then
218 print *,
'Erreur à la création du lien : ', lien_maa2
223 call efgaue(fid, med_tria6, refcoo1, user_interlace,
224 1 ngauss1_1, gscoo1_1, wg1_1, gauss1_1, ret)
225 if (ret .ne. 0 )
then
226 print *,
'Erreur à la création du modèle n°1 : ', gauss1_1
231 call efgaue(fid, med_tria6, refcoo1, user_interlace,
232 1 ngauss1_2, gscoo1_2, wg1_2, gauss1_2, ret)
233 if (ret .ne. 0 )
then
234 print *,
'Erreur à la création du modèle n°2 : ', gauss1_2
243 call efchae(fid,maa1,nomcha1,valr1_1,user_interlace,nval1_1,
244 1 gauss1_1,2,med_nopfl,med_no_pflmod,
245 2 med_maille,med_tria6,
246 3 med_nopdt,dtunit1,dt,med_nonor,ret)
247 if (ret .ne. 0 )
then
248 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.1'
255 call efchae(fid,maa1,nomcha1,valr1_1,user_interlace,nval1_1,
256 1 gauss1_1,1,med_nopfl,med_no_pflmod,
257 2 med_maille,med_tria6,
258 3 med_nopdt,dtunit1,dt,med_nonor,ret)
259 if (ret .ne. 0 )
then
260 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.2'
270 call efchae(fid,maa2,nomcha1,valr1_2,user_interlace,nval1_2,
271 1 gauss1_2,1,med_nopfl,med_no_pflmod,
272 2 med_maille,med_tria6,
273 3 1,
"ms",dt,med_nonor,ret)
274 if (ret .ne. 0 )
then
275 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.3'
285 call efchae(fid,maa1,nomcha1,valr1_1,user_interlace,nval1_1,
286 1 gauss1_1,2,med_nopfl,med_no_pflmod,
287 2 med_maille,med_tria6,
288 3 1,
"ms",dt,med_nonor,ret)
289 if (ret .ne. 0 )
then
290 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.4'
301 call efchae(fid,maa3,nomcha1,valr1_2,user_interlace,nval1_2,
302 1 gauss1_2,1,med_nopfl,med_no_pflmod,
303 2 med_maille,med_tria6,
305 if (ret .ne. 0 )
then
306 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.5'
312 call efpfle(fid,profil1,1,nomprofil1,ret)
313 if (ret .ne. 0 )
then
314 print *,
'Erreur à la création du profil : ', nomprofil1
325 call efchae(fid,maa1,nomcha1,valr1_3p,user_interlace,nval1_3,
326 1 med_nogauss,med_all,nomprofil1,user_mode,
327 2 med_maille,med_tria6,
329 if (ret .ne. 0 )
then
330 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.6'
340 call efchae(fid,maa2,nomcha1,valr1_2p,user_interlace,nval1_2,
341 1 gauss1_2,med_all,nomprofil1,user_mode,
342 2 med_maille,med_tria6,
344 if (ret .ne. 0 )
then
345 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.7'
356 call efchae(fid,maa1,nomcha1,valr1_3p,user_interlace,nval1_3,
357 1 med_nogauss,2,nomprofil1,user_mode,
358 2 med_maille,med_tria6,
360 if (ret .ne. 0 )
then
361 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.8'
370 call efchae(fid,maa1,nomcha2,valr2,user_interlace,nval2,
371 1 med_nogauss,1,med_nopfl,med_no_pflmod,med_arete,
372 1 med_seg2,med_nopdt,nounit,dt,med_nonor,ret)
373 if (ret .ne. 0 )
then
374 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.1'
383 call efchae(fid,maa1,nomcha2,valr2,user_interlace,nval2,
384 1 med_nogauss,2,med_nopfl,med_no_pflmod,med_noeud,
385 1 0,med_nopdt,nounit,dt,med_nonor,ret)
386 if (ret .ne. 0 )
then
387 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.2'
397 call efchae(fid,maa1,nomcha2,valr2,user_interlace,nval2,
398 1 med_nogauss,3,med_nopfl,med_no_pflmod,med_face,
399 1 med_tria6,med_nopdt,nounit,dt,med_nonor,ret)
400 if (ret .ne. 0 )
then
401 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.3'
407 call efpfle(fid,profil2,3,
"PROFIL(champ2)",ret)
408 if (ret .ne. 0 )
then
409 print *,
'Erreur à l''écriture du profil : ',
421 call efchae(fid,maa1,nomcha2,valr2p,user_interlace,nval2,
422 1 med_nogauss,3,
"PROFIL(champ2)",user_mode,med_maille,
423 1 med_tria6,med_nopdt,nounit,dt,med_nonor,ret)
424 if (ret .ne. 0 )
then
425 print *,
'Erreur à l''écriture du profil : ',
431 call efchac(fid,nomcha3,
med_int32,comp3,unit3,ncomp3,ret)
432 if (ret .ne. 0 )
then
433 print *,
'Erreur à la création du champ : ', nomcha3
442 call efchae(fid,maa1,nomcha3,valr3,user_interlace,nval3,
443 1 med_nogauss,1,med_nopfl,med_no_pflmod,med_noeud_maille,
444 1 med_quad4,med_nopdt,nounit,dt,med_nonor,ret)
445 if (ret .ne. 0 )
then
446 print *,
'Erreur à l''écriture du champ : ', nomcha3,
'et.1'
455 call efchae(fid,maa2,nomcha3,valr3,user_interlace,nval3,
456 1 med_nogauss,med_all,med_nopfl,med_no_pflmod,
458 1 med_quad4,med_nopdt,nounit,dt,med_nonor,ret)
459 if (ret .ne. 0 )
then
460 print *,
'Erreur à l''écriture du champ : ', nomcha3,
'et.2'
470 call efchae(fid,maa3,nomcha3,valr3p,user_interlace,nval3,
471 1 med_nogauss,med_all,
"PROFIL(champ2)",user_mode,
473 1 med_quad4,med_nopdt,nounit,dt,med_nonor,ret)
474 if (ret .ne. 0 )
then
475 print *,
'Erreur à l''écriture du profil : ',
481 call efferm (fid,ret)
482 if (ret .ne. 0 )
then
483 print *,
'Erreur à la fermeture du fichier : '
487 print *,
"Le code retour : ",ret