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.hf90'
00029 
00030 
00031   integer      ret,cret,fid
00032   character*64 maa
00033   integer      mdim,nequ,ncor,sdim
00034   integer, allocatable, dimension(:) :: cor
00035   character*64  equ
00036   character*200 desc,des
00037   integer       i,j,k
00038   character*255 argc
00039   integer,parameter :: MY_NOF_DESCENDING_FACE_TYPE =  5
00040   integer,parameter :: MY_NOF_DESCENDING_EDGE_TYPE =  2
00041 
00042 
00043   integer, parameter :: MED_NBR_MAILLE_EQU = 8
00044   integer,parameter  :: typmai(MED_NBR_MAILLE_EQU) =  (/ MED_POINT1,MED_SEG2,   
00045                                                         MED_SEG3,MED_TRIA3,    &
00046                                                         MED_TRIA6,MED_QUAD4,   &
00047                                                         MED_QUAD8,MED_POLYGON/)
00048 
00049    integer,parameter :: typfac(MY_NOF_DESCENDING_FACE_TYPE) = (/MED_TRIA3,MED_TRIA6,       
00050                                                  MED_QUAD4,MED_QUAD8, MED_POLYGON/)
00051    integer,parameter ::typare(MY_NOF_DESCENDING_EDGE_TYPE) = (/MED_SEG2,MED_SEG3/)
00052    integer type
00053    character(16)  :: dtunit
00054    integer nstep, stype, atype
00055    character*16 nomcoo(3)   
00056    character*16 unicoo(3)
00057    integer nctcor,nstepc
00058 
00059 
00060    
00061    call mfiope(fid,'test12.med',MED_ACC_RDONLY, cret)
00062    print *,cret
00063    
00064      
00065    
00066    if (cret.eq.0) then
00067       call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
00068       print *,"Maillage de nom : ",maa," et de dimension : ", mdim
00069    endif
00070    print *,cret
00071 
00072 
00073    
00074    if (cret.eq.0) then
00075       call meqneq(fid,maa,nequ,cret)
00076       if (cret.eq.0) then
00077          print *,"Nombre d'equivalence : ",nequ
00078       endif
00079    endif
00080 
00081  
00082    
00083    if (cret.eq.0) then
00084       do i=1,nequ
00085          print *,"Equivalence numero : ",i
00086          
00087          if (cret.eq.0) then
00088             call meqeqi(fid,maa,i,equ,des,nstepc,nctcor,cret)
00089          endif
00090          print *,cret
00091          if (cret.eq.0) then
00092             print *,"Nom de l'equivalence : ",equ          
00093             print *,"Description de l'equivalence : ",des
00094             print *,"Nombre de pas de temps sur l'equivalence : ",nstepc
00095             print *,"Nombre de correspondance sur MED_NO_IT, MED_NO_DT : ", nctcor 
00096          endif
00097 
00098          
00099          if (cret.eq.0) then
00100             
00101             call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,ncor,cret)
00102             print *,cret
00103             print *,"Il y a ",ncor," correspondances sur les noeuds "
00104             if (ncor > 0) then
00105                allocate(cor(ncor*2),STAT=ret)
00106                call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_NODE,MED_NONE,cor,cret)
00107                do j=0,(ncor-1)
00108                   print *,"Correspondance ",j+1," : ",cor(2*j+1)," et ",cor(2*j+2)
00109                end do
00110                deallocate(cor)
00111             end if
00112             
00113 
00114 
00115             do j=1,MED_NBR_MAILLE_EQU
00116                call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_CELL,typmai(j),ncor,cret)
00117                print *,"Il y a ",ncor," correspondances sur les mailles ",typmai(j)
00118                if (ncor > 0 ) then
00119                   allocate(cor(2*ncor),STAT=ret)
00120                   call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_CELL,typmai(j),cor,cret)
00121                   do k=0,(ncor-1)
00122                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00123                   end do
00124                   deallocate(cor)
00125                endif
00126             end do
00127 
00128 
00129             do j=1,MY_NOF_DESCENDING_FACE_TYPE
00130                call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_FACE,typmai(j),ncor,cret)
00131                print *,"Il y a ",ncor," correspondances sur les faces ",typfac(j)
00132                if (ncor > 0 ) then
00133                   allocate(cor(2*ncor),STAT=ret)
00134                   call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_FACE,typfac(j),cor,cret)
00135                   do k=0,(ncor-1)
00136                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00137                   end do
00138                   deallocate(cor)
00139                endif
00140             end do
00141 
00142 
00143             do j=1,MY_NOF_DESCENDING_EDGE_TYPE
00144                call meqcsz(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,typare(j),ncor,cret)
00145                print *,"Il y a ",ncor," correspondances sur les aretes ",typare(j)
00146                if (ncor > 0 ) then
00147                   allocate(cor(2*ncor),STAT=ret)
00148                   call meqcor(fid,maa,equ,MED_NO_DT,MED_NO_IT,MED_DESCENDING_EDGE,typare(j),cor,cret)
00149                   do k=0,(ncor-1)
00150                      print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
00151                   end do
00152                   deallocate(cor)
00153                endif
00154             end do
00155 
00156          end if
00157       end do
00158    end if
00159 
00160 
00161    call mficlo(fid,cret)
00162    print *,cret
00163 
00164 
00165    call efexit(cret)
00166    
00167  end program test13
00168         
00169 
00170 
00171 
00172