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*64 maa1,maa2,maa3
00033 character*13 lien_maa2
00034 character*16 nomcoo(3)
00035 character*16 unicoo(3)
00036
00037 character*64 nomcha1
00038 character*16 comp1(2), unit1(2)
00039 character*16 dtunit1, nounit
00040 integer ncomp1
00041
00042 integer ngauss1_1
00043 character*64 gauss1_1
00044 real*8 refcoo1(12), gscoo1_1(12), wg1_1(6)
00045 integer nval1_1, nent1_1
00046 real*8 valr1_1(1*6*2)
00047
00048 integer ngauss1_2
00049 character*64 gauss1_2
00050 real*8 gscoo1_2(6), wg1_2(3)
00051 integer nval1_2, nent1_2
00052 real*8 valr1_2(2*3*2)
00053 real*8 valr1_2p(2*3)
00054
00055 integer ngauss1_3,nval1_3, nent1_3
00056 real*8 valr1_3(2*3*2)
00057 real*8 valr1_3p(2*2)
00058
00059
00060 character*64 nomcha2
00061 character*16 comp2(3), unit2(3)
00062 integer ncomp2, nval2
00063 integer valr2(5*3), valr2p(3*3)
00064
00065
00066 character*64 nomcha3
00067 character*16 comp3(2), unit3(2)
00068 integer ncomp3, nval3, nent3
00069 integer valr3(5*4*2), valr3p(3*4*2)
00070
00071
00072 character*64 nomprofil1
00073 integer profil1(2) , profil2(3)
00074
00075 parameter (USER_INTERLACE = MED_FULL_INTERLACE)
00076 parameter (USER_MODE = MED_COMPACT_PFLMODE )
00077 parameter ( a=0.446948490915965D0, b=0.091576213509771D0 )
00078 parameter ( p1=0.11169079483905D0, p2=0.0549758718227661D0 )
00079
00080 parameter ( maa1 = "maa1", maa2 = "maa2", maa3 = "maa3" )
00081 parameter ( lien_maa2= "./testfoo.med" )
00082
00083 parameter ( nomcha1 = "champ reel" )
00084 parameter ( ncomp1 = 2 )
00085 parameter ( dtunit1 = " ")
00086 parameter ( nounit = " ")
00087
00088 parameter ( gauss1_1 = "Model n1" )
00089 parameter ( ngauss1_1 = 6 )
00090
00091 parameter ( gauss1_2 = "Model n2" )
00092 parameter ( ngauss1_2 = 3 )
00093
00094 parameter ( ngauss1_3 = 6 )
00095 parameter ( nval1_3 = 6 )
00096
00097 parameter ( nomcha2="champ entier")
00098 parameter ( ncomp2 = 3, nval2= 5 )
00099
00100 parameter ( nomcha3="champ entier 3")
00101 parameter ( ncomp3 = 2, nval3= 5*4 )
00102
00103 parameter ( nomprofil1 = "PROFIL(champ(1))" )
00104
00105
00106
00107 data comp1 /"comp1", "comp2"/
00108 data unit1 /"unit1","unit2"/
00109
00110 data nval1_1 / 1*6 /
00111 data nent1_1 / 1 /
00112 data refcoo1 / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0,
00113 1 0.0,-1.0, 0.0,0.0 /
00114 data valr1_1 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
00115 1 20.0,21.0, 22.0,23.0/
00116
00117 data nent1_2 / 2 /
00118 data valr1_2 / 0.0,1.0, 2.0,3.0, 10.0,11.0,
00119 1 12.0,13.0, 20.0,21.0, 22.0,23.0 /
00120 data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 /
00121
00122 data nent1_3 / 6 /
00123 data valr1_3 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
00124 1 20.0,21.0, 22.0,23.0 /
00125 data valr1_3p / 2.0,3.0, 10.0,11.0 /
00126
00127 data comp2 /"comp1", "comp2", "comp3"/
00128 data unit2 /"unit1","unit2", "unit3"/
00129 data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 /
00130 data valr2p / 0,1,2, 20,21,22, 40,41,42 /
00131
00132 data nent3 / 5 /
00133 data comp3 /"comp1", "comp2"/
00134 data unit3 /"unit1","unit2"/
00135 data valr3 / 0,1, 10,11, 20,21, 30,31,
00136 1 40,41, 50,51, 60,61, 70,71,
00137 1 80,81, 90,91, 100,101, 110,111,
00138 1 120,121, 130,131, 140,141, 150,151,
00139 1 160,161, 170,171, 180,181, 190,191 /
00140 data valr3p / 0,1, 10,11, 20,21, 30,31,
00141 1 80,81, 90,91, 100,101, 110,111,
00142 1 160,161, 170,171, 180,181, 190,191 /
00143
00144
00145
00146 data profil1 /2,3/
00147 data profil2 /1,3,5/
00148
00149 data nomcoo /"x","y","z"/, unicoo /"cm","cm","cm"/
00150
00151 ret = 0
00152
00153 gscoo1_1(1) = 2*b-1
00154 gscoo1_1(2) = 1-4*b
00155 gscoo1_1(3) = 2*b-1
00156 gscoo1_1(4) = 2*b-1
00157 gscoo1_1(5) = 1-4*b
00158 gscoo1_1(6) = 2*b-1
00159 gscoo1_1(7) = 1-4*a
00160 gscoo1_1(8) = 2*a-1
00161 gscoo1_1(9) = 2*a-1
00162 gscoo1_1(10) = 1-4*a
00163 gscoo1_1(11) = 2*a-1
00164 gscoo1_1(12) = 2*a-1
00165
00166 wg1_1(1) = 4*p2
00167 wg1_1(2) = 4*p2
00168 wg1_1(3) = 4*p2
00169 wg1_1(4) = 4*p1
00170 wg1_1(5) = 4*p1
00171 wg1_1(6) = 4*p1
00172
00173 nval1_2 = 2*3
00174 gscoo1_2(1) = -2.0D0/3
00175 gscoo1_2(2) = 1.0D0/3
00176 gscoo1_2(3) = -2.0D0/3
00177 gscoo1_2(4) = -2.0D0/3
00178 gscoo1_2(5) = 1.0D0/3
00179 gscoo1_2(6) = -2.0D0/3
00180
00181 wg1_2(1) = 2.0D0/3
00182 wg1_2(2) = 2.0D0/3
00183 wg1_2(3) = 2.0D0/3
00184
00185
00186 call mfiope(fid,'test10.med',MED_ACC_RDWR, ret)
00187 print *,ret
00188 if (ret .ne. 0 ) then
00189 print *,'Erreur à l''ouverture du fichier : ','test10.med'
00190 call efexit(-1)
00191 endif
00192
00193
00194 call mmhcre(fid,maa1,3,3,
00195 & MED_UNSTRUCTURED_MESH,'Maillage vide',
00196 & "",MED_SORT_DTIT,MED_CARTESIAN,nomcoo,unicoo,ret)
00197 print *,ret
00198 if (ret .ne. 0 ) then
00199 print *,'Erreur à la création du maillage : ', maa1
00200 call efexit(-1)
00201 endif
00202
00203
00204 call mmhcre(fid,maa3,3,3,
00205 & MED_UNSTRUCTURED_MESH,'Maillage vide',
00206 & "",MED_SORT_DTIT,MED_CARTESIAN,nomcoo,unicoo,ret)
00207 print *,ret
00208 if (ret .ne. 0 ) then
00209 print *,'Erreur à la création du maillage : ', maa3
00210 call efexit(-1)
00211 endif
00212
00213
00214
00215 call mfdcre(fid,nomcha1,MED_FLOAT64,ncomp1,comp1,unit1,
00216 & dtunit1,maa1,ret)
00217 print *,ret
00218 if (ret .ne. 0 ) then
00219 print *,'Erreur à la création du champ : ', nomcha1
00220 call efexit(-1)
00221 endif
00222
00223
00224 call mfdcre(fid,nomcha2,MED_INT32,ncomp2,comp2,unit2,
00225 & dtunit1,maa1,ret)
00226 print *,ret
00227 if (ret .ne. 0 ) then
00228 print *,'Erreur à la création du champ : ', nomcha2
00229 call efexit(-1)
00230 endif
00231
00232
00233 call mlnliw(fid,maa2,lien_maa2,ret)
00234 print *,ret
00235 if (ret .ne. 0 ) then
00236 print *,'Erreur à la création du lien : ', lien_maa2
00237 call efexit(-1)
00238 endif
00239
00240
00241
00242 call mlclow(fid,gauss1_1,MED_TRIA6,2,refcoo1,USER_INTERLACE,
00243 & ngauss1_1,gscoo1_1, wg1_1,MED_NO_INTERPOLATION,
00244 & MED_NO_MESH_SUPPORT, ret)
00245 print *,ret
00246 if (ret .ne. 0 ) then
00247 print *,'Erreur à la création du modèle n°1 : ', gauss1_1
00248 call efexit(-1)
00249 endif
00250
00251
00252 call mlclow(fid,gauss1_2,MED_TRIA6,2,refcoo1,USER_INTERLACE,
00253 & ngauss1_2,gscoo1_2, wg1_2,MED_NO_INTERPOLATION,
00254 & MED_NO_MESH_SUPPORT, ret)
00255 print *,ret
00256 if (ret .ne. 0 ) then
00257 print *,'Erreur à la création du modèle n°2 : ', gauss1_2
00258 call efexit(-1)
00259 endif
00260
00261
00262
00263
00264
00265 dt = 0.0
00266 call mfdrpw(fid,nomcha1,MED_NO_DT,MED_NO_IT,dt,MED_CELL,
00267 & MED_TRIA6,USER_MODE,MED_ALLENTITIES_PROFILE,
00268 & gauss1_1,USER_INTERLACE,2,nent1_1,valr1_1,ret)
00269 print *,ret
00270 if (ret .ne. 0 ) then
00271 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.1'
00272 call efexit(-1)
00273 endif
00274
00275
00276
00277
00278 call mfdrpw(fid,nomcha1,MED_NO_DT,MED_NO_IT,dt,MED_CELL,
00279 & MED_TRIA6,USER_MODE,MED_ALLENTITIES_PROFILE,
00280 & gauss1_1,USER_INTERLACE,1,nent1_1,valr1_1,ret)
00281 print *,ret
00282 if (ret .ne. 0 ) then
00283 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.2'
00284 call efexit(-1)
00285 endif
00286
00287
00288
00289
00290
00291
00292 dt = 5.5
00293 call mfdrpw(fid,nomcha1,1,MED_NO_IT,dt,MED_CELL,MED_TRIA6,
00294 & USER_MODE,MED_ALLENTITIES_PROFILE,gauss1_2,
00295 & USER_INTERLACE,1,nent1_2,valr1_2,ret)
00296 print *,ret
00297 if (ret .ne. 0 ) then
00298 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.3'
00299 call efexit(-1)
00300 endif
00301
00302
00303
00304
00305
00306
00307 call mfdrpw(fid,nomcha1,1,MED_NO_IT,dt,MED_CELL,MED_TRIA6,
00308 & USER_MODE,MED_ALLENTITIES_PROFILE,gauss1_2,
00309 & USER_INTERLACE,2,nent1_2,valr1_2,ret)
00310 print *,ret
00311 if (ret .ne. 0 ) then
00312 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.4'
00313 call efexit(-1)
00314 endif
00315
00316
00317
00318
00319
00320
00321 call mfdrpw(fid,nomcha1,1,2,dt,MED_CELL,MED_TRIA6,
00322 & USER_MODE,MED_ALLENTITIES_PROFILE,gauss1_1,
00323 & USER_INTERLACE,1,nent1_1,valr1_1,ret)
00324 print *,ret
00325 if (ret .ne. 0 ) then
00326 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.5'
00327 call efexit(-1)
00328 endif
00329
00330
00331
00332 call mpfprw(fid,nomprofil1,1,profil1,ret)
00333 print *,ret
00334 if (ret .ne. 0 ) then
00335 print *,'Erreur à la création du profil : ', nomprofil1
00336 call efexit(-1)
00337 endif
00338
00339
00340
00341
00342
00343
00344
00345 dt = 5.6
00346 call mfdrpw(fid,nomcha1,2,2,dt,MED_CELL,MED_TRIA6,
00347 & USER_MODE, nomprofil1, MED_NO_LOCALIZATION,
00348 & USER_INTERLACE,MED_ALL_CONSTITUENT,
00349 & nval1_3,valr1_3p,ret)
00350 print *,ret
00351 if (ret .ne. 0 ) then
00352 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.6'
00353 call efexit(-1)
00354 endif
00355
00356
00357
00358
00359
00360
00361 call mfdrpw(fid,nomcha1,2,2,dt,MED_CELL,MED_TRIA6,
00362 & USER_MODE, nomprofil1, gauss1_2,
00363 & USER_INTERLACE,MED_ALL_CONSTITUENT,
00364 & nent1_2,valr1_2p,ret)
00365 print *,ret
00366 if (ret .ne. 0 ) then
00367 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.7'
00368 call efexit(-1)
00369 endif
00370
00371
00372
00373
00374
00375
00376
00377 dt = 5.7
00378 call mfdrpw(fid,nomcha1,3,2,dt,MED_CELL,MED_TRIA6,
00379 & USER_MODE, nomprofil1, MED_NO_LOCALIZATION,
00380 & USER_INTERLACE,2,
00381 & nent1_3,valr1_3p,ret)
00382 print *,ret
00383 if (ret .ne. 0 ) then
00384 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.8'
00385 call efexit(-1)
00386 endif
00387
00388
00389
00390
00391
00392 dt = 0.0
00393 call mfdivw(fid,nomcha2,MED_NO_DT,MED_NO_IT,dt,
00394 & MED_DESCENDING_EDGE,MED_SEG2,USER_INTERLACE,
00395 & 1,nval2,valr2,ret)
00396 print *,ret
00397 if (ret .ne. 0 ) then
00398 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.1'
00399 call efexit(-1)
00400 endif
00401
00402
00403
00404
00405
00406
00407 call mfdivw(fid,nomcha2,MED_NO_DT,MED_NO_IT,dt,
00408 & MED_NODE,MED_NONE,USER_INTERLACE,
00409 & 2,nval2,valr2,ret)
00410 print *,ret
00411 if (ret .ne. 0 ) then
00412 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.2'
00413 call efexit(-1)
00414 endif
00415
00416
00417
00418
00419
00420
00421
00422 call mfdivw(fid,nomcha2,MED_NO_DT,MED_NO_IT,dt,
00423 & MED_DESCENDING_FACE,MED_TRIA6,USER_INTERLACE,
00424 & 3,nval2,valr2,ret)
00425 print *,ret
00426 if (ret .ne. 0 ) then
00427 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.3'
00428 call efexit(-1)
00429 endif
00430
00431
00432
00433 call mpfprw(fid,"PROFIL(champ2)",3,profil2,ret)
00434 print *,ret
00435 if (ret .ne. 0 ) then
00436 print *,'Erreur à l''écriture du profil : ',
00437 1 'profil2(champ2)'
00438 call efexit(-1)
00439 endif
00440
00441
00442
00443
00444
00445
00446
00447
00448 call mfdipw(fid,nomcha2,MED_NO_DT,MED_NO_IT,dt,
00449 & MED_CELL,MED_TRIA6,USER_MODE,"PROFIL(champ2)",
00450 & MED_NO_LOCALIZATION,USER_INTERLACE,3,
00451 & nval2,valr2p,ret)
00452 print *,ret
00453 if (ret .ne. 0 ) then
00454 print *,'Erreur à l''écriture du profil : ',
00455 1 'profil2(champ2)'
00456 call efexit(-1)
00457 endif
00458
00459
00460 call mfdcre(fid,nomcha3,MED_INT32,ncomp3,comp3,unit3,
00461 & dtunit1,maa1,ret)
00462 print *,ret
00463 if (ret .ne. 0 ) then
00464 print *,'Erreur à la création du champ : ', nomcha3
00465 call efexit(-1)
00466 endif
00467
00468
00469
00470
00471
00472
00473 call mfdivw(fid,nomcha3,MED_NO_DT,MED_NO_IT,dt,
00474 & MED_CELL,MED_QUAD4,USER_INTERLACE,
00475 & 1,nval3,valr3,ret)
00476 print *,ret
00477 if (ret .ne. 0 ) then
00478 print *,'Erreur à l''écriture du champ : ', nomcha3,'et.1'
00479 call efexit(-1)
00480 endif
00481
00482
00483
00484
00485
00486
00487 call mfdivw(fid,nomcha3,MED_NO_DT,MED_NO_IT,dt,
00488 & MED_NODE_ELEMENT,MED_QUAD4,USER_INTERLACE,
00489 & MED_ALL_CONSTITUENT,nent3,valr3,ret)
00490 print *,ret
00491 if (ret .ne. 0 ) then
00492 print *,'Erreur à l''écriture du champ : ', nomcha3,'et.2'
00493 call efexit(-1)
00494 endif
00495
00496
00497
00498
00499
00500
00501
00502
00503
00504
00505
00506 call mfdipw(fid,nomcha3,MED_NO_DT,MED_NO_IT,dt,
00507 & MED_NODE_ELEMENT,MED_QUAD4,USER_MODE,
00508 & "PROFIL(champ2)",MED_NO_LOCALIZATION,
00509 & USER_INTERLACE,MED_ALL_CONSTITUENT,
00510 & nent3,valr3p,ret)
00511 print *,ret
00512 if (ret .ne. 0 ) then
00513 print *,'Erreur à l''écriture du profil : ',
00514 1 'profil2(champ2)'
00515 call efexit(-1)
00516 endif
00517
00518
00519 call mficlo(fid,ret)
00520 if (ret .ne. 0 ) then
00521 print *,'Erreur à la fermeture du fichier : '
00522 ret = -1
00523 endif
00524
00525 print *,"Le code retour : ",ret
00526 call efexit(ret)
00527
00528 end
00529
00530
00531