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 : test24.f 21 C * 22 C * - Description : lecture de mailles MED_POLYGONE dans le maillage MED 23 C * du fichier test23.med 24 C * 25 C ****************************************************************************** 26 program test23 27 C 28 implicit none 29 include 'med.hf' 30 C 31 integer cret, fid,mdim,nmaa,npoly,i,j,k,taille 32 character*32 maa 33 character*200 desc 34 integer ni, n 35 parameter (ni=4, n=3) 36 integer index(ni),ind1,ind2 37 character*16 nom(n) 38 integer num(n),fam(n) 39 integer con(16) 40 integer type 41 C 42 C Ouverture du fichier test23.med en lecture seule 43 call efouvr(fid,'test23.med',MED_LECTURE, cret) 44 print *,cret 45 if (cret .ne. 0 ) then 46 print *,'Erreur ouverture du fichier' 47 call efexit(-1) 48 endif 49 print *,'Ouverture du fichier test23.med' 50 C 51 C Lecture du nombre de maillages 52 call efnmaa(fid,nmaa,cret) 53 print *,cret 54 if (cret .ne. 0 ) then 55 print *,'Erreur lecture nombre de maillage' 56 call efexit(-1) 57 endif 58 print *,'Nombre de maillages : ',nmaa 59 C 60 C Lecture de toutes les mailles MED_POLYGONE 61 C dans chaque maillage 62 do 10 i=1,nmaa 63 C 64 C Info sur chaque maillage 65 call efmaai(fid,i,maa,mdim,type,desc,cret) 66 if (cret .ne. 0 ) then 67 print *,'Erreur lecture infos maillage' 68 call efexit(-1) 69 endif 70 print *,cret 71 print *,'Maillage : ',maa 72 print *,'Dimension : ',mdim 73 C 74 C Combien de mailles polygones 75 call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_POLYGONE, 76 & MED_NOD,npoly,cret) 77 print *,cret 78 if (cret .ne. 0 ) then 79 print *,'Erreur lecture du nombre de polygone' 80 call efexit(-1) 81 endif 82 print *,'Nombre de mailles MED_POLYGONE : ',npoly 83 C 84 C Taille des connectivites 85 call efpygi(fid,maa,MED_MAILLE,MED_NOD,taille,cret) 86 print *,cret 87 if (cret .ne. 0 ) then 88 print *,'Erreur lecture infos polygones' 89 call efexit(-1) 90 endif 91 print *,'Taille de la connectivite : ',taille 92 C 93 C Lecture de la connectivite 94 call efpgcl(fid,maa,index,npoly+1,con,MED_MAILLE, 95 & MED_NOD,cret) 96 print *,cret 97 if (cret .ne. 0 ) then 98 print *,'Erreur lecture des connectivites polygones' 99 call efexit(-1) 100 endif 101 print *,'Lecture de la connectivite des polygones' 102 C 103 C Lecture des noms 104 call efnoml(fid,maa,nom,npoly,MED_MAILLE,MED_POLYGONE, 105 & cret) 106 print *,cret 107 if (cret .ne. 0 ) then 108 print *,'Erreur lecture des noms des polygones' 109 call efexit(-1) 110 endif 111 print *,'Lecture des noms' 112 C 113 C Lecture des numeros 114 call efnuml(fid,maa,num,npoly,MED_MAILLE,MED_POLYGONE, 115 & cret) 116 print *,cret 117 if (cret .ne. 0 ) then 118 print *,'Erreur lecture des numeros des polygones' 119 call efexit(-1) 120 endif 121 print *,'Lecture des numeros' 122 C 123 C Lecture des numeros de familles 124 call effaml(fid,maa,fam,npoly,MED_MAILLE,MED_POLYGONE, 125 & cret) 126 print *,cret 127 if (cret .ne. 0 ) then 128 print *,'Erreur lecture des numeros de famille des 129 & polygones' 130 call efexit(-1) 131 endif 132 print *,'Lecture des numeros de famille' 133 C 134 C Affichage des resultats 135 print *,'Affichage des resultats' 136 do 20 j=1,npoly 137 C 138 print *,'>> Maille polygone ',j 139 print *,'---- Connectivite ---- : ' 140 ind1 = index(j) 141 ind2 = index(j+1) 142 do 30 k=ind1,ind2-1 143 print *,con(k) 144 30 continue 145 print *,'---- Nom ---- : ',nom(j) 146 print *,'---- Numero ----: ',num(j) 147 print *,'---- Numero de famille ---- : ',fam(j) 148 C 149 20 continue 150 C 151 10 continue 152 C 153 C Fermeture du fichier 154 call efferm (fid,cret) 155 print *,cret 156 if (cret .ne. 0 ) then 157 print *,'Erreur fermeture du fichier' 158 call efexit(-1) 159 endif 160 print *,'Fermeture du fichier' 161 C 162 end