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 test6
00025 
00026         implicit none
00027         include 'med.hf'
00028 
00029 
00030         integer cret, fid
00031         
00032         integer     mdim,nse2,ntr3,sdim
00033         parameter  (nse2=5, ntr3=2, mdim=2, sdim=2)
00034         integer     se2 (2*nse2)
00035         character*16 nomse2(nse2)
00036         integer     numse2(nse2),nufase2(nse2)
00037 
00038         character*16 nomcoo(2)
00039         character*16 unicoo(2)
00040 
00041 
00042         integer     tr3 (3*ntr3)
00043         character*16 nomtr3(ntr3)
00044         integer     numtr3(ntr3), nufatr3(ntr3) 
00045         character*64 maa 
00046         real*8 dt
00047         parameter (dt = 0.0)
00048     
00049         data  nomcoo /"x","y"/, unicoo /"cm","cm"/
00050         data se2     / 1,2,1,3,2,4,3,4,2,3 /    
00051         data nomse2  /"se1","se2","se3","se4","se5" / 
00052         data numse2  / 1,2,3,4,5 /, nufase2 /-1,-1,0,-2,-3/
00053         data tr3     /1,2,-5,-5,3,-4 /, nomtr3 /"tr1","tr2"/,
00054      &                                  numtr3 /4,5/
00055         data nufatr3 /0,-1/,  maa /"maa1"/
00056 
00057 
00058         call mfiope(fid,'test6.med',MED_ACC_CREAT, cret) 
00059         print *,cret
00060         if (cret .ne. 0 ) then
00061            print *,'Erreur creation du fichier'
00062            call efexit(-1)
00063         endif      
00064 
00065 
00066         call mmhcre(fid,maa,mdim,sdim,
00067      &     MED_UNSTRUCTURED_MESH,'un maillage pour test6', 
00068      &     "",MED_SORT_DTIT,MED_CARTESIAN,nomcoo,unicoo,cret)
00069         print *,cret
00070         if (cret .ne. 0 ) then
00071            print *,'Erreur creation du maillage'
00072            call efexit(-1)
00073         endif      
00074 
00075 
00076         call mmhcyw(fid,maa,MED_NO_DT,MED_NO_IT,dt,
00077      &              MED_DESCENDING_EDGE,MED_SEG2,MED_DESCENDING,
00078      &              MED_NO_INTERLACE,nse2,se2,cret)
00079         print *,cret
00080         if (cret .ne. 0 ) then
00081            print *,'Erreur ecriture de la connectivite'
00082            call efexit(-1)
00083         endif      
00084 
00085 
00086         call mmheaw(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,
00087      &              MED_SEG2,nse2,nomse2,cret)
00088         print *,cret
00089         if (cret .ne. 0 ) then
00090            print *,'Erreur ecriture des noms'
00091            call efexit(-1)
00092         endif      
00093 
00094 
00095         call mmhenw(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,
00096      &              MED_SEG2,nse2,numse2,cret)
00097         print *,cret
00098         if (cret .ne. 0 ) then
00099            print *,'Erreur ecriture des numeros'
00100            call efexit(-1)
00101         endif      
00102 
00103 
00104         call mmhfnw(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,
00105      &              MED_SEG2,nse2,nufase2,cret)     
00106         print *,cret
00107         if (cret .ne. 0 ) then
00108            print *,'Erreur ecriture des numéros de famille'
00109            call efexit(-1)
00110         endif      
00111 
00112 
00113         call mmhcyw(fid,maa,MED_NO_DT,MED_NO_IT,dt,
00114      &              MED_CELL,MED_TRIA3,MED_DESCENDING,
00115      &              MED_NO_INTERLACE,ntr3,tr3,cret)
00116         print *,cret
00117         if (cret .ne. 0 ) then
00118            print *,'Erreur ecriture de la connectivite'
00119            call efexit(-1)
00120         endif      
00121 
00122 
00123         call mmheaw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00124      &              MED_TRIA3,ntr3,nomtr3,cret)
00125         print *,cret
00126         if (cret .ne. 0 ) then
00127            print *,'Erreur ecriture des noms'
00128            call efexit(-1)
00129         endif      
00130 
00131 
00132         call mmhenw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00133      &              MED_TRIA3,ntr3,numtr3,cret)
00134         print *,cret
00135         if (cret .ne. 0 ) then
00136            print *,'Erreur ecriture des numeros'
00137            call efexit(-1)
00138         endif      
00139 
00140 
00141         call mmhfnw(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
00142      &              MED_TRIA3,ntr3,nufatr3,cret)          
00143         print *,cret
00144         if (cret .ne. 0 ) then
00145            print *,'Erreur ecriture des numeros de famille'
00146            call efexit(-1)
00147         endif      
00148 
00149 
00150         call mficlo(fid,cret)
00151         print *,cret
00152         if (cret .ne. 0 ) then
00153            print *,'Erreur a la fermeture du fichier'
00154            call efexit(-1)
00155         endif      
00156 
00157         end