1 C************************************************************************* 2 C COPYRIGHT (C) 1999 - 2007 EDF R&D, CEA/DEN 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 if (cret .ne. 0 ) then 52 print *,'Erreur ouverture du fichier' 53 call efexit(-1) 54 endif 55 print *,'Ouverture du fichier test25.med' 56 C 57 C Combien de maillage 58 call efnmaa(fid,nmaa,cret) 59 print *,cret 60 if (cret .ne. 0 ) then 61 print *,'Erreur lecture du nombre de maillage' 62 call efexit(-1) 63 endif 64 print *,'Nombre de maillages : ',nmaa 65 C 66 C Lecture de toutes les mailles MED_POLYEDRE 67 C dans chaque maillage 68 do 10 i=1,nmaa 69 C 70 C Info sur chaque maillage 71 call efmaai(fid,i,maa,mdim,type,desc,cret) 72 print *,cret 73 if (cret .ne. 0 ) then 74 print *,'Erreur infos maillage' 75 call efexit(-1) 76 endif 77 print *,'Maillage : ',maa 78 print *,'Dimension : ',mdim 79 C 80 C Combien de mailles polyedres 81 call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_POLYEDRE, 82 & MED_NOD,npoly,cret) 83 print *,cret 84 if (cret .ne. 0 ) then 85 print *,'Erreur lecture nombre de polyedre' 86 call efexit(-1) 87 endif 88 print *,'Nombre de mailles MED_POLYEDRE : ',npoly 89 C 90 C Taille des connectivites et du tableau d'indexation 91 call efpyei(fid,maa,MED_NOD,tmp,taille,cret) 92 print *,cret 93 if (cret .ne. 0 ) then 94 print *,'Erreur infos sur les polyedres' 95 call efexit(-1) 96 endif 97 print *,'Taille de la connectivite : ',taille 98 print *,'Taille du tableau indexf : ',tmp 99 C 100 C Lecture de la connectivite en mode nodal 101 call efpecl(fid,maa,indexp,npoly+1,indexf,tmp,conn, 102 & MED_NOD,cret) 103 print *,cret 104 if (cret .ne. 0 ) then 105 print *,'Erreur lecture connectivites polyedres' 106 call efexit(-1) 107 endif 108 print *,'Lecture de la connectivite des polyedres' 109 print *,'Connectivite nodale' 110 C 111 C Lecture de la connectivite en mode descendant 112 call efpecl(fid,maa,indexp2,npoly+1,indexf2,tmp,conn2, 113 & MED_DESC,cret) 114 print *,cret 115 if (cret .ne. 0 ) then 116 print *,'Erreur lecture connectivite des polyedres' 117 call efexit(-1) 118 endif 119 print *,'Lecture de la connectivite des polyedres' 120 print *,'Connectivite descendante' 121 C 122 C Lecture des noms 123 call efnoml(fid,maa,nom,npoly,MED_MAILLE,MED_POLYEDRE, 124 & cret) 125 print *,cret 126 if (cret .ne. 0 ) then 127 print *,'Erreur lecture noms des polyedres' 128 call efexit(-1) 129 endif 130 print *,'Lecture des noms' 131 C 132 C Lecture des numeros 133 call efnuml(fid,maa,num,npoly,MED_MAILLE,MED_POLYEDRE, 134 & cret) 135 print *,cret 136 if (cret .ne. 0 ) then 137 print *,'Erreur lecture des numeros des polyedres' 138 call efexit(-1) 139 endif 140 print *,'Lecture des numeros' 141 C 142 C Lecture des numeros de familles 143 call effaml(fid,maa,fam,npoly,MED_MAILLE,MED_POLYEDRE, 144 & cret) 145 print *,cret 146 if (cret .ne. 0 ) then 147 print *,'Erreur lecture numeros de famille polyedres' 148 call efexit(-1) 149 endif 150 print *,'Lecture des numeros de famille' 151 C 152 C Affichage des resultats 153 print *,'Affichage des resultats' 154 do 20 j=1,npoly 155 C 156 print *,'>> Maille polygone ',j 157 print *,'---- Connectivite nodale ---- : ' 158 nfaces = indexp(j+1) - indexp(j) 159 C ind1 = indice dans "indexf" pour acceder aux 160 C numeros des faces 161 ind1 = indexp(j) 162 do 30 k=1,nfaces 163 C ind2 = indice dans "conn" pour acceder au premier noeud 164 ind2 = indexf(ind1+k-1) 165 nnoeuds = indexf(ind1+k) - indexf(ind1+k-1) 166 print *,' - Face ',k 167 do 40 l=1,nnoeuds 168 print *,' ',conn(ind2+l-1) 169 40 continue 170 30 continue 171 print *,'---- Connectivite descendante ---- : ' 172 nfaces = indexp2(j+1) - indexp2(j) 173 C ind1 = indice dans "conn2" pour acceder aux faces 174 ind1 = indexp2(j) 175 do 50 k=1,nfaces 176 print *,' - Face ',k 177 print *,' => Numero : ',conn2(ind1+k-1) 178 print *,' => Type : ',indexf2(ind1+k-1) 179 50 continue 180 print *,'---- Nom ---- : ',nom(j) 181 print *,'---- Numero ----: ',num(j) 182 print *,'---- Numero de famille ---- : ',fam(j) 183 C 184 20 continue 185 C 186 10 continue 187 C 188 C Fermeture du fichier 189 call efferm (fid,cret) 190 print *,cret 191 if (cret .ne. 0 ) then 192 print *,'Erreur fermeture du fichier' 193 call efexit(-1) 194 endif 195 print *,'Fermeture du fichier' 196 C 197 end