00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022 
00023 
00024 
00025 
00026 
00027 program test17
00028   
00029   implicit none
00030   include 'med.hf90'
00031 
00032   integer      :: cret,ret, fid, nse2, mdim, sdim 
00033   integer,     allocatable, dimension(:) ::se2
00034   character*16, allocatable, dimension(:) ::nomse2
00035   integer,     allocatable, dimension(:) ::numse2,nufase2 
00036   integer      ntr3
00037   integer,     allocatable, dimension(:) ::tr3
00038   character*16, allocatable, dimension(:) ::nomtr3
00039   integer,     allocatable, dimension(:) ::numtr3
00040   integer,     allocatable, dimension(:) ::nufatr3
00041   character*64  :: maa
00042   character*200 :: desc
00043   integer      :: inoele1,inuele1,inoele2,inuele2,ifaele1,ifaele2
00044   integer      tse2,ttr3
00045   integer i,type,rep,nstep,stype
00046   integer chgt,tsf
00047   character*16 nomcoo(2)
00048   character*16 unicoo(2)
00049   character*16 dtunit
00050 
00051   
00052   call mfiope(fid,'test16.med',MED_ACC_RDONLY, cret)
00053   print *,cret
00054 
00055   
00056   if (cret.eq.0) then
00057      call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,rep,nomcoo,unicoo,cret)
00058      print *,"Maillage de nom : ",maa," et de dimension ",mdim
00059   endif
00060   print *,cret
00061 
00062    
00063   if (cret.eq.0) then
00064      call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,MED_CONNECTIVITY,MED_DESCENDING,chgt,tsf,nse2,cret)
00065   endif
00066   print *,cret
00067 
00068   if (cret.eq.0) then
00069      call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_CONNECTIVITY,MED_DESCENDING,chgt,tsf,ntr3,cret)
00070   endif
00071   print *,cret
00072 
00073   print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3
00074 
00075   
00076   tse2 = 2;  
00077   allocate(se2(tse2*nse2),nomse2(nse2),numse2(nse2),nufase2(nse2),STAT=ret)
00078   ttr3 = 3;
00079   allocate(tr3(ntr3*ttr3),nomtr3(ntr3),numtr3(ntr3),nufatr3(ntr3),STAT=ret)
00080  
00081   
00082   
00083   
00084   
00085   
00086   if (cret.eq.0) then
00087      call mmhelr(fid,maa,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,MED_SEG2,MED_DESCENDING,MED_NO_INTERLACE,se2,&
00088                  inoele1,nomse2,inuele1,numse2,ifaele1,nufase2,cret)
00089   endif
00090   print *,cret
00091         
00092   
00093   
00094   
00095   
00096   
00097   
00098   if (cret.eq.0) then
00099      call mmhelr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_TRIA3,MED_DESCENDING,MED_NO_INTERLACE,tr3,&
00100                  inoele2,nomtr3,inuele2,numtr3,ifaele2,nufatr3,cret)
00101   endif
00102   print *,cret
00103  
00104   
00105   call mficlo(fid,cret)
00106   print *,cret
00107         
00108   
00109   if (cret.eq.0) then
00110       print *,"Connectivite des segments : ",se2
00111      
00112       if (inoele1 .eq. MED_TRUE) then
00113          print *,"Noms des segments : ",nomse2
00114       endif
00115 
00116       if (inuele1 .eq. MED_TRUE) then
00117          print *,"Numeros des segments : ",numse2
00118       endif
00119 
00120       print *,"Numeros des familles des segments : ",nufase2
00121   
00122       
00123       print *,"Connectivite des triangles : ",tr3
00124       
00125       if (inoele2 .eq. MED_TRUE) then
00126          print *,"Noms des triangles :", nomtr3
00127       endif
00128 
00129       if (inuele2 .eq. MED_TRUE) then
00130           print *,"Numeros des triangles :", numtr3
00131       endif
00132 
00133       print *,"Numeros des familles des triangles :", nufatr3
00134       
00135    end if
00136 
00137    
00138    
00139    deallocate(se2,nomse2,numse2,nufase2);
00140    deallocate(tr3,nomtr3,numtr3,nufatr3);
00141 
00142    
00143    call efexit(cret)
00144    
00145  end program test17