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