1 C************************************************************************* 2 C COPYRIGHT (C) 1999 - 2003 EDF R&D 3 C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY 4 C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 5 C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 6 C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION. 7 C 8 C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT 9 C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF 10 C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU 11 C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS. 12 C 13 C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE 14 C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION, 15 C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA 16 C 17 C************************************************************************** 18 19 C ******************************************************************************* 20 C * - Nom du fichier : test26.f 21 C * 22 C * - Description : lecture de mailles MED_POLYEDRE dans le maillage MED 23 C * du fichier test25.med 24 C * 25 C ****************************************************************************** 26 program test26 27 C 28 implicit none 29 include 'med.hf' 30 C 31 integer cret,fid,mdim,nmaa,npoly,i,j,k,l 32 integer nfaces, nnoeuds 33 integer ind1, ind2 34 character*32 maa 35 character*200 desc 36 integer n 37 parameter (n=2) 38 integer np,nf,np2,nf2,taille,tmp 39 parameter (np=3,nf=9,np2=3,nf2=8) 40 integer indexp(np),indexf(nf) 41 integer conn(24) 42 integer indexp2(np2),indexf2(nf2) 43 integer conn2(nf2) 44 character*16 nom(n) 45 integer num(n),fam(n) 46 integer type 47 C 48 C Ouverture du fichier test25.med en lecture seule 49 call efouvr(fid,'test25.med',MED_LECTURE, cret) 50 print *,cret 51 print *,'Ouverture du fichier test25.med' 52 C 53 C Combien de maillage 54 if (cret .eq. 0) then 55 call efnmaa(fid,nmaa,cret) 56 print *,cret 57 print *,'Nombre de maillages : ',nmaa 58 endif 59 C 60 C Lecture de toutes les mailles MED_POLYEDRE 61 C dans chaque maillage 62 if (cret .eq. 0) then 63 do 10 i=1,nmaa 64 C 65 C Info sur chaque maillage 66 call efmaai(fid,i,maa,mdim,type,desc,cret) 67 print *,cret 68 print *,'Maillage : ',maa 69 print *,'Dimension : ',mdim 70 C 71 C Combien de mailles polyedres 72 if (cret .eq. 0) then 73 call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_POLYEDRE, 74 & MED_NOD,npoly,cret) 75 print *,cret 76 print *,'Nombre de mailles MED_POLYEDRE : ',npoly 77 endif 78 C 79 C Taille des connectivites et du tableau d'indexation 80 if (cret .eq. 0) then 81 call efpyei(fid,maa,MED_NOD,tmp,taille,cret) 82 print *,cret 83 print *,'Taille de la connectivite : ',taille 84 print *,'Taille du tableau indexf : ',tmp 85 endif 86 C 87 C Lecture de la connectivite en mode nodal 88 if (cret .eq. 0) then 89 call efpecl(fid,maa,indexp,npoly+1,indexf,tmp,conn, 90 & MED_NOD,cret) 91 print *,cret 92 print *,'Lecture de la connectivite des polyedres' 93 print *,'Connectivite nodale' 94 endif 95 C 96 C Lecture de la connectivite en mode descendant 97 if (cret .eq. 0) then 98 call efpecl(fid,maa,indexp2,npoly+1,indexf2,tmp,conn2, 99 & MED_DESC,cret) 100 print *,cret 101 print *,'Lecture de la connectivite des polyedres' 102 print *,'Connectivite descendante' 103 endif 104 C 105 C Lecture des noms 106 if (cret .eq. 0) then 107 call efnoml(fid,maa,nom,npoly,MED_MAILLE,MED_POLYEDRE, 108 & cret) 109 print *,cret 110 print *,'Lecture des noms' 111 endif 112 C 113 C Lecture des numeros 114 if (cret .eq. 0) then 115 call efnuml(fid,maa,num,npoly,MED_MAILLE,MED_POLYEDRE, 116 & cret) 117 print *,cret 118 print *,'Lecture des numeros' 119 endif 120 C 121 C Lecture des numeros de familles 122 if (cret .eq. 0) then 123 call effaml(fid,maa,fam,npoly,MED_MAILLE,MED_POLYEDRE, 124 & cret) 125 print *,cret 126 print *,'Lecture des numeros de famille' 127 endif 128 C 129 C Affichage des resultats 130 if (cret .eq. 0) then 131 print *,'Affichage des resultats' 132 do 20 j=1,npoly 133 C 134 print *,'>> Maille polygone ',j 135 print *,'---- Connectivite nodale ---- : ' 136 nfaces = indexp(j+1) - indexp(j) 137 C ind1 = indice dans "indexf" pour acceder aux 138 C numeros des faces 139 ind1 = indexp(j) 140 do 30 k=1,nfaces 141 C ind2 = indice dans "conn" pour acceder au premier noeud 142 ind2 = indexf(ind1+k-1) 143 nnoeuds = indexf(ind1+k) - indexf(ind1+k-1) 144 print *,' - Face ',k 145 do 40 l=1,nnoeuds 146 print *,' ',conn(ind2+l-1) 147 40 continue 148 30 continue 149 print *,'---- Connectivite descendante ---- : ' 150 nfaces = indexp2(j+1) - indexp2(j) 151 C ind1 = indice dans "conn2" pour acceder aux faces 152 ind1 = indexp2(j) 153 do 50 k=1,nfaces 154 print *,' - Face ',k 155 print *,' => Numero : ',conn2(ind1+k-1) 156 print *,' => Type : ',indexf2(ind1+k-1) 157 50 continue 158 print *,'---- Nom ---- : ',nom(j) 159 print *,'---- Numero ----: ',num(j) 160 print *,'---- Numero de famille ---- : ',fam(j) 161 C 162 20 continue 163 endif 164 C 165 10 continue 166 endif 167 C 168 C Fermeture du fichier 169 call efferm (fid,cret) 170 print *,cret 171 print *,'Fermeture du fichier' 172 end