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.8a'
00385 call efexit(-1)
00386 endif
00387
00388
00389
00390
00391
00392
00393 dt = 5.7
00394 call mfdrpw(fid,nomcha1,3,2,dt,MED_CELL,MED_TRIA6,
00395 & USER_MODE, nomprofil1, MED_NO_LOCALIZATION,
00396 & USER_INTERLACE,1,
00397 & nent1_3,valr1_3p,ret)
00398 print *,ret
00399 if (ret .ne. 0 ) then
00400 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.8b'
00401 call efexit(-1)
00402 endif
00403
00404
00405
00406
00407
00408 dt = 0.0
00409 call mfdivw(fid,nomcha2,MED_NO_DT,MED_NO_IT,dt,
00410 & MED_DESCENDING_EDGE,MED_SEG2,USER_INTERLACE,
00411 & 1,nval2,valr2,ret)
00412 print *,ret
00413 if (ret .ne. 0 ) then
00414 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.1'
00415 call efexit(-1)
00416 endif
00417
00418
00419
00420
00421
00422
00423 call mfdivw(fid,nomcha2,MED_NO_DT,MED_NO_IT,dt,
00424 & MED_NODE,MED_NONE,USER_INTERLACE,
00425 & 2,nval2,valr2,ret)
00426 print *,ret
00427 if (ret .ne. 0 ) then
00428 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.2'
00429 call efexit(-1)
00430 endif
00431
00432
00433
00434
00435
00436
00437
00438 call mfdivw(fid,nomcha2,MED_NO_DT,MED_NO_IT,dt,
00439 & MED_DESCENDING_FACE,MED_TRIA6,USER_INTERLACE,
00440 & 3,nval2,valr2,ret)
00441 print *,ret
00442 if (ret .ne. 0 ) then
00443 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.3'
00444 call efexit(-1)
00445 endif
00446
00447
00448
00449 call mpfprw(fid,"PROFIL(champ2)",3,profil2,ret)
00450 print *,ret
00451 if (ret .ne. 0 ) then
00452 print *,'Erreur à l''écriture du profil : ',
00453 1 'profil2(champ2)'
00454 call efexit(-1)
00455 endif
00456
00457
00458
00459
00460
00461
00462
00463
00464 call mfdipw(fid,nomcha2,MED_NO_DT,MED_NO_IT,dt,
00465 & MED_CELL,MED_TRIA6,USER_MODE,"PROFIL(champ2)",
00466 & MED_NO_LOCALIZATION,USER_INTERLACE,3,
00467 & nval2,valr2p,ret)
00468 print *,ret
00469 if (ret .ne. 0 ) then
00470 print *,'Erreur à l''écriture du profil : ',
00471 1 'profil2(champ2)'
00472 call efexit(-1)
00473 endif
00474
00475
00476 call mfdcre(fid,nomcha3,MED_INT32,ncomp3,comp3,unit3,
00477 & dtunit1,maa1,ret)
00478 print *,ret
00479 if (ret .ne. 0 ) then
00480 print *,'Erreur à la création du champ : ', nomcha3
00481 call efexit(-1)
00482 endif
00483
00484
00485
00486
00487
00488
00489 call mfdivw(fid,nomcha3,MED_NO_DT,MED_NO_IT,dt,
00490 & MED_CELL,MED_QUAD4,USER_INTERLACE,
00491 & 1,nval3,valr3,ret)
00492 print *,ret
00493 if (ret .ne. 0 ) then
00494 print *,'Erreur à l''écriture du champ : ', nomcha3,'et.1'
00495 call efexit(-1)
00496 endif
00497
00498
00499
00500
00501
00502
00503 call mfdivw(fid,nomcha3,MED_NO_DT,MED_NO_IT,dt,
00504 & MED_NODE_ELEMENT,MED_QUAD4,USER_INTERLACE,
00505 & MED_ALL_CONSTITUENT,nent3,valr3,ret)
00506 print *,ret
00507 if (ret .ne. 0 ) then
00508 print *,'Erreur à l''écriture du champ : ', nomcha3,'et.2'
00509 call efexit(-1)
00510 endif
00511
00512
00513
00514
00515
00516
00517
00518
00519
00520
00521
00522 call mfdipw(fid,nomcha3,MED_NO_DT,MED_NO_IT,dt,
00523 & MED_NODE_ELEMENT,MED_QUAD4,USER_MODE,
00524 & "PROFIL(champ2)",MED_NO_LOCALIZATION,
00525 & USER_INTERLACE,MED_ALL_CONSTITUENT,
00526 & nent3,valr3p,ret)
00527 print *,ret
00528 if (ret .ne. 0 ) then
00529 print *,'Erreur à l''écriture du profil : ',
00530 1 'profil2(champ2)'
00531 call efexit(-1)
00532 endif
00533
00534
00535 call mficlo(fid,ret)
00536 if (ret .ne. 0 ) then
00537 print *,'Erreur à la fermeture du fichier : '
00538 ret = -1
00539 endif
00540
00541 print *,"Le code retour : ",ret
00542 call efexit(ret)
00543
00544 end
00545
00546
00547