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 program test13
00026   
00027   implicit none
00028   include 'med.hf'
00029 
00030 
00031   integer      ret,cret,fid
00032   character*32 maa
00033   integer      mdim,nequ,ncor
00034   integer, allocatable, dimension(:) :: cor
00035   character*32  equ
00036   character*200 des
00037   integer       i,j,k
00038   character*255 argc
00039   integer, parameter :: MED_NBR_MAILLE_EQU = 8
00040   integer,parameter  :: typmai(MED_NBR_MAILLE_EQU) =  (/ MED_POINT1,MED_SEG2,   
00041                                                         MED_SEG3,MED_TRIA3,    &
00042                                                         MED_TRIA6,MED_QUAD4,   &
00043                                                         MED_QUAD8,MED_POLYGONE/)
00044 
00045    integer,parameter :: typfac(MED_NBR_GEOMETRIE_FACE+1) = (/MED_TRIA3,MED_TRIA6,       
00046                                                  MED_QUAD4,MED_QUAD8, MED_POLYGONE/)
00047    integer,parameter ::typare(MED_NBR_GEOMETRIE_ARETE) = (/MED_SEG2,MED_SEG3/)
00048    character*200 desc
00049    integer type
00050  
00051    print *,"Indiquez le fichier med a decrire : "
00052    
00053    argc = "test12.med"
00054 
00055    
00056    call efouvr(fid,argc,MED_LECTURE, cret)
00057    print *,cret
00058    
00059      
00060    
00061    if (cret.eq.0) then
00062       call efmaai(fid,1,maa,mdim,type,desc,cret)
00063       print *,"Maillage de nom : ",maa," et de dimension : ", mdim
00064    endif
00065    print *,cret
00066 
00067 
00068    
00069    if (cret.eq.0) then
00070       call efnequ(fid,maa,nequ,cret)
00071       if (cret.eq.0) then
00072          print *,"Nombre d'equivalences : ",nequ
00073       endif
00074    endif
00075  
00076    
00077    if (cret.eq.0) then
00078       do i=1,nequ
00079          print *,"Equivalence numero : ",i
00080          
00081          if (cret.eq.0) then
00082             call efequi(fid,maa,i,equ,des,cret)
00083          endif
00084          print *,cret
00085          if (cret.eq.0) then
00086             print *,"Nom de l'equivalence : ",equ          
00087             print *,"Description de l'equivalence : ",des 
00088          endif
00089 
00090          
00091          if (cret.eq.0) then
00092             
00093             call efncor(fid,maa,equ,MED_NOEUD,0,ncor,cret)
00094             print *,"Il y a ",ncor," correspondances sur les noeuds "
00095             if (ncor > 0) then
00096                allocate(cor(ncor*2),STAT=ret)
00097                call efequl(fid,maa,equ,cor,ncor,MED_NOEUD,0,cret)
00098                do j=0,(ncor-1)
00099                   print *,"Correspondance ",j+1," : ",cor(2*j+1)," et ",cor(2*j+2)
00100                end do
00101                deallocate(cor)
00102             end if
00103             
00104             
00105 
00106             do j=1,MED_NBR_MAILLE_EQU
00107                call efncor(fid,maa,equ,MED_MAILLE,typmai(j),ncor,cret)
00108                print *,"Il y a ",ncor," correspondances sur les mailles ",typmai(j)
00109                if (ncor > 0 ) then
00110                   allocate(cor(2*ncor),STAT=ret)
00111                   call efequl(fid,maa,equ,cor,ncor,MED_MAILLE,typmai(j),cret)
00112                   do k=0,(ncor-1)
00113                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00114                   end do
00115                   deallocate(cor)
00116                endif
00117             end do
00118 
00119             
00120             do j=1,MED_NBR_GEOMETRIE_FACE+1
00121                call efncor(fid,maa,equ,MED_FACE,typfac(j),ncor,cret)
00122                print *,"Il y a ",ncor," correspondances sur les faces ",typfac(j)
00123                if (ncor > 0 ) then
00124                   allocate(cor(2*ncor),STAT=ret)
00125                   call efequl(fid,maa,equ,cor,ncor,MED_FACE,typfac(j),cret)
00126                   do k=0,(ncor-1)
00127                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00128                   end do
00129                   deallocate(cor)
00130                endif
00131             end do
00132 
00133             
00134             do j=1,MED_NBR_GEOMETRIE_ARETE
00135                call efncor(fid,maa,equ,MED_ARETE,typare(j),ncor,cret)
00136                print *,"Il y a ",ncor," correspondances sur les aretes ",typare(j)
00137                if (ncor > 0 ) then
00138                   allocate(cor(2*ncor),STAT=ret)
00139                   call efequl(fid,maa,equ,cor,ncor,MED_ARETE,typare(j),cret)
00140                   do k=0,(ncor-1)
00141                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00142                   end do
00143                   deallocate(cor)
00144                endif
00145             end do
00146 
00147          end if
00148       end do
00149    end if
00150 
00151 
00152    call efferm (fid,cret)
00153    print *,cret
00154 
00155 
00156    call efexit(cret)
00157    
00158  end program test13
00159         
00160 
00161 
00162 
00163