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 test26
00026 
00027         implicit none
00028         include 'med.hf'
00029 
00030         integer cret,fid,mdim,nmaa,npoly,i,j,k,l
00031         integer nfaces, nnoeuds
00032         integer ind1, ind2
00033         character*32 maa
00034         character*200 desc
00035         integer n
00036         parameter (n=2)
00037         integer np,nf,np2,nf2,taille,tmp
00038         parameter (np=3,nf=9,np2=3,nf2=8)
00039         integer indexp(np),indexf(nf)
00040         integer conn(24)
00041         integer indexp2(np2),indexf2(nf2)
00042         integer conn2(nf2)
00043         character*16 nom(n)
00044         integer num(n),fam(n)
00045         integer type
00046 
00047 
00048         call efouvr(fid,'test25.med',MED_LECTURE, cret)
00049         print *,cret
00050         if (cret .ne. 0 ) then
00051            print *,'Erreur ouverture du fichier'
00052            call efexit(-1)
00053         endif      
00054         print *,'Ouverture du fichier test25.med'
00055 
00056 
00057         call efnmaa(fid,nmaa,cret)
00058         print *,cret
00059         if (cret .ne. 0 ) then
00060            print *,'Erreur lecture du nombre de maillage'
00061            call efexit(-1)
00062         endif      
00063         print *,'Nombre de maillages : ',nmaa
00064 
00065 
00066 
00067         do 10 i=1,nmaa
00068 
00069 
00070            call efmaai(fid,i,maa,mdim,type,desc,cret)
00071            print *,cret
00072            if (cret .ne. 0 ) then
00073               print *,'Erreur infos maillage'
00074               call efexit(-1)
00075            endif      
00076            print *,'Maillage : ',maa
00077            print *,'Dimension : ',mdim
00078 
00079 
00080            call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_POLYEDRE,
00081      &                       MED_NOD,npoly,cret)
00082            print *,cret
00083            if (cret .ne. 0 ) then
00084               print *,'Erreur lecture nombre de polyedre'
00085               call efexit(-1)
00086            endif      
00087            print *,'Nombre de mailles MED_POLYEDRE : ',npoly
00088 
00089 
00090            call efpyei(fid,maa,MED_NOD,tmp,taille,cret)
00091            print *,cret
00092            if (cret .ne. 0 ) then
00093               print *,'Erreur infos sur les polyedres'
00094               call efexit(-1)
00095            endif      
00096            print *,'Taille de la connectivite : ',taille
00097            print *,'Taille du tableau indexf : ',tmp
00098 
00099 
00100            call efpecl(fid,maa,indexp,npoly+1,indexf,tmp,conn,
00101      &                       MED_NOD,cret)
00102            print *,cret
00103            if (cret .ne. 0 ) then
00104               print *,'Erreur lecture connectivites polyedres'
00105               call efexit(-1)
00106            endif      
00107            print *,'Lecture de la connectivite des polyedres'
00108            print *,'Connectivite nodale'
00109 
00110 
00111            call efpecl(fid,maa,indexp2,npoly+1,indexf2,tmp,conn2,
00112      &                       MED_DESC,cret)
00113            print *,cret
00114            if (cret .ne. 0 ) then
00115               print *,'Erreur lecture connectivite des polyedres'
00116               call efexit(-1)
00117            endif      
00118            print *,'Lecture de la connectivite des polyedres'
00119            print *,'Connectivite descendante'
00120 
00121 
00122            call efnoml(fid,maa,nom,npoly,MED_MAILLE,MED_POLYEDRE,
00123      &                       cret)
00124            print *,cret
00125            if (cret .ne. 0 ) then
00126               print *,'Erreur lecture noms des polyedres'
00127               call efexit(-1)
00128            endif      
00129            print *,'Lecture des noms'
00130 
00131 
00132            call efnuml(fid,maa,num,npoly,MED_MAILLE,MED_POLYEDRE,
00133      &                       cret)
00134            print *,cret
00135            if (cret .ne. 0 ) then
00136               print *,'Erreur lecture des numeros des polyedres'
00137               call efexit(-1)
00138            endif      
00139            print *,'Lecture des numeros'
00140 
00141 
00142            call effaml(fid,maa,fam,npoly,MED_MAILLE,MED_POLYEDRE,
00143      &                       cret)
00144            print *,cret
00145            if (cret .ne. 0 ) then
00146               print *,'Erreur lecture numeros de famille polyedres'
00147               call efexit(-1)
00148            endif      
00149            print *,'Lecture des numeros de famille'
00150 
00151 
00152            print *,'Affichage des resultats'
00153            do 20 j=1,npoly
00154 
00155               print *,'>> Maille polygone ',j
00156               print *,'---- Connectivite nodale    ---- : '
00157               nfaces = indexp(j+1) - indexp(j)
00158 
00159 
00160               ind1 = indexp(j)
00161               do 30 k=1,nfaces
00162 
00163                  ind2 = indexf(ind1+k-1)
00164                  nnoeuds = indexf(ind1+k) - indexf(ind1+k-1)
00165                  print *,'   - Face ',k
00166                  do 40 l=1,nnoeuds
00167                     print *,'   ',conn(ind2+l-1)
00168  40              continue
00169  30           continue
00170               print *,'---- Connectivite descendante ---- : '
00171               nfaces = indexp2(j+1) - indexp2(j)
00172 
00173               ind1 = indexp2(j)
00174               do 50 k=1,nfaces
00175                  print *,'   - Face ',k
00176                  print *,'   => Numero : ',conn2(ind1+k-1)
00177                  print *,'   => Type   : ',indexf2(ind1+k-1)
00178  50           continue
00179               print *,'---- Nom                    ---- : ',nom(j)
00180               print *,'---- Numero                 ----:  ',num(j)
00181               print *,'---- Numero de famille      ---- : ',fam(j)
00182 
00183  20        continue
00184 
00185  10     continue
00186 
00187 
00188         call efferm (fid,cret)
00189         print *,cret
00190         if (cret .ne. 0 ) then
00191            print *,'Erreur fermeture du fichier'
00192            call efexit(-1)
00193         endif      
00194         print *,'Fermeture du fichier'
00195 
00196         end