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 : 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 test24 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 print *,'Ouverture du fichier test23.med' 46 C 47 C Lecture du nombre de maillages 48 if (cret .eq. 0) then 49 call efnmaa(fid,nmaa,cret) 50 print *,cret 51 print *,'Nombre de maillages : ',nmaa 52 endif 53 C 54 C Lecture de toutes les mailles MED_POLYGONE 55 C dans chaque maillage 56 if (cret .eq. 0) then 57 do 10 i=1,nmaa 58 C 59 C Info sur chaque maillage 60 call efmaai(fid,i,maa,mdim,type,desc,cret) 61 print *,cret 62 print *,'Maillage : ',maa 63 print *,'Dimension : ',mdim 64 C 65 C Combien de mailles polygones 66 if (cret .eq. 0) then 67 call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_POLYGONE, 68 & MED_NOD,npoly,cret) 69 print *,cret 70 print *,'Nombre de mailles MED_POLYGONE : ',npoly 71 endif 72 C 73 C Taille des connectivites 74 if (cret .eq. 0) then 75 call efpygi(fid,maa,MED_MAILLE,MED_NOD,taille,cret) 76 print *,cret 77 print *,'Taille de la connectivite : ',taille 78 endif 79 C 80 C Lecture de la connectivite 81 if (cret .eq. 0) then 82 call efpgcl(fid,maa,index,npoly+1,con,MED_MAILLE, 83 & MED_NOD,cret) 84 print *,cret 85 print *,'Lecture de la connectivite des polygones' 86 endif 87 C 88 C Lecture des noms 89 if (cret .eq. 0) then 90 call efnoml(fid,maa,nom,npoly,MED_MAILLE,MED_POLYGONE, 91 & cret) 92 print *,cret 93 print *,'Lecture des noms' 94 endif 95 C 96 C Lecture des numeros 97 if (cret .eq. 0) then 98 call efnuml(fid,maa,num,npoly,MED_MAILLE,MED_POLYGONE, 99 & cret) 100 print *,cret 101 print *,'Lecture des numeros' 102 endif 103 C 104 C Lecture des numeros de familles 105 if (cret .eq. 0) then 106 call effaml(fid,maa,fam,npoly,MED_MAILLE,MED_POLYGONE, 107 & cret) 108 print *,cret 109 print *,'Lecture des numeros de famille' 110 endif 111 C 112 C Affichage des resultats 113 if (cret .eq. 0) then 114 print *,'Affichage des resultats' 115 do 20 j=1,npoly 116 C 117 print *,'>> Maille polygone ',j 118 print *,'---- Connectivite ---- : ' 119 ind1 = index(j) 120 ind2 = index(j+1) 121 do 30 k=ind1,ind2-1 122 print *,con(k) 123 30 continue 124 print *,'---- Nom ---- : ',nom(j) 125 print *,'---- Numero ----: ',num(j) 126 print *,'---- Numero de famille ---- : ',fam(j) 127 C 128 20 continue 129 endif 130 C 131 10 continue 132 endif 133 C 134 C Fermeture du fichier 135 call efferm (fid,cret) 136 print *,cret 137 print *,'Fermeture du fichier' 138 end