00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024 program test10
00025
00026 implicit none
00027 include 'med.hf'
00028
00029 integer ret,fid,USER_INTERLACE,USER_MODE
00030 real*8 a,b,p1,p2,dt
00031
00032 character*32 maa1,maa2,maa3
00033 character*13 lien_maa2
00034
00035 character*32 nomcha1
00036 character*16 comp1(2), unit1(2)
00037 character*16 dtunit1, nounit
00038 integer ncomp1
00039
00040 integer ngauss1_1
00041 character*32 gauss1_1
00042 real*8 refcoo1(12), gscoo1_1(12), wg1_1(6)
00043 integer nval1_1
00044 real*8 valr1_1(1*6*2)
00045
00046 integer ngauss1_2
00047 character*32 gauss1_2
00048 real*8 gscoo1_2(6), wg1_2(3)
00049 integer nval1_2
00050 real*8 valr1_2(2*3*2)
00051 real*8 valr1_2p(2*3)
00052
00053 integer ngauss1_3,nval1_3
00054 real*8 valr1_3(2*3*2)
00055 real*8 valr1_3p(2*2)
00056
00057
00058 character*32 nomcha2
00059 character*16 comp2(3), unit2(3)
00060 integer ncomp2, nval2
00061 integer valr2(5*3), valr2p(3*3)
00062
00063
00064 character*32 nomprofil1
00065 integer profil1(2) , profil2(3)
00066
00067 parameter (USER_INTERLACE = MED_FULL_INTERLACE)
00068 parameter (USER_MODE = MED_COMPACT )
00069 parameter ( a=0.446948490915965D0, b=0.091576213509771D0 )
00070 parameter ( p1=0.11169079483905D0, p2=0.0549758718227661D0 )
00071
00072 parameter ( maa1 = "maa1", maa2 = "maa2", maa3 = "maa3" )
00073 parameter ( lien_maa2= "./testfoo.med" )
00074
00075 parameter ( nomcha1 = "champ reel" )
00076 parameter ( ncomp1 = 2 )
00077 parameter ( dtunit1 = " ")
00078 parameter ( nounit = " ")
00079
00080 parameter ( gauss1_1 = "Model n1" )
00081 parameter ( ngauss1_1 = 6 )
00082
00083 parameter ( gauss1_2 = "Model n2" )
00084 parameter ( ngauss1_2 = 3 )
00085
00086 parameter ( ngauss1_3 = 6 )
00087 parameter ( nval1_3 = 6 )
00088
00089 parameter ( nomcha2="champ entier")
00090 parameter ( ncomp2 = 3, nval2= 5 )
00091
00092 parameter ( nomprofil1 = "PROFIL(champ(1))" )
00093
00094
00095
00096 data comp1 /"comp1", "comp2"/
00097 data unit1 /"unit1","unit2"/
00098
00099 data nval1_1 / 1*6 /
00100 data refcoo1 / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0,
00101 1 0.0,-1.0, 0.0,0.0 /
00102 data valr1_1 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
00103 1 20.0,21.0, 22.0,23.0/
00104
00105 data valr1_2 / 0.0,1.0, 2.0,3.0, 10.0,11.0,
00106 1 12.0,13.0, 20.0,21.0, 22.0,23.0 /
00107 data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 /
00108
00109 data valr1_3 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
00110 1 20.0,21.0, 22.0,23.0 /
00111 data valr1_3p / 2.0,3.0, 10.0,11.0 /
00112
00113 data comp2 /"comp1", "comp2", "comp3"/
00114 data unit2 /"unit1","unit2", "unit3"/
00115 data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 /
00116 data valr2p / 0,1,2, 20,21,22, 40,41,42 /
00117
00118 data profil1 /2,3/
00119 data profil2 /1,3,5/
00120
00121 ret = 0
00122
00123 gscoo1_1(1) = 2*b-1
00124 gscoo1_1(2) = 1-4*b
00125 gscoo1_1(3) = 2*b-1
00126 gscoo1_1(4) = 2*b-1
00127 gscoo1_1(5) = 1-4*b
00128 gscoo1_1(6) = 2*b-1
00129 gscoo1_1(7) = 1-4*a
00130 gscoo1_1(8) = 2*a-1
00131 gscoo1_1(9) = 2*a-1
00132 gscoo1_1(10) = 1-4*a
00133 gscoo1_1(11) = 2*a-1
00134 gscoo1_1(12) = 2*a-1
00135
00136 wg1_1(1) = 4*p2
00137 wg1_1(2) = 4*p2
00138 wg1_1(3) = 4*p2
00139 wg1_1(4) = 4*p1
00140 wg1_1(5) = 4*p1
00141 wg1_1(6) = 4*p1
00142
00143 nval1_2 = 2*3
00144 gscoo1_2(1) = -2.0D0/3
00145 gscoo1_2(2) = 1.0D0/3
00146 gscoo1_2(3) = -2.0D0/3
00147 gscoo1_2(4) = -2.0D0/3
00148 gscoo1_2(5) = 1.0D0/3
00149 gscoo1_2(6) = -2.0D0/3
00150
00151 wg1_2(1) = 2.0D0/3
00152 wg1_2(2) = 2.0D0/3
00153 wg1_2(3) = 2.0D0/3
00154
00155
00156 call efouvr(fid,'test10.med',MED_LECTURE_ECRITURE, ret)
00157 if (ret .ne. 0 ) then
00158 print *,'Erreur à l''ouverture du fichier : ','test10.med'
00159 call efexit(-1)
00160 endif
00161
00162
00163 call efmaac(fid,maa1,3,MED_NON_STRUCTURE,
00164 1 "Maillage vide",ret)
00165 if (ret .ne. 0 ) then
00166 print *,'Erreur à la création du maillage : ', maa1
00167 call efexit(-1)
00168 endif
00169
00170
00171 call efmaac(fid,maa3,3,MED_NON_STRUCTURE,
00172 1 "Maillage vide",ret)
00173 if (ret .ne. 0 ) then
00174 print *,'Erreur à la création du maillage : ', maa3
00175 call efexit(-1)
00176 endif
00177
00178
00179
00180 call efchac(fid,nomcha1,MED_FLOAT64,comp1,unit1,ncomp1,ret)
00181 if (ret .ne. 0 ) then
00182 print *,'Erreur à la création du champ : ', nomcha1
00183 ret = -1
00184 endif
00185
00186
00187 call efchac(fid,nomcha2,MED_INT32,comp2,unit2,ncomp2,ret)
00188 if (ret .ne. 0 ) then
00189 print *,'Erreur à la création du champ : ', nomcha2
00190 ret = -1
00191 endif
00192
00193
00194 call efliee(fid,lien_maa2,maa2,ret)
00195 if (ret .ne. 0 ) then
00196 print *,'Erreur à la création du lien : ', lien_maa2
00197 ret = -1
00198 endif
00199
00200
00201 call efgaue(fid, MED_TRIA6, refcoo1, USER_INTERLACE,
00202 1 ngauss1_1, gscoo1_1, wg1_1, gauss1_1, ret)
00203 if (ret .ne. 0 ) then
00204 print *,'Erreur à la création du modèle n°1 : ', gauss1_1
00205 ret = -1
00206 endif
00207
00208
00209 call efgaue(fid, MED_TRIA6, refcoo1, USER_INTERLACE,
00210 1 ngauss1_2, gscoo1_2, wg1_2, gauss1_2, ret)
00211 if (ret .ne. 0 ) then
00212 print *,'Erreur à la création du modèle n°2 : ', gauss1_2
00213 ret = -1
00214 endif
00215
00216
00217
00218
00219
00220 dt = 0.0D0
00221 call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1,
00222 1 gauss1_1,2,MED_NOPFL,MED_NO_PFLMOD,
00223 2 MED_MAILLE,MED_TRIA6,
00224 3 MED_NOPDT,dtunit1,dt,MED_NONOR,ret)
00225 if (ret .ne. 0 ) then
00226 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.1'
00227 ret = -1
00228 endif
00229
00230
00231
00232
00233 call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1,
00234 1 gauss1_1,1,MED_NOPFL,MED_NO_PFLMOD,
00235 2 MED_MAILLE,MED_TRIA6,
00236 3 MED_NOPDT,dtunit1,dt,MED_NONOR,ret)
00237 if (ret .ne. 0 ) then
00238 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.2'
00239 ret = -1
00240 endif
00241
00242
00243
00244
00245
00246
00247 dt = 5.5D0
00248 call efchae(fid,maa2,nomcha1,valr1_2,USER_INTERLACE,nval1_2,
00249 1 gauss1_2,1,MED_NOPFL,MED_NO_PFLMOD,
00250 2 MED_MAILLE,MED_TRIA6,
00251 3 1,"ms",dt,MED_NONOR,ret)
00252 if (ret .ne. 0 ) then
00253 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.3'
00254 ret = -1
00255 endif
00256
00257
00258
00259
00260
00261
00262 dt = 5.5D0
00263 call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1,
00264 1 gauss1_1,2,MED_NOPFL,MED_NO_PFLMOD,
00265 2 MED_MAILLE,MED_TRIA6,
00266 3 1,"ms",dt,MED_NONOR,ret)
00267 if (ret .ne. 0 ) then
00268 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.4'
00269 ret = -1
00270 endif
00271
00272
00273
00274
00275
00276
00277
00278 dt = 5.5D0
00279 call efchae(fid,maa3,nomcha1,valr1_2,USER_INTERLACE,nval1_2,
00280 1 gauss1_2,1,MED_NOPFL,MED_NO_PFLMOD,
00281 2 MED_MAILLE,MED_TRIA6,
00282 3 1,"ms",dt,2,ret)
00283 if (ret .ne. 0 ) then
00284 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.5'
00285 ret = -1
00286 endif
00287
00288
00289
00290 call efpfle(fid,profil1,1,nomprofil1,ret)
00291 if (ret .ne. 0 ) then
00292 print *,'Erreur à la création du profil : ', nomprofil1
00293 ret = -1
00294 endif
00295
00296
00297
00298
00299
00300
00301
00302 dt = 5.6D0
00303 call efchae(fid,maa1,nomcha1,valr1_3p,USER_INTERLACE,nval1_3,
00304 1 MED_NOGAUSS,MED_ALL,nomprofil1,USER_MODE,
00305 2 MED_MAILLE,MED_TRIA6,
00306 3 2,"ms",dt,2,ret)
00307 if (ret .ne. 0 ) then
00308 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.6'
00309 ret = -1
00310 endif
00311
00312
00313
00314
00315
00316
00317 dt = 5.6D0
00318 call efchae(fid,maa2,nomcha1,valr1_2p,USER_INTERLACE,nval1_2,
00319 1 gauss1_2,MED_ALL,nomprofil1,USER_MODE,
00320 2 MED_MAILLE,MED_TRIA6,
00321 3 2,"ms",dt,2,ret)
00322 if (ret .ne. 0 ) then
00323 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.7'
00324 ret = -1
00325 endif
00326
00327
00328
00329
00330
00331
00332
00333 dt = 5.7D0
00334 call efchae(fid,maa1,nomcha1,valr1_3p,USER_INTERLACE,nval1_3,
00335 1 MED_NOGAUSS,2,nomprofil1,USER_MODE,
00336 2 MED_MAILLE,MED_TRIA6,
00337 3 3,"ms",dt,2,ret)
00338 if (ret .ne. 0 ) then
00339 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.8'
00340 ret = -1
00341 endif
00342
00343
00344
00345
00346
00347 dt = 0.0D0
00348 call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2,
00349 1 MED_NOGAUSS,1,MED_NOPFL,MED_NO_PFLMOD,MED_ARETE,
00350 1 MED_SEG2,MED_NOPDT,nounit,dt,MED_NONOR,ret)
00351 if (ret .ne. 0 ) then
00352 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.1'
00353 ret = -1
00354 endif
00355
00356
00357
00358
00359
00360
00361 call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2,
00362 1 MED_NOGAUSS,2,MED_NOPFL,MED_NO_PFLMOD,MED_NOEUD,
00363 1 0,MED_NOPDT,nounit,dt,MED_NONOR,ret)
00364 if (ret .ne. 0 ) then
00365 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.2'
00366 ret = -1
00367 endif
00368
00369
00370
00371
00372
00373
00374
00375 call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2,
00376 1 MED_NOGAUSS,3,MED_NOPFL,MED_NO_PFLMOD,MED_FACE,
00377 1 MED_TRIA6,MED_NOPDT,nounit,dt,MED_NONOR,ret)
00378 if (ret .ne. 0 ) then
00379 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.3'
00380 ret = -1
00381 endif
00382
00383
00384
00385 call efpfle(fid,profil2,3,"PROFIL(champ2)",ret)
00386 if (ret .ne. 0 ) then
00387 print *,'Erreur à l''écriture du profil : ',
00388 1 'profil2(champ2)'
00389 ret = -1
00390 endif
00391
00392
00393
00394
00395
00396
00397
00398
00399 call efchae(fid,maa1,nomcha2,valr2p,USER_INTERLACE,nval2,
00400 1 MED_NOGAUSS,3,"PROFIL(champ2)",USER_MODE,MED_MAILLE,
00401 1 MED_TRIA6,MED_NOPDT,nounit,dt,MED_NONOR,ret)
00402 if (ret .ne. 0 ) then
00403 print *,'Erreur à l''écriture du profil : ',
00404 1 'profil2(champ2)'
00405 ret = -1
00406 endif
00407
00408
00409 call efferm (fid,ret)
00410 if (ret .ne. 0 ) then
00411 print *,'Erreur à la fermeture du fichier : '
00412 ret = -1
00413 endif
00414
00415 print *,"Le code retour : ",ret
00416 call efexit(ret)
00417
00418 end
00419
00420
00421