1C* This file is part of MED. 2C* 3C* COPYRIGHT (C) 1999 - 2019 EDF R&D, CEA/DEN 4C* MED is free software: you can redistribute it and/or modify 5C* it under the terms of the GNU Lesser General Public License as published by 6C* the Free Software Foundation, either version 3 of the License, or 7C* (at your option) any later version. 8C* 9C* MED is distributed in the hope that it will be useful, 10C* but WITHOUT ANY WARRANTY; without even the implied warranty of 11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12C* GNU Lesser General Public License for more details. 13C* 14C* You should have received a copy of the GNU Lesser General Public License 15C* along with MED. If not, see <http://www.gnu.org/licenses/>. 16C* 17 18C ******************************************************************************* 19C * - Nom du fichier : test24.f 20C * 21C * - Description : lecture de mailles MED_POLYGONE dans le maillage MED 22C * du fichier test23.med 23C * 24C ****************************************************************************** 25 program test23 26C 27 implicit none 28 include 'med.hf' 29C 30 integer*8 fid 31 integer cret,mdim,nmaa,npoly,i,j,k,taille 32 integer edim,nstep,stype,atype, chgt, tsf 33 character*64 maa 34 character*200 desc 35 integer ni, n, isize; 36 parameter (ni=4, n=3) 37 integer index(ni),ind1,ind2 38 character*16 nom(n) 39 integer num(n),fam(n) 40 integer con(16) 41 integer type 42 character*16 nomcoo(2) 43 character*16 unicoo(2) 44 character(16) :: dtunit 45C 46C Ouverture du fichier test23.med en lecture seule 47 call mfiope(fid,'test23.med',MED_ACC_RDONLY, cret) 48 print *,cret 49 if (cret .ne. 0 ) then 50 print *,'Erreur ouverture du fichier' 51 call efexit(-1) 52 endif 53 print *,'Ouverture du fichier test23.med' 54C 55C Lecture du nombre de maillages 56 call mmhnmh(fid,nmaa,cret) 57 print *,cret 58 if (cret .ne. 0 ) then 59 print *,'Erreur lecture nombre de maillage' 60 call efexit(-1) 61 endif 62 print *,'Nombre de maillages : ',nmaa 63C 64C Lecture de toutes les mailles MED_POLYGONE 65C dans chaque maillage 66 do 10 i=1,nmaa 67C 68C Info sur chaque maillage 69 call mmhmii(fid,i,maa,edim,mdim,type,desc, 70 & dtunit,stype,nstep,atype, 71 & nomcoo,unicoo,cret) 72 if (cret .ne. 0 ) then 73 print *,'Erreur lecture infos maillage' 74 call efexit(-1) 75 endif 76 print *,cret 77 print *,'Maillage : ',maa 78 print *,'Dimension : ',mdim 79C 80C Combien de mailles polygones 81 call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON, 82 & MED_INDEX_NODE,MED_NODAL,chgt,tsf,isize,cret) 83 npoly = isize - 1; 84 print *,cret 85 if (cret .ne. 0 ) then 86 print *,'Erreur lecture du nombre de polygone' 87 call efexit(-1) 88 endif 89 print *,'Nombre de mailles MED_POLYGONE : ',npoly 90C 91C Taille des connectivites 92 call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON, 93 & MED_CONNECTIVITY,MED_NODAL,chgt,tsf,taille,cret) 94 print *,cret 95 if (cret .ne. 0 ) then 96 print *,'Erreur lecture infos polygones' 97 call efexit(-1) 98 endif 99 print *,'Taille de la connectivite : ',taille 100C 101C Lecture de la connectivite 102 call mmhpgr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL, 103 & MED_NODAL,index,con,cret) 104 print *,cret 105 if (cret .ne. 0 ) then 106 print *,'Erreur lecture des connectivites polygones' 107 call efexit(-1) 108 endif 109 print *,'Lecture de la connectivite des polygones' 110C 111C Lecture des noms 112 call mmhear(fid,maa,MED_NO_DT,MED_NO_IT, 113 & MED_CELL,MED_POLYGON,nom,cret) 114 print *,cret 115 if (cret .ne. 0 ) then 116 print *,'Erreur lecture des noms des polygones' 117 call efexit(-1) 118 endif 119 print *,'Lecture des noms' 120C 121C Lecture des numeros 122 call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON, 123 & num,cret) 124 print *,cret 125 if (cret .ne. 0 ) then 126 print *,'Erreur lecture des numeros des polygones' 127 call efexit(-1) 128 endif 129 print *,'Lecture des numeros' 130C 131C Lecture des numeros de familles 132 call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON, 133 & fam,cret) 134 print *,cret 135 if (cret .ne. 0 ) then 136 print *,'Erreur lecture des numeros de famille des 137 & polygones' 138 call efexit(-1) 139 endif 140 print *,'Lecture des numeros de famille' 141C 142C Affichage des resultats 143 print *,'Affichage des resultats' 144 do 20 j=1,npoly 145C 146 print *,'>> Maille polygone ',j 147 print *,'---- Connectivite ---- : ' 148 ind1 = index(j) 149 ind2 = index(j+1) 150 do 30 k=ind1,ind2-1 151 print *,con(k) 152 30 continue 153c print *,'---- Nom ---- : ',nom(j) 154 print *,'---- Numero ----: ',num(j) 155 print *,'---- Numero de famille ---- : ',fam(j) 156C 157 20 continue 158C 159 10 continue 160C 161C Fermeture du fichier 162 call mficlo(fid,cret) 163 print *,cret 164 if (cret .ne. 0 ) then 165 print *,'Erreur fermeture du fichier' 166 call efexit(-1) 167 endif 168 print *,'Fermeture du fichier' 169C 170 end 171