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