30 integer ret,user_interlace,user_mode
33 character*32 maa1,maa2,maa3
34 character*13 lien_maa2
37 character*16 comp1(2), unit1(2)
38 character*16 dtunit1, nounit
43 real*8 refcoo1(12), gscoo1_1(12), wg1_1(6)
49 real*8 gscoo1_2(6), wg1_2(3)
54 integer ngauss1_3,nval1_3
60 character*16 comp2(3), unit2(3)
62 integer valr2(5*3), valr2p(3*3)
65 character*32 nomprofil1
66 integer profil1(2) , profil2(3)
68 parameter(user_interlace = med_full_interlace)
69 parameter(user_mode = med_compact )
70 parameter( a=0.446948490915965d0, b=0.091576213509771d0 )
71 parameter( p1=0.11169079483905d0, p2=0.0549758718227661d0 )
73 parameter( maa1 =
"maa1", maa2 =
"maa2", maa3 =
"maa3" )
74 parameter( lien_maa2=
"./testfoo.med" )
76 parameter( nomcha1 =
"champ reel" )
77 parameter( ncomp1 = 2 )
78 parameter( dtunit1 =
" ")
79 parameter( nounit =
" ")
81 parameter( gauss1_1 =
"Model n1" )
82 parameter( ngauss1_1 = 6 )
84 parameter( gauss1_2 =
"Model n2" )
85 parameter( ngauss1_2 = 3 )
87 parameter( ngauss1_3 = 6 )
88 parameter( nval1_3 = 6 )
90 parameter( nomcha2=
"champ entier")
91 parameter( ncomp2 = 3, nval2= 5 )
93 parameter( nomprofil1 =
"PROFIL(champ(1))" )
97 data comp1 /
"comp1",
"comp2"/
98 data unit1 /
"unit1",
"unit2"/
101 data refcoo1 / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0,
102 1 0.0,-1.0, 0.0,0.0 /
103 data valr1_1 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
104 1 20.0,21.0, 22.0,23.0/
106 data valr1_2 / 0.0,1.0, 2.0,3.0, 10.0,11.0,
107 1 12.0,13.0, 20.0,21.0, 22.0,23.0 /
108 data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 /
110 data valr1_3 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
111 1 20.0,21.0, 22.0,23.0 /
112 data valr1_3p / 2.0,3.0, 10.0,11.0 /
114 data comp2 /
"comp1",
"comp2",
"comp3"/
115 data unit2 /
"unit1",
"unit2",
"unit3"/
116 data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 /
117 data valr2p / 0,1,2, 20,21,22, 40,41,42 /
145 gscoo1_2(1) = -2.0d0/3
146 gscoo1_2(2) = 1.0d0/3
147 gscoo1_2(3) = -2.0d0/3
148 gscoo1_2(4) = -2.0d0/3
149 gscoo1_2(5) = 1.0d0/3
150 gscoo1_2(6) = -2.0d0/3
157 call efouvr(fid,
'test10.med',med_lecture_ecriture, ret)
158 if (ret .ne. 0 )
then 159 print *,
'Erreur à l''ouverture du fichier : ',
'test10.med' 164 call efmaac(fid,maa1,3,med_non_structure,
165 1
"Maillage vide",ret)
166 if (ret .ne. 0 )
then 167 print *,
'Erreur à la création du maillage : ', maa1
172 call efmaac(fid,maa3,3,med_non_structure,
173 1
"Maillage vide",ret)
174 if (ret .ne. 0 )
then 175 print *,
'Erreur à la création du maillage : ', maa3
181 call efchac(fid,nomcha1,
med_float64,comp1,unit1,ncomp1,ret)
182 if (ret .ne. 0 )
then 183 print *,
'Erreur à la création du champ : ', nomcha1
188 call efchac(fid,nomcha2,
med_int32,comp2,unit2,ncomp2,ret)
189 if (ret .ne. 0 )
then 190 print *,
'Erreur à la création du champ : ', nomcha2
195 call efliee(fid,lien_maa2,maa2,ret)
196 if (ret .ne. 0 )
then 197 print *,
'Erreur à la création du lien : ', lien_maa2
202 call efgaue(fid, med_tria6, refcoo1, user_interlace,
203 1 ngauss1_1, gscoo1_1, wg1_1, gauss1_1, ret)
204 if (ret .ne. 0 )
then 205 print *,
'Erreur à la création du modèle n°1 : ', gauss1_1
210 call efgaue(fid, med_tria6, refcoo1, user_interlace,
211 1 ngauss1_2, gscoo1_2, wg1_2, gauss1_2, ret)
212 if (ret .ne. 0 )
then 213 print *,
'Erreur à la création du modèle n°2 : ', gauss1_2
222 call efchae(fid,maa1,nomcha1,valr1_1,user_interlace,nval1_1,
223 1 gauss1_1,2,med_nopfl,med_no_pflmod,
224 2 med_maille,med_tria6,
225 3 med_nopdt,dtunit1,dt,med_nonor,ret)
226 if (ret .ne. 0 )
then 227 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.1' 234 call efchae(fid,maa1,nomcha1,valr1_1,user_interlace,nval1_1,
235 1 gauss1_1,1,med_nopfl,med_no_pflmod,
236 2 med_maille,med_tria6,
237 3 med_nopdt,dtunit1,dt,med_nonor,ret)
238 if (ret .ne. 0 )
then 239 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.2' 249 call efchae(fid,maa2,nomcha1,valr1_2,user_interlace,nval1_2,
250 1 gauss1_2,1,med_nopfl,med_no_pflmod,
251 2 med_maille,med_tria6,
252 3 1,
"ms",dt,med_nonor,ret)
253 if (ret .ne. 0 )
then 254 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.3' 264 call efchae(fid,maa1,nomcha1,valr1_1,user_interlace,nval1_1,
265 1 gauss1_1,2,med_nopfl,med_no_pflmod,
266 2 med_maille,med_tria6,
267 3 1,
"ms",dt,med_nonor,ret)
268 if (ret .ne. 0 )
then 269 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.4' 280 call efchae(fid,maa3,nomcha1,valr1_2,user_interlace,nval1_2,
281 1 gauss1_2,1,med_nopfl,med_no_pflmod,
282 2 med_maille,med_tria6,
284 if (ret .ne. 0 )
then 285 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.5' 291 call efpfle(fid,profil1,1,nomprofil1,ret)
292 if (ret .ne. 0 )
then 293 print *,
'Erreur à la création du profil : ', nomprofil1
304 call efchae(fid,maa1,nomcha1,valr1_3p,user_interlace,nval1_3,
305 1 med_nogauss,med_all,nomprofil1,user_mode,
306 2 med_maille,med_tria6,
308 if (ret .ne. 0 )
then 309 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.6' 319 call efchae(fid,maa2,nomcha1,valr1_2p,user_interlace,nval1_2,
320 1 gauss1_2,med_all,nomprofil1,user_mode,
321 2 med_maille,med_tria6,
323 if (ret .ne. 0 )
then 324 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.7' 335 call efchae(fid,maa1,nomcha1,valr1_3p,user_interlace,nval1_3,
336 1 med_nogauss,2,nomprofil1,user_mode,
337 2 med_maille,med_tria6,
339 if (ret .ne. 0 )
then 340 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.8' 349 call efchae(fid,maa1,nomcha2,valr2,user_interlace,nval2,
350 1 med_nogauss,1,med_nopfl,med_no_pflmod,med_arete,
351 1 med_seg2,med_nopdt,nounit,dt,med_nonor,ret)
352 if (ret .ne. 0 )
then 353 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.1' 362 call efchae(fid,maa1,nomcha2,valr2,user_interlace,nval2,
363 1 med_nogauss,2,med_nopfl,med_no_pflmod,med_noeud,
364 1 0,med_nopdt,nounit,dt,med_nonor,ret)
365 if (ret .ne. 0 )
then 366 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.2' 376 call efchae(fid,maa1,nomcha2,valr2,user_interlace,nval2,
377 1 med_nogauss,3,med_nopfl,med_no_pflmod,med_face,
378 1 med_tria6,med_nopdt,nounit,dt,med_nonor,ret)
379 if (ret .ne. 0 )
then 380 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.3' 386 call efpfle(fid,profil2,3,
"PROFIL(champ2)",ret)
387 if (ret .ne. 0 )
then 388 print *,
'Erreur à l''écriture du profil : ',
400 call efchae(fid,maa1,nomcha2,valr2p,user_interlace,nval2,
401 1 med_nogauss,3,
"PROFIL(champ2)",user_mode,med_maille,
402 1 med_tria6,med_nopdt,nounit,dt,med_nonor,ret)
403 if (ret .ne. 0 )
then 404 print *,
'Erreur à l''écriture du profil : ',
410 call efferm (fid,ret)
411 if (ret .ne. 0 )
then 412 print *,
'Erreur à la fermeture du fichier : ' 416 print *,
"Le code retour : ",ret