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 test25
00025 
00026         implicit none
00027         include 'med.hf'
00028 
00029         integer cret, fid,mdim, sdim
00030         parameter  (mdim = 3, sdim = 3)
00031         character*64 maa        
00032         integer n
00033         parameter (n=2)
00034 
00035         integer np,nf
00036         parameter (nf=9,np=3)
00037         integer indexp(np),indexf(nf)
00038         integer conn(24)
00039 
00040         integer np2,nf2
00041         parameter (nf2=8,np2=3)
00042         integer indexp2(np2),indexf2(nf2)
00043         integer conn2(nf2)
00044         character*16 nom(n)
00045         integer num(n),fam(n)
00046 
00047 
00048         character*16 nomcoo(3)
00049         character*16 unicoo(3)
00050 
00051         data indexp / 1,5,9 /
00052         data indexf / 1,4,7,10,13,16,19,22,25 /
00053         data conn / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,
00054      &              15,16,17,18,19,20,21,22,23,24 /    
00055         data indexp2 / 1,5,9 /
00056         data indexf2 / MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3,
00057      &                 MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3 /
00058         data conn2 / 1,2,3,4,5,6,7,8 /
00059         data nom  / "poly1", "poly2"/ 
00060         data num  / 1,2 /, fam / 0,-1 /
00061         data maa /"maa1"/
00062         data nomcoo /"x","y","z"/, unicoo /"cm","cm","cm"/
00063 
00064 
00065         call mfiope(fid,'test25.med',MED_ACC_RDWR, cret)
00066         print *,cret
00067         if (cret .ne. 0 ) then
00068            print *,'Erreur creation du fichier'
00069            call efexit(-1)
00070         endif      
00071         print *,'Creation du fichier test25.med'
00072 
00073 
00074         call mmhcre(fid,maa,mdim,sdim,
00075      &     MED_UNSTRUCTURED_MESH,'un maillage pour test 25', 
00076      &     "",MED_SORT_DTIT,MED_CARTESIAN,nomcoo,unicoo,cret)
00077         if (cret .ne. 0 ) then
00078            print *,'Erreur creation du maillage'
00079            call efexit(-1)
00080         endif      
00081         print *,cret
00082         print *,'Creation du maillage'
00083 
00084 
00085         call mmhphw(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,MED_CELL,
00086      &              MED_NODAL,np,indexp,nf,indexf,conn,cret)
00087         print *,cret
00088         if (cret .ne. 0 ) then
00089            print *,'Erreur ecriture connectivite des polyedres'
00090            call efexit(-1)
00091         endif      
00092         print *,
00093 'Ecriture des connectivites des mailles     & de type MED_POLYEDRE'
00094         print *,'Description nodale'
00095 
00096 
00097         call mmhphw(fid,maa,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,MED_CELL,
00098      &              MED_DESCENDING,np2,indexp2,nf2,indexf2,conn2,cret)
00099         print *,cret
00100         if (cret .ne. 0 ) then
00101            print *,'Erreur ecriture connectivite des polyedres'
00102            call efexit(-1)
00103         endif      
00104         print *,
00105 'Ecriture des connectivites des mailles      & de type MED_POLYEDRE'
00106         print *,'Description descendante'
00107 
00108 
00109         call mmheaw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00110      &              MED_POLYHEDRON,n,nom,cret)
00111         print *,cret
00112         if (cret .ne. 0 ) then
00113            print *,'Erreur ecriture noms des polyedres'
00114            call efexit(-1)
00115         endif      
00116         print *,'Ecriture des noms des polyedress'
00117 
00118 
00119         call mmhenw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00120      &              MED_POLYHEDRON,n,num,cret)
00121         print *,cret
00122         if (cret .ne. 0 ) then
00123            print *,'Erreur ecriture numeros des polyedres'
00124            call efexit(-1)
00125         endif      
00126         print *,'Ecriture des numeros des polyedres'
00127 
00128 
00129         call mmhfnw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00130      &              MED_POLYHEDRON,n,fam,cret)   
00131         print *,cret
00132         if (cret .ne. 0 ) then
00133            print *,'Erreur ecriture numeros de familles polyedres'
00134            call efexit(-1)
00135         endif      
00136         print *,'Ecriture des numeros de familles des polyedres'
00137 
00138 
00139         call mficlo(fid,cret)
00140         print *,cret
00141         if (cret .ne. 0 ) then
00142            print *,'Erreur fermeture du fichier'
00143            call efexit(-1)
00144         endif      
00145         print *,'Fermeture du fichier'
00146 
00147         end